diff --git a/IMPLS.yml b/IMPLS.yml index 17e38a53eb..ec96e2b3a5 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -30,6 +30,8 @@ IMPL: - {IMPL: fennel} - {IMPL: forth} - {IMPL: fsharp} + - {IMPL: gleam, gleam_MODE: erlang} + - {IMPL: gleam, gleam_MODE: js, NO_PERF: 1, NO_SELF_HOST_PERF: 1} # stack overflow - {IMPL: go} - {IMPL: groovy} - {IMPL: gnu-smalltalk} diff --git a/Makefile.impls b/Makefile.impls index 2c3517d7ff..e6a24164ba 100644 --- a/Makefile.impls +++ b/Makefile.impls @@ -33,7 +33,7 @@ wasm_MODE = wasmtime # IMPLS = ada ada.2 awk bash basic bbc-basic c c.2 chuck clojure coffee common-lisp cpp crystal cs d dart \ - elisp elixir elm erlang es6 factor fantom fennel forth fsharp go groovy gnu-smalltalk \ + elisp elixir elm erlang es6 factor fantom fennel forth fsharp gleam go groovy gnu-smalltalk \ guile hare haskell haxe hy io janet java java-truffle js jq julia kotlin latex3 livescript logo lua make mal \ matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \ plsql powershell prolog ps purs python2 python3 r racket rexx rpython ruby ruby.2 rust scala scheme skew sml \ @@ -51,6 +51,7 @@ step5_EXCLUDES += powershell # too slow for 10,000 step5_EXCLUDES += prolog # no iteration (but interpreter does TCO implicitly) step5_EXCLUDES += sml # not implemented :( step5_EXCLUDES += $(if $(filter cpp,$(haxe_MODE)),haxe,) # cpp finishes 10,000, segfaults at 100,000 +step5_EXCLUDES += $(if $(filter js,$(gleam_MODE)),gleam,) step5_EXCLUDES += xslt # iteration cannot be expressed step5_EXCLUDES += vbs # too slow for 10,000 @@ -133,6 +134,7 @@ fantom_STEP_TO_PROG = impls/fantom/lib/fan/$($(1)).pod fennel_STEP_TO_PROG = impls/fennel/$($(1)).fnl forth_STEP_TO_PROG = impls/forth/$($(1)).fs fsharp_STEP_TO_PROG = impls/fsharp/$($(1)).exe +gleam_STEP_TO_PROG = impls/gleam/$($(1)) go_STEP_TO_PROG = impls/go/$($(1)) groovy_STEP_TO_PROG = impls/groovy/$($(1)).groovy gnu-smalltalk_STEP_TO_PROG = impls/gnu-smalltalk/$($(1)).st diff --git a/README.md b/README.md index 3dca01ab2d..125e6f59ca 100644 --- a/README.md +++ b/README.md @@ -73,6 +73,7 @@ FAQ](docs/FAQ.md) where I attempt to answer some common questions. | [Fantom](#fantom) | [Dov Murik](https://github.com/dubek) | | [Fennel](#fennel) | [sogaiu](https://github.com/sogaiu) | | [Forth](#forth) | [Chris Houser](https://github.com/chouser) | +| [Gleam](#gleam) | [Dondorio](https://github.com/Dondorio) | | [GNU Guile](#gnu-guile-21) | [Mu Lei](https://github.com/NalaGinrut) | | [GNU Smalltalk](#gnu-smalltalk) | [Vasilij Schneidermann](https://github.com/wasamasa) | | [Go](#go) | [Joel Martin](https://github.com/kanaka) | @@ -531,6 +532,15 @@ cd impls/forth gforth stepX_YYY.fs ``` +### Gleam + +The Gleam implementation of mal has been tested with Gleam 1.17.0 + +``` +cd impls/gleam +./run +``` + ### GNU Guile 2.1+ ``` diff --git a/impls/gleam/.gitignore b/impls/gleam/.gitignore new file mode 100644 index 0000000000..f18ca5d5f1 --- /dev/null +++ b/impls/gleam/.gitignore @@ -0,0 +1,5 @@ +*.beam +*.ez +/build +/node_modules +erl_crash.dump diff --git a/impls/gleam/Dockerfile b/impls/gleam/Dockerfile new file mode 100644 index 0000000000..12a326cac4 --- /dev/null +++ b/impls/gleam/Dockerfile @@ -0,0 +1,26 @@ +FROM alpine:3.24.1 +MAINTAINER Dondorio +LABEL org.opencontainers.image.source=https://github.com/kanaka/mal +LABEL org.opencontainers.image.description="mal test container: gleam" + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +# Required for running tests +RUN apk add --no-cache make python3 bash +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apk add --no-cache gleam erlang28 rebar3 nodejs npm +RUN mkdir -p /.cache +RUN chmod -R 777 /.cache +RUN mkdir -p /.npm +RUN chmod -R 777 /.npm diff --git a/impls/gleam/Makefile b/impls/gleam/Makefile new file mode 100644 index 0000000000..276ba0b0b8 --- /dev/null +++ b/impls/gleam/Makefile @@ -0,0 +1,24 @@ +STEPS = \ +step0_repl \ +step1_read_print \ +step2_eval \ +step3_env \ +step4_if_fn_do \ +step5_tco \ +step6_file \ +step7_quote \ +step8_macros \ +step9_try \ +stepA_mal + +gleam_MODE ?= erlang + +$(STEPS): +ifneq ($(filter $(gleam_MODE), javascript js), ) + npm install +endif + gleam build --target $(gleam_MODE) + +clean: + gleam clean + rm -rf node_modules diff --git a/impls/gleam/gleam.toml b/impls/gleam/gleam.toml new file mode 100644 index 0000000000..66594746ce --- /dev/null +++ b/impls/gleam/gleam.toml @@ -0,0 +1,12 @@ +name = "mal" +version = "1.0.0" + +[dependencies] +gleam_stdlib = ">= 0.44.0 and < 2.0.0" +argv = ">= 1.0.2 and < 2.0.0" +input = ">= 1.0.1 and < 2.0.0" +gleam_regexp = ">= 1.1.1 and < 2.0.0" +gleam_erlang = ">= 1.3.0 and < 2.0.0" +gleam_otp = ">= 1.2.0 and < 2.0.0" +simplifile = ">= 2.4.0 and < 3.0.0" +gleam_time = ">= 1.8.0 and < 2.0.0" diff --git a/impls/gleam/manifest.toml b/impls/gleam/manifest.toml new file mode 100644 index 0000000000..8ad918caa6 --- /dev/null +++ b/impls/gleam/manifest.toml @@ -0,0 +1,24 @@ +# This file was generated by Gleam +# You typically do not need to edit this file + +packages = [ + { name = "argv", version = "1.0.2", build_tools = ["gleam"], requirements = [], otp_app = "argv", source = "hex", outer_checksum = "BA1FF0929525DEBA1CE67256E5ADF77A7CDDFE729E3E3F57A5BDCAA031DED09D" }, + { name = "filepath", version = "1.1.2", build_tools = ["gleam"], requirements = ["gleam_stdlib"], otp_app = "filepath", source = "hex", outer_checksum = "B06A9AF0BF10E51401D64B98E4B627F1D2E48C154967DA7AF4D0914780A6D40A" }, + { name = "gleam_erlang", version = "1.3.0", build_tools = ["gleam"], requirements = ["gleam_stdlib"], otp_app = "gleam_erlang", source = "hex", outer_checksum = "1124AD3AA21143E5AF0FC5CF3D9529F6DB8CA03E43A55711B60B6B7B3874375C" }, + { name = "gleam_otp", version = "1.2.0", build_tools = ["gleam"], requirements = ["gleam_erlang", "gleam_stdlib"], otp_app = "gleam_otp", source = "hex", outer_checksum = "BA6A294E295E428EC1562DC1C11EA7530DCB981E8359134BEABC8493B7B2258E" }, + { name = "gleam_regexp", version = "1.1.1", build_tools = ["gleam"], requirements = ["gleam_stdlib"], otp_app = "gleam_regexp", source = "hex", outer_checksum = "9C215C6CA84A5B35BB934A9B61A9A306EC743153BE2B0425A0D032E477B062A9" }, + { name = "gleam_stdlib", version = "0.65.0", build_tools = ["gleam"], requirements = [], otp_app = "gleam_stdlib", source = "hex", outer_checksum = "7C69C71D8C493AE11A5184828A77110EB05A7786EBF8B25B36A72F879C3EE107" }, + { name = "gleam_time", version = "1.8.0", build_tools = ["gleam"], requirements = ["gleam_stdlib"], otp_app = "gleam_time", source = "hex", outer_checksum = "533D8723774D61AD4998324F5DD1DABDCDBFABAFB9E87CB5D03C6955448FC97D" }, + { name = "input", version = "1.0.1", build_tools = ["gleam"], requirements = [], otp_app = "input", source = "hex", outer_checksum = "FE84CDADC78A1367E4AFD561A529825A8FEC88D165CBDF511FD3226CABCDEE6F" }, + { name = "simplifile", version = "2.4.0", build_tools = ["gleam"], requirements = ["filepath", "gleam_stdlib"], otp_app = "simplifile", source = "hex", outer_checksum = "7C18AFA4FED0B4CE1FA5B0B4BAC1FA1744427054EA993565F6F3F82E5453170D" }, +] + +[requirements] +argv = { version = ">= 1.0.2 and < 2.0.0" } +gleam_erlang = { version = ">= 1.3.0 and < 2.0.0" } +gleam_otp = { version = ">= 1.2.0 and < 2.0.0" } +gleam_regexp = { version = ">= 1.1.1 and < 2.0.0" } +gleam_stdlib = { version = ">= 0.44.0 and < 2.0.0" } +gleam_time = { version = ">= 1.8.0 and < 2.0.0" } +input = { version = ">= 1.0.1 and < 2.0.0" } +simplifile = { version = ">= 2.4.0 and < 3.0.0" } diff --git a/impls/gleam/package-lock.json b/impls/gleam/package-lock.json new file mode 100644 index 0000000000..5121d0aaba --- /dev/null +++ b/impls/gleam/package-lock.json @@ -0,0 +1,21 @@ +{ + "name": "gleam", + "lockfileVersion": 3, + "requires": true, + "packages": { + "": { + "dependencies": { + "readline-sync": "^1.4.10" + } + }, + "node_modules/readline-sync": { + "version": "1.4.10", + "resolved": "https://registry.npmjs.org/readline-sync/-/readline-sync-1.4.10.tgz", + "integrity": "sha512-gNva8/6UAe8QYepIQH/jQ2qn91Qj0B9sYjMBBs3QOB8F2CXcKgLxQaJRP76sWVRQt+QU+8fAkCbCvjjMFu7Ycw==", + "license": "MIT", + "engines": { + "node": ">= 0.8.0" + } + } + } +} diff --git a/impls/gleam/package.json b/impls/gleam/package.json new file mode 100644 index 0000000000..65adf18429 --- /dev/null +++ b/impls/gleam/package.json @@ -0,0 +1,5 @@ +{ + "dependencies": { + "readline-sync": "^1.4.10" + } +} diff --git a/impls/gleam/run b/impls/gleam/run new file mode 100755 index 0000000000..0133764a29 --- /dev/null +++ b/impls/gleam/run @@ -0,0 +1,9 @@ +#!/usr/bin/env bash + +# Gleam does not let you have uppercase letters in module(file) names +if [ "$STEP" == "stepA_mal" ]; then + STEP=stepa_mal +fi + +cd $(dirname $0) +exec gleam run --module ${STEP:-stepa_mal} --no-print-progress --target ${gleam_MODE:-erlang} -- "${@}" diff --git a/impls/gleam/src/core.gleam b/impls/gleam/src/core.gleam new file mode 100644 index 0000000000..cdf8624558 --- /dev/null +++ b/impls/gleam/src/core.gleam @@ -0,0 +1,516 @@ +import argv +import gleam/dict +import gleam/float +import gleam/io +import gleam/list +import gleam/option.{type Option, None, Some} +import gleam/result +import gleam/string +import gleam/time/timestamp +import mut_cell +import printer +import reader +import readline +import simplifile +import types.{ + type Error, type MalType, Atom, Bool, Func, HashMap, Int, Keyword, List, + StrErr, String, Symbol, Vector, func, +} + +fn bool(b) { + Ok(Bool(b)) +} + +fn f(name: String, fun) { + #(name, func(fun)) +} + +fn int_op(name, with: fn(Int, Int) -> Result(MalType, Error)) { + #( + name, + func(fn(l: List(MalType)) { + case l { + [a, b] -> { + case a, b { + Int(x), Int(y) -> with(x, y) |> result.map(fn(z) { z }) + _, _ -> types.wrong_type_err("int, int", [a, b]) + } + } + _ -> Error(types.EvalWrongArgLen(2, list.length(l))) + } + }), + ) +} + +fn nth(list: List(a), n: Int) -> Option(a) { + case n < 0 { + True -> None + False -> + case list { + [] -> None + [x, ..rest] -> + case n == 0 { + True -> Some(x) + False -> nth(rest, n - 1) + } + } + } +} + +fn do_str(args, print_readability) { + let join = case print_readability { + True -> " " + False -> "" + } + + Ok( + list.map(args, fn(x) { printer.pr_str(x, print_readability) }) + |> string.join(join) + |> String, + ) +} + +fn str(args) { + do_str(args, False) +} + +fn pr_str(args) { + do_str(args, True) +} + +fn time_ms(args) { + case args { + [] -> { + let time = + timestamp.system_time() + |> timestamp.to_unix_seconds() + + let int = float.truncate(time *. 1000.0) + + Ok(Int(int)) + } + _ -> types.wrong_type_err("", args) + } +} + +pub fn ns() { + [ + // Int + int_op("+", fn(a, b) { Ok(Int(a + b)) }), + int_op("-", fn(a, b) { Ok(Int(a - b)) }), + int_op("*", fn(a, b) { Ok(Int(a * b)) }), + int_op("/", fn(a, b) { + case b == 0 { + False -> Ok(Int(a / b)) + True -> Error(types.EvalDivideByZero) + } + }), + + // Bool + int_op(">", fn(a, b) { bool(a > b) }), + int_op(">=", fn(a, b) { bool(a >= b) }), + int_op("<", fn(a, b) { bool(a < b) }), + int_op("<=", fn(a, b) { bool(a <= b) }), + f("=", fn(args) { + case args { + [a, b, ..] -> bool(types.eq(a, b)) + _ -> bool(False) + } + }), + f("number?", fn(args) { + case args { + [Int(_)] -> bool(True) + [_] -> bool(False) + _ -> types.wrong_type_err("any", args) + } + }), + f("list?", fn(args) { + case args { + [List(..), ..] -> bool(True) + _ -> bool(False) + } + }), + f("vector?", fn(args) { + case args { + [Vector(..), ..] -> bool(True) + _ -> bool(False) + } + }), + f("sequential?", fn(args) { + case args { + [List(..), ..] | [Vector(..), ..] -> bool(True) + _ -> bool(False) + } + }), + f("empty?", fn(args) { + case args { + [List([], _)] | [Vector([], _)] -> bool(True) + [List(_, _)] | [Vector(_, _)] -> bool(False) + _ -> types.wrong_type_err("list | vector", args) + } + }), + f("atom?", fn(args) { + case args { + [Atom(_)] -> bool(True) + _ -> bool(False) + } + }), + f("fn?", fn(args) { + case args { + [Func(is_macro: False, ..)] -> bool(True) + [_] -> bool(False) + _ -> types.wrong_type_err("any", args) + } + }), + f("macro?", fn(args) { + case args { + [Func(is_macro: True, ..)] -> bool(True) + [_] -> bool(False) + _ -> types.wrong_type_err("any", args) + } + }), + f("string?", fn(args) { + case args { + [String(_)] -> bool(True) + [_] -> bool(False) + _ -> types.wrong_type_err("any", args) + } + }), + f("symbol?", fn(args) { + case args { + [Symbol(_)] -> bool(True) + [_] -> bool(False) + _ -> types.wrong_type_err("any", args) + } + }), + f("nil?", fn(args) { + case args { + [types.Nil] -> bool(True) + [_] -> bool(False) + _ -> types.wrong_type_err("any", args) + } + }), + f("true?", fn(args) { + case args { + [Bool(True)] -> bool(True) + [_] -> bool(False) + _ -> types.wrong_type_err("any", args) + } + }), + f("false?", fn(args) { + case args { + [Bool(False)] -> bool(True) + [_] -> bool(False) + _ -> types.wrong_type_err("any", args) + } + }), + f("keyword?", fn(args) { + case args { + [Keyword(_)] -> bool(True) + [_] -> bool(False) + _ -> types.wrong_type_err("any", args) + } + }), + f("map?", fn(args) { + case args { + [HashMap(..)] -> bool(True) + [_] -> bool(False) + _ -> types.wrong_type_err("any", args) + } + }), + + // String + f("pr-str", pr_str), + f("str", str), + + // Seq + f("count", fn(args) { + case args { + [List(l, _)] | [Vector(l, _)] -> Ok(Int(list.length(l))) + _ -> Ok(Int(0)) + } + }), + f("cons", fn(args) { + case args { + [head, List(tail, _)] | [head, Vector(tail, _)] -> + Ok(List([head, ..tail], types.Nil)) + _ -> types.wrong_type_err("any, list | vector", args) + } + }), + f("concat", fn(args) { + list.try_fold(args, [], fn(acc, x) { + case x { + List(l, _) | Vector(l, _) -> Ok(list.append(acc, l)) + _ -> types.wrong_type_err("...(list | vector)", args) + } + }) + |> result.map(fn(res) { List(res, types.Nil) }) + }), + f("conj", fn(args) { + case args { + [List(data, _), ..rest] -> + Ok(List(list.append(list.reverse(rest), data), types.Nil)) + [Vector(data, _), ..rest] -> + Ok(Vector(list.append(data, rest), types.Nil)) + _ -> types.wrong_type_err("any, list | vector", args) + } + }), + f("first", fn(args) { + case args { + [List([first, ..], _)] | [Vector([first, ..], _)] -> Ok(first) + [types.Nil] | [List(_, _)] | [Vector(_, _)] -> Ok(types.Nil) + _ -> types.wrong_type_err("list | vector", args) + } + }), + f("rest", fn(args) { + case args { + [List([_, ..rest], _)] | [Vector([_, ..rest], _)] -> + Ok(List(rest, types.Nil)) + [types.Nil] | [List(_, _)] | [Vector(_, _)] -> Ok(List([], types.Nil)) + _ -> types.wrong_type_err("list | vector", args) + } + }), + f("nth", fn(args) { + case args { + [List(data, _), Int(n)] | [Vector(data, _), Int(n)] -> + nth(data, n) + |> option.to_result(StrErr("index out of bounds")) + _ -> types.wrong_type_err("list | vector, int", args) + } + }), + f("map", fn(args) { + case args { + [Func(f, ..), List(data, _)] | [Func(f, ..), Vector(data, _)] -> + list.try_map(data, fn(x) { f([x]) }) + |> result.map(fn(res) { List(res, types.Nil) }) + _ -> types.wrong_type_err("list | vector, func", args) + } + }), + f("seq", fn(args) { + case args { + [List([], _)] | [Vector([], _)] | [String("")] | [types.Nil] -> + Ok(types.Nil) + [List(l, _)] | [Vector(l, _)] -> Ok(List(l, types.Nil)) + [String(str)] -> { + let chars = + string.to_graphemes(str) |> list.map(fn(char) { String(char) }) + + Ok(List(chars, types.Nil)) + } + _ -> types.wrong_type_err("list | vector | string | nil", args) + } + }), + + // HashMap + f("assoc", fn(args) { + case args { + [HashMap(hm, _), ..rest] -> { + types.assoc(rest) + |> result.map(fn(res) { HashMap(dict.merge(hm, res), types.Nil) }) + } + _ -> types.wrong_type_err("hashmap, ...any", args) + } + }), + f("dissoc", fn(args) { + case args { + [HashMap(hm, _), ..keys] -> { + Ok(HashMap(dict.drop(hm, keys), types.Nil)) + } + [types.Nil, String(_)] | [types.Nil, Keyword(_)] -> Ok(types.Nil) + _ -> types.wrong_type_err("hashmap, string | keyword", args) + } + }), + f("get", fn(args) { + case args { + [HashMap(hm, _), String(_) as key] + | [HashMap(hm, _), Keyword(_) as key] -> { + case dict.get(hm, key) { + Ok(ok) -> Ok(ok) + _ -> Ok(types.Nil) + } + } + [types.Nil, String(_)] | [types.Nil, Keyword(_)] -> Ok(types.Nil) + _ -> types.wrong_type_err("hashmap, string | keyword", args) + } + }), + f("contains?", fn(args) { + case args { + [HashMap(hm, _), String(_) as key] + | [HashMap(hm, _), Keyword(_) as key] -> { + case dict.has_key(hm, key) { + b -> bool(b) + } + } + _ -> types.wrong_type_err("hashmap, string | keyword", args) + } + }), + f("keys", fn(args) { + case args { + [HashMap(hm, _)] -> { + Ok(List(dict.keys(hm), types.Nil)) + } + _ -> types.wrong_type_err("hashmap", args) + } + }), + f("vals", fn(args) { + case args { + [HashMap(hm, _)] -> { + Ok(List(dict.values(hm), types.Nil)) + } + _ -> types.wrong_type_err("hashmap", args) + } + }), + + // IO + f("prn", fn(args) { + list.map(args, fn(x) { printer.pr_str(x, True) }) + |> string.join(" ") + |> io.println() + Ok(types.Nil) + }), + f("println", fn(args) { + list.map(args, fn(x) { printer.pr_str(x, False) }) + |> string.join(" ") + |> io.println() + Ok(types.Nil) + }), + f("slurp", fn(args) { + case args { + [String(path)] -> { + case simplifile.read(path) { + Ok(str) -> Ok(String(str)) + Error(err) -> + Error(StrErr("failed to open file: " <> string.inspect(err))) + } + } + _ -> types.wrong_type_err("string", args) + } + }), + f("readline", fn(args) { + case args { + [String(str)] -> { + case readline.readline(str) { + Ok(input) -> Ok(String(input)) + Error(_) -> Ok(types.Nil) + } + } + _ -> types.wrong_type_err("string", args) + } + }), + + // Declare + f("list", fn(args) { Ok(List(args, types.Nil)) }), + f("vector", fn(args) { Ok(Vector(args, types.Nil)) }), + f("vec", fn(args) { + case args { + [List(l, _)] | [Vector(l, _)] -> Ok(Vector(l, types.Nil)) + _ -> types.wrong_type_err("list | vector", args) + } + }), + f("atom", fn(args) { + case args { + [data] -> Ok(Atom(mut_cell.new(data))) + _ -> types.wrong_type_err("any", args) + } + }), + f("symbol", fn(args) { + case args { + [String(str)] -> Ok(Symbol(str)) + _ -> types.wrong_type_err("string", args) + } + }), + f("keyword", fn(args) { + case args { + [String(str)] | [Keyword(str)] -> Ok(Keyword(str)) + _ -> types.wrong_type_err("string | keyword", args) + } + }), + f("hash-map", fn(args) { types.hashmap(args) }), + + // Atom + f("deref", fn(args) { + case args { + [Atom(ref)] -> Ok(mut_cell.get(ref)) + _ -> types.wrong_type_err("atom", args) + } + }), + f("reset!", fn(args) { + case args { + [Atom(ref), data] -> { + mut_cell.set(ref, data) + Ok(data) + } + _ -> types.wrong_type_err("atom", args) + } + }), + f("swap!", fn(args) { + case args { + [Atom(ref), Func(f, ..), ..rest] -> + mut_cell.try_update(ref, fn(data) { f([data, ..rest]) }) + _ -> types.wrong_type_err("atom, func", args) + } + }), + + // Meta + f("meta", fn(args) { + case args { + [List(meta:, ..)] + | [Vector(meta:, ..)] + | [HashMap(meta:, ..)] + | [Func(meta:, ..)] -> Ok(meta) + _ -> types.wrong_type_err("list | vector | hashmap | func", args) + } + }), + f("with-meta", fn(args) { + case args { + [List(..) as l, meta] -> Ok(List(..l, meta:)) + [Vector(..) as l, meta] -> Ok(Vector(..l, meta:)) + [HashMap(..) as l, meta] -> Ok(HashMap(..l, meta:)) + [Func(..) as l, meta] -> Ok(Func(..l, meta: meta)) + _ -> types.wrong_type_err("list | vector | hashmap | func", args) + } + }), + + // Other + f("apply", fn(args) { + case args { + [Func(f, ..), ..rest] -> { + let middle = list.take(rest, list.length(rest) - 1) + + case list.last(rest) { + Ok(List(l, _)) | Ok(Vector(l, _)) -> { + let appended = list.append(middle, l) + f(appended) + } + _ -> types.wrong_type_err("func, ...any, list | vector", args) + } + } + _ -> types.wrong_type_err("func, ...any, list | vector", args) + } + }), + f("read-string", fn(args) { + case args { + [String(str)] -> reader.read_str(str) + _ -> types.wrong_type_err("string", args) + } + }), + f("throw", fn(args) { + case args { + [data] -> Error(types.Throw(data)) + _ -> types.wrong_type_err("any", args) + } + }), + f("time-ms", time_ms), + #( + "*ARGV*", + List( + argv.load().arguments + // Ignore file path arg + |> list.drop(1) + |> list.map(fn(arg) { String(arg) }), + types.Nil, + ), + ), + #("*host-language*", String("gleam")), + ] +} diff --git a/impls/gleam/src/env.gleam b/impls/gleam/src/env.gleam new file mode 100644 index 0000000000..75e0d3db30 --- /dev/null +++ b/impls/gleam/src/env.gleam @@ -0,0 +1,69 @@ +import gleam/dict.{type Dict} +import gleam/option.{type Option, None, Some} +import mut_cell.{type MutCell} +import types.{type Error, type MalType} + +pub opaque type Env { + Env(outer: Option(Env), data: MutCell(Dict(String, MalType))) +} + +pub fn new(outer, data) -> Env { + Env(outer, mut_cell.new(data)) +} + +pub fn get(env: Env, key: String) -> Option(MalType) { + let hm = mut_cell.get(env.data) + + case dict.get(hm, key) { + Error(_) -> { + case env.outer { + None -> None + Some(e) -> get(e, key) + } + } + Ok(data) -> Some(data) + } +} + +pub fn set(env: Env, key: String, val: MalType) { + mut_cell.update(env.data, fn(data) { + data + |> dict.insert(key, val) + }) +} + +pub fn bind(env: Env, from: List(String), to: List(MalType)) { + case from { + ["&", sym] -> Ok(set(env, sym, types.List(to, types.Nil))) + [sym, ..from_rest] -> + case to { + [t, ..rest] -> { + set(env, sym, t) + bind(env, from_rest, rest) + } + [] -> Error(types.StrErr("can't bind env: not enough args provided")) + } + [] if to == [] -> Ok(Nil) + _ -> Error(types.StrErr("can't bind env: too many args provided")) + } +} + +pub fn from_list(input: List(#(String, MalType)), outer: Option(Env)) -> Env { + let data = dict.from_list(input) + Env(outer, mut_cell.new(data)) +} + +pub fn from_dict(input: Dict(String, MalType), outer: Option(Env)) -> Env { + Env(outer, mut_cell.new(input)) +} + +pub fn into_outer(outer: Env) -> Env { + Env(Some(outer), mut_cell.new(dict.new())) +} + +pub fn try_key(ast: MalType) -> Result(String, Error) { + case ast { + types.Symbol(sym) -> Ok(sym) + _ -> Error(types.EnvToKey(ast)) + } +} diff --git a/impls/gleam/src/mal.gleam b/impls/gleam/src/mal.gleam new file mode 100644 index 0000000000..a50feabb2a --- /dev/null +++ b/impls/gleam/src/mal.gleam @@ -0,0 +1,5 @@ +import stepa_mal + +pub fn main() -> Nil { + stepa_mal.main() +} diff --git a/impls/gleam/src/mut_cell.gleam b/impls/gleam/src/mut_cell.gleam new file mode 100644 index 0000000000..2083e4db43 --- /dev/null +++ b/impls/gleam/src/mut_cell.gleam @@ -0,0 +1,87 @@ +@target(erlang) +import gleam/erlang/process.{type Subject} +@target(erlang) +import gleam/otp/actor +import gleam/result + +// ----- erlang ----- +@target(erlang) +pub type MutCell(a) = + actor.Started(process.Subject(Message(a))) + +@target(erlang) +pub type Message(a) { + Get(Subject(a)) + Set(a) + Update(fn(a) -> a) +} + +@target(erlang) +pub fn new(value: a) -> MutCell(a) { + let handle_message = fn(state: a, message: Message(a)) -> actor.Next( + a, + Message(a), + ) { + case message { + Get(reply) -> { + actor.send(reply, state) + actor.continue(state) + } + Set(i) -> { + actor.continue(i) + } + Update(f) -> { + actor.continue(f(state)) + } + } + } + + let assert Ok(actor) = + actor.new(value) + |> actor.on_message(handle_message) + |> actor.start + actor +} + +@target(erlang) +pub fn get(cell: MutCell(a)) -> a { + actor.call(cell.data, waiting: 10, sending: Get) +} + +@target(erlang) +pub fn set(cell: MutCell(a), new: a) -> Nil { + actor.send(cell.data, Set(new)) +} + +@target(erlang) +pub fn update(cell: MutCell(a), f: fn(a) -> a) -> Nil { + actor.send(cell.data, Update(f)) +} + +// ----- javascript ----- +@target(javascript) +pub type MutCell(a) + +@target(javascript) +@external(javascript, "./mut_cell_ffi.mjs", "new_cell") +pub fn new(value: a) -> MutCell(a) + +@target(javascript) +@external(javascript, "./mut_cell_ffi.mjs", "get") +pub fn get(cell: MutCell(a)) -> a + +@target(javascript) +@external(javascript, "./mut_cell_ffi.mjs", "set") +pub fn set(cell: MutCell(a), new: a) -> Nil + +@target(javascript) +@external(javascript, "./mut_cell_ffi.mjs", "update") +pub fn update(cell: MutCell(a), f: fn(a) -> a) -> Nil + +// ----- common ----- +pub fn try_update(cell: MutCell(a), f: fn(a) -> Result(a, e)) { + let data = get(cell) + use res <- result.try(f(data)) + set(cell, res) + Ok(res) +} diff --git a/impls/gleam/src/mut_cell_ffi.mjs b/impls/gleam/src/mut_cell_ffi.mjs new file mode 100644 index 0000000000..258c3d1930 --- /dev/null +++ b/impls/gleam/src/mut_cell_ffi.mjs @@ -0,0 +1,17 @@ +export function new_cell(value) { + return { value }; +} + +export function get(cell) { + return cell.value; +} + +export function set(cell, value) { + cell.value = value; + return undefined; +} + +export function update(cell, func) { + cell.value = func(cell.value); + return undefined; +} diff --git a/impls/gleam/src/printer.gleam b/impls/gleam/src/printer.gleam new file mode 100644 index 0000000000..bcfb8b9d31 --- /dev/null +++ b/impls/gleam/src/printer.gleam @@ -0,0 +1,110 @@ +import gleam/dict +import gleam/int +import gleam/list +import gleam/string +import mut_cell +import types.{Bool, HashMap, Int, Keyword, List, Nil, String, Symbol, Vector} + +pub fn pr_err(err: types.Error) -> String { + case err { + types.ReaderEof(expected) -> "expected '" <> expected <> "', found EOF" + types.ReaderInvalidHashMap -> "failed to construct hashmap" + types.ReaderEmpyForm -> "read_form called with empty list" + + types.EvalWrongArgLen(expected, got) -> + "expected " + <> int.to_string(expected) + <> " arguments, got " + <> int.to_string(got) + types.EvalWrongArgLenGreaterThan(expected, got) -> + "expected at least " + <> int.to_string(expected) + <> " arguments, got " + <> int.to_string(got) + types.EvalWrongArgLenRange(expected, got) -> + "expected " + <> int.to_string(expected.0) + <> " - " + <> int.to_string(expected.1) + <> " arguments, got " + <> int.to_string(got) + types.EvalLetPairOddCount(got) -> + "can't bind let values: odd number of items " + <> "(" + <> list.map(got, fn(x) { pr_str(x, True) }) + |> string.join(" ") + <> ")" + + types.EvalWrongType(expected, got) -> + "expected '" <> expected <> "', got '" <> got <> "'" + + types.Throw(exception) -> "thrown exception: " <> pr_str(exception, True) + + types.EvalDivideByZero -> "can't divide by zero" + types.EvalApplyType(x) -> "can't apply '" <> pr_str(x, True) <> "'" + types.EvalSymbolNotFound(sym) -> "'" <> sym <> "' not found" + types.EnvToKey(ast) -> "can't bind value to '" <> pr_str(ast, True) <> "'" + types.EvalFuncParamNotSymbol -> "function parameter not of type symbol" + types.StrErr(str) -> str + } +} + +fn escape_str(str, acc) { + case str { + "\n" <> rest -> escape_str(rest, acc <> "\\n") + "\"" <> rest -> escape_str(rest, acc <> "\\\"") + "\\" <> rest -> escape_str(rest, acc <> "\\\\") + "" -> acc + _ -> { + case string.pop_grapheme(str) { + Error(_) -> acc + Ok(#(g, rest)) -> escape_str(rest, acc <> g) + } + } + } +} + +pub fn pr_str(ast: types.MalType, print_readability: Bool) -> String { + case ast { + Nil -> "nil" + Int(int) -> int.to_string(int) + String(str) -> + case print_readability { + False -> str + True -> "\"" <> escape_str(str, "") <> "\"" + } + Symbol(sym) -> sym + Bool(bool) -> + case bool { + True -> "true" + False -> "false" + } + Keyword(kwd) -> ":" <> kwd + List(list, _) -> + "(" + <> list.map(list, fn(x) { pr_str(x, print_readability) }) + |> string.join(" ") + <> ")" + Vector(arr, _) -> + "[" + <> list.map(arr, fn(x) { pr_str(x, print_readability) }) + |> string.join(" ") + <> "]" + HashMap(hm, _) -> { + let d = + dict.fold(hm, [], fn(acc, key, val) { + [ + pr_str(key, print_readability), + pr_str(val, print_readability), + ..acc + ] + }) + |> string.join(" ") + + "{" <> d <> "}" + } + types.Func(..) -> "#" + types.Atom(ref) -> + "(atom " <> pr_str(mut_cell.get(ref), print_readability) <> ")" + } +} diff --git a/impls/gleam/src/reader.gleam b/impls/gleam/src/reader.gleam new file mode 100644 index 0000000000..860c60df02 --- /dev/null +++ b/impls/gleam/src/reader.gleam @@ -0,0 +1,153 @@ +import gleam/int +import gleam/list +import gleam/regexp +import gleam/result +import gleam/string +import types.{ + type Error, type MalType, Bool, Int, Keyword, List, ReaderEmpyForm, ReaderEof, + ReaderInvalidHashMap, String, Symbol, Vector, +} + +pub fn read_str(str: String) { + let res = + tokenize(str) + |> read_form() + + case res { + Error(err) -> Error(err) + Ok(ok) -> Ok(ok.0) + } +} + +fn tokenize(str: String) { + let assert Ok(re) = + regexp.from_string( + "[\\s,]*" + <> "(" + <> "~@" + <> "|[\\[\\]{}()'`~^@]" + <> "|\"(?:\\\\.|[^\"])*\"?" + <> "|;.*" + <> "|[^\\s\\[\\]{}('\"`,;)]*" + <> ")", + ) + + regexp.split(re, str) + |> list.filter(fn(x) { x != "" }) + |> list.filter(fn(x) { !string.starts_with(x, ";") }) +} + +fn read_form(x: List(String)) { + let expand = fn(rest: List(String), sym: String) { + use #(f, new_rest) <- result.try(read_form(rest)) + + let res = List([Symbol(sym), f], types.Nil) + Ok(#(res, new_rest)) + } + + case x { + ["(", ..rest] -> read_seq(rest, [], ")") + ["[", ..rest] -> read_seq(rest, [], "]") + ["{", ..rest] -> read_seq(rest, [], "}") + ["'", ..rest] -> expand(rest, "quote") + ["`", ..rest] -> expand(rest, "quasiquote") + ["~", ..rest] -> expand(rest, "unquote") + ["~@", ..rest] -> expand(rest, "splice-unquote") + ["@", ..rest] -> expand(rest, "deref") + + ["^", ..rest] -> { + use #(meta, r) <- result.try(read_form(rest)) + use #(data, new_rest) <- result.try(read_form(r)) + + let res = List([Symbol("with-meta"), data, meta], types.Nil) + Ok(#(res, new_rest)) + } + + [a, ..rest] -> { + let res = read_atom(a) + + case res { + Ok(o) -> Ok(#(o, rest)) + Error(e) -> Error(e) + } + } + _ -> Error(ReaderEmpyForm) + } +} + +fn read_seq(input: List(String), acc: List(MalType), closing: String) { + case input { + [] -> Error(ReaderEof(closing)) + [x, ..rest] if x == closing -> { + case closing { + ")" -> Ok(#(List(acc, types.Nil), rest)) + "]" -> Ok(#(Vector(acc, types.Nil), rest)) + "}" -> { + case types.hashmap(acc) { + Ok(res) -> Ok(#(res, rest)) + _ -> Error(ReaderInvalidHashMap) + } + } + _ -> panic as "read_seq called with unknown closing symbol" + } + } + _ -> { + use #(atom, rest) <- result.try(read_form(input)) + read_seq(rest, list.append(acc, [atom]), closing) + } + } +} + +fn use_parse_int(input: String, with: fn(Nil) -> Result(MalType, Error)) { + let res = int.parse(input) + case res { + Error(_) -> with(Nil) + Ok(int) -> Ok(Int(int)) + } +} + +fn unescape_str(str, acc) { + case str { + "\\n" <> rest -> unescape_str(rest, acc <> "\n") + "\\\"" <> rest -> unescape_str(rest, acc <> "\"") + "\\\\" <> rest -> unescape_str(rest, acc <> "\\") + "" -> acc + _ -> { + case string.pop_grapheme(str) { + Error(_) -> acc + Ok(#(g, rest)) -> unescape_str(rest, acc <> g) + } + } + } +} + +fn use_parse_str(input: String, with: fn(Nil) -> Result(MalType, Error)) { + let assert Ok(str_re) = regexp.from_string("\"(?:\\\\.|[^\\\\\"])*\"") + let is_string = regexp.check(str_re, input) + + case is_string { + False -> with(Nil) + True -> + Ok(String( + input |> string.drop_end(1) |> string.drop_start(1) |> unescape_str(""), + )) + } +} + +fn read_atom(input: String) -> Result(MalType, Error) { + case input { + "nil" -> Ok(types.Nil) + "true" -> Ok(Bool(True)) + "false" -> Ok(Bool(False)) + _ -> { + use _ <- use_parse_int(input) + use _ <- use_parse_str(input) + + case input { + ":" <> rest -> Ok(Keyword(rest)) + "\"" <> _ -> Error(ReaderEof("\"")) + _ -> Ok(Symbol(input)) + } + } + } +} diff --git a/impls/gleam/src/readline.gleam b/impls/gleam/src/readline.gleam new file mode 100644 index 0000000000..1bf871c7b7 --- /dev/null +++ b/impls/gleam/src/readline.gleam @@ -0,0 +1,6 @@ +import input.{input} + +@external(javascript, "./readline_ffi.mjs", "readline_func") +pub fn readline(prn: String) -> Result(String, Nil) { + input(prn) +} diff --git a/impls/gleam/src/readline_ffi.mjs b/impls/gleam/src/readline_ffi.mjs new file mode 100644 index 0000000000..02bcfa1fbd --- /dev/null +++ b/impls/gleam/src/readline_ffi.mjs @@ -0,0 +1,10 @@ +import { Ok } from "./gleam.mjs"; +import readlineSync from "readline-sync"; + +export function readline_func(prn) { + const input = readlineSync.question(prn, { + history: true, + }); + + return new Ok(input); +} diff --git a/impls/gleam/src/step0_repl.gleam b/impls/gleam/src/step0_repl.gleam new file mode 100644 index 0000000000..3aebcfb016 --- /dev/null +++ b/impls/gleam/src/step0_repl.gleam @@ -0,0 +1,33 @@ +import gleam/io +import gleam/result +import readline.{readline} + +pub fn main() -> Nil { + let _ = loop() + Nil +} + +fn loop() { + use input <- result.try(readline("user> ")) + + let _res = input |> rep() + + loop() +} + +fn read(str) { + str +} + +fn eval(ast) { + ast +} + +fn print(ast) { + io.println(ast) + ast +} + +fn rep(str) { + read(str) |> eval() |> print() +} diff --git a/impls/gleam/src/step1_read_print.gleam b/impls/gleam/src/step1_read_print.gleam new file mode 100644 index 0000000000..5fe8362fb3 --- /dev/null +++ b/impls/gleam/src/step1_read_print.gleam @@ -0,0 +1,45 @@ +import gleam/io +import gleam/result +import printer +import reader +import readline.{readline} + +pub fn main() -> Nil { + let _ = loop() + Nil +} + +fn loop() { + use input <- result.try(readline("user> ")) + + let prn = + input + |> rep() + case prn { + Error(err) -> printer.pr_err(err) |> io.println_error() + Ok(str) -> io.println(str) + } + + loop() +} + +fn read(str) { + reader.read_str(str) +} + +fn eval(ast) { + ast +} + +fn print(ast) { + printer.pr_str(ast, True) +} + +fn rep(str) { + use re <- result.try( + read(str) + |> eval(), + ) + + Ok(print(re)) +} diff --git a/impls/gleam/src/step2_eval.gleam b/impls/gleam/src/step2_eval.gleam new file mode 100644 index 0000000000..d53fda6234 --- /dev/null +++ b/impls/gleam/src/step2_eval.gleam @@ -0,0 +1,116 @@ +import gleam/dict +import gleam/io +import gleam/list +import gleam/result +import printer +import reader +import readline.{readline} +import types.{ + type MalRet, type MalType, Func, HashMap, Int, List, Symbol, Vector, +} + +pub fn main() -> Nil { + let int_op = fn(with: fn(Int, Int) -> Result(Int, types.Error)) { + types.func(fn(l: List(MalType)) { + case l { + [a, b] -> { + case a, b { + Int(x), Int(y) -> with(x, y) |> result.map(fn(z) { Int(z) }) + _, _ -> types.wrong_type_err("int, int", [a, b]) + } + } + _ -> Error(types.EvalWrongArgLen(2, list.length(l))) + } + }) + } + let env = + [ + #("+", int_op(fn(a, b) { Ok(a + b) })), + #("-", int_op(fn(a, b) { Ok(a - b) })), + #("*", int_op(fn(a, b) { Ok(a * b) })), + #( + "/", + int_op(fn(a, b) { + case b == 0 { + False -> Ok(a / b) + True -> Error(types.EvalDivideByZero) + } + }), + ), + ] + |> dict.from_list() + + let _ = loop(env) + + Nil +} + +fn loop(env) { + use input <- result.try(readline("user> ")) + + let prn = + input + |> rep(env) + case prn { + Error(err) -> printer.pr_err(err) |> io.println_error() + Ok(str) -> io.println(str) + } + + loop(env) +} + +fn apply(x: MalType, args: List(MalType)) -> MalRet { + case x { + Func(f, ..) -> f(args) + _ -> Error(types.EvalApplyType(x)) + } +} + +fn eval(ast: MalType, env: dict.Dict(String, MalType)) -> types.MalRet { + case ast { + Symbol(sym) -> { + case dict.get(env, sym) { + Error(_) -> Error(types.EvalSymbolNotFound(sym)) + Ok(val) -> Ok(val) + } + } + List([l, ..rest], _) -> { + use first <- result.try(eval(l, env)) + use args <- result.try(list.try_map(rest, fn(x) { eval(x, env) })) + + apply(first, args) + } + Vector(vec, _) -> + vec + |> list.try_map(fn(x) { eval(x, env) }) + |> result.map(fn(o) { Vector(o, types.Nil) }) + HashMap(hm, _) -> { + use res <- result.try( + hm + |> dict.to_list() + |> list.try_map(fn(x) { + use e <- result.try(eval(x.1, env)) + Ok(#(x.0, e)) + }), + ) + + Ok(HashMap(dict.from_list(res), types.Nil)) + } + _ -> Ok(ast) + } +} + +fn read(str) { + reader.read_str(str) +} + +fn print(ast) { + printer.pr_str(ast, True) +} + +fn rep(str, env) { + use r <- result.try(read(str)) + use e <- result.try(eval(r, env)) + + Ok(print(e)) +} diff --git a/impls/gleam/src/step3_env.gleam b/impls/gleam/src/step3_env.gleam new file mode 100644 index 0000000000..3c3e0210f1 --- /dev/null +++ b/impls/gleam/src/step3_env.gleam @@ -0,0 +1,204 @@ +import env +import gleam/dict +import gleam/io +import gleam/list +import gleam/option.{None, Some} +import gleam/result +import printer +import reader +import readline.{readline} +import types.{ + type MalRet, type MalType, Func, HashMap, Int, List, Symbol, Vector, +} + +pub fn main() -> Nil { + let int_op = fn(with: fn(Int, Int) -> Result(Int, types.Error)) { + types.func(fn(l: List(MalType)) { + case l { + [a, b] -> { + case a, b { + Int(x), Int(y) -> with(x, y) |> result.map(fn(z) { Int(z) }) + _, _ -> types.wrong_type_err("int, int", [a, b]) + } + } + _ -> Error(types.EvalWrongArgLen(2, list.length(l))) + } + }) + } + + let env = + env.from_list( + [ + #("+", int_op(fn(a, b) { Ok(a + b) })), + #("-", int_op(fn(a, b) { Ok(a - b) })), + #("*", int_op(fn(a, b) { Ok(a * b) })), + #( + "/", + int_op(fn(a, b) { + case b == 0 { + False -> Ok(a / b) + True -> Error(types.EvalDivideByZero) + } + }), + ), + ], + None, + ) + + let _ = loop(env) + + Nil +} + +fn loop(env) { + use input <- result.try(readline("user> ")) + + let prn = + input + |> rep(env) + case prn { + Error(err) -> { + printer.pr_err(err) |> io.println_error() + loop(env) + } + Ok(#(str, env)) -> { + io.println(str) + + loop(env) + } + } +} + +fn apply(x: MalType, args: List(MalType)) -> MalRet { + case x { + Func(f, ..) -> f(args) + _ -> Error(types.EvalApplyType(x)) + } +} + +fn eval(ast: MalType, env: env.Env) -> MalRet { + case env.get(env, "DEBUG-EVAL") { + None -> Nil + Some(_) -> { + io.println("EVAL: " <> printer.pr_str(ast, True)) + } + } + + case ast { + Symbol(sym) -> { + case env.get(env, sym) { + None -> Error(types.EvalSymbolNotFound(sym)) + Some(val) -> Ok(val) + } + } + List([l, ..rest], _) -> { + let eval_args = fn(env) { list.try_map(rest, fn(x) { eval(x, env) }) } + + case l { + Symbol("def!") -> + case rest { + [key, val] -> { + use res <- result.try(eval(val, env)) + use k <- result.try(env.try_key(key)) + + env.set(env, k, res) + + Ok(res) + } + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } + Symbol("let*") -> + case rest { + [pairs, body] -> + case pairs { + List(l, _) | Vector(l, _) -> { + let_special(l, body, env) + } + _ -> types.wrong_type_err("list | vector", [pairs]) + } + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } + + _ -> { + use f <- result.try(eval(l, env)) + use args <- result.try(eval_args(env)) + + apply(f, args) + } + } + } + Vector(vec, _) -> { + use res <- result.try( + list.try_fold(vec, [], fn(acc, x) { + use res <- result.try(eval(x, env)) + + Ok([res, ..acc]) + }) + |> result.map(fn(o) { list.reverse(o) }), + ) + + Ok(Vector(res, types.Nil)) + } + HashMap(hm, _) -> { + use res <- result.try( + hm + |> dict.to_list() + |> list.try_fold([], fn(acc, x) { + use res <- result.try(eval(x.1, env)) + + let pair = #(x.0, res) + Ok([pair, ..acc]) + }), + ) + + let ret = HashMap(dict.from_list(res), types.Nil) + Ok(ret) + } + _ -> Ok(ast) + } +} + +fn get_pairs(list, acc) { + case list { + [a, b, ..rest] -> { + get_pairs(rest, [#(a, b), ..acc]) + } + [] -> Ok(list.reverse(acc)) + _ -> Error(Nil) + } +} + +fn let_special(p, body, env) { + use pairs <- result.try( + get_pairs(p, []) + |> result.replace_error(types.EvalLetPairOddCount(p)), + ) + let let_env = env.into_outer(env) + + use _ <- result.try( + list.try_map(pairs, fn(x) { + use key <- result.try(env.try_key(x.0)) + use val <- result.try(eval(x.1, let_env)) + env.set(let_env, key, val) + + Ok(Nil) + }), + ) + + eval(body, let_env) +} + +fn read(str) { + reader.read_str(str) +} + +fn print(ast) { + printer.pr_str(ast, True) +} + +fn rep(str, env) { + use r <- result.try(read(str)) + use e <- result.try(eval(r, env)) + + Ok(#(print(e), env)) +} diff --git a/impls/gleam/src/step4_if_fn_do.gleam b/impls/gleam/src/step4_if_fn_do.gleam new file mode 100644 index 0000000000..7b7f938f4b --- /dev/null +++ b/impls/gleam/src/step4_if_fn_do.gleam @@ -0,0 +1,214 @@ +import core +import env +import gleam/dict +import gleam/io +import gleam/list +import gleam/option.{None, Some} +import gleam/result +import printer +import reader +import readline.{readline} +import types.{ + type MalRet, type MalType, Bool, Func, HashMap, List, Symbol, Vector, +} + +pub fn main() -> Nil { + let env = env.from_list(core.ns(), None) + + let assert Ok(_) = rep("(def! not (fn* (a) (if a false true)))", env) + + let _ = loop(env) + + Nil +} + +fn loop(env) { + use input <- result.try(readline("user> ")) + + let prn = + input + |> rep(env) + case prn { + Error(err) -> { + printer.pr_err(err) |> io.println_error() + loop(env) + } + Ok(str) -> { + io.println(str) + + loop(env) + } + } +} + +fn apply(x: MalType, args: List(MalType)) -> MalRet { + case x { + Func(f, ..) -> f(args) + _ -> Error(types.EvalApplyType(x)) + } +} + +fn eval(ast: MalType, env: env.Env) -> MalRet { + case env.get(env, "DEBUG-EVAL") { + None | Some(Bool(False)) | Some(types.Nil) -> Nil + _ -> { + io.println("EVAL: " <> printer.pr_str(ast, True)) + } + } + + case ast { + Symbol(sym) -> + env.get(env, sym) + |> option.to_result(types.EvalSymbolNotFound(sym)) + List([first, ..rest], _) -> eval_list(first, rest, env) + Vector(vec, _) -> + list.try_map(vec, fn(x) { eval(x, env) }) + |> result.map(fn(x) { Vector(x, types.Nil) }) + HashMap(hm, _) -> { + dict.to_list(hm) + |> list.try_map(fn(x) { + let key = x.0 + let val = x.1 + + eval(val, env) + |> result.map(fn(e) { #(key, e) }) + }) + |> result.map(fn(res) { HashMap(dict.from_list(res), types.Nil) }) + } + _ -> Ok(ast) + } +} + +fn eval_list(first, rest, env) -> Result(MalType, types.Error) { + case first { + Symbol("def!") -> + case rest { + [key, val] -> def_special(key, val, env) + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } + Symbol("let*") -> + case rest { + [pairs, body] -> + case pairs { + List(l, _) | Vector(l, _) -> { + let_special(l, body, env) + } + _ -> types.wrong_type_err("list | vector", [pairs]) + } + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } + Symbol("if") -> + case rest { + [predicate, branch_true, ..branch_false] -> { + use predicate <- result.try(eval(predicate, env)) + + use false_ast <- result.try(case branch_false { + [] -> Ok(types.Nil) + [f] -> Ok(f) + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + }) + + case predicate { + Bool(False) | types.Nil -> { + eval(false_ast, env) + } + _ -> { + eval(branch_true, env) + } + } + } + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + } + Symbol("do") -> { + let do = list.take(rest, list.length(rest) - 1) + use _ <- result.try(list.try_map(do, fn(x) { eval(x, env) })) + + case list.last(rest) { + Error(_) -> Error(types.EvalWrongArgLenGreaterThan(1, 0)) + Ok(last) -> eval(last, env) + } + } + Symbol("fn*") -> + case rest { + [List(params, _), body] | [Vector(params, _), body] -> { + use param_names <- result.try( + list.try_map(params, fn(x) { + case x { + Symbol(sym) -> Ok(sym) + _ -> Error(types.EvalFuncParamNotSymbol) + } + }), + ) + + let closure = fn(args) { + let fn_env = env.into_outer(env) + use _ <- result.try(env.bind(fn_env, param_names, args)) + + eval(body, fn_env) + } + + Ok(types.func(closure)) + } + [_, _] as l -> types.wrong_type_err("list, any", l) + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } + _ -> { + use f <- result.try(eval(first, env)) + use args <- result.try(list.try_map(rest, fn(x) { eval(x, env) })) + + apply(f, args) + } + } +} + +fn def_special(key, val, env) { + use k <- result.try(env.try_key(key)) + use v <- result.try(eval(val, env)) + env.set(env, k, v) + Ok(v) +} + +fn get_pairs(list, acc) { + case list { + [a, b, ..rest] -> { + get_pairs(rest, [#(a, b), ..acc]) + } + [] -> Ok(list.reverse(acc)) + _ -> Error(Nil) + } +} + +fn let_special(p, body, env) { + use pairs <- result.try( + get_pairs(p, []) + |> result.replace_error(types.EvalLetPairOddCount(p)), + ) + let let_env = env.into_outer(env) + + use _ <- result.try( + list.try_map(pairs, fn(x) { + use key <- result.try(env.try_key(x.0)) + use val <- result.try(eval(x.1, let_env)) + env.set(let_env, key, val) + + Ok(Nil) + }), + ) + + eval(body, let_env) +} + +fn read(str) { + reader.read_str(str) +} + +fn print(ast) { + printer.pr_str(ast, True) +} + +fn rep(str, env) { + use r <- result.try(read(str)) + use e <- result.try(eval(r, env)) + + Ok(print(e)) +} diff --git a/impls/gleam/src/step5_tco.gleam b/impls/gleam/src/step5_tco.gleam new file mode 100644 index 0000000000..7b7f938f4b --- /dev/null +++ b/impls/gleam/src/step5_tco.gleam @@ -0,0 +1,214 @@ +import core +import env +import gleam/dict +import gleam/io +import gleam/list +import gleam/option.{None, Some} +import gleam/result +import printer +import reader +import readline.{readline} +import types.{ + type MalRet, type MalType, Bool, Func, HashMap, List, Symbol, Vector, +} + +pub fn main() -> Nil { + let env = env.from_list(core.ns(), None) + + let assert Ok(_) = rep("(def! not (fn* (a) (if a false true)))", env) + + let _ = loop(env) + + Nil +} + +fn loop(env) { + use input <- result.try(readline("user> ")) + + let prn = + input + |> rep(env) + case prn { + Error(err) -> { + printer.pr_err(err) |> io.println_error() + loop(env) + } + Ok(str) -> { + io.println(str) + + loop(env) + } + } +} + +fn apply(x: MalType, args: List(MalType)) -> MalRet { + case x { + Func(f, ..) -> f(args) + _ -> Error(types.EvalApplyType(x)) + } +} + +fn eval(ast: MalType, env: env.Env) -> MalRet { + case env.get(env, "DEBUG-EVAL") { + None | Some(Bool(False)) | Some(types.Nil) -> Nil + _ -> { + io.println("EVAL: " <> printer.pr_str(ast, True)) + } + } + + case ast { + Symbol(sym) -> + env.get(env, sym) + |> option.to_result(types.EvalSymbolNotFound(sym)) + List([first, ..rest], _) -> eval_list(first, rest, env) + Vector(vec, _) -> + list.try_map(vec, fn(x) { eval(x, env) }) + |> result.map(fn(x) { Vector(x, types.Nil) }) + HashMap(hm, _) -> { + dict.to_list(hm) + |> list.try_map(fn(x) { + let key = x.0 + let val = x.1 + + eval(val, env) + |> result.map(fn(e) { #(key, e) }) + }) + |> result.map(fn(res) { HashMap(dict.from_list(res), types.Nil) }) + } + _ -> Ok(ast) + } +} + +fn eval_list(first, rest, env) -> Result(MalType, types.Error) { + case first { + Symbol("def!") -> + case rest { + [key, val] -> def_special(key, val, env) + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } + Symbol("let*") -> + case rest { + [pairs, body] -> + case pairs { + List(l, _) | Vector(l, _) -> { + let_special(l, body, env) + } + _ -> types.wrong_type_err("list | vector", [pairs]) + } + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } + Symbol("if") -> + case rest { + [predicate, branch_true, ..branch_false] -> { + use predicate <- result.try(eval(predicate, env)) + + use false_ast <- result.try(case branch_false { + [] -> Ok(types.Nil) + [f] -> Ok(f) + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + }) + + case predicate { + Bool(False) | types.Nil -> { + eval(false_ast, env) + } + _ -> { + eval(branch_true, env) + } + } + } + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + } + Symbol("do") -> { + let do = list.take(rest, list.length(rest) - 1) + use _ <- result.try(list.try_map(do, fn(x) { eval(x, env) })) + + case list.last(rest) { + Error(_) -> Error(types.EvalWrongArgLenGreaterThan(1, 0)) + Ok(last) -> eval(last, env) + } + } + Symbol("fn*") -> + case rest { + [List(params, _), body] | [Vector(params, _), body] -> { + use param_names <- result.try( + list.try_map(params, fn(x) { + case x { + Symbol(sym) -> Ok(sym) + _ -> Error(types.EvalFuncParamNotSymbol) + } + }), + ) + + let closure = fn(args) { + let fn_env = env.into_outer(env) + use _ <- result.try(env.bind(fn_env, param_names, args)) + + eval(body, fn_env) + } + + Ok(types.func(closure)) + } + [_, _] as l -> types.wrong_type_err("list, any", l) + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } + _ -> { + use f <- result.try(eval(first, env)) + use args <- result.try(list.try_map(rest, fn(x) { eval(x, env) })) + + apply(f, args) + } + } +} + +fn def_special(key, val, env) { + use k <- result.try(env.try_key(key)) + use v <- result.try(eval(val, env)) + env.set(env, k, v) + Ok(v) +} + +fn get_pairs(list, acc) { + case list { + [a, b, ..rest] -> { + get_pairs(rest, [#(a, b), ..acc]) + } + [] -> Ok(list.reverse(acc)) + _ -> Error(Nil) + } +} + +fn let_special(p, body, env) { + use pairs <- result.try( + get_pairs(p, []) + |> result.replace_error(types.EvalLetPairOddCount(p)), + ) + let let_env = env.into_outer(env) + + use _ <- result.try( + list.try_map(pairs, fn(x) { + use key <- result.try(env.try_key(x.0)) + use val <- result.try(eval(x.1, let_env)) + env.set(let_env, key, val) + + Ok(Nil) + }), + ) + + eval(body, let_env) +} + +fn read(str) { + reader.read_str(str) +} + +fn print(ast) { + printer.pr_str(ast, True) +} + +fn rep(str, env) { + use r <- result.try(read(str)) + use e <- result.try(eval(r, env)) + + Ok(print(e)) +} diff --git a/impls/gleam/src/step6_file.gleam b/impls/gleam/src/step6_file.gleam new file mode 100644 index 0000000000..f7e540ff1b --- /dev/null +++ b/impls/gleam/src/step6_file.gleam @@ -0,0 +1,242 @@ +import argv +import core +import env +import gleam/dict +import gleam/io +import gleam/list +import gleam/option.{None, Some} +import gleam/result +import printer +import reader +import readline.{readline} +import types.{ + type MalRet, type MalType, Bool, Func, HashMap, List, Symbol, Vector, +} + +pub fn main() -> Nil { + let env = env.from_list(core.ns(), None) + + let assert Ok(_) = + [ + "(def! not (fn* (a) (if a false true)))", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", + ] + |> list.try_map(fn(x) { rep(x, env) }) + + env.set( + env, + "eval", + types.func(fn(args) { + case args { + [ast] -> eval(ast, env) + _ -> types.wrong_type_err("any", args) + } + }), + ) + + case argv.load().arguments { + [file, ..] -> { + let _ = case rep("(load-file \"" <> file <> "\")", env) { + Error(err) -> printer.pr_err(err) |> io.println_error() + _ -> Nil + } + } + _ -> { + let _ = loop(env) + Nil + } + } +} + +fn loop(env) { + use input <- result.try(readline("user> ")) + + input + |> rep(env) + |> print_res() + + loop(env) +} + +fn print_res(res) { + case res { + Ok(str) -> { + io.println(str) + } + Error(err) -> { + printer.pr_err(err) |> io.println_error() + } + } +} + +fn apply(x: MalType, args: List(MalType)) -> MalRet { + case x { + Func(f, ..) -> f(args) + _ -> Error(types.EvalApplyType(x)) + } +} + +fn eval(ast: MalType, env: env.Env) -> MalRet { + case env.get(env, "DEBUG-EVAL") { + None | Some(Bool(False)) | Some(types.Nil) -> Nil + _ -> { + io.println("EVAL: " <> printer.pr_str(ast, True)) + } + } + + case ast { + Symbol(sym) -> + env.get(env, sym) + |> option.to_result(types.EvalSymbolNotFound(sym)) + List([first, ..rest], _) -> eval_list(first, rest, env) + Vector(vec, _) -> + list.try_map(vec, fn(x) { eval(x, env) }) + |> result.map(fn(x) { Vector(x, types.Nil) }) + HashMap(hm, _) -> { + dict.to_list(hm) + |> list.try_map(fn(x) { + let key = x.0 + let val = x.1 + + eval(val, env) + |> result.map(fn(e) { #(key, e) }) + }) + |> result.map(fn(res) { HashMap(dict.from_list(res), types.Nil) }) + } + _ -> Ok(ast) + } +} + +fn eval_list(first, rest, env) -> Result(MalType, types.Error) { + case first { + Symbol("def!") -> + case rest { + [key, val] -> def_special(key, val, env) + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } + Symbol("let*") -> + case rest { + [pairs, body] -> + case pairs { + List(l, _) | Vector(l, _) -> { + let_special(l, body, env) + } + _ -> types.wrong_type_err("list | vector", [pairs]) + } + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } + Symbol("if") -> + case rest { + [predicate, branch_true, ..branch_false] -> { + use predicate <- result.try(eval(predicate, env)) + + use false_ast <- result.try(case branch_false { + [] -> Ok(types.Nil) + [f] -> Ok(f) + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + }) + + case predicate { + Bool(False) | types.Nil -> { + eval(false_ast, env) + } + _ -> { + eval(branch_true, env) + } + } + } + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + } + Symbol("do") -> { + let do = list.take(rest, list.length(rest) - 1) + use _ <- result.try(list.try_map(do, fn(x) { eval(x, env) })) + + case list.last(rest) { + Error(_) -> Error(types.EvalWrongArgLenGreaterThan(1, 0)) + Ok(last) -> eval(last, env) + } + } + Symbol("fn*") -> + case rest { + [List(params, _), body] | [Vector(params, _), body] -> { + use param_names <- result.try( + list.try_map(params, fn(x) { + case x { + Symbol(sym) -> Ok(sym) + _ -> Error(types.EvalFuncParamNotSymbol) + } + }), + ) + + let closure = fn(args) { + let fn_env = env.into_outer(env) + use _ <- result.try(env.bind(fn_env, param_names, args)) + + eval(body, fn_env) + } + + Ok(types.func(closure)) + } + [_, _] as l -> types.wrong_type_err("list, any", l) + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } + _ -> { + use f <- result.try(eval(first, env)) + use args <- result.try(list.try_map(rest, fn(x) { eval(x, env) })) + + apply(f, args) + } + } +} + +fn def_special(key, val, env) { + use k <- result.try(env.try_key(key)) + use v <- result.try(eval(val, env)) + env.set(env, k, v) + Ok(v) +} + +fn get_pairs(list, acc) { + case list { + [a, b, ..rest] -> { + get_pairs(rest, [#(a, b), ..acc]) + } + [] -> Ok(list.reverse(acc)) + _ -> Error(Nil) + } +} + +fn let_special(p, body, env) { + use pairs <- result.try( + get_pairs(p, []) + |> result.replace_error(types.EvalLetPairOddCount(p)), + ) + let let_env = env.into_outer(env) + + use _ <- result.try( + list.try_map(pairs, fn(x) { + use key <- result.try(env.try_key(x.0)) + use val <- result.try(eval(x.1, let_env)) + env.set(let_env, key, val) + + Ok(Nil) + }), + ) + + eval(body, let_env) +} + +fn read(str) { + reader.read_str(str) +} + +fn print(ast) { + printer.pr_str(ast, True) +} + +fn rep(str, env) { + use r <- result.try(read(str)) + use e <- result.try(eval(r, env)) + + Ok(print(e)) +} diff --git a/impls/gleam/src/step7_quote.gleam b/impls/gleam/src/step7_quote.gleam new file mode 100644 index 0000000000..4ce397466d --- /dev/null +++ b/impls/gleam/src/step7_quote.gleam @@ -0,0 +1,296 @@ +import argv +import core +import env +import gleam/dict +import gleam/io +import gleam/list +import gleam/option.{None, Some} +import gleam/result +import printer +import reader +import readline.{readline} +import types.{ + type MalRet, type MalType, Bool, Func, HashMap, List, Symbol, Vector, +} + +pub fn main() -> Nil { + let env = env.from_list(core.ns(), None) + + let assert Ok(_) = + [ + "(def! not (fn* (a) (if a false true)))", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", + ] + |> list.try_map(fn(x) { rep(x, env) }) + + env.set( + env, + "eval", + types.func(fn(args) { + case args { + [ast] -> eval(ast, env) + _ -> types.wrong_type_err("any", args) + } + }), + ) + + case argv.load().arguments { + [file, ..] -> { + let _ = case rep("(load-file \"" <> file <> "\")", env) { + Error(err) -> printer.pr_err(err) |> io.println_error() + _ -> Nil + } + } + _ -> { + let _ = loop(env) + Nil + } + } +} + +fn loop(env) { + use input <- result.try(readline("user> ")) + + input + |> rep(env) + |> print_res() + + loop(env) +} + +fn print_res(res) { + case res { + Ok(str) -> { + io.println(str) + } + Error(err) -> { + printer.pr_err(err) |> io.println_error() + } + } +} + +fn apply(x: MalType, args: List(MalType)) -> MalRet { + case x { + Func(f, ..) -> f(args) + _ -> Error(types.EvalApplyType(x)) + } +} + +fn eval(ast: MalType, env: env.Env) -> MalRet { + case env.get(env, "DEBUG-EVAL") { + None | Some(Bool(False)) | Some(types.Nil) -> Nil + _ -> { + io.println("EVAL: " <> printer.pr_str(ast, True)) + } + } + + case ast { + Symbol(sym) -> + env.get(env, sym) + |> option.to_result(types.EvalSymbolNotFound(sym)) + List([first, ..rest], _) -> eval_list(first, rest, env) + Vector(vec, _) -> + list.try_map(vec, fn(x) { eval(x, env) }) + |> result.map(fn(x) { Vector(x, types.Nil) }) + HashMap(hm, _) -> { + dict.to_list(hm) + |> list.try_map(fn(x) { + let key = x.0 + let val = x.1 + + eval(val, env) + |> result.map(fn(e) { #(key, e) }) + }) + |> result.map(fn(res) { HashMap(dict.from_list(res), types.Nil) }) + } + _ -> Ok(ast) + } +} + +fn eval_list(first, rest, env) -> Result(MalType, types.Error) { + case first { + Symbol("def!") -> def_special(rest, env) + Symbol("let*") -> let_special(rest, env) + Symbol("if") -> if_special(rest, env) + Symbol("do") -> do_special(rest, env) + Symbol("fn*") -> fn_special(rest, env) + Symbol("quote") -> + case rest { + [a] -> Ok(a) + _ -> types.wrong_type_err("any", rest) + } + Symbol("quasiquote") -> + case rest { + [a] -> quasiquote(a) |> eval(env) + _ -> types.wrong_type_err("any", rest) + } + _ -> { + use f <- result.try(eval(first, env)) + use args <- result.try(list.try_map(rest, fn(x) { eval(x, env) })) + + apply(f, args) + } + } +} + +fn def_special(rest, env) { + case rest { + [key, val] -> { + use k <- result.try(env.try_key(key)) + use v <- result.try(eval(val, env)) + env.set(env, k, v) + Ok(v) + } + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } +} + +fn let_special(rest, env) { + case rest { + [pairs, body] -> + case pairs { + List(l, _) | Vector(l, _) -> { + use pairs <- result.try( + get_pairs(l, []) + |> result.replace_error(types.EvalLetPairOddCount(l)), + ) + let let_env = env.into_outer(env) + + use _ <- result.try( + list.try_map(pairs, fn(x) { + use key <- result.try(env.try_key(x.0)) + use val <- result.try(eval(x.1, let_env)) + env.set(let_env, key, val) + + Ok(Nil) + }), + ) + + eval(body, let_env) + } + _ -> types.wrong_type_err("list | vector", [pairs]) + } + _ -> types.wrong_type_err("list | vector, any", rest) + } +} + +fn do_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + let do = list.take(rest, list.length(rest) - 1) + use _ <- result.try(list.try_map(do, fn(x) { eval(x, env) })) + + case list.last(rest) { + Error(_) -> Error(types.EvalWrongArgLenGreaterThan(1, 0)) + Ok(last) -> eval(last, env) + } +} + +fn if_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + case rest { + [predicate, branch_true, ..branch_false] -> { + use predicate <- result.try(eval(predicate, env)) + + use false_ast <- result.try(case branch_false { + [] -> Ok(types.Nil) + [f] -> Ok(f) + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + }) + + case predicate { + Bool(False) | types.Nil -> { + eval(false_ast, env) + } + _ -> { + eval(branch_true, env) + } + } + } + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + } +} + +fn fn_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + case rest { + [List(params, _), body] | [Vector(params, _), body] -> { + use param_names <- result.try( + list.try_map(params, fn(x) { + case x { + Symbol(sym) -> Ok(sym) + _ -> Error(types.EvalFuncParamNotSymbol) + } + }), + ) + + let closure = fn(args) { + let fn_env = env.into_outer(env) + use _ <- result.try(env.bind(fn_env, param_names, args)) + + eval(body, fn_env) + } + + Ok(types.func(closure)) + } + [_, _] as l -> types.wrong_type_err("list, any", l) + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } +} + +fn make_call(sym, rest) { + List([Symbol(sym), ..rest], types.Nil) +} + +fn quasiquote(ast: MalType) -> MalType { + case ast { + List([Symbol("unquote"), x], _) -> x + List(l, _) -> qq_fold(l) + Vector(v, _) -> make_call("vec", [qq_fold(v)]) + HashMap(..) -> make_call("quote", [ast]) + Symbol(_) -> make_call("quote", [ast]) + _ -> ast + } +} + +fn qq_fold(l) { + list.fold_right(l, List([], types.Nil), qq_loop) +} + +fn qq_loop(acc, elt) { + case elt { + List([Symbol("splice-unquote"), splice], _) -> + make_call("concat", [splice, acc]) + _ -> make_call("cons", [quasiquote(elt), acc]) + } +} + +fn get_pairs(list, acc) { + case list { + [a, b, ..rest] -> { + get_pairs(rest, [#(a, b), ..acc]) + } + [] -> Ok(list.reverse(acc)) + _ -> Error(Nil) + } +} + +fn read(str) { + reader.read_str(str) +} + +fn print(ast) { + printer.pr_str(ast, True) +} + +fn rep(str, env) { + use r <- result.try(read(str)) + use e <- result.try(eval(r, env)) + + Ok(print(e)) +} diff --git a/impls/gleam/src/step8_macros.gleam b/impls/gleam/src/step8_macros.gleam new file mode 100644 index 0000000000..5837f10127 --- /dev/null +++ b/impls/gleam/src/step8_macros.gleam @@ -0,0 +1,323 @@ +import argv +import core +import env +import gleam/dict +import gleam/io +import gleam/list +import gleam/option.{None, Some} +import gleam/result +import printer +import reader +import readline.{readline} +import types.{ + type MalRet, type MalType, Bool, Func, HashMap, List, Symbol, Vector, +} + +pub fn main() -> Nil { + let env = env.from_list(core.ns(), None) + + let assert Ok(_) = + [ + "(def! not (fn* (a) (if a false true)))", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", + "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", + ] + |> list.try_map(fn(x) { rep(x, env) }) + + env.set( + env, + "eval", + types.func(fn(args) { + case args { + [ast] -> eval(ast, env) + _ -> types.wrong_type_err("any", args) + } + }), + ) + + case argv.load().arguments { + [file, ..] -> { + let _ = case rep("(load-file \"" <> file <> "\")", env) { + Error(err) -> printer.pr_err(err) |> io.println_error() + _ -> Nil + } + } + _ -> { + let _ = loop(env) + Nil + } + } +} + +fn loop(env) { + use input <- result.try(readline("user> ")) + + input + |> rep(env) + |> print_res() + + loop(env) +} + +fn print_res(res) { + case res { + Ok(str) -> { + io.println(str) + } + Error(err) -> { + printer.pr_err(err) |> io.println_error() + } + } +} + +fn apply(x: MalType, args: List(MalType)) -> MalRet { + case x { + Func(f, ..) -> f(args) + _ -> Error(types.EvalApplyType(x)) + } +} + +fn eval(ast: MalType, env: env.Env) -> MalRet { + case env.get(env, "DEBUG-EVAL") { + None | Some(Bool(False)) | Some(types.Nil) -> Nil + _ -> { + io.println("EVAL: " <> printer.pr_str(ast, True)) + } + } + + case ast { + Symbol(sym) -> + env.get(env, sym) + |> option.to_result(types.EvalSymbolNotFound(sym)) + List([first, ..rest], _) -> eval_list(first, rest, env) + Vector(vec, _) -> + list.try_map(vec, fn(x) { eval(x, env) }) + |> result.map(fn(x) { Vector(x, types.Nil) }) + HashMap(hm, _) -> { + dict.to_list(hm) + |> list.try_map(fn(x) { + let key = x.0 + let val = x.1 + + eval(val, env) + |> result.map(fn(e) { #(key, e) }) + }) + |> result.map(fn(res) { HashMap(dict.from_list(res), types.Nil) }) + } + _ -> Ok(ast) + } +} + +fn eval_list(first, rest, env) -> Result(MalType, types.Error) { + case first { + Symbol("def!") -> def_special(rest, env) + Symbol("defmacro!") -> defmacro_special(rest, env) + Symbol("let*") -> let_special(rest, env) + Symbol("fn*") -> fn_special(rest, env) + Symbol("if") -> if_special(rest, env) + Symbol("do") -> do_special(rest, env) + Symbol("quote") -> + case rest { + [a] -> Ok(a) + _ -> types.wrong_type_err("any", rest) + } + Symbol("quasiquote") -> + case rest { + [a] -> quasiquote(a) |> eval(env) + _ -> types.wrong_type_err("any", rest) + } + _ -> { + use f <- result.try(eval(first, env)) + + case f { + Func(f, is_macro: True, ..) -> + f(rest) |> result.try(fn(res) { eval(res, env) }) + _ -> { + use args <- result.try(list.try_map(rest, fn(x) { eval(x, env) })) + + apply(f, args) + } + } + } + } +} + +fn def_special(rest, env) { + case rest { + [key, val] -> { + use k <- result.try(env.try_key(key)) + use v <- result.try(eval(val, env)) + env.set(env, k, v) + Ok(v) + } + _ -> types.wrong_type_err("symbol, any", rest) + } +} + +fn defmacro_special(rest, env) { + case rest { + [key, f] -> { + use k <- result.try(env.try_key(key)) + use f <- result.try(eval(f, env)) + case f { + Func(fun, ..) -> { + let v = Func(fun, is_macro: True, meta: types.Nil) + env.set(env, k, v) + Ok(v) + } + _ -> types.wrong_type_err("symbol, func", rest) + } + } + _ -> types.wrong_type_err("symbol, func", rest) + } +} + +fn let_special(rest, env) { + case rest { + [pairs, body] -> + case pairs { + List(l, _) | Vector(l, _) -> { + use pairs <- result.try( + get_pairs(l, []) + |> result.replace_error(types.EvalLetPairOddCount(l)), + ) + let let_env = env.into_outer(env) + + use _ <- result.try( + list.try_map(pairs, fn(x) { + use key <- result.try(env.try_key(x.0)) + use val <- result.try(eval(x.1, let_env)) + env.set(let_env, key, val) + + Ok(Nil) + }), + ) + + eval(body, let_env) + } + _ -> types.wrong_type_err("list | vector", [pairs]) + } + _ -> types.wrong_type_err("list | vector, any", rest) + } +} + +fn fn_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + case rest { + [List(params, _), body] | [Vector(params, _), body] -> { + use param_names <- result.try( + list.try_map(params, fn(x) { + case x { + Symbol(sym) -> Ok(sym) + _ -> Error(types.EvalFuncParamNotSymbol) + } + }), + ) + + let func = fn(args) { + let fn_env = env.into_outer(env) + use _ <- result.try(env.bind(fn_env, param_names, args)) + + eval(body, fn_env) + } + + Ok(Func(func, False, types.Nil)) + } + [_, _] as l -> types.wrong_type_err("list, any", l) + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } +} + +fn do_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + let do = list.take(rest, list.length(rest) - 1) + use _ <- result.try(list.try_map(do, fn(x) { eval(x, env) })) + + case list.last(rest) { + Error(_) -> Error(types.EvalWrongArgLenGreaterThan(1, 0)) + Ok(last) -> eval(last, env) + } +} + +fn if_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + case rest { + [predicate, branch_true, ..branch_false] -> { + use predicate <- result.try(eval(predicate, env)) + + use false_ast <- result.try(case branch_false { + [] -> Ok(types.Nil) + [f] -> Ok(f) + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + }) + + case predicate { + Bool(False) | types.Nil -> { + eval(false_ast, env) + } + _ -> { + eval(branch_true, env) + } + } + } + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + } +} + +fn make_call(sym, rest) { + List([Symbol(sym), ..rest], types.Nil) +} + +fn quasiquote(ast: MalType) -> MalType { + case ast { + List([Symbol("unquote"), x], _) -> x + List(l, _) -> qq_fold(l) + Vector(v, _) -> make_call("vec", [qq_fold(v)]) + HashMap(..) -> make_call("quote", [ast]) + Symbol(_) -> make_call("quote", [ast]) + _ -> ast + } +} + +fn qq_fold(l) { + list.fold_right(l, List([], types.Nil), qq_loop) +} + +fn qq_loop(acc, elt) { + case elt { + List([Symbol("splice-unquote"), splice], _) -> + make_call("concat", [splice, acc]) + _ -> make_call("cons", [quasiquote(elt), acc]) + } +} + +fn get_pairs(list, acc) { + case list { + [a, b, ..rest] -> { + get_pairs(rest, [#(a, b), ..acc]) + } + [] -> Ok(list.reverse(acc)) + _ -> Error(Nil) + } +} + +fn read(str) { + reader.read_str(str) +} + +fn print(ast) { + printer.pr_str(ast, True) +} + +fn rep(str, env) { + use r <- result.try(read(str)) + use e <- result.try(eval(r, env)) + + Ok(print(e)) +} diff --git a/impls/gleam/src/step9_try.gleam b/impls/gleam/src/step9_try.gleam new file mode 100644 index 0000000000..819457befa --- /dev/null +++ b/impls/gleam/src/step9_try.gleam @@ -0,0 +1,346 @@ +import argv +import core +import env +import gleam/dict +import gleam/io +import gleam/list +import gleam/option.{None, Some} +import gleam/result +import printer +import reader +import readline.{readline} +import types.{ + type MalRet, type MalType, Bool, Func, HashMap, List, String, Symbol, Vector, +} + +pub fn main() -> Nil { + let env = env.from_list(core.ns(), None) + + let assert Ok(_) = + [ + "(def! not (fn* (a) (if a false true)))", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", + "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", + ] + |> list.try_map(fn(x) { rep(x, env) }) + + env.set( + env, + "eval", + types.func(fn(args) { + case args { + [ast] -> eval(ast, env) + _ -> types.wrong_type_err("any", args) + } + }), + ) + + case argv.load().arguments { + [file, ..] -> { + let _ = case rep("(load-file \"" <> file <> "\")", env) { + Error(err) -> printer.pr_err(err) |> io.println_error() + _ -> Nil + } + } + _ -> { + let _ = loop(env) + Nil + } + } +} + +fn loop(env) { + use input <- result.try(readline("user> ")) + + input + |> rep(env) + |> print_res() + + loop(env) +} + +fn print_res(res) { + case res { + Ok(str) -> { + io.println(str) + } + Error(err) -> { + printer.pr_err(err) |> io.println_error() + } + } +} + +fn apply(x: MalType, args: List(MalType)) -> MalRet { + case x { + Func(f, ..) -> f(args) + _ -> Error(types.EvalApplyType(x)) + } +} + +fn eval(ast: MalType, env: env.Env) -> MalRet { + case env.get(env, "DEBUG-EVAL") { + None | Some(Bool(False)) | Some(types.Nil) -> Nil + _ -> { + io.println("EVAL: " <> printer.pr_str(ast, True)) + } + } + + case ast { + Symbol(sym) -> + env.get(env, sym) + |> option.to_result(types.EvalSymbolNotFound(sym)) + List([first, ..rest], _) -> eval_list(first, rest, env) + Vector(vec, _) -> + list.try_map(vec, fn(x) { eval(x, env) }) + |> result.map(fn(x) { Vector(x, types.Nil) }) + HashMap(hm, _) -> { + dict.to_list(hm) + |> list.try_map(fn(x) { + let key = x.0 + let val = x.1 + + eval(val, env) + |> result.map(fn(e) { #(key, e) }) + }) + |> result.map(fn(res) { HashMap(dict.from_list(res), types.Nil) }) + } + _ -> Ok(ast) + } +} + +fn eval_list(first, rest, env) -> Result(MalType, types.Error) { + case first { + Symbol("def!") -> def_special(rest, env) + Symbol("defmacro!") -> defmacro_special(rest, env) + Symbol("let*") -> let_special(rest, env) + Symbol("fn*") -> fn_special(rest, env) + Symbol("try*") -> try_special(rest, env) + + Symbol("if") -> if_special(rest, env) + Symbol("do") -> do_special(rest, env) + Symbol("quote") -> + case rest { + [a] -> Ok(a) + _ -> types.wrong_type_err("any", rest) + } + Symbol("quasiquote") -> + case rest { + [a] -> quasiquote(a) |> eval(env) + _ -> types.wrong_type_err("any", rest) + } + _ -> { + use f <- result.try(eval(first, env)) + + case f { + Func(f, is_macro: True, ..) -> + f(rest) |> result.try(fn(res) { eval(res, env) }) + _ -> { + use args <- result.try(list.try_map(rest, fn(x) { eval(x, env) })) + + apply(f, args) + } + } + } + } +} + +fn def_special(rest, env) { + case rest { + [key, val] -> { + use k <- result.try(env.try_key(key)) + use v <- result.try(eval(val, env)) + env.set(env, k, v) + Ok(v) + } + _ -> types.wrong_type_err("symbol, any", rest) + } +} + +fn defmacro_special(rest, env) { + case rest { + [key, f] -> { + use k <- result.try(env.try_key(key)) + use f <- result.try(eval(f, env)) + case f { + Func(fun, ..) -> { + let v = Func(fun, is_macro: True, meta: types.Nil) + env.set(env, k, v) + Ok(v) + } + _ -> types.wrong_type_err("symbol, func", rest) + } + } + _ -> types.wrong_type_err("symbol, func", rest) + } +} + +fn let_special(rest, env) { + case rest { + [pairs, body] -> + case pairs { + List(l, _) | Vector(l, _) -> { + use pairs <- result.try( + get_pairs(l, []) + |> result.replace_error(types.EvalLetPairOddCount(l)), + ) + let let_env = env.into_outer(env) + + use _ <- result.try( + list.try_map(pairs, fn(x) { + use key <- result.try(env.try_key(x.0)) + use val <- result.try(eval(x.1, let_env)) + env.set(let_env, key, val) + + Ok(Nil) + }), + ) + + eval(body, let_env) + } + _ -> types.wrong_type_err("list | vector", [pairs]) + } + _ -> types.wrong_type_err("list | vector, any", rest) + } +} + +fn fn_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + case rest { + [List(params, _), body] | [Vector(params, _), body] -> { + use param_names <- result.try( + list.try_map(params, fn(x) { + case x { + Symbol(sym) -> Ok(sym) + _ -> Error(types.EvalFuncParamNotSymbol) + } + }), + ) + + let func = fn(args) { + let fn_env = env.into_outer(env) + use _ <- result.try(env.bind(fn_env, param_names, args)) + + eval(body, fn_env) + } + + Ok(Func(func, False, types.Nil)) + } + [_, _] as l -> types.wrong_type_err("list, any", l) + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } +} + +fn try_special(rest, env) { + case rest { + [a] -> eval(a, env) + [a, List([Symbol("catch*"), Symbol(sym), catch], _)] -> + case eval(a, env) { + Ok(res) -> Ok(res) + Error(err) -> { + let catch_env = env.into_outer(env) + let v = case err { + types.Throw(ast) -> ast + _ -> String(printer.pr_err(err)) + } + env.set(env, sym, v) + + eval(catch, catch_env) + } + } + _ -> types.wrong_type_err("any, (catch* symbol, any)?", rest) + } +} + +fn do_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + let do = list.take(rest, list.length(rest) - 1) + use _ <- result.try(list.try_map(do, fn(x) { eval(x, env) })) + + case list.last(rest) { + Error(_) -> Error(types.EvalWrongArgLenGreaterThan(1, 0)) + Ok(last) -> eval(last, env) + } +} + +fn if_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + case rest { + [predicate, branch_true, ..branch_false] -> { + use predicate <- result.try(eval(predicate, env)) + + use false_ast <- result.try(case branch_false { + [] -> Ok(types.Nil) + [f] -> Ok(f) + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + }) + + case predicate { + Bool(False) | types.Nil -> { + eval(false_ast, env) + } + _ -> { + eval(branch_true, env) + } + } + } + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + } +} + +fn make_call(sym, rest) { + List([Symbol(sym), ..rest], types.Nil) +} + +fn quasiquote(ast: MalType) -> MalType { + case ast { + List([Symbol("unquote"), x], _) -> x + List(l, _) -> qq_fold(l) + Vector(v, _) -> make_call("vec", [qq_fold(v)]) + HashMap(..) -> make_call("quote", [ast]) + Symbol(_) -> make_call("quote", [ast]) + _ -> ast + } +} + +fn qq_fold(l) { + list.fold_right(l, List([], types.Nil), qq_loop) +} + +fn qq_loop(acc, elt) { + case elt { + List([Symbol("splice-unquote"), splice], _) -> + make_call("concat", [splice, acc]) + _ -> make_call("cons", [quasiquote(elt), acc]) + } +} + +fn get_pairs(list, acc) { + case list { + [a, b, ..rest] -> { + get_pairs(rest, [#(a, b), ..acc]) + } + [] -> Ok(list.reverse(acc)) + _ -> Error(Nil) + } +} + +fn read(str) { + reader.read_str(str) +} + +fn print(ast) { + printer.pr_str(ast, True) +} + +fn rep(str, env) { + use r <- result.try(read(str)) + use e <- result.try(eval(r, env)) + + Ok(print(e)) +} diff --git a/impls/gleam/src/stepa_mal.gleam b/impls/gleam/src/stepa_mal.gleam new file mode 100644 index 0000000000..f2397b0243 --- /dev/null +++ b/impls/gleam/src/stepa_mal.gleam @@ -0,0 +1,347 @@ +import argv +import core +import env +import gleam/dict +import gleam/io +import gleam/list +import gleam/option.{None, Some} +import gleam/result +import printer +import reader +import readline.{readline} +import types.{ + type MalRet, type MalType, Bool, Func, HashMap, List, String, Symbol, Vector, +} + +pub fn main() -> Nil { + let env = env.from_list(core.ns(), None) + + let assert Ok(_) = + [ + "(def! not (fn* (a) (if a false true)))", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", + "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))", + ] + |> list.try_map(fn(x) { rep(x, env) }) + + env.set( + env, + "eval", + types.func(fn(args) { + case args { + [ast] -> eval(ast, env) + _ -> types.wrong_type_err("any", args) + } + }), + ) + + case argv.load().arguments { + [file, ..] -> { + let _ = case rep("(load-file \"" <> file <> "\")", env) { + Error(err) -> printer.pr_err(err) |> io.println_error() + _ -> Nil + } + } + _ -> { + let _ = rep("(println (str \"Mal [\" *host-language* \"]\"))", env) + let _ = loop(env) + Nil + } + } +} + +fn loop(env) { + use input <- result.try(readline("user> ")) + + input + |> rep(env) + |> print_res() + + loop(env) +} + +fn print_res(res) { + case res { + Ok(str) -> { + io.println(str) + } + Error(err) -> { + printer.pr_err(err) |> io.println_error() + } + } +} + +fn apply(x: MalType, args: List(MalType)) -> MalRet { + case x { + Func(f, ..) -> f(args) + _ -> Error(types.EvalApplyType(x)) + } +} + +fn eval(ast: MalType, env: env.Env) -> MalRet { + case env.get(env, "DEBUG-EVAL") { + None | Some(Bool(False)) | Some(types.Nil) -> Nil + _ -> { + io.println("EVAL: " <> printer.pr_str(ast, True)) + } + } + + case ast { + Symbol(sym) -> + env.get(env, sym) + |> option.to_result(types.EvalSymbolNotFound(sym)) + List([first, ..rest], _) -> eval_list(first, rest, env) + Vector(vec, _) -> + list.try_map(vec, fn(x) { eval(x, env) }) + |> result.map(fn(x) { Vector(x, types.Nil) }) + HashMap(hm, _) -> { + dict.to_list(hm) + |> list.try_map(fn(x) { + let key = x.0 + let val = x.1 + + eval(val, env) + |> result.map(fn(e) { #(key, e) }) + }) + |> result.map(fn(res) { HashMap(dict.from_list(res), types.Nil) }) + } + _ -> Ok(ast) + } +} + +fn eval_list(first, rest, env) -> Result(MalType, types.Error) { + case first { + Symbol("def!") -> def_special(rest, env) + Symbol("defmacro!") -> defmacro_special(rest, env) + Symbol("let*") -> let_special(rest, env) + Symbol("fn*") -> fn_special(rest, env) + Symbol("try*") -> try_special(rest, env) + + Symbol("if") -> if_special(rest, env) + Symbol("do") -> do_special(rest, env) + Symbol("quote") -> + case rest { + [a] -> Ok(a) + _ -> types.wrong_type_err("any", rest) + } + Symbol("quasiquote") -> + case rest { + [a] -> quasiquote(a) |> eval(env) + _ -> types.wrong_type_err("any", rest) + } + _ -> { + use f <- result.try(eval(first, env)) + + case f { + Func(f, is_macro: True, ..) -> + f(rest) |> result.try(fn(res) { eval(res, env) }) + _ -> { + use args <- result.try(list.try_map(rest, fn(x) { eval(x, env) })) + + apply(f, args) + } + } + } + } +} + +fn def_special(rest, env) { + case rest { + [key, val] -> { + use k <- result.try(env.try_key(key)) + use v <- result.try(eval(val, env)) + env.set(env, k, v) + Ok(v) + } + _ -> types.wrong_type_err("symbol, any", rest) + } +} + +fn defmacro_special(rest, env) { + case rest { + [key, f] -> { + use k <- result.try(env.try_key(key)) + use f <- result.try(eval(f, env)) + case f { + Func(fun, ..) -> { + let v = Func(fun, is_macro: True, meta: types.Nil) + env.set(env, k, v) + Ok(v) + } + _ -> types.wrong_type_err("symbol, func", rest) + } + } + _ -> types.wrong_type_err("symbol, func", rest) + } +} + +fn let_special(rest, env) { + case rest { + [pairs, body] -> + case pairs { + List(l, _) | Vector(l, _) -> { + use pairs <- result.try( + get_pairs(l, []) + |> result.replace_error(types.EvalLetPairOddCount(l)), + ) + let let_env = env.into_outer(env) + + use _ <- result.try( + list.try_map(pairs, fn(x) { + use key <- result.try(env.try_key(x.0)) + use val <- result.try(eval(x.1, let_env)) + env.set(let_env, key, val) + + Ok(Nil) + }), + ) + + eval(body, let_env) + } + _ -> types.wrong_type_err("list | vector", [pairs]) + } + _ -> types.wrong_type_err("list | vector, any", rest) + } +} + +fn fn_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + case rest { + [List(params, _), body] | [Vector(params, _), body] -> { + use param_names <- result.try( + list.try_map(params, fn(x) { + case x { + Symbol(sym) -> Ok(sym) + _ -> Error(types.EvalFuncParamNotSymbol) + } + }), + ) + + let func = fn(args) { + let fn_env = env.into_outer(env) + use _ <- result.try(env.bind(fn_env, param_names, args)) + + eval(body, fn_env) + } + + Ok(Func(func, False, types.Nil)) + } + [_, _] as l -> types.wrong_type_err("list, any", l) + _ -> Error(types.EvalWrongArgLen(2, list.length(rest))) + } +} + +fn try_special(rest, env) { + case rest { + [a] -> eval(a, env) + [a, List([Symbol("catch*"), Symbol(sym), catch], _)] -> + case eval(a, env) { + Ok(res) -> Ok(res) + Error(err) -> { + let catch_env = env.into_outer(env) + let v = case err { + types.Throw(ast) -> ast + _ -> String(printer.pr_err(err)) + } + env.set(env, sym, v) + + eval(catch, catch_env) + } + } + _ -> types.wrong_type_err("any, (catch* symbol, any)?", rest) + } +} + +fn do_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + let do = list.take(rest, list.length(rest) - 1) + use _ <- result.try(list.try_map(do, fn(x) { eval(x, env) })) + + case list.last(rest) { + Error(_) -> Error(types.EvalWrongArgLenGreaterThan(1, 0)) + Ok(last) -> eval(last, env) + } +} + +fn if_special( + rest: List(MalType), + env: env.Env, +) -> Result(MalType, types.Error) { + case rest { + [predicate, branch_true, ..branch_false] -> { + use predicate <- result.try(eval(predicate, env)) + + use false_ast <- result.try(case branch_false { + [] -> Ok(types.Nil) + [f] -> Ok(f) + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + }) + + case predicate { + Bool(False) | types.Nil -> { + eval(false_ast, env) + } + _ -> { + eval(branch_true, env) + } + } + } + _ -> Error(types.EvalWrongArgLenRange(#(3, 4), list.length(rest))) + } +} + +fn make_call(sym, rest) { + List([Symbol(sym), ..rest], types.Nil) +} + +fn quasiquote(ast: MalType) -> MalType { + case ast { + List([Symbol("unquote"), x], _) -> x + List(l, _) -> qq_fold(l) + Vector(v, _) -> make_call("vec", [qq_fold(v)]) + HashMap(..) -> make_call("quote", [ast]) + Symbol(_) -> make_call("quote", [ast]) + _ -> ast + } +} + +fn qq_fold(l) { + list.fold_right(l, List([], types.Nil), qq_loop) +} + +fn qq_loop(acc, elt) { + case elt { + List([Symbol("splice-unquote"), splice], _) -> + make_call("concat", [splice, acc]) + _ -> make_call("cons", [quasiquote(elt), acc]) + } +} + +fn get_pairs(list, acc) { + case list { + [a, b, ..rest] -> { + get_pairs(rest, [#(a, b), ..acc]) + } + [] -> Ok(list.reverse(acc)) + _ -> Error(Nil) + } +} + +fn read(str) { + reader.read_str(str) +} + +fn print(ast) { + printer.pr_str(ast, True) +} + +fn rep(str, env) { + use r <- result.try(read(str)) + use e <- result.try(eval(r, env)) + + Ok(print(e)) +} diff --git a/impls/gleam/src/types.gleam b/impls/gleam/src/types.gleam new file mode 100644 index 0000000000..bd2c0a7af8 --- /dev/null +++ b/impls/gleam/src/types.gleam @@ -0,0 +1,135 @@ +import gleam/dict.{type Dict} +import gleam/list +import gleam/result +import gleam/string +import mut_cell.{type MutCell} + +pub type MalRet = + Result(MalType, Error) + +pub type MalType { + Nil + Int(Int) + Bool(Bool) + String(String) + Symbol(String) + Keyword(String) + List(List(MalType), meta: MalType) + Vector(List(MalType), meta: MalType) + HashMap(Dict(MalType, MalType), meta: MalType) + Atom(MutCell(MalType)) + + Func(fn(List(MalType)) -> MalRet, is_macro: Bool, meta: MalType) +} + +pub fn func(f: fn(List(MalType)) -> MalRet) { + Func(f, False, Nil) +} + +fn list_to_pairs( + l: List(MalType), + acc: List(#(MalType, MalType)), +) -> Result(List(#(MalType, MalType)), Error) { + case l { + [] -> Ok(acc) + [String(_) as a, b, ..rest] | [Keyword(_) as a, b, ..rest] -> + list_to_pairs(rest, [#(a, b), ..acc]) + _ -> Error(StrErr("failed to get hashmap pairs")) + } +} + +pub fn assoc(list) -> Result(Dict(_, _), Error) { + use pairs <- result.try(list_to_pairs(list, [])) + // Reversed for (get { :a 1 :a 2 } :a) -> 2 + Ok(dict.from_list(list.reverse(pairs))) +} + +pub fn hashmap(list) -> MalRet { + assoc(list) + |> result.map(fn(res) { HashMap(res, Nil) }) +} + +pub fn eq(a: MalType, b: MalType) -> Bool { + case a, b { + List(l, _), Vector(v, _) + | Vector(l, _), List(v, _) + | List(l, _), List(v, _) + | Vector(l, _), Vector(v, _) + -> seq_eq(l, v) + HashMap(a, _), HashMap(b, _) -> hm_eq(a, b) + _, _ -> a == b + } +} + +fn hm_eq(a: Dict(MalType, MalType), b: Dict(MalType, MalType)) -> Bool { + case dict.size(a) == dict.size(b) { + True -> { + list.all(dict.to_list(a), fn(pairs) { + let #(key, val) = pairs + case dict.get(b, key) { + Ok(val_b) -> eq(val, val_b) + _ -> False + } + }) + } + False -> False + } +} + +fn seq_eq(a: List(MalType), b: List(MalType)) { + case a, b { + [x, ..rest], [y, ..rest2] -> + case eq(x, y) { + False -> False + True -> seq_eq(rest, rest2) + } + [], [] -> True + _, _ -> False + } +} + +pub fn wrong_type_err(expected: String, got: List(MalType)) { + let t = + got + |> list.map(fn(x) { + case x { + Nil -> "nil" + Int(_) -> "int" + Bool(_) -> "bool" + String(_) -> "string" + Symbol(_) -> "symbol" + Keyword(_) -> "keyword" + List(..) -> "list" + Vector(..) -> "vector" + HashMap(..) -> "hashmap" + Func(..) -> "func" + Atom(_) -> "atom" + } + }) + |> string.join(", ") + + Error(EvalWrongType(expected, t)) +} + +pub type Error { + ReaderEof(expected: String) + ReaderInvalidHashMap + ReaderEmpyForm + + EvalWrongArgLen(expected: Int, got: Int) + EvalWrongArgLenRange(expected: #(Int, Int), got: Int) + EvalWrongArgLenGreaterThan(expected: Int, got: Int) + EvalWrongType(expected: String, got: String) + EvalDivideByZero + EvalLetPairOddCount(got: List(MalType)) + EvalApplyType(got: MalType) + EvalSymbolNotFound(symbol: String) + EvalFuncParamNotSymbol + + EnvToKey(ast: MalType) + + Throw(MalType) + + /// Used for one off errors + StrErr(String) +}