From 0a61b05f06f5404d7ba4a3256b1fc0d7f5a8c0e8 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Tue, 20 Aug 2024 23:30:10 +0200 Subject: [PATCH 01/39] lean: step0_repl --- Makefile.impls | 3 +- impls/lean/.gitignore | 1 + impls/lean/LeanMal.lean | 2 + impls/lean/LeanMal/step0_repl.lean | 24 ++++++++ impls/lean/Makefile | 22 +++++++ impls/lean/README.md | 1 + impls/lean/lake-manifest.json | 95 ++++++++++++++++++++++++++++++ impls/lean/lakefile.lean | 22 +++++++ impls/lean/lean-toolchain | 1 + impls/lean/run | 2 + 10 files changed, 172 insertions(+), 1 deletion(-) create mode 100644 impls/lean/.gitignore create mode 100644 impls/lean/LeanMal.lean create mode 100644 impls/lean/LeanMal/step0_repl.lean create mode 100644 impls/lean/Makefile create mode 100644 impls/lean/README.md create mode 100644 impls/lean/lake-manifest.json create mode 100644 impls/lean/lakefile.lean create mode 100644 impls/lean/lean-toolchain create mode 100755 impls/lean/run diff --git a/Makefile.impls b/Makefile.impls index 32fe439ca6..ee9699e560 100644 --- a/Makefile.impls +++ b/Makefile.impls @@ -36,7 +36,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 \ - guile haskell haxe hy io janet java java-truffle js jq julia kotlin latex3 livescript logo lua make mal \ + guile haskell haxe hy io janet java java-truffle js jq julia kotlin latex3 lean livescript logo lua make mal \ matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \ plsql powershell prolog ps purs python python.2 r racket rexx rpython ruby ruby.2 rust scala scheme skew sml \ swift swift3 swift4 swift5 tcl ts vala vb vbs vhdl vimscript wasm wren yorick xslt zig @@ -149,6 +149,7 @@ jq_STEP_PROG = impls/jq/$($(1)).jq julia_STEP_TO_PROG = impls/julia/$($(1)).jl kotlin_STEP_TO_PROG = impls/kotlin/$($(1)).jar latex3_STEP_TO_PROG = impls/latex3/$($(1)).tex +lean_STEP_TO_PROG = impls/lean/$($(1)) livescript_STEP_TO_PROG = impls/livescript/$($(1)).js logo_STEP_TO_PROG = impls/logo/$($(1)).lg lua_STEP_TO_PROG = impls/lua/$($(1)).lua diff --git a/impls/lean/.gitignore b/impls/lean/.gitignore new file mode 100644 index 0000000000..bfb30ec8c7 --- /dev/null +++ b/impls/lean/.gitignore @@ -0,0 +1 @@ +/.lake diff --git a/impls/lean/LeanMal.lean b/impls/lean/LeanMal.lean new file mode 100644 index 0000000000..d8cccf1d66 --- /dev/null +++ b/impls/lean/LeanMal.lean @@ -0,0 +1,2 @@ +-- This module serves as the root of the `Mal` library. +-- Import modules here that should be built as part of the library. diff --git a/impls/lean/LeanMal/step0_repl.lean b/impls/lean/LeanMal/step0_repl.lean new file mode 100644 index 0000000000..f55373406f --- /dev/null +++ b/impls/lean/LeanMal/step0_repl.lean @@ -0,0 +1,24 @@ +def READ (input : String) := input + +def EVAL (input : String) (_: String) := input + +def PRINT (input : String) := input + +def rep (input : String): String := + PRINT (EVAL (READ input) "") + +def main : IO Unit := do + IO.println "Welcome to Mal REPL!" + let mut donext := true + while donext do + IO.print "user> " + let stdin ← IO.getStdin + let input ← stdin.getLine + let value := input.trim + if value = "exit" then + donext := false + IO.println "Exiting REPL." + if value.isEmpty then + donext := false + else + IO.println (rep value) diff --git a/impls/lean/Makefile b/impls/lean/Makefile new file mode 100644 index 0000000000..93795e1d1c --- /dev/null +++ b/impls/lean/Makefile @@ -0,0 +1,22 @@ +# List of Lean binaries you want to produce +LEAN_BINARIES = 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 + +# Default target to build all binaries +all: $(LEAN_BINARIES) + +# Target for each Lean binary +$(LEAN_BINARIES): % : .lake/build/bin/% + cp $< ./ + +# Trigger the Lean build if binaries do not exist +.lake/build/bin/%: + lake build + +# Phony targets to avoid file name conflicts +.PHONY: all clean + +# Clean up all generated binaries +clean: + rm -f $(LEAN_BINARIES) && rm -rf ./.lake/build/bin diff --git a/impls/lean/README.md b/impls/lean/README.md new file mode 100644 index 0000000000..180ffcfa72 --- /dev/null +++ b/impls/lean/README.md @@ -0,0 +1 @@ +# mal diff --git a/impls/lean/lake-manifest.json b/impls/lean/lake-manifest.json new file mode 100644 index 0000000000..dafe18e287 --- /dev/null +++ b/impls/lean/lake-manifest.json @@ -0,0 +1,95 @@ +{"version": "1.1.0", + "packagesDir": ".lake/packages", + "packages": + [{"url": "https://github.com/leanprover-community/batteries", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "a975dea2c4d8258a55b4f9861c537e2bb0f9ef63", + "name": "batteries", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover-community/quote4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "71f54425e6fe0fa75f3aef33a2813a7898392222", + "name": "Qq", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover-community/aesop", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "776a5a8f9c789395796e442d78a9d4cb9c4c9d03", + "name": "aesop", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/ProofWidgets4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "a96aee5245720f588876021b6a0aa73efee49c76", + "name": "proofwidgets", + "manifestFile": "lake-manifest.json", + "inputRev": "v0.0.41", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/leanprover/lean4-cli", + "type": "git", + "subDir": null, + "scope": "", + "rev": "2cf1030dc2ae6b3632c84a09350b675ef3e347d0", + "name": "Cli", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/import-graph", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "57bd2065f1dbea5e9235646fb836c7cea9ab03b6", + "name": "importGraph", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml"}, + {"url": "https://github.com/leanprover-community/mathlib4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "b72af9fce632c0cc0fa928dc1a55efb9f0aa68da", + "name": "mathlib", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": false, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/fgdorais/lean4-unicode-basic", + "type": "git", + "subDir": null, + "scope": "", + "rev": "9447739fe9714f8a091192bad5cd5e7b5a8ae1e4", + "name": "UnicodeBasic", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.lean"}, + {"url": "https://github.com/fgdorais/lean4-parser", + "type": "git", + "subDir": null, + "scope": "", + "rev": "a145b9deb3272fb8af7d26d06f5ab70ae5e3d575", + "name": "Parser", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": false, + "configFile": "lakefile.toml"}], + "name": "mal", + "lakeDir": ".lake"} diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean new file mode 100644 index 0000000000..3be902850f --- /dev/null +++ b/impls/lean/lakefile.lean @@ -0,0 +1,22 @@ +import Lake +open Lake DSL + +package "mal" where + -- Settings applied to both builds and interactive editing + leanOptions := #[ + ⟨`pp.unicode.fun, true⟩ -- pretty-prints `fun a ↦ b` + ] + -- add any additional package configuration options here + +require "leanprover-community" / "mathlib" + +require Parser from git "https://github.com/fgdorais/lean4-parser" @ "main" + +@[default_target] +lean_lib LeanMal where + -- add any library configuration options here + +@[default_target] +lean_exe "step0_repl" { + root := `LeanMal.step0_repl +} diff --git a/impls/lean/lean-toolchain b/impls/lean/lean-toolchain new file mode 100644 index 0000000000..e7a4f40b89 --- /dev/null +++ b/impls/lean/lean-toolchain @@ -0,0 +1 @@ +leanprover/lean4:v4.11.0-rc2 diff --git a/impls/lean/run b/impls/lean/run new file mode 100755 index 0000000000..8ba68a5484 --- /dev/null +++ b/impls/lean/run @@ -0,0 +1,2 @@ +#!/bin/bash +exec $(dirname $0)/${STEP:-stepA_mal} "${@}" From 634252f191652975f8d7c2052c12ee6d7e129b49 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Wed, 21 Aug 2024 15:34:05 +0200 Subject: [PATCH 02/39] lean: step1_read_print --- impls/lean/LeanMal/printer.lean | 6 + impls/lean/LeanMal/reader.lean | 225 +++++++++++++++++++++++ impls/lean/LeanMal/step0_repl.lean | 2 + impls/lean/LeanMal/step1_read_print.lean | 35 ++++ impls/lean/LeanMal/types.lean | 216 ++++++++++++++++++++++ impls/lean/lakefile.lean | 10 + 6 files changed, 494 insertions(+) create mode 100644 impls/lean/LeanMal/printer.lean create mode 100644 impls/lean/LeanMal/reader.lean create mode 100644 impls/lean/LeanMal/step1_read_print.lean create mode 100644 impls/lean/LeanMal/types.lean diff --git a/impls/lean/LeanMal/printer.lean b/impls/lean/LeanMal/printer.lean new file mode 100644 index 0000000000..8593e43fb6 --- /dev/null +++ b/impls/lean/LeanMal/printer.lean @@ -0,0 +1,6 @@ +import LeanMal.types + +universe u + +def pr_str (readably: Bool) (input : Types) : String := + input.toString readably diff --git a/impls/lean/LeanMal/reader.lean b/impls/lean/LeanMal/reader.lean new file mode 100644 index 0000000000..91ba28b344 --- /dev/null +++ b/impls/lean/LeanMal/reader.lean @@ -0,0 +1,225 @@ +import Lean +import Mathlib +import LeanMal.types + +open Lean Lean.Parsec + +universe u + +-- parser for optional whitespace +def wspace : Parsec Unit := + many (pchar ' ' <|> pchar '\t' <|> pchar '\n' <|> pchar '\r') *> pure () + +def wspace_or_comma_strict : Parsec Unit := + many1 (pchar ' ' <|> pchar ',' <|> pchar '\t' <|> pchar '\n' <|> pchar '\r') *> pure () + +-- custom `sep_by` combinator +partial def sep_by {α β : Type} (p : Parsec α) (sep : Parsec β) : Parsec (Array α) := do + let mut res := #[] + let first ← optional p + match first with + | none => pure res + | some x => + res := res.push x + while true do + let next ← optional (sep *> p) + match next with + | none => break + | some y => res := res.push y + pure res + + +def int_to_float (n : Int) : Float := + if n >= 0 then + Float.ofNat n.toNat + else + -Float.ofNat (-n).toNat + +def read_float (intPart fracPart expPart : String) (sign : Option Char) : Option Float := + let fullnum := (intPart ++ fracPart).toNat! + let plc := fracPart.length + let exponent := expPart.toInt! + let floatVal := Float.ofScientific fullnum true plc + let adjustedFloat := floatVal * Float.pow 10.0 (int_to_float exponent) + match sign with + | some '-' => some (-adjustedFloat) + | _ => some adjustedFloat + +def read_str_val : Parsec Types := do + let _ ← pchar '"' + let str ← manyChars (do + let c ← satisfy (λ c => c ≠ '"') + if c = '\\' then + let nextChar ← anyChar + match nextChar with + | '"' => pure '"' + | '\\' => pure '\\' + | 'n' => pure '\n' + | 't' => pure '\t' + | _ => fail s!"Invalid escape sequence: \\{nextChar}" + else + pure c + ) + let _ ← pchar '"' + return Types.strVal str + +def read_bool_val : Parsec Types := do + ws + let b ← (pstring "true" <|> pstring "false") + return Types.boolVal (b == "true") + +def read_nil_val : Parsec Types := do + ws + let _ ← pstring "nil" + return Types.Nil + +def read_symbol_val : Parsec Types := do + ws + let sym ← many1Chars (satisfy (λ c => c.isAlphanum || c == '_' || c == '+' || c == '*' || c == '!' || c == '/' || c == '-' || c == '=' || c == '<' || c == '>' || c == ':')) + ws + return Types.symbolVal sym + +def read_keyword : Parsec Types := do + let _ ← pstring ":" + let rest ← read_symbol_val + match rest with + | Types.symbolVal x => return Types.keywordVal x + | _ => fail "not keyword" + +def read_float_or_int_internal (sign: Option Char) : Parsec Types := do + let intPart ← many1Chars digit + optional (pchar '.') >>= fun + | some _ => do + let fracPart ← many1Chars digit + optional (pchar 'e' <|> pchar 'E') >>= fun + | some _ => do + let expPart ← manyChars (pchar '+' <|> pchar '-' <|> digit) + let floatStr := intPart ++ "." ++ fracPart ++ "e" ++ expPart + match read_float intPart fracPart expPart sign with + | some f => return Types.floatVal f + | none => fail s!"Invalid float: {floatStr}" + | none => do + let floatStr := intPart ++ "." ++ fracPart + match read_float intPart fracPart "0" sign with + | some f => return Types.floatVal f + | none => fail s!"Invalid float: {floatStr}" + | none => do + let intVal := intPart.toInt! + return Types.intVal (match sign with | some '-' => -intVal | _ => intVal) + +def read_float_or_int : Parsec Types := do + let sign ← optional (pchar '+' <|> pchar '-') + read_float_or_int_internal sign + +def read_operator_or_number : Parsec Types := do + let sign ← (pchar '+' <|> pchar '-') + let nextChar ← peek? + match nextChar with + | some c => + if c.isWhitespace then return Types.symbolVal (String.singleton sign) + else if c.isDigit then read_float_or_int_internal sign + else + let rest ← read_symbol_val + match rest with + | Types.symbolVal x => return Types.symbolVal (String.singleton sign ++ x) + | _ => return Types.symbolVal (String.singleton sign) + | none => return Types.symbolVal (String.singleton sign) + +mutual + partial def read_list (envir: Dict := Dict.empty) : Parsec Types := do + -- ws + let _ ← optional wspace_or_comma_strict + let _ ← pstring "(" + let _ ← optional wspace_or_comma_strict + let els ← many (do + let e ← read_types envir + let _ ← optional wspace_or_comma_strict + -- let _ ← optional (pchar ',') + return e) + -- ws + let _ ← optional wspace_or_comma_strict + let _ ← pchar ')' + let _ ← optional wspace_or_comma_strict + return Types.listVal (els.toList) + + partial def read_vector (envir: Dict := Dict.empty) : Parsec Types := do + let _ ← optional wspace_or_comma_strict + let _ ← pchar '[' + let _ ← optional wspace_or_comma_strict + let els ← many (do + let e ← read_types envir + let _ ← optional wspace_or_comma_strict + -- let _ ← optional (pchar ',') + return e) + let _ ← optional wspace_or_comma_strict + let _ ← pchar ']' + let _ ← optional wspace_or_comma_strict + let vecLst := els.toList + let vec := listToVec vecLst + return Types.vecVal vec + + partial def read_hash_map (_: Dict := Dict.empty) : Parsec Types := do + let _ ← optional wspace_or_comma_strict + let _ ← pchar '{' + let _ ← optional wspace_or_comma_strict + let els ← sep_by read_hash_map_pair (wspace *> optional (pchar ',') *> wspace) + let _ ← optional wspace_or_comma_strict + let _ ← pchar '}' + let _ ← optional wspace_or_comma_strict + let dict := Array.foldl (fun m (k, v) => + + m.insert k v + ) (Dict.empty) els + return Types.dictVal dict + + -- A parser for key-value pairs (String, Int in this case) + partial def read_hash_map_pair : Parsec (KeyType × Types) := do + let _ ← optional wspace_or_comma_strict + let key ← read_keyword <|> read_str_val + let _ ← optional wspace_or_comma_strict + let value ← read_types + let _ ← optional wspace_or_comma_strict + + match key with + | Types.keywordVal v => return (KeyType.keywordKey v, value) + | Types.strVal v => return (KeyType.strKey v, value) + | _ => default + + partial def read_symbol (chars: String) (name: String) (envir: Dict := Dict.empty) : Parsec Types := do + let _ ← optional wspace_or_comma_strict + let _ ← pstring chars + let elem ← read_types envir + let _ ← optional wspace_or_comma_strict + + let vecLst := [(Types.symbolVal name), elem] + return Types.listVal vecLst + + partial def read_with_meta (envir: Dict := Dict.empty) : Parsec Types := do + ws + let _ ← pstring "^" + + let els ← many (do + let e ← read_types envir + ws + let _ ← optional (pchar ',') + return e) + + let elsVec := els.toList + let vecLst := (Types.symbolVal "with-meta") :: elsVec + return Types.listVal (List.append vecLst elsVec) + + partial def read_atom (_: Dict := Dict.empty) : Parsec Types := + read_operator_or_number <|> read_float_or_int <|> read_str_val <|> read_keyword <|> read_nil_val <|> read_bool_val <|> read_symbol_val + + partial def read_types (envir: Dict := Dict.empty) : Parsec Types := + read_list envir <|> read_vector envir <|> read_hash_map envir <|> read_symbol "'" "quote" envir <|> read_symbol "`" "quasiquote" envir <|> read_symbol "~@" "splice-unquote" envir <|> read_symbol "~" "unquote" envir <|> read_symbol "@" "deref" envir <|> read_with_meta envir <|> read_atom envir + +end + +def read_types_with_env (input : String) (envir: Dict := Dict.empty) : Except String Types := + match read_types envir input.trim.iter with + | Lean.Parsec.ParseResult.success _ res => Except.ok res + | Lean.Parsec.ParseResult.error _ err => Except.error err + +def read_str (input : String) : Except String Types := + read_types_with_env input (Dict.empty : Dict.{u}) diff --git a/impls/lean/LeanMal/step0_repl.lean b/impls/lean/LeanMal/step0_repl.lean index f55373406f..33bc7b379d 100644 --- a/impls/lean/LeanMal/step0_repl.lean +++ b/impls/lean/LeanMal/step0_repl.lean @@ -1,3 +1,5 @@ +universe u + def READ (input : String) := input def EVAL (input : String) (_: String) := input diff --git a/impls/lean/LeanMal/step1_read_print.lean b/impls/lean/LeanMal/step1_read_print.lean new file mode 100644 index 0000000000..282a5c3e72 --- /dev/null +++ b/impls/lean/LeanMal/step1_read_print.lean @@ -0,0 +1,35 @@ +import LeanMal.reader +import LeanMal.printer + +universe u + +def READ (input : String) := + read_str.{u} input + +def EVAL (ast : Types) (_: String) := ast + +def PRINT (ast : Types): String := + pr_str true ast + +def rep (input : String): String := + match READ.{u} input with + | Except.ok result => + PRINT (EVAL result "") + | Except.error err => + s!"Parsing failed: {err}" + +def main : IO Unit := do + IO.println "Welcome to Mal REPL!" + let mut donext := true + while donext do + IO.print "user> " + let stdin ← IO.getStdin + let input ← stdin.getLine + let value := input.trim + if value = "exit" then + donext := false + IO.println "Exiting REPL." + if value.isEmpty then + donext := false + else + IO.println (rep.{u} value) diff --git a/impls/lean/LeanMal/types.lean b/impls/lean/LeanMal/types.lean new file mode 100644 index 0000000000..c44456c770 --- /dev/null +++ b/impls/lean/LeanMal/types.lean @@ -0,0 +1,216 @@ +import Lean.Data.RBMap +import Lean + +set_option diagnostics true +set_option genSizeOfSpec false +set_option diagnostics.threshold 5000 + +universe u + +inductive Vec (α : Type u) : Nat → Type u +| nil : Vec α 0 +| cons : α → Vec α n → Vec α (n + 1) +deriving Repr + +-- Define the map function for Vec +def map {α : Type u} {β : Type v} {n : Nat} (f : α → β) : Vec α n → Vec β n +| Vec.nil => Vec.nil +| Vec.cons x xs => Vec.cons (f x) (map f xs) + +-- Function to convert Vec to List +def toList {α : Type u} {n : Nat} : Vec α n → List α +| Vec.nil => [] +| Vec.cons x xs => x :: toList xs + +def listToVec : (lst : List Types) → Vec Types lst.length + | [] => Vec.nil + | x :: xs => Vec.cons x (listToVec xs) + +inductive KeyType + | strKey : String → KeyType + | keywordKey : String → KeyType + deriving Repr + +mutual + + inductive Types : Type u + | strVal (v : String) + | intVal (v : Int) + | floatVal (v : Float) + | boolVal (v : Bool) + | symbolVal (sym: String) + | keywordVal (key: String) + | listVal (el : List Types) + | funcVal (el: Fun) + | vecVal {n : Nat} (el : Vec Types n) + | dictVal (el : Dict) + | atomVal (el: Atom) + | Nil + deriving Repr + + inductive Fun : Type u + | builtin (name : String) + | userDefined (ref: Dict) (params : Types) (body : Types) + | macroFn (ref: Dict) (params : Types) (body : Types) + + inductive Dict: Type u + | empty : Dict + | insert: KeyType → Types → Dict → Dict + deriving Repr + + inductive Atom + | v : Types -> Atom + | withmeta : Types → Types → Atom + deriving Repr + +end + +def getEntry : Dict → KeyType → Option Types + | Dict.empty, _ => default + | Dict.insert k v d, key => + match k, key with + | KeyType.strKey ks, KeyType.strKey keyg => if ks = keyg then some v else getEntry d key + | KeyType.keywordKey ks, KeyType.keywordKey keyg => if ks = keyg then some v else getEntry d key + | KeyType.strKey ks, KeyType.keywordKey keyg => if ks = keyg then some v else getEntry d key + | KeyType.keywordKey ks, KeyType.strKey keyg => if ks = keyg then some v else getEntry d key + +def addEntry : Dict → KeyType → Types → Dict + | d, k, v => Dict.insert k v d + +def getKeys : Dict → List KeyType + | Dict.empty => [] + | Dict.insert k _ d => + let restKeys := getKeys d + k :: restKeys + +def getValues : Dict → List Types + | Dict.empty => [] + | Dict.insert _ v d => + let restValues := getValues d + v :: restValues + +def removeKey (d : Dict) (key : KeyType) : Dict := + match d with + | Dict.empty => Dict.empty + | Dict.insert k v rest => + match k, key with + | KeyType.strKey ks, KeyType.strKey keyg => if ks = keyg then removeKey rest key else Dict.insert k v (removeKey rest key) + | KeyType.keywordKey ks, KeyType.keywordKey keyg => if ks = keyg then removeKey rest key else Dict.insert k v (removeKey rest key) + | KeyType.strKey ks, KeyType.keywordKey keyg => if ks = keyg then removeKey rest key else Dict.insert k v (removeKey rest key) + | KeyType.keywordKey ks, KeyType.strKey keyg => if ks = keyg then removeKey rest key else Dict.insert k v (removeKey rest key) + +-- Function to merge two Dicts +def mergeDicts : Dict → Dict → Dict + | d1, Dict.empty => d1 -- If the second Dict is empty, return the first Dict + | d1, Dict.insert k v rest => + let d1Updated := Dict.insert k v d1 + mergeDicts d1Updated rest + +-- Function to extract the string from a Types.symbolVal +def getSymbol (t : Types) : Option String := + match t with + | Types.symbolVal sym => some sym + | _ => none + +def getKeyword (t : Types) : Option String := + match t with + | Types.keywordVal key => some key + | _ => none + +def buildDictWithSymbols (ref: Dict) (keys : List String) (values : List Types) : Dict := + match keys, values with + | [], _ => Dict.empty + | _, [] => Dict.empty + | key :: keyTail, value :: valueTail => + let val := match value with + | Types.symbolVal v => + let entry := getEntry ref (KeyType.strKey v) + match entry with + | some v => v + | none => Types.Nil + | _ => value + let restDict := buildDictWithSymbols ref keyTail valueTail + Dict.insert (KeyType.strKey key) val restDict + +instance : Inhabited Dict where + default := Dict.empty + +instance : Inhabited Types where + default := Types.Nil + +instance : Inhabited (List Types) where + default := [] + +instance : Inhabited (Dict × Types) where + default := (default, default) + +def Types.toBool: Types -> Bool + | Types.boolVal v => if v then true else false + | Types.Nil => false + | _ => true + +def getFirst! (lst : List Types) : Types := + match lst with + | [] => default + | x :: _ => x + +def escapeString (input : String) : String := + input.foldl (fun acc c => + acc ++ match c with + | '\\' => "\\\\" + -- | '"' => "\\\"" + | '\"' => "\\\"" + | '\n' => "\\n" + | _ => String.singleton c + ) "" + +mutual + partial def Types.toString (readably: Bool) (t:Types) : String := + match t with + | Types.strVal v => stringToString readably v + | Types.intVal v => s!"{v}" + | Types.floatVal v => s!"{v}" + | Types.boolVal v => s!"{v}" + | Types.funcVal el => Fun.toString readably el + -- | Types.funcVal v => "(" ++ s!"{(Types.toString v)}" ++ ")" + | Types.listVal el => s!"({String.intercalate " " (el.map (Types.toString readably))})" + | Types.dictVal el => "{" ++ s!"{Dict.toString readably el}" ++ "}" + | Types.Nil => "nil" + | Types.symbolVal sym => s!"{sym}" + | Types.keywordVal key => s!":{key}" + | Types.vecVal el => + let content := toList el + s!"[{String.intercalate " " (content.map (Types.toString readably))}]" + | Types.atomVal el => Atom.toString readably el + + partial def stringToString (readably: Bool) (v:String) : String := + if readably then s!"\"{escapeString v}\"" + else v + + partial def Atom.toString (readably: Bool) (t:Atom) : String := + match t with + | Atom.v v => s!"(atom {v.toString readably})" + | Atom.withmeta v _ => s!"(atom {v.toString readably})" + + partial def Fun.toString (readably: Bool) (t:Fun) : String := + match t with + | Fun.userDefined _ params body => "(fn* " ++ s!"{(Types.toString readably params)}" ++ s!"{(Types.toString readably body)}" ++ ")" + | Fun.macroFn _ params body => "(fn* " ++ s!"{(Types.toString readably params)}" ++ s!"{(Types.toString readably body)}" ++ ")" + | Fun.builtin name => s!"{name}" + + partial def Dict.toString (readably: Bool) (d:Dict) : String := + match d with + | Dict.empty => "" + | Dict.insert key value Dict.empty => + match key with + | KeyType.strKey k => s!"\"{k}\" {Types.toString readably value}" + | KeyType.keywordKey k => s!":{k} {Types.toString readably value}" + | Dict.insert key value rest => + let restStr := Dict.toString readably rest + match key with + | KeyType.strKey k => s!"{restStr} \"{k}\" {Types.toString readably value}" + | KeyType.keywordKey k => s!"{restStr} :{k} {Types.toString readably value}" + + + +end diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean index 3be902850f..9923eca359 100644 --- a/impls/lean/lakefile.lean +++ b/impls/lean/lakefile.lean @@ -20,3 +20,13 @@ lean_lib LeanMal where lean_exe "step0_repl" { root := `LeanMal.step0_repl } + +@[default_target] +lean_exe "step1_read_print" { + root := `LeanMal.step1_read_print +} + +@[default_target] +lean_exe "mal" { + root := `LeanMal.step1_read_print +} From 8cb71198435205d2196fb30139ac0c1e79002392 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Thu, 22 Aug 2024 13:40:04 +0200 Subject: [PATCH 03/39] lean: step2_eval --- impls/lean/LeanMal/step2_eval.lean | 158 +++++++++++++++++++++++++++++ impls/lean/lakefile.lean | 5 + 2 files changed, 163 insertions(+) create mode 100644 impls/lean/LeanMal/step2_eval.lean diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean new file mode 100644 index 0000000000..190c05e04b --- /dev/null +++ b/impls/lean/LeanMal/step2_eval.lean @@ -0,0 +1,158 @@ +import LeanMal.reader +import LeanMal.printer + +universe u + +def READ (input : String): Except String Types := + read_str.{u} input + +def sum (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x + y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x + y)) + | _ => Except.error "+ operator not supported" + +def sub (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x - y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x - y)) + | _ => Except.error "- operator not supported" + +def mul (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x * y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x * y)) + | _ => Except.error "* operator not supported" + +def div (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x / y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x / y)) + | _ => Except.error "/ operator not supported" + +def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types): Except String (Dict × Types) := + match name with + | "+" => sum ref results + | "-" => sub ref results + | "*" => mul ref results + | "/" => div ref results + | _ => Except.error s!"function not found: {name}" + +mutual + + partial def evalTypes (ref : Dict := Dict.empty) (ast : Types) : Except String (Dict × Types) := + match ast with + | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with + | some vi => Except.ok (ref, vi) + | none => Except.ok (ref, Types.symbolVal v ) + | Types.listVal el => (evalList ref el) + | Types.vecVal el => (evalVec ref (toList el)) + | Types.dictVal el => (evalDict ref el) + | x => Except.ok (ref, x) + + partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except String (Dict × Types) := + match evalTypes ref head with + | Except.error e => Except.error s!"error evaluating function: {head.toString true}: {e}" + | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + + partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except String (Dict × Types) := + -- first execute each function argument - reduce computation + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + match fn with + | Types.symbolVal name => evalFnNative newRef name results + | Types.funcVal v => match v with + | Fun.builtin name => evalFnNative newRef name results + | Fun.userDefined fref params body => + let keys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + + let built := buildDictWithSymbols fref keys results + let merged := mergeDicts newRef built + evalTypes merged body + | Fun.macroFn _ _ _ => Except.error "macro not implemented" + | _ => Except.error s!"`unexpected token, expected: function`" + + partial def evalList (ref: Dict) (lst : List Types) : Except String (Dict × Types) := + if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + else + let head := lst[0]! + match lst[0]! with + | Types.symbolVal v => match v with + | _ => evalFunc ref head (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + + partial def evalVec (ref: Dict) (elems : List Types) : Except String (Dict × Types) := + match evalFuncArgs ref elems with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + + partial def evalDict (ref: Dict) (lst : Dict) : Except String (Dict × Types) := + match evalDictInner ref lst with + | Except.error e => Except.error e + | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + + partial def evalDictInner (ref: Dict) (lst : Dict) : Except String (Dict × Dict) := + match lst with + | Dict.empty => Except.ok (ref, lst) + | Dict.insert k v restDict => match evalTypes ref v with + | Except.error e => Except.error e + | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.error e => Except.error e + | Except.ok (updatedRef, updatedDict) => + let newDict := Dict.insert k newVal updatedDict + Except.ok (updatedRef, newDict) + + partial def evalFuncArgs (ref: Dict) (args: List Types) : Except String (Dict × List Types) := + match args.foldl (fun (res : Except String (Dict × List Types)) x => + match res with + | Except.error e => Except.error s!"error evaluating function argument accumulator: {x.toString true}: {e}" + | Except.ok (r, acc) => match evalTypes r x with + | Except.error e => Except.error s!"error evaluating function argument: {x.toString true}: {e}" + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, acc ++ [res]) + ) (Except.ok (ref, [])) with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) +end + +def PRINT (ast : Types): String := + pr_str true ast + +def rep (input : String): String := + match READ.{u} input with + | Except.ok result => match evalTypes Dict.empty result with + | Except.error e => e + | Except.ok (_, res) => PRINT res + | Except.error err => + s!"Parsing failed: {err}" + +def main : IO Unit := do + IO.println "Welcome to Mal REPL!" + let mut donext := true + while donext do + IO.print "user> " + let stdin ← IO.getStdin + let input ← stdin.getLine + let value := input.trim + if value = "exit" then + donext := false + IO.println "Exiting REPL." + if value.isEmpty then + donext := false + else + IO.println (rep.{u} value) diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean index 9923eca359..04df9305d3 100644 --- a/impls/lean/lakefile.lean +++ b/impls/lean/lakefile.lean @@ -26,6 +26,11 @@ lean_exe "step1_read_print" { root := `LeanMal.step1_read_print } +@[default_target] +lean_exe "step2_eval" { + root := `LeanMal.step2_eval +} + @[default_target] lean_exe "mal" { root := `LeanMal.step1_read_print From 925d87431c59a06af7d9491e02982c596e5c1be1 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Thu, 22 Aug 2024 18:35:10 +0200 Subject: [PATCH 04/39] lean: step3_env --- impls/lean/LeanMal/step3_env.lean | 216 ++++++++++++++++++++++++++++++ impls/lean/lakefile.lean | 5 + 2 files changed, 221 insertions(+) create mode 100644 impls/lean/LeanMal/step3_env.lean diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean new file mode 100644 index 0000000000..912365aecc --- /dev/null +++ b/impls/lean/LeanMal/step3_env.lean @@ -0,0 +1,216 @@ +import LeanMal.reader +import LeanMal.printer + +universe u + +def READ (input : String): Except String Types := + read_str.{u} input + +def sum (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x + y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x + y)) + | _ => Except.error "+ operator not supported" + +def sub (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x - y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x - y)) + | _ => Except.error "- operator not supported" + +def mul (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x * y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x * y)) + | _ => Except.error "* operator not supported" + +def div (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x / y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x / y)) + | _ => Except.error "/ operator not supported" + +def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types): Except String (Dict × Types) := + match name with + | "+" => sum ref results + | "-" => sub ref results + | "*" => mul ref results + | "/" => div ref results + | _ => Except.error s!"'{name}' not found" + +mutual + + partial def evalTypes (ref : Dict := Dict.empty) (ast : Types) : Except String (Dict × Types) := + match ast with + | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with + | some vi => Except.ok (ref, vi) + | none => Except.error s!"'{v}' not found" + | Types.listVal el => (evalList ref el) + | Types.vecVal el => (evalVec ref (toList el)) + | Types.dictVal el => (evalDict ref el) + | x => Except.ok (ref, x) + + partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except String (Dict × Types) := + match evalTypes ref head with + | Except.error e => Except.error s!"error evaluating function: {head.toString true}: {e}" + | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + + partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except String (Dict × Types) := + -- first execute each function argument - reduce computation + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => evalFnNative newRef name results + | Fun.userDefined fref params body => + let keys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + + let built := buildDictWithSymbols fref keys results + let merged := mergeDicts newRef built + evalTypes merged body + | Fun.macroFn _ _ _ => Except.error "macro not implemented" + | _ => Except.error s!"`unexpected token, expected: function`" + + partial def evalList (ref: Dict) (lst : List Types) : Except String (Dict × Types) := + if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + else + let head := lst[0]! + match lst[0]! with + | Types.symbolVal v => match v with + | "def!" => evalDefn ref (lst.drop 1) + | "let*" => evalLet ref (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + + partial def evalVec (ref: Dict) (elems : List Types) : Except String (Dict × Types) := + match evalFuncArgs ref elems with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + + partial def evalDict (ref: Dict) (lst : Dict) : Except String (Dict × Types) := + match evalDictInner ref lst with + | Except.error e => Except.error e + | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + + partial def evalDictInner (ref: Dict) (lst : Dict) : Except String (Dict × Dict) := + match lst with + | Dict.empty => Except.ok (ref, lst) + | Dict.insert k v restDict => match evalTypes ref v with + | Except.error e => Except.error e + | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.error e => Except.error e + | Except.ok (updatedRef, updatedDict) => + let newDict := Dict.insert k newVal updatedDict + Except.ok (updatedRef, newDict) + + partial def evalFuncArgs (ref: Dict) (args: List Types) : Except String (Dict × List Types) := + match args.foldl (fun (res : Except String (Dict × List Types)) x => + match res with + | Except.error e => Except.error s!"error evaluating function argument accumulator: {x.toString true}: {e}" + | Except.ok (r, acc) => match evalTypes r x with + | Except.error e => Except.error s!"error evaluating function argument: {x.toString true}: {e}" + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, acc ++ [res]) + ) (Except.ok (ref, [])) with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + + partial def evalDefn (ref: Dict) (args : List Types) : Except String (Dict × Types) := + if args.length < 2 then Except.error "def! unexpected syntax" + else + let key := args[0]! + let body := args[1]! + match (evalTypes ref body) with + | Except.error e => Except.error s!"def!: {e}" + | Except.ok (newRef, value) => + match key with + | Types.symbolVal v => + let refResult := addEntry newRef (KeyType.strKey v) value + Except.ok (refResult, value) + | _ => Except.error s!"def! unexpected token, expected: symbol" + + partial def evalLet (ref: Dict) (args : List Types) : Except String (Dict × Types) := + if args.length < 2 then Except.error "let*: unexpected syntax" + else + let pairs := args[0]! + let body := args[1]! + let result := match pairs with + | Types.listVal v => evalLetArgs ref v + | Types.vecVal v => evalLetArgs ref (toList v) + | _ => Except.error s!"unexpected token type: ${pairs.toString true}, expected: list or vector" + + match result with + | Except.error e => Except.error s!"let*: {e}" + | Except.ok newRef => match evalTypes newRef body with + | Except.error e => Except.error e + -- we do not propagate the let* environment to the parent scope + | Except.ok (_, result) => Except.ok (ref, result) + + partial def evalLetArgs (ref: Dict) (args : List Types) : Except String Dict := + match args with + | [] => Except.ok ref + | [_] => Except.error "let*: unexpected syntax" + | x :: y :: rest => + match x with + | Types.symbolVal key => match evalTypes ref y with + | Except.error e => Except.error s!"error evaluating function argument: {key}: {e}" + | Except.ok (updatedRef, value) => + evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + | _ => Except.error "let*: unexpected syntax" +end + +def loadFnNative (ref: Dict) (name: String) : Dict := + ref.insert (KeyType.strKey name) (Types.funcVal (Fun.builtin name)) + +def loadFnNativeAll (ref: Dict) : Dict := + loadFnNative ( + loadFnNative ( + loadFnNative ( + loadFnNative ref "+" + ) "-" + ) "*" + ) "/" + +def PRINT (ast : Types): String := + pr_str true ast + +def rep (ref: Dict) (input : String): Dict × String := + match READ.{u} input with + | Except.ok result => match evalTypes ref result with + | Except.error e => (ref, e) + | Except.ok (newref, res) => (newref, PRINT res) + | Except.error err => (ref, s!"Parsing failed: {err}") + +def main : IO Unit := do + IO.println "Welcome to Mal REPL!" + let mut env := loadFnNativeAll Dict.empty + let mut donext := true + while donext do + IO.print "user> " + let stdin ← IO.getStdin + let input ← stdin.getLine + let value := input.trim + if value = "exit" then + donext := false + IO.println "Exiting REPL." + if value.isEmpty then + donext := false + else + let (ref, val) := rep.{u} env value + IO.println val + env := ref diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean index 04df9305d3..9e6f4fc707 100644 --- a/impls/lean/lakefile.lean +++ b/impls/lean/lakefile.lean @@ -31,6 +31,11 @@ lean_exe "step2_eval" { root := `LeanMal.step2_eval } +@[default_target] +lean_exe "step3_env" { + root := `LeanMal.step3_env +} + @[default_target] lean_exe "mal" { root := `LeanMal.step1_read_print From aa105c5138c4b82cdca1f877b440f284a5740e77 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Thu, 22 Aug 2024 23:12:50 +0200 Subject: [PATCH 05/39] lean: step4_if_fn_do --- impls/lean/LeanMal/core.lean | 254 +++++++++++++++++++++++++ impls/lean/LeanMal/reader.lean | 2 +- impls/lean/LeanMal/step4_if_fn_do.lean | 207 ++++++++++++++++++++ impls/lean/lakefile.lean | 5 + 4 files changed, 467 insertions(+), 1 deletion(-) create mode 100644 impls/lean/LeanMal/core.lean create mode 100644 impls/lean/LeanMal/step4_if_fn_do.lean diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean new file mode 100644 index 0000000000..ebf8e2d30c --- /dev/null +++ b/impls/lean/LeanMal/core.lean @@ -0,0 +1,254 @@ +import Lean +import Mathlib +import LeanMal.types + +universe u + +def sum (ref : Dict := Dict.empty) (lst: List Types) : Except (Dict × String) (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x + y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x + y)) + | _ => Except.error (ref, "+ operator not supported") + +def sub (ref : Dict := Dict.empty) (lst: List Types) : Except (Dict × String) (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x - y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x - y)) + | _ => Except.error (ref, "- operator not supported") + +def mul (ref : Dict := Dict.empty) (lst: List Types) : Except (Dict × String) (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x * y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x * y)) + | _ => Except.error (ref, "* operator not supported") + +def div (ref : Dict := Dict.empty) (lst: List Types) : Except (Dict × String) (Dict × Types) := + match lst with + | [] => Except.ok (ref, Types.intVal 0) + | [Types.intVal x] => Except.ok (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x / y)) + | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x / y)) + | _ => Except.error (ref, "/ operator not supported") + +def ltInternal (first: Types) (second: Types) (orEq: Bool) : Bool := + match first, second with + | Types.intVal n, Types.intVal v => n < v || (if orEq then n == v else false) + | Types.intVal n, Types.floatVal v => (Float.ofInt n) < v || (if orEq then (Float.ofInt n) == v else false) + | Types.floatVal n, Types.floatVal v => n < v || (if orEq then n == v else false) + | Types.floatVal n, Types.intVal v => n < (Float.ofInt v) || (if orEq then n == (Float.ofInt v) else false) + | Types.strVal n, Types.strVal v => n < v || (if orEq then n == v else false) + | _, _ => false + +def lt (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") + else + let first := lst[0]! + let second := lst[1]! + let res := ltInternal first second false + Except.ok (ref, Types.boolVal res) + +def lte (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") + else + let first := lst[0]! + let second := lst[1]! + let res := ltInternal first second true + Except.ok (ref, Types.boolVal res) + +def gtInternal (first: Types) (second: Types) (orEq: Bool) : Bool := + match first, second with + | Types.intVal n, Types.intVal v => n > v || (if orEq then n == v else false) + | Types.intVal n, Types.floatVal v => (Float.ofInt n) > v || (if orEq then (Float.ofInt n) == v else false) + | Types.floatVal n, Types.floatVal v => n > v || (if orEq then n == v else false) + | Types.floatVal n, Types.intVal v => n > (Float.ofInt v) || (if orEq then n == (Float.ofInt v) else false) + | Types.strVal n, Types.strVal v => n > v || (if orEq then n == v else false) + | _, _ => false + +def gt (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") + else + let first := lst[0]! + let second := lst[1]! + let res := gtInternal first second false + Except.ok (ref, Types.boolVal res) + +def gte (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") + else + let first := lst[0]! + let second := lst[1]! + let res := gtInternal first second true + Except.ok (ref, Types.boolVal res) + +mutual + partial def eqList (n: List Types) (v: List Types) (strict: Bool) : Bool := + match n, v with + | [], [] => true + | [], _ => false + | _, [] => false + | a :: nrest, b :: vrest => + if !(eqInternal a b strict) then false + else eqList nrest vrest strict + + -- partial def eqDictKeys (k1: List KeyType) (k2: List KeyType) : Bool := + -- match k1, k2 with + -- | KeyType.strKey x, + + partial def eqDict (n: Dict) (v: Dict) (strict: Bool) : Bool := + match n, v with + | Dict.empty, Dict.empty => true + | d1, d2 => + let keys1 := getKeys d1 + let keys2 := getKeys d2 + if keys1.length != keys2.length then false + else + keys1.all (fun k => + match (getEntry d1 k, getEntry d2 k) with + | (some v1, some v2) => eqInternal v1 v2 strict + | _ => false) + + partial def eqInternal (first: Types) (second: Types) (strict: Bool) : Bool := + match first, second with + | Types.intVal n, Types.intVal v => n == v + | Types.intVal n, Types.floatVal v => if strict then false else (Float.ofInt n) == v + | Types.floatVal n, Types.floatVal v => n == v + | Types.floatVal n, Types.intVal v => if strict then false else n == (Float.ofInt v) + | Types.strVal n, Types.strVal v => n == v + | Types.boolVal n, Types.boolVal v => n == v + | Types.symbolVal n, Types.symbolVal v => n == v + | Types.keywordVal n, Types.keywordVal v => n == v + | Types.Nil, Types.Nil => true + | Types.listVal n, Types.listVal v => + if n.length != v.length then false + else eqList n v strict + | Types.vecVal nvec, Types.vecVal vvec => + let n := toList nvec + let v := toList vvec + if n.length != v.length then false + else eqList n v strict + | Types.dictVal n, Types.dictVal v => eqDict n v strict + | _, _ => false + +end + +def eq (ref: Dict) (lst: List Types) (strict: Bool) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") + else + let first := lst[0]! + let second := lst[1]! + let res := eqInternal first second strict + Except.ok (ref, Types.boolVal res) + +def prStrInternal (lst: List Types) (printReadably: Bool) (sep: String) : String := + let elems := lst.map (fun x => x.toString printReadably) + String.intercalate sep elems + +def KEY_LOGS_INFO := "LOGS_INFO" +def KEY_LOGS_DEBUG := "LOGS_DEBUG" +def KEY_DEBUG_EVAL := "DEBUG-EVAL" + +def getLogs (ref: Dict) (type: String): List Types := + match getEntry ref (KeyType.strKey type) with + | some v => match v with + | Types.listVal loglist => loglist + | _ => [] + | _ => [] + +def getDebugEval (ref: Dict): Bool := + match getEntry ref (KeyType.strKey KEY_DEBUG_EVAL) with + | some v => match v with + | Types.boolVal v => v + | Types.Nil => false + | _ => false + | _ => false + +def getLogsInfo (ref: Dict): List Types := + getLogs ref KEY_LOGS_INFO + +def logInfo (ref: Dict) (msg: String): Dict := + let loglist := getLogs ref KEY_LOGS_INFO + let newlogs := loglist ++ [(Types.strVal msg)] + ref.insert (KeyType.strKey KEY_LOGS_INFO) (Types.listVal newlogs) + +def prStrFunc (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + let str := prStrInternal lst true " " + Except.ok (ref, Types.strVal str) + +def prnFunc (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + let str := prStrInternal lst true " " + let newRef := logInfo ref str + Except.ok (newRef, Types.Nil) + +def printlnFunc (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + let str := prStrInternal lst false " " + let newRef := logInfo ref str + Except.ok (newRef, Types.Nil) + +def strFunc (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + let str := prStrInternal lst false "" + Except.ok (ref, Types.strVal str) + +def countFunc(ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "count: 1 argument required") + else + let x := lst[0]! + match x with + | Types.listVal v => Except.ok (ref, Types.intVal v.length) + | Types.Nil => Except.ok (ref, Types.intVal 0) + | _ => Except.error (ref, "count called on non-sequence") + +def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types): Except (Dict × String) (Dict × Types) := + match name with + | "+" => sum ref results + | "-" => sub ref results + | "*" => mul ref results + | "/" => div ref results + | "<" => lt ref results + | "<=" => lte ref results + | ">" => gt ref results + | ">=" => gte ref results + | "=" => eq ref results false + | "prn" => prnFunc ref results + | "pr-str" => prStrFunc ref results + | "str" => strFunc ref results + | "println" => printlnFunc ref results + | "list" => Except.ok (ref, Types.listVal results) + | "count" => countFunc ref results + | _ => match results with + | [x] => match x with + | Types.listVal x => match name with + | "list?" => Except.ok (ref, Types.boolVal true) + | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.error (ref, s!"'{name}' not found") + +def loadFnNative (ref: Dict) (name: String) : Dict := + ref.insert (KeyType.strKey name) (Types.funcVal (Fun.builtin name)) + +def loadFnNativeFold (ref: Dict) (fnNames : List String) : Dict := + fnNames.foldl loadFnNative ref + +def coreFnSymbols: List String := [ + "+", "-", "*", "/", + "<", "<=", ">", ">=", "=", + "list", "list?", "empty?", "count", + "prn", "pr-str", "str", "println", +] + +def loadFnNativeAll (ref: Dict) : Dict := + let newRef := loadFnNativeFold ref coreFnSymbols + (( + newRef.insert (KeyType.strKey KEY_LOGS_INFO) (Types.listVal []) + ).insert (KeyType.strKey KEY_LOGS_DEBUG) (Types.listVal []) + ).insert (KeyType.strKey KEY_DEBUG_EVAL) (Types.boolVal false) diff --git a/impls/lean/LeanMal/reader.lean b/impls/lean/LeanMal/reader.lean index 91ba28b344..7cd5b9993f 100644 --- a/impls/lean/LeanMal/reader.lean +++ b/impls/lean/LeanMal/reader.lean @@ -75,7 +75,7 @@ def read_nil_val : Parsec Types := do def read_symbol_val : Parsec Types := do ws - let sym ← many1Chars (satisfy (λ c => c.isAlphanum || c == '_' || c == '+' || c == '*' || c == '!' || c == '/' || c == '-' || c == '=' || c == '<' || c == '>' || c == ':')) + let sym ← many1Chars (satisfy (λ c => c.isAlphanum || c == '+' || c == '-' || c == '*' || c == '/' || c == '=' || c == '<' || c == '>' || c == ':' || c == '_' || c == '!' || c == '?')) ws return Types.symbolVal sym diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean new file mode 100644 index 0000000000..305df39409 --- /dev/null +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -0,0 +1,207 @@ +import LeanMal.reader +import LeanMal.printer +import LeanMal.core + +universe u + +def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let params := args[0]! + let body := args[1]! + let newfn := Fun.userDefined ref params body + Except.ok (ref, Types.funcVal newfn) + +mutual + partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" + else _ref + match ast with + | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with + | some vi => Except.ok (ref, vi) + | none => Except.error (ref, s!"'{v}' not found") + | Types.listVal el => (evalList ref el) + | Types.vecVal el => (evalVec ref (toList el)) + | Types.dictVal el => (evalDict ref el) + | x => Except.ok (ref, x) + + partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + match evalTypes ref head with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") + | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + + partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + -- first execute each function argument - reduce computation + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => evalFnNative newRef name results + | Fun.userDefined fref params body => + let keys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + + let built := buildDictWithSymbols fref keys results + let merged := mergeDicts newRef built + evalTypes merged body + | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") + | _ => Except.error (newRef, s!"`unexpected token, expected: function`") + + partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + else + let head := lst[0]! + match lst[0]! with + | Types.symbolVal v => match v with + | "def!" => evalDefn ref (lst.drop 1) + | "let*" => evalLet ref (lst.drop 1) + | "do" => evalDo ref (lst.drop 1) + | "if" => evalIf ref (lst.drop 1) + | "fn*" => makeFn ref (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + + partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + match evalFuncArgs ref elems with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + + partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + match evalDictInner ref lst with + | Except.error e => Except.error e + | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + + partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + match lst with + | Dict.empty => Except.ok (ref, lst) + | Dict.insert k v restDict => match evalTypes ref v with + | Except.error e => Except.error e + | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.error e => Except.error e + | Except.ok (updatedRef, updatedDict) => + let newDict := Dict.insert k newVal updatedDict + Except.ok (updatedRef, newDict) + + partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + match res with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") + | Except.ok (r, acc) => match evalTypes r x with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, acc ++ [res]) + ) (Except.ok (ref, [])) with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + + partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "def! unexpected syntax") + else + let key := args[0]! + let body := args[1]! + match (evalTypes ref body) with + | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") + | Except.ok (newRef, value) => + match key with + | Types.symbolVal v => + let refResult := addEntry newRef (KeyType.strKey v) value + Except.ok (refResult, value) + | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + + partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + else + let pairs := args[0]! + let body := args[1]! + let result := match pairs with + | Types.listVal v => evalLetArgs ref v + | Types.vecVal v => evalLetArgs ref (toList v) + | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + + match result with + | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") + | Except.ok newRef => match evalTypes newRef body with + | Except.error e => Except.error e + -- we do not propagate the let* environment to the parent scope + | Except.ok (_, result) => Except.ok (ref, result) + + partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + match args with + | [] => Except.ok ref + | [_] => Except.error (ref, "let*: unexpected syntax") + | x :: y :: rest => + match x with + | Types.symbolVal key => match evalTypes ref y with + | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.ok (updatedRef, value) => + evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + | _ => Except.error (ref, "let*: unexpected syntax") + + partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + -- only return last computation result + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + if results.length == 0 then Except.ok (newRef, Types.Nil) + else Except.ok (newRef, results[results.length - 1]!) + + partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let condition := args[0]! + let thenExpr := args[1]! + let hasElse := args.length > 2 + + match evalTypes ref condition with + | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") + | Except.ok (newRef, condResp) => + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newRef thenExpr + else if hasElse then evalTypes newRef args[2]! + else Except.ok (newRef, Types.Nil) +end + +def READ (input : String): Except String Types := + read_str.{u} input + +def PRINT (ast : Types): String := + pr_str true ast + +def rep (ref: Dict) (input : String): Dict × String := + match READ.{u} input with + | Except.ok result => match evalTypes ref result with + | Except.error (newref, e) => (newref, e) + | Except.ok (newref, res) => (newref, PRINT res) + | Except.error err => (ref, s!"Parsing failed: {err}") + +def printLogs (ref : Dict) : IO Unit := + forM (getLogsInfo ref) (fun elem => + match elem with + | Types.strVal log => IO.println log + | x => IO.println (x.toString true) + ) + +def main : IO Unit := do + IO.println "Welcome to Mal REPL!" + let mut env := loadFnNativeAll Dict.empty + let mut donext := true + while donext do + IO.print "user> " + let stdin ← IO.getStdin + let input ← stdin.getLine + let value := input.trim + if value = "exit" then + donext := false + IO.println "Exiting REPL." + if value.isEmpty then + donext := false + else + let (ref, val) := rep.{u} env value + printLogs ref + IO.println val + env := ref diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean index 9e6f4fc707..90f477b147 100644 --- a/impls/lean/lakefile.lean +++ b/impls/lean/lakefile.lean @@ -36,6 +36,11 @@ lean_exe "step3_env" { root := `LeanMal.step3_env } +@[default_target] +lean_exe "step4_if_fn_do" { + root := `LeanMal.step4_if_fn_do +} + @[default_target] lean_exe "mal" { root := `LeanMal.step1_read_print From ec3ea5e63f6ec5f2b8315fc60ae3d0b732bf061c Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Fri, 23 Aug 2024 00:24:10 +0200 Subject: [PATCH 06/39] lean: step5_tco --- impls/lean/LeanMal/step5_tco.lean | 207 ++++++++++++++++++++++++++++++ impls/lean/lakefile.lean | 5 + 2 files changed, 212 insertions(+) create mode 100644 impls/lean/LeanMal/step5_tco.lean diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean new file mode 100644 index 0000000000..305df39409 --- /dev/null +++ b/impls/lean/LeanMal/step5_tco.lean @@ -0,0 +1,207 @@ +import LeanMal.reader +import LeanMal.printer +import LeanMal.core + +universe u + +def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let params := args[0]! + let body := args[1]! + let newfn := Fun.userDefined ref params body + Except.ok (ref, Types.funcVal newfn) + +mutual + partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" + else _ref + match ast with + | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with + | some vi => Except.ok (ref, vi) + | none => Except.error (ref, s!"'{v}' not found") + | Types.listVal el => (evalList ref el) + | Types.vecVal el => (evalVec ref (toList el)) + | Types.dictVal el => (evalDict ref el) + | x => Except.ok (ref, x) + + partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + match evalTypes ref head with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") + | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + + partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + -- first execute each function argument - reduce computation + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => evalFnNative newRef name results + | Fun.userDefined fref params body => + let keys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + + let built := buildDictWithSymbols fref keys results + let merged := mergeDicts newRef built + evalTypes merged body + | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") + | _ => Except.error (newRef, s!"`unexpected token, expected: function`") + + partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + else + let head := lst[0]! + match lst[0]! with + | Types.symbolVal v => match v with + | "def!" => evalDefn ref (lst.drop 1) + | "let*" => evalLet ref (lst.drop 1) + | "do" => evalDo ref (lst.drop 1) + | "if" => evalIf ref (lst.drop 1) + | "fn*" => makeFn ref (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + + partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + match evalFuncArgs ref elems with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + + partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + match evalDictInner ref lst with + | Except.error e => Except.error e + | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + + partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + match lst with + | Dict.empty => Except.ok (ref, lst) + | Dict.insert k v restDict => match evalTypes ref v with + | Except.error e => Except.error e + | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.error e => Except.error e + | Except.ok (updatedRef, updatedDict) => + let newDict := Dict.insert k newVal updatedDict + Except.ok (updatedRef, newDict) + + partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + match res with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") + | Except.ok (r, acc) => match evalTypes r x with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, acc ++ [res]) + ) (Except.ok (ref, [])) with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + + partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "def! unexpected syntax") + else + let key := args[0]! + let body := args[1]! + match (evalTypes ref body) with + | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") + | Except.ok (newRef, value) => + match key with + | Types.symbolVal v => + let refResult := addEntry newRef (KeyType.strKey v) value + Except.ok (refResult, value) + | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + + partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + else + let pairs := args[0]! + let body := args[1]! + let result := match pairs with + | Types.listVal v => evalLetArgs ref v + | Types.vecVal v => evalLetArgs ref (toList v) + | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + + match result with + | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") + | Except.ok newRef => match evalTypes newRef body with + | Except.error e => Except.error e + -- we do not propagate the let* environment to the parent scope + | Except.ok (_, result) => Except.ok (ref, result) + + partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + match args with + | [] => Except.ok ref + | [_] => Except.error (ref, "let*: unexpected syntax") + | x :: y :: rest => + match x with + | Types.symbolVal key => match evalTypes ref y with + | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.ok (updatedRef, value) => + evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + | _ => Except.error (ref, "let*: unexpected syntax") + + partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + -- only return last computation result + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + if results.length == 0 then Except.ok (newRef, Types.Nil) + else Except.ok (newRef, results[results.length - 1]!) + + partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let condition := args[0]! + let thenExpr := args[1]! + let hasElse := args.length > 2 + + match evalTypes ref condition with + | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") + | Except.ok (newRef, condResp) => + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newRef thenExpr + else if hasElse then evalTypes newRef args[2]! + else Except.ok (newRef, Types.Nil) +end + +def READ (input : String): Except String Types := + read_str.{u} input + +def PRINT (ast : Types): String := + pr_str true ast + +def rep (ref: Dict) (input : String): Dict × String := + match READ.{u} input with + | Except.ok result => match evalTypes ref result with + | Except.error (newref, e) => (newref, e) + | Except.ok (newref, res) => (newref, PRINT res) + | Except.error err => (ref, s!"Parsing failed: {err}") + +def printLogs (ref : Dict) : IO Unit := + forM (getLogsInfo ref) (fun elem => + match elem with + | Types.strVal log => IO.println log + | x => IO.println (x.toString true) + ) + +def main : IO Unit := do + IO.println "Welcome to Mal REPL!" + let mut env := loadFnNativeAll Dict.empty + let mut donext := true + while donext do + IO.print "user> " + let stdin ← IO.getStdin + let input ← stdin.getLine + let value := input.trim + if value = "exit" then + donext := false + IO.println "Exiting REPL." + if value.isEmpty then + donext := false + else + let (ref, val) := rep.{u} env value + printLogs ref + IO.println val + env := ref diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean index 90f477b147..92acca3b2e 100644 --- a/impls/lean/lakefile.lean +++ b/impls/lean/lakefile.lean @@ -41,6 +41,11 @@ lean_exe "step4_if_fn_do" { root := `LeanMal.step4_if_fn_do } +@[default_target] +lean_exe "step5_tco" { + root := `LeanMal.step5_tco +} + @[default_target] lean_exe "mal" { root := `LeanMal.step1_read_print From 28223089604ecee734c3e5b905b808bd1ff021f8 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Fri, 23 Aug 2024 18:57:36 +0200 Subject: [PATCH 07/39] lean: step6_file --- impls/lean/LeanMal/core.lean | 103 +++++++++++- impls/lean/LeanMal/reader.lean | 1 - impls/lean/LeanMal/step4_if_fn_do.lean | 2 +- impls/lean/LeanMal/step5_tco.lean | 2 +- impls/lean/LeanMal/step6_file.lean | 210 +++++++++++++++++++++++++ impls/lean/lakefile.lean | 5 + 6 files changed, 317 insertions(+), 6 deletions(-) create mode 100644 impls/lean/LeanMal/step6_file.lean diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index ebf8e2d30c..c8572ac188 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -1,6 +1,7 @@ import Lean import Mathlib import LeanMal.types +import LeanMal.reader universe u @@ -149,6 +150,41 @@ def eq (ref: Dict) (lst: List Types) (strict: Bool) : Except (Dict × String) (D let res := eqInternal first second strict Except.ok (ref, Types.boolVal res) +def makeAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "keyword: 1 argument required") + else + let first := lst[0]! + Except.ok (ref, Types.atomVal (Atom.v first)) + +def derefAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "deref: 1 argument required") + else + let first := lst[0]! + match first with + | Types.atomVal x => match x with + | Atom.v v => Except.ok (ref, v) + | Atom.withmeta v _ => Except.ok (ref, v) + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") + +def resetAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "reset!: 2 argument required") + else + let first := lst[0]! + let second := lst[1]! + let atomSymbol := args[0]! + match atomSymbol with + | Types.symbolVal sym => + match first with + | Types.atomVal x => match x with + | Atom.v _ => + let newRef := addEntry ref (KeyType.strKey sym) (Types.atomVal (Atom.v second)) + Except.ok (newRef, second) + | Atom.withmeta _ meta => + let newRef := addEntry ref (KeyType.strKey sym) (Types.atomVal (Atom.withmeta second meta)) + Except.ok (newRef, second) + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"deref: unexpected token: {x.toString true}, expected: symbol") + def prStrInternal (lst: List Types) (printReadably: Bool) (sep: String) : String := let elems := lst.map (fun x => x.toString printReadably) String.intercalate sep elems @@ -207,7 +243,15 @@ def countFunc(ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Ty | Types.Nil => Except.ok (ref, Types.intVal 0) | _ => Except.error (ref, "count called on non-sequence") -def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types): Except (Dict × String) (Dict × Types) := +def readString (lst: List Types) (envir: Dict := Dict.empty) : Except String Types := + if lst.length < 1 then Except.error "read-string: 1 arguments required" + else + let first := lst[0]! + match first with + | Types.strVal v => read_types_with_env v envir + | x => Except.error s!"unexpected symbol: {x.toString true}, expected: string" + +def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := match name with | "+" => sum ref results | "-" => sub ref results @@ -218,21 +262,68 @@ def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) | ">" => gt ref results | ">=" => gte ref results | "=" => eq ref results false + | "list" => Except.ok (ref, Types.listVal results) + | "count" => countFunc ref results + | "atom" => makeAtom ref results + | "deref" => derefAtom ref results + | "reset!" => resetAtom ref results args + -- | "swap!" => swapAtom ref results | "prn" => prnFunc ref results | "pr-str" => prStrFunc ref results | "str" => strFunc ref results | "println" => printlnFunc ref results - | "list" => Except.ok (ref, Types.listVal results) - | "count" => countFunc ref results + -- | "eval" => eval ref results + | "read-string" => match readString results ref with -- readString results Dict.empty + | Except.error e => Except.error (ref, e) + | Except.ok res => Except.ok (ref, res) | _ => match results with | [x] => match x with | Types.listVal x => match name with | "list?" => Except.ok (ref, Types.boolVal true) | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) | _ => Except.ok (ref, Types.boolVal false) + | Types.atomVal _ => match name with + | "atom?" => Except.ok (ref, Types.boolVal true) + | _ => Except.ok (ref, Types.boolVal false) | _ => Except.ok (ref, Types.boolVal false) | _ => Except.error (ref, s!"'{name}' not found") +def readFileContent (filePath : String) : IO String := do + IO.FS.readFile filePath + +def slurp (ref: Dict) (lst: List Types) : IO (Except (Dict × String) (Dict × Types)) := do + if lst.length < 1 then + return Except.error (ref, "slurp: 2 arguments required") + else + match lst[0]! with + | Types.strVal filename => do + let result ← try + let content ← readFileContent filename + return Except.ok (ref, Types.strVal content) + catch e => + return Except.error (ref, s!"slurp: failed to read file: {e.toString}") + + -- return result + | _ => + return Except.error (ref, "slurp: filename must be a string") + +def slurp2 (ref: Dict) (lst: List Types) : IO (Dict × Types) := do + if lst.length < 1 then + throw (IO.userError "slurp: 2 arguments required") + else + match lst[0]! with + | Types.strVal filename => do + let content ← readFileContent filename + return (ref, Types.strVal content) + | _ => + throw (IO.userError "slurp: filename must be a string") + +-- IO monad limits some of the formal proving capabilities that Lean offers because IO introduces side effects that are inherently non-deterministic and impure, such as reading from files +def evalFnNativeWithIO (ref : Dict := Dict.empty) (name: String) (results: List Types): IO (Except (Dict × String) (Dict × Types)) := + match name with + | "slurp" => slurp ref results + | _ => return Except.error (ref, s!"'{name}' not found") + def loadFnNative (ref: Dict) (name: String) : Dict := ref.insert (KeyType.strKey name) (Types.funcVal (Fun.builtin name)) @@ -244,6 +335,8 @@ def coreFnSymbols: List String := [ "<", "<=", ">", ">=", "=", "list", "list?", "empty?", "count", "prn", "pr-str", "str", "println", + "read-string", "slurp", + "atom", "atom?", "deref", "reset!", ] def loadFnNativeAll (ref: Dict) : Dict := @@ -252,3 +345,7 @@ def loadFnNativeAll (ref: Dict) : Dict := newRef.insert (KeyType.strKey KEY_LOGS_INFO) (Types.listVal []) ).insert (KeyType.strKey KEY_LOGS_DEBUG) (Types.listVal []) ).insert (KeyType.strKey KEY_DEBUG_EVAL) (Types.boolVal false) + +def setSymbol (ref: Dict) (name: String) (value: Types): Dict := + let newRef := loadFnNative ref name + newRef.insert (KeyType.strKey name) value diff --git a/impls/lean/LeanMal/reader.lean b/impls/lean/LeanMal/reader.lean index 7cd5b9993f..cab0ed6c38 100644 --- a/impls/lean/LeanMal/reader.lean +++ b/impls/lean/LeanMal/reader.lean @@ -213,7 +213,6 @@ mutual partial def read_types (envir: Dict := Dict.empty) : Parsec Types := read_list envir <|> read_vector envir <|> read_hash_map envir <|> read_symbol "'" "quote" envir <|> read_symbol "`" "quasiquote" envir <|> read_symbol "~@" "splice-unquote" envir <|> read_symbol "~" "unquote" envir <|> read_symbol "@" "deref" envir <|> read_with_meta envir <|> read_atom envir - end def read_types_with_env (input : String) (envir: Dict := Dict.empty) : Except String Types := diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index 305df39409..44889db33c 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -37,7 +37,7 @@ mutual | Except.ok (newRef, results) => match fn with | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newRef name results + | Fun.builtin name => evalFnNative newRef name results args | Fun.userDefined fref params body => let keys: List String := match params with | Types.listVal v => v.map fun x => x.toString false diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index 305df39409..44889db33c 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -37,7 +37,7 @@ mutual | Except.ok (newRef, results) => match fn with | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newRef name results + | Fun.builtin name => evalFnNative newRef name results args | Fun.userDefined fref params body => let keys: List String := match params with | Types.listVal v => v.map fun x => x.toString false diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean new file mode 100644 index 0000000000..5033f0057d --- /dev/null +++ b/impls/lean/LeanMal/step6_file.lean @@ -0,0 +1,210 @@ +import LeanMal.reader +import LeanMal.printer +import LeanMal.core + +universe u + +def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let params := args[0]! + let body := args[1]! + let newfn := Fun.userDefined ref params body + Except.ok (ref, Types.funcVal newfn) + +mutual + partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" + else _ref + match ast with + | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with + | some vi => Except.ok (ref, vi) + | none => Except.error (ref, s!"'{v}' not found") + | Types.listVal el => (evalList ref el) + | Types.vecVal el => (evalVec ref (toList el)) + | Types.dictVal el => (evalDict ref el) + | x => Except.ok (ref, x) + + partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + match evalTypes ref head with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") + | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + + partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + -- first execute each function argument - reduce computation + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => + evalFnNative newRef name results args + -- match evalFnNative newRef name results with + -- | Except.ok r => r + -- | Except.error e => evalFnNativeWithIO newRef name results + | Fun.userDefined fref params body => + let keys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let built := buildDictWithSymbols fref keys results + let merged := mergeDicts newRef built + evalTypes merged body + | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") + | _ => Except.error (newRef, s!"`unexpected token, expected: function`") + + partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + else + let head := lst[0]! + match lst[0]! with + | Types.symbolVal v => match v with + | "def!" => evalDefn ref (lst.drop 1) + | "let*" => evalLet ref (lst.drop 1) + | "do" => evalDo ref (lst.drop 1) + | "if" => evalIf ref (lst.drop 1) + | "fn*" => makeFn ref (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + + partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + match evalFuncArgs ref elems with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + + partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + match evalDictInner ref lst with + | Except.error e => Except.error e + | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + + partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + match lst with + | Dict.empty => Except.ok (ref, lst) + | Dict.insert k v restDict => match evalTypes ref v with + | Except.error e => Except.error e + | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.error e => Except.error e + | Except.ok (updatedRef, updatedDict) => + let newDict := Dict.insert k newVal updatedDict + Except.ok (updatedRef, newDict) + + partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + match res with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") + | Except.ok (r, acc) => match evalTypes r x with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, acc ++ [res]) + ) (Except.ok (ref, [])) with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + + partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "def! unexpected syntax") + else + let key := args[0]! + let body := args[1]! + match (evalTypes ref body) with + | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") + | Except.ok (newRef, value) => + match key with + | Types.symbolVal v => + let refResult := addEntry newRef (KeyType.strKey v) value + Except.ok (refResult, value) + | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + + partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + else + let pairs := args[0]! + let body := args[1]! + let result := match pairs with + | Types.listVal v => evalLetArgs ref v + | Types.vecVal v => evalLetArgs ref (toList v) + | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + + match result with + | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") + | Except.ok newRef => match evalTypes newRef body with + | Except.error e => Except.error e + -- we do not propagate the let* environment to the parent scope + | Except.ok (_, result) => Except.ok (ref, result) + + partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + match args with + | [] => Except.ok ref + | [_] => Except.error (ref, "let*: unexpected syntax") + | x :: y :: rest => + match x with + | Types.symbolVal key => match evalTypes ref y with + | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.ok (updatedRef, value) => + evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + | _ => Except.error (ref, "let*: unexpected syntax") + + partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + -- only return last computation result + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + if results.length == 0 then Except.ok (newRef, Types.Nil) + else Except.ok (newRef, results[results.length - 1]!) + + partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let condition := args[0]! + let thenExpr := args[1]! + let hasElse := args.length > 2 + + match evalTypes ref condition with + | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") + | Except.ok (newRef, condResp) => + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newRef thenExpr + else if hasElse then evalTypes newRef args[2]! + else Except.ok (newRef, Types.Nil) +end + +def READ (input : String): Except String Types := + read_str.{u} input + +def PRINT (ast : Types): String := + pr_str true ast + +def rep (ref: Dict) (input : String): Dict × String := + match READ.{u} input with + | Except.ok result => match evalTypes ref result with + | Except.error (newref, e) => (newref, e) + | Except.ok (newref, res) => (newref, PRINT res) + | Except.error err => (ref, s!"Parsing failed: {err}") + +def printLogs (ref : Dict) : IO Unit := + forM (getLogsInfo ref) (fun elem => + match elem with + | Types.strVal log => IO.println log + | x => IO.println (x.toString true) + ) + +def main : IO Unit := do + IO.println "Welcome to Mal REPL!" + let mut env := loadFnNativeAll Dict.empty + let mut donext := true + while donext do + IO.print "user> " + let stdin ← IO.getStdin + let input ← stdin.getLine + let value := input.trim + if value = "exit" then + donext := false + IO.println "Exiting REPL." + if value.isEmpty then + donext := false + else + let (ref, val) := rep.{u} env value + printLogs ref + IO.println val + env := ref diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean index 92acca3b2e..9d9158817d 100644 --- a/impls/lean/lakefile.lean +++ b/impls/lean/lakefile.lean @@ -46,6 +46,11 @@ lean_exe "step5_tco" { root := `LeanMal.step5_tco } +@[default_target] +lean_exe "step6_file" { + root := `LeanMal.step6_file +} + @[default_target] lean_exe "mal" { root := `LeanMal.step1_read_print From 561bf88d385b76a7368e81adcd3a9c4dda2227c4 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Fri, 23 Aug 2024 19:21:31 +0200 Subject: [PATCH 08/39] lean: step7_quote --- impls/lean/LeanMal/core.lean | 38 +++++ impls/lean/LeanMal/step7_quote.lean | 249 ++++++++++++++++++++++++++++ impls/lean/lakefile.lean | 5 + 3 files changed, 292 insertions(+) create mode 100644 impls/lean/LeanMal/step7_quote.lean diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index c8572ac188..ced8062420 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -251,6 +251,40 @@ def readString (lst: List Types) (envir: Dict := Dict.empty) : Except String Typ | Types.strVal v => read_types_with_env v envir | x => Except.error s!"unexpected symbol: {x.toString true}, expected: string" +def cons (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "cons: >= 2 arguments required") + else + let elem := lst[0]! + let seq := lst[1]! + match seq with + | Types.listVal v => Except.ok (ref, (Types.listVal (elem :: v))) + | Types.vecVal v => Except.ok (ref, (Types.listVal (elem :: (toList v)))) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + +def concat (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.ok (ref, Types.listVal []) + else + match lst.foldl (fun (acc: Except (Dict × String) (List Types)) x => + match acc with + | Except.error e => Except.error e + | Except.ok newlist => + match x with + | Types.listVal v => Except.ok (newlist ++ v) + | Types.vecVal v => Except.ok (newlist ++ (toList v)) + | x => Except.ok (newlist ++ [x]) + ) (Except.ok []) with + | Except.error e => Except.error e + | Except.ok v => Except.ok (ref, Types.listVal v) + +def makeVec (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "vec: 1 arguments required") + else + let first := lst[0]! + match first with + | Types.vecVal v => Except.ok (ref, Types.vecVal v) + | Types.listVal v => Except.ok (ref, Types.vecVal (listToVec v)) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := match name with | "+" => sum ref results @@ -264,6 +298,9 @@ def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) | "=" => eq ref results false | "list" => Except.ok (ref, Types.listVal results) | "count" => countFunc ref results + | "cons" => cons ref results + | "concat" => concat ref results + | "vec" => makeVec ref results | "atom" => makeAtom ref results | "deref" => derefAtom ref results | "reset!" => resetAtom ref results args @@ -334,6 +371,7 @@ def coreFnSymbols: List String := [ "+", "-", "*", "/", "<", "<=", ">", ">=", "=", "list", "list?", "empty?", "count", + "concat", "cons", "vec", "prn", "pr-str", "str", "println", "read-string", "slurp", "atom", "atom?", "deref", "reset!", diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean new file mode 100644 index 0000000000..d3fc092904 --- /dev/null +++ b/impls/lean/LeanMal/step7_quote.lean @@ -0,0 +1,249 @@ +import LeanMal.reader +import LeanMal.printer +import LeanMal.core + +universe u + +def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let params := args[0]! + let body := args[1]! + let newfn := Fun.userDefined ref params body + Except.ok (ref, Types.funcVal newfn) + +mutual + partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" + else _ref + match ast with + | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with + | some vi => Except.ok (ref, vi) + | none => Except.error (ref, s!"'{v}' not found") + | Types.listVal el => (evalList ref el) + | Types.vecVal el => (evalVec ref (toList el)) + | Types.dictVal el => (evalDict ref el) + | x => Except.ok (ref, x) + + partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + match evalTypes ref head with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") + | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + + partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + -- first execute each function argument - reduce computation + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => + evalFnNative newRef name results args + -- match evalFnNative newRef name results with + -- | Except.ok r => r + -- | Except.error e => evalFnNativeWithIO newRef name results + | Fun.userDefined fref params body => + let keys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let built := buildDictWithSymbols fref keys results + let merged := mergeDicts newRef built + evalTypes merged body + | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") + | _ => Except.error (newRef, s!"`unexpected token, expected: function`") + + partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + else + let head := lst[0]! + match lst[0]! with + | Types.symbolVal v => match v with + | "def!" => evalDefn ref (lst.drop 1) + | "let*" => evalLet ref (lst.drop 1) + | "do" => evalDo ref (lst.drop 1) + | "if" => evalIf ref (lst.drop 1) + | "fn*" => makeFn ref (lst.drop 1) + | "quote" => + if lst.length < 2 then Except.error (ref, "quote: expected 1 argument") + else Except.ok (ref, lst[1]!) + | "quasiquote" => + if lst.length < 2 then Except.error (ref, "quasiquote: expected 1 argument") + else evalTypes ref (quasiquote lst[1]!) + | _ => evalFunc ref head (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + + partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + match evalFuncArgs ref elems with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + + partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + match evalDictInner ref lst with + | Except.error e => Except.error e + | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + + partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + match lst with + | Dict.empty => Except.ok (ref, lst) + | Dict.insert k v restDict => match evalTypes ref v with + | Except.error e => Except.error e + | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.error e => Except.error e + | Except.ok (updatedRef, updatedDict) => + let newDict := Dict.insert k newVal updatedDict + Except.ok (updatedRef, newDict) + + partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + match res with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") + | Except.ok (r, acc) => match evalTypes r x with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, acc ++ [res]) + ) (Except.ok (ref, [])) with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + + partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "def! unexpected syntax") + else + let key := args[0]! + let body := args[1]! + match (evalTypes ref body) with + | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") + | Except.ok (newRef, value) => + match key with + | Types.symbolVal v => + let refResult := addEntry newRef (KeyType.strKey v) value + Except.ok (refResult, value) + | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + + partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + else + let pairs := args[0]! + let body := args[1]! + let result := match pairs with + | Types.listVal v => evalLetArgs ref v + | Types.vecVal v => evalLetArgs ref (toList v) + | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + + match result with + | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") + | Except.ok newRef => match evalTypes newRef body with + | Except.error e => Except.error e + -- we do not propagate the let* environment to the parent scope + | Except.ok (_, result) => Except.ok (ref, result) + + partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + match args with + | [] => Except.ok ref + | [_] => Except.error (ref, "let*: unexpected syntax") + | x :: y :: rest => + match x with + | Types.symbolVal key => match evalTypes ref y with + | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.ok (updatedRef, value) => + evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + | _ => Except.error (ref, "let*: unexpected syntax") + + partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + -- only return last computation result + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + if results.length == 0 then Except.ok (newRef, Types.Nil) + else Except.ok (newRef, results[results.length - 1]!) + + partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let condition := args[0]! + let thenExpr := args[1]! + let hasElse := args.length > 2 + + match evalTypes ref condition with + | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") + | Except.ok (newRef, condResp) => + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newRef thenExpr + else if hasElse then evalTypes newRef args[2]! + else Except.ok (newRef, Types.Nil) + + partial def starts_with (lst: List Types) (symb: String) : Bool := + if lst.length == 2 then + match lst[0]! with + | Types.symbolVal v => v == symb + | _ => false + else false + + partial def qq_loop (elt : Types) (acc: List Types): List Types := + match elt with + | Types.listVal v => + if starts_with v "splice-unquote" + then + [Types.symbolVal "concat", v[1]!, Types.listVal acc] + else + [Types.symbolVal "cons", quasiquote elt, Types.listVal acc] + | _ => [Types.symbolVal "cons", quasiquote elt, Types.listVal acc] + + partial def qq_foldr (lst : List Types): Types := + let res := lst.reverse.foldl (fun acc x => qq_loop x acc) [] + Types.listVal res + + partial def quasiquote (ast: Types) : Types := + match ast with + | Types.symbolVal _ => Types.listVal [Types.symbolVal "quote", ast] + | Types.dictVal _ => Types.listVal [Types.symbolVal "quote", ast] + | Types.listVal v => + if starts_with v "unquote" then v[1]! + else qq_foldr v + | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] + | _ => ast + +end + +def READ (input : String): Except String Types := + read_str.{u} input + +def PRINT (ast : Types): String := + pr_str true ast + +def rep (ref: Dict) (input : String): Dict × String := + match READ.{u} input with + | Except.ok result => match evalTypes ref result with + | Except.error (newref, e) => (newref, e) + | Except.ok (newref, res) => (newref, PRINT res) + | Except.error err => (ref, s!"Parsing failed: {err}") + +def printLogs (ref : Dict) : IO Unit := + forM (getLogsInfo ref) (fun elem => + match elem with + | Types.strVal log => IO.println log + | x => IO.println (x.toString true) + ) + +def main : IO Unit := do + IO.println "Welcome to Mal REPL!" + let mut env := loadFnNativeAll Dict.empty + + let mut donext := true + while donext do + IO.print "user> " + let stdin ← IO.getStdin + let input ← stdin.getLine + let value := input.trim + if value = "exit" then + donext := false + IO.println "Exiting REPL." + if value.isEmpty then + donext := false + else + let (ref, val) := rep.{u} env value + printLogs ref + IO.println val + env := ref diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean index 9d9158817d..48b8d65184 100644 --- a/impls/lean/lakefile.lean +++ b/impls/lean/lakefile.lean @@ -51,6 +51,11 @@ lean_exe "step6_file" { root := `LeanMal.step6_file } +@[default_target] +lean_exe "step7_quote" { + root := `LeanMal.step7_quote +} + @[default_target] lean_exe "mal" { root := `LeanMal.step1_read_print From ce1722bd7db628eb0e5db3de233e0d6f1c4f6315 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Fri, 23 Aug 2024 22:04:36 +0200 Subject: [PATCH 09/39] lean: step8_macros --- impls/lean/LeanMal/core.lean | 64 +++++- impls/lean/LeanMal/step8_macros.lean | 292 +++++++++++++++++++++++++++ impls/lean/lakefile.lean | 5 + 3 files changed, 360 insertions(+), 1 deletion(-) create mode 100644 impls/lean/LeanMal/step8_macros.lean diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index ced8062420..200288ec13 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -285,6 +285,64 @@ def makeVec (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Typ | Types.listVal v => Except.ok (ref, Types.vecVal (listToVec v)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") +def nthSeq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "nth: >= 2 arguments required") + else + let first := lst[0]! + let indx := lst[1]! + match indx with + | Types.intVal i => + match first with + | Types.vecVal v => + let lv := toList v + match lv.get? i.toNat with + | some v => Except.ok (ref, v) + | none => Except.error (ref, "nth: index out of range") + | Types.listVal lv => + if lv.length <= i then Except.error (ref, s!"nth: index out of range: {i}") + else + match lv.get? i.toNat with + | some v => Except.ok (ref, v) + | none => Except.error (ref, "nth: index out of range") + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: number") + +def firstSeq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "first: 1 arguments required") + else + let first := lst[0]! + match first with + | Types.Nil => Except.ok (ref, Types.Nil) + | Types.vecVal v => + let lv := toList v + if lv.length == 0 then Except.ok (ref, Types.Nil) + else + let elem := lv[0]! + Except.ok (ref, elem) + | Types.listVal lv => + if lv.length == 0 then Except.ok (ref, Types.Nil) + else + let elem := lv[0]! + Except.ok (ref, elem) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + +def restSeq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "rest: 1 arguments required") + else + let first := lst[0]! + match first with + | Types.Nil => Except.ok (ref, Types.Nil) + | Types.vecVal v => + let lv := toList v + if lv.length < 1 then Except.ok (ref, Types.listVal []) + else + Except.ok (ref, Types.listVal (lv.drop 1)) + | Types.listVal lv => + if lv.length < 1 then Except.ok (ref, Types.listVal []) + else + Except.ok (ref, Types.listVal (lv.drop 1)) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := match name with | "+" => sum ref results @@ -301,6 +359,9 @@ def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) | "cons" => cons ref results | "concat" => concat ref results | "vec" => makeVec ref results + | "nth" => nthSeq ref results + | "first" => firstSeq ref results + | "rest" => restSeq ref results | "atom" => makeAtom ref results | "deref" => derefAtom ref results | "reset!" => resetAtom ref results args @@ -371,7 +432,8 @@ def coreFnSymbols: List String := [ "+", "-", "*", "/", "<", "<=", ">", ">=", "=", "list", "list?", "empty?", "count", - "concat", "cons", "vec", + "concat", "cons", + "vec", "nth", "first", "rest", "prn", "pr-str", "str", "println", "read-string", "slurp", "atom", "atom?", "deref", "reset!", diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean new file mode 100644 index 0000000000..0052cb5282 --- /dev/null +++ b/impls/lean/LeanMal/step8_macros.lean @@ -0,0 +1,292 @@ +import LeanMal.reader +import LeanMal.printer +import LeanMal.core + +universe u + +def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let params := args[0]! + let body := args[1]! + let newfn := Fun.userDefined ref params body + Except.ok (ref, Types.funcVal newfn) + +mutual + partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" + else _ref + match ast with + | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with + | some vi => Except.ok (ref, vi) + | none => Except.error (ref, s!"'{v}' not found") + | Types.listVal el => (evalList ref el) + | Types.vecVal el => (evalVec ref (toList el)) + | Types.dictVal el => (evalDict ref el) + | x => Except.ok (ref, x) + + partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + match evalTypes ref head with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") + | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + + partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + evalFnNative newRef name results args + | Fun.userDefined fref params body => + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + let keys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let built := buildDictWithSymbols fref keys results + let merged := mergeDicts newRef built + evalTypes merged body + | Fun.macroFn fref params body => + let keys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let built := buildDictWithSymbols fref keys args + match evalTypes built body with + | Except.error e => Except.error e + | Except.ok (_, newast) => evalTypes ref newast + | _ => Except.error (ref, s!"`unexpected token, expected: function`") + + partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + else + let head := lst[0]! + match lst[0]! with + | Types.symbolVal v => match v with + | "def!" => evalDefn ref (lst.drop 1) + | "let*" => evalLet ref (lst.drop 1) + | "do" => evalDo ref (lst.drop 1) + | "if" => evalIf ref (lst.drop 1) + | "fn*" => makeFn ref (lst.drop 1) + | "quote" => + if lst.length < 2 then Except.error (ref, "quote: expected 1 argument") + else Except.ok (ref, lst[1]!) + | "quasiquote" => + if lst.length < 2 then Except.error (ref, "quasiquote: expected 1 argument") + else evalTypes ref (quasiquote lst[1]!) + | "defmacro!" => evalDefMacro ref (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + + partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + match evalFuncArgs ref elems with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + + partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + match evalDictInner ref lst with + | Except.error e => Except.error e + | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + + partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + match lst with + | Dict.empty => Except.ok (ref, lst) + | Dict.insert k v restDict => match evalTypes ref v with + | Except.error e => Except.error e + | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.error e => Except.error e + | Except.ok (updatedRef, updatedDict) => + let newDict := Dict.insert k newVal updatedDict + Except.ok (updatedRef, newDict) + + partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + match res with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") + | Except.ok (r, acc) => match evalTypes r x with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, acc ++ [res]) + ) (Except.ok (ref, [])) with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + + partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "def! unexpected syntax") + else + let key := args[0]! + let body := args[1]! + match (evalTypes ref body) with + | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") + | Except.ok (newRef, value) => + match key with + | Types.symbolVal v => + let refResult := addEntry newRef (KeyType.strKey v) value + Except.ok (refResult, value) + | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + + partial def evalDefMacro (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "def! unexpected syntax") + else + let key := args[0]! + let body := args[1]! + match (evalTypes ref body) with + | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") + | Except.ok (newRef, value) => + match key with + | Types.symbolVal v => + match value with + | Types.funcVal func => + match func with + | Fun.macroFn _ _ _ => + let refResult := addEntry newRef (KeyType.strKey v) value + Except.ok (refResult, value) + | Fun.userDefined fref params body => + let refResult := addEntry newRef (KeyType.strKey v) (Types.funcVal (Fun.macroFn fref params body)) + Except.ok (refResult, value) + | _ => Except.error (newRef, s!"defmacro!: unexpected builtin function") + | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") + | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + + partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + else + let pairs := args[0]! + let body := args[1]! + let result := match pairs with + | Types.listVal v => evalLetArgs ref v + | Types.vecVal v => evalLetArgs ref (toList v) + | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + + match result with + | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") + | Except.ok newRef => match evalTypes newRef body with + | Except.error e => Except.error e + -- we do not propagate the let* environment to the parent scope + | Except.ok (_, result) => Except.ok (ref, result) + + partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + match args with + | [] => Except.ok ref + | [_] => Except.error (ref, "let*: unexpected syntax") + | x :: y :: rest => + match x with + | Types.symbolVal key => match evalTypes ref y with + | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.ok (updatedRef, value) => + evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + | _ => Except.error (ref, "let*: unexpected syntax") + + partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + -- only return last computation result + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + if results.length == 0 then Except.ok (newRef, Types.Nil) + else Except.ok (newRef, results[results.length - 1]!) + + partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let condition := args[0]! + let thenExpr := args[1]! + let hasElse := args.length > 2 + + match evalTypes ref condition with + | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") + | Except.ok (newRef, condResp) => + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newRef thenExpr + else if hasElse then evalTypes newRef args[2]! + else Except.ok (newRef, Types.Nil) + + partial def starts_with (lst: List Types) (symb: String) : Bool := + if lst.length == 2 then + match lst[0]! with + | Types.symbolVal v => v == symb + | _ => false + else false + + partial def qq_loop (elt : Types) (acc: List Types): List Types := + match elt with + | Types.listVal v => + if starts_with v "splice-unquote" + then + [Types.symbolVal "concat", v[1]!, Types.listVal acc] + else + [Types.symbolVal "cons", quasiquote elt, Types.listVal acc] + | _ => [Types.symbolVal "cons", quasiquote elt, Types.listVal acc] + + partial def qq_foldr (lst : List Types): Types := + let res := lst.reverse.foldl (fun acc x => qq_loop x acc) [] + Types.listVal res + + partial def quasiquote (ast: Types) : Types := + match ast with + | Types.symbolVal _ => Types.listVal [Types.symbolVal "quote", ast] + | Types.dictVal _ => Types.listVal [Types.symbolVal "quote", ast] + | Types.listVal v => + if starts_with v "unquote" then v[1]! + else qq_foldr v + | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] + | _ => ast + +end + +def READ (input : String): Except String Types := + read_str.{u} input + +def PRINT (ast : Types): String := + pr_str true ast + +def rep (ref: Dict) (input : String): Dict × String := + match READ.{u} input with + | Except.ok result => match evalTypes ref result with + | Except.error (newref, e) => (newref, e) + | Except.ok (newref, res) => (newref, PRINT res) + | Except.error err => (ref, s!"Parsing failed: {err}") + +def printLogs (ref : Dict) : IO Unit := + forM (getLogsInfo ref) (fun elem => + match elem with + | Types.strVal log => IO.println log + | x => IO.println (x.toString true) + ) + +def loadMalFns (ref: Dict) (fndefs: List String): Dict × String := + fndefs.foldl (fun (res : Dict × String) fndef => + let (ref, msg) := res + let (newref, newmsg) := rep.{u} ref fndef + (newref, s!"{msg}¬{newmsg}") + ) (ref, "") + +def fnDefs: List String := [ + "(def! *host-language* \"Lean\")", + "(def! not (fn* (a) (if a false true)))" + ] + +def main : IO Unit := do + IO.println "Welcome to Mal REPL!" + let (env0, _) := loadMalFns.{u} (loadFnNativeAll Dict.empty) fnDefs + let mut env := env0 + + let mut donext := true + while donext do + IO.print "user> " + let stdin ← IO.getStdin + let input ← stdin.getLine + let value := input.trim + if value = "exit" then + donext := false + IO.println "Exiting REPL." + if value.isEmpty then + donext := false + else + let (ref, val) := rep.{u} env value + printLogs ref + IO.println val + env := ref diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean index 48b8d65184..b3ae6e13d7 100644 --- a/impls/lean/lakefile.lean +++ b/impls/lean/lakefile.lean @@ -56,6 +56,11 @@ lean_exe "step7_quote" { root := `LeanMal.step7_quote } +@[default_target] +lean_exe "step8_macros" { + root := `LeanMal.step8_macros +} + @[default_target] lean_exe "mal" { root := `LeanMal.step1_read_print From bce13d4c57f2c51211f327710b9fcdc73189b442 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Sat, 24 Aug 2024 16:36:42 +0200 Subject: [PATCH 10/39] lean: step9_try --- impls/lean/LeanMal/core.lean | 233 +++++++++--- impls/lean/LeanMal/reader.lean | 40 +- impls/lean/LeanMal/step2_eval.lean | 4 +- impls/lean/LeanMal/step3_env.lean | 4 +- impls/lean/LeanMal/step4_if_fn_do.lean | 48 ++- impls/lean/LeanMal/step5_tco.lean | 49 ++- impls/lean/LeanMal/step6_file.lean | 91 ++++- impls/lean/LeanMal/step7_quote.lean | 94 ++++- impls/lean/LeanMal/step8_macros.lean | 108 +++++- impls/lean/LeanMal/step9_try.lean | 496 +++++++++++++++++++++++++ impls/lean/LeanMal/types.lean | 8 + impls/lean/lakefile.lean | 5 + 12 files changed, 1092 insertions(+), 88 deletions(-) create mode 100644 impls/lean/LeanMal/step9_try.lean diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 200288ec13..86c475d61c 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -189,10 +189,16 @@ def prStrInternal (lst: List Types) (printReadably: Bool) (sep: String) : String let elems := lst.map (fun x => x.toString printReadably) String.intercalate sep elems +-- we avoid introducing the IO monad for logging, by just collecting the logs in the environment Dict def KEY_LOGS_INFO := "LOGS_INFO" def KEY_LOGS_DEBUG := "LOGS_DEBUG" def KEY_DEBUG_EVAL := "DEBUG-EVAL" +def resetLogs (ref: Dict): Dict := + ( + ref.insert (KeyType.strKey KEY_LOGS_INFO) (Types.listVal []) + ).insert (KeyType.strKey KEY_LOGS_DEBUG) (Types.listVal []) + def getLogs (ref: Dict) (type: String): List Types := match getEntry ref (KeyType.strKey type) with | some v => match v with @@ -331,7 +337,7 @@ def restSeq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Typ else let first := lst[0]! match first with - | Types.Nil => Except.ok (ref, Types.Nil) + | Types.Nil => Except.ok (ref, Types.listVal []) | Types.vecVal v => let lv := toList v if lv.length < 1 then Except.ok (ref, Types.listVal []) @@ -343,48 +349,181 @@ def restSeq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Typ Except.ok (ref, Types.listVal (lv.drop 1)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") -def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := - match name with - | "+" => sum ref results - | "-" => sub ref results - | "*" => mul ref results - | "/" => div ref results - | "<" => lt ref results - | "<=" => lte ref results - | ">" => gt ref results - | ">=" => gte ref results - | "=" => eq ref results false - | "list" => Except.ok (ref, Types.listVal results) - | "count" => countFunc ref results - | "cons" => cons ref results - | "concat" => concat ref results - | "vec" => makeVec ref results - | "nth" => nthSeq ref results - | "first" => firstSeq ref results - | "rest" => restSeq ref results - | "atom" => makeAtom ref results - | "deref" => derefAtom ref results - | "reset!" => resetAtom ref results args - -- | "swap!" => swapAtom ref results - | "prn" => prnFunc ref results - | "pr-str" => prStrFunc ref results - | "str" => strFunc ref results - | "println" => printlnFunc ref results - -- | "eval" => eval ref results - | "read-string" => match readString results ref with -- readString results Dict.empty +def makeVector (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + Except.ok (ref, Types.vecVal (listToVec lst)) + +def makeDictInternal (initialDict : Dict) (lst: List Types) : Except String (Dict) := + let rec loop (lst : List Types) (acc : Dict) : Except String Dict := + match lst with + | [] => Except.ok acc + | (Types.strVal k) :: v :: rest => + loop rest (Dict.insert (KeyType.strKey k) v acc) + | _ => Except.error "Invalid list format: Expected alternating strVal and Types" + loop lst initialDict + +def makeDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + match makeDictInternal Dict.empty lst with + | Except.error e => Except.error (ref, e) + | Except.ok (newDict) => Except.ok (ref, Types.dictVal newDict) + +def assocDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "assoc: >= 1 arguments required") + else + let first := lst[0]! + let rest := lst.drop 1 + match first with + | Types.dictVal v => + match makeDictInternal v rest with | Except.error e => Except.error (ref, e) - | Except.ok res => Except.ok (ref, res) - | _ => match results with - | [x] => match x with - | Types.listVal x => match name with - | "list?" => Except.ok (ref, Types.boolVal true) - | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) - | _ => Except.ok (ref, Types.boolVal false) - | Types.atomVal _ => match name with - | "atom?" => Except.ok (ref, Types.boolVal true) - | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.error (ref, s!"'{name}' not found") + | Except.ok (newDict) => Except.ok (ref, Types.dictVal newDict) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + +def dissoc (dict : Dict) (keys : List Types) : Except String Dict := + let rec loop (keys : List Types) (acc : Dict) : Except String Dict := + match keys with + | [] => Except.ok acc + | key :: rest => + match key with + | Types.strVal v => + let newDict := removeKey acc (KeyType.strKey v) + loop rest newDict + | Types.keywordVal v => + let newDict := removeKey acc (KeyType.strKey v) + loop rest newDict + | x => Except.error s!"unexpected symbol: {x.toString true}, expected: keyword or string" + loop keys dict + +def dissocDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "dissoc: >= 1 arguments required") + else + let first := lst[0]! + let rest := lst.drop 1 + match first with + | Types.dictVal v => + match dissoc v rest with + | Except.error e => Except.error (ref, e) + | Except.ok newDict => Except.ok (ref, Types.dictVal newDict) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + +def getDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "get: >= 1 arguments required") + else + let first := lst[0]! + let rest := lst.drop 1 + match first with + | Types.dictVal v => + match rest with + | [] => Except.ok (ref, Types.Nil) + | _ => + match (rest[0]!) with + | Types.strVal k => + match getEntry v (KeyType.strKey k) with + | some val => Except.ok (ref, val) + | none => Except.ok (ref, Types.Nil) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: keyword or string") + | Types.Nil => Except.ok (ref, Types.Nil) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + +def containsDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "contains?: >= 1 arguments required") + else + let first := lst[0]! + let rest := lst.drop 1 + match first with + | Types.dictVal v => + match rest with + | [] => Except.ok (ref, Types.boolVal false) + | _ => + match (rest[0]!) with + | Types.strVal k => + match getEntry v (KeyType.strKey k) with + | some _ => Except.ok (ref, Types.boolVal true) + | none => Except.ok (ref, Types.boolVal false) + | Types.keywordVal k => + match getEntry v (KeyType.strKey k) with + | some _ => Except.ok (ref, Types.boolVal true) + | none => Except.ok (ref, Types.boolVal false) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: keyword or string") + | Types.Nil => Except.ok (ref, Types.boolVal false) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + +def getKeysDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "keys: 1 arguments required") + else + let first := lst[0]! + match first with + | Types.dictVal v => + let keys := getKeys v + let result := keys.map (fun k => + match k with + | KeyType.strKey v => (Types.strVal v) + | KeyType.keywordKey v => (Types.keywordVal v) + ) + Except.ok (ref, (Types.listVal result)) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + +def getValuesDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "get: 1 arguments required") + else + let first := lst[0]! + match first with + | Types.dictVal v => + let values := getValues v + Except.ok (ref, (Types.listVal values)) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + +def makeSymbol (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "symbol: 1 argument required") + else + let first := lst[0]! + match first with + | Types.symbolVal v => Except.ok (ref, Types.symbolVal v) + | Types.strVal v => Except.ok (ref, Types.symbolVal v) + | x => Except.error (ref, s!"symbol: unexpected symbol: {x.toString true}, expected: string") + +def makeKeyword (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "keyword: 1 argument required") + else + let first := lst[0]! + match first with + | Types.keywordVal v => Except.ok (ref, Types.keywordVal v) + | Types.strVal v => Except.ok (ref, Types.keywordVal v) + | x => Except.error (ref, s!"keyword: unexpected symbol: {x.toString true}, expected: string") + +def conj (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "conj: >= 1 arguments required") + else + let first := lst[0]! + let rest := lst.drop 1 + match first with + | Types.listVal v => Except.ok (ref, Types.listVal (v ++ rest)) + | Types.vecVal v => Except.ok (ref, Types.vecVal (listToVec ((toList v) ++ rest))) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + +def seq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "conj: 1 arguments required") + else + let first := lst[0]! + match first with + | Types.Nil => Except.ok (ref, Types.Nil) + | Types.listVal v => if v.length == 0 then Except.ok (ref, Types.Nil) else Except.ok (ref, Types.listVal v) + | Types.vecVal vv => + let v := toList vv + if v.length == 0 then Except.ok (ref, Types.Nil) else Except.ok (ref, Types.listVal v) + | Types.strVal v => + if v.length == 0 then Except.ok (ref, Types.Nil) + else + let lv := v.toList.map (fun x => Types.strVal (String.singleton x)) + Except.ok (ref, Types.listVal lv) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list, vector or string") + +partial def throwFn (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "panic") + else + let a := lst[0]! + match a with + | Types.strVal v => Except.error (ref, v) + | x => Except.error (ref, x.toString true) def readFileContent (filePath : String) : IO String := do IO.FS.readFile filePath @@ -431,9 +570,17 @@ def loadFnNativeFold (ref: Dict) (fnNames : List String) : Dict := def coreFnSymbols: List String := [ "+", "-", "*", "/", "<", "<=", ">", ">=", "=", + "number?", "list", "list?", "empty?", "count", "concat", "cons", - "vec", "nth", "first", "rest", + "vec", "nth", "first", "rest", "vector", + "map", "apply", + "conj", "seq", "sequential?", + "hash-map", "assoc", "dissoc", "get", "contains?", "keys", "vals", "map?", + "string?", + "throw", + "symbol", "keyword", "symbol?", "keyword?", + "nil?", "true?", "false?", "fn?", "macro?", "prn", "pr-str", "str", "println", "read-string", "slurp", "atom", "atom?", "deref", "reset!", diff --git a/impls/lean/LeanMal/reader.lean b/impls/lean/LeanMal/reader.lean index cab0ed6c38..dfa716eb69 100644 --- a/impls/lean/LeanMal/reader.lean +++ b/impls/lean/LeanMal/reader.lean @@ -63,21 +63,45 @@ def read_str_val : Parsec Types := do let _ ← pchar '"' return Types.strVal str +def is_symbol_char (c: Char): Bool := + c.isAlphanum || c == '+' || c == '-' || c == '*' || c == '/' || c == '=' || c == '<' || c == '>' || c == ':' || c == '_' || c == '!' || c == '?' || c == '&' + +def read_symbol_val : Parsec Types := do + ws + let sym ← many1Chars (satisfy (λ c => is_symbol_char c)) + ws + return Types.symbolVal sym + def read_bool_val : Parsec Types := do ws let b ← (pstring "true" <|> pstring "false") - return Types.boolVal (b == "true") + let boolVal := Types.boolVal (b == "true") + let nextChar ← peek? + match nextChar with + | none => return boolVal + | some v => + if is_symbol_char v then + let rest ← read_symbol_val + match rest with + | Types.symbolVal x => return Types.symbolVal (b ++ x) + | _ => return boolVal + else + return boolVal def read_nil_val : Parsec Types := do ws let _ ← pstring "nil" - return Types.Nil - -def read_symbol_val : Parsec Types := do - ws - let sym ← many1Chars (satisfy (λ c => c.isAlphanum || c == '+' || c == '-' || c == '*' || c == '/' || c == '=' || c == '<' || c == '>' || c == ':' || c == '_' || c == '!' || c == '?')) - ws - return Types.symbolVal sym + let nextChar ← peek? + match nextChar with + | none => return Types.Nil + | some v => + if is_symbol_char v then + let rest ← read_symbol_val + match rest with + | Types.symbolVal x => return Types.symbolVal ("nil" ++ x) + | _ => return Types.Nil + else + return Types.Nil def read_keyword : Parsec Types := do let _ ← pstring ":" diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean index 190c05e04b..d598edb1fd 100644 --- a/impls/lean/LeanMal/step2_eval.lean +++ b/impls/lean/LeanMal/step2_eval.lean @@ -80,9 +80,7 @@ mutual let keys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] - - let built := buildDictWithSymbols fref keys results - let merged := mergeDicts newRef built + let merged := mergeDicts newRef (mergeDicts fref (buildDict keys results)) evalTypes merged body | Fun.macroFn _ _ _ => Except.error "macro not implemented" | _ => Except.error s!"`unexpected token, expected: function`" diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index 912365aecc..d218908c0c 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -79,9 +79,7 @@ mutual let keys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] - - let built := buildDictWithSymbols fref keys results - let merged := mergeDicts newRef built + let merged := mergeDicts newRef (mergeDicts fref (buildDict keys results)) evalTypes merged body | Fun.macroFn _ _ _ => Except.error "macro not implemented" | _ => Except.error s!"`unexpected token, expected: function`" diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index 44889db33c..0ebf3f5c42 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -12,6 +12,16 @@ def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Ty let newfn := Fun.userDefined ref params body Except.ok (ref, Types.funcVal newfn) +def splitOnAmpersand (input : List String) : (List String × List String) := + let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := + match rest with + | [] => (acc1, []) -- If no "&" found, second list is empty + | "&" :: xs => match xs with + | [] => (acc1, []) -- If "&" is the last element, second list is empty + | y :: _ => (acc1, [y]) -- Add the next element after "&" to the second list + | x :: xs => loop (acc1 ++ [x]) xs -- Accumulate elements before "&" + loop [] input + mutual partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" @@ -37,14 +47,17 @@ mutual | Except.ok (newRef, results) => match fn with | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newRef name results args + | Fun.builtin name => evalFnNative newRef name results | Fun.userDefined fref params body => - let keys: List String := match params with + let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) - let built := buildDictWithSymbols fref keys results - let merged := mergeDicts newRef built evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") @@ -164,6 +177,33 @@ mutual if cond then evalTypes newRef thenExpr else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) + + partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types): Except (Dict × String) (Dict × Types) := + match name with + | "+" => sum ref results + | "-" => sub ref results + | "*" => mul ref results + | "/" => div ref results + | "<" => lt ref results + | "<=" => lte ref results + | ">" => gt ref results + | ">=" => gte ref results + | "=" => eq ref results false + | "prn" => prnFunc ref results + | "pr-str" => prStrFunc ref results + | "str" => strFunc ref results + | "println" => printlnFunc ref results + | "list" => Except.ok (ref, Types.listVal results) + | "count" => countFunc ref results + | _ => match results with + | [x] => match x with + | Types.listVal x => match name with + | "list?" => Except.ok (ref, Types.boolVal true) + | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.error (ref, s!"'{name}' not found") + end def READ (input : String): Except String Types := diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index 44889db33c..ae7e830bd1 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -12,6 +12,16 @@ def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Ty let newfn := Fun.userDefined ref params body Except.ok (ref, Types.funcVal newfn) +def splitOnAmpersand (input : List String) : (List String × List String) := + let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := + match rest with + | [] => (acc1, []) -- If no "&" found, second list is empty + | "&" :: xs => match xs with + | [] => (acc1, []) -- If "&" is the last element, second list is empty + | y :: _ => (acc1, [y]) -- Add the next element after "&" to the second list + | x :: xs => loop (acc1 ++ [x]) xs -- Accumulate elements before "&" + loop [] input + mutual partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" @@ -37,14 +47,17 @@ mutual | Except.ok (newRef, results) => match fn with | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newRef name results args + | Fun.builtin name => evalFnNative newRef name results | Fun.userDefined fref params body => - let keys: List String := match params with + let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) - let built := buildDictWithSymbols fref keys results - let merged := mergeDicts newRef built evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") @@ -164,6 +177,32 @@ mutual if cond then evalTypes newRef thenExpr else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) + + partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types): Except (Dict × String) (Dict × Types) := + match name with + | "+" => sum ref results + | "-" => sub ref results + | "*" => mul ref results + | "/" => div ref results + | "<" => lt ref results + | "<=" => lte ref results + | ">" => gt ref results + | ">=" => gte ref results + | "=" => eq ref results false + | "prn" => prnFunc ref results + | "pr-str" => prStrFunc ref results + | "str" => strFunc ref results + | "println" => printlnFunc ref results + | "list" => Except.ok (ref, Types.listVal results) + | "count" => countFunc ref results + | _ => match results with + | [x] => match x with + | Types.listVal x => match name with + | "list?" => Except.ok (ref, Types.boolVal true) + | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.error (ref, s!"'{name}' not found") end def READ (input : String): Except String Types := @@ -204,4 +243,4 @@ def main : IO Unit := do let (ref, val) := rep.{u} env value printLogs ref IO.println val - env := ref + env := resetLogs ref diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 5033f0057d..bb68728adb 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -12,6 +12,16 @@ def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Ty let newfn := Fun.userDefined ref params body Except.ok (ref, Types.funcVal newfn) +def splitOnAmpersand (input : List String) : (List String × List String) := + let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := + match rest with + | [] => (acc1, []) -- If no "&" found, second list is empty + | "&" :: xs => match xs with + | [] => (acc1, []) -- If "&" is the last element, second list is empty + | y :: _ => (acc1, [y]) -- Add the next element after "&" to the second list + | x :: xs => loop (acc1 ++ [x]) xs -- Accumulate elements before "&" + loop [] input + mutual partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" @@ -39,15 +49,16 @@ mutual | Types.funcVal v => match v with | Fun.builtin name => evalFnNative newRef name results args - -- match evalFnNative newRef name results with - -- | Except.ok r => r - -- | Except.error e => evalFnNativeWithIO newRef name results | Fun.userDefined fref params body => - let keys: List String := match params with + let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] - let built := buildDictWithSymbols fref keys results - let merged := mergeDicts newRef built + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") @@ -167,6 +178,72 @@ mutual if cond then evalTypes newRef thenExpr else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) + + partial def swapAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") + else + let first := lst[0]! + let fn := lst[1]! + let rest := lst.drop 2 + match fn with + | Types.funcVal _ => + match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, Types.atomVal (Atom.v res)) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, Types.atomVal (Atom.withmeta res meta)) + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: function") + + partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") + else + let ast := lst[0]! + evalTypes ref ast + + partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := + match name with + | "+" => sum ref results + | "-" => sub ref results + | "*" => mul ref results + | "/" => div ref results + | "<" => lt ref results + | "<=" => lte ref results + | ">" => gt ref results + | ">=" => gte ref results + | "=" => eq ref results false + | "list" => Except.ok (ref, Types.listVal results) + | "count" => countFunc ref results + | "atom" => makeAtom ref results + | "deref" => derefAtom ref results + | "reset!" => resetAtom ref results args + | "swap!" => swapAtom ref results + | "prn" => prnFunc ref results + | "pr-str" => prStrFunc ref results + | "str" => strFunc ref results + | "println" => printlnFunc ref results + | "eval" => eval ref results + | "read-string" => match readString results ref with -- readString results Dict.empty + | Except.error e => Except.error (ref, e) + | Except.ok res => Except.ok (ref, res) + | _ => match results with + | [x] => match x with + | Types.listVal x => match name with + | "list?" => Except.ok (ref, Types.boolVal true) + | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) + | _ => Except.ok (ref, Types.boolVal false) + | Types.atomVal _ => match name with + | "atom?" => Except.ok (ref, Types.boolVal true) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.error (ref, s!"'{name}' not found") end def READ (input : String): Except String Types := @@ -207,4 +284,4 @@ def main : IO Unit := do let (ref, val) := rep.{u} env value printLogs ref IO.println val - env := ref + env := resetLogs ref diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index d3fc092904..f86bb87991 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -12,6 +12,16 @@ def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Ty let newfn := Fun.userDefined ref params body Except.ok (ref, Types.funcVal newfn) +def splitOnAmpersand (input : List String) : (List String × List String) := + let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := + match rest with + | [] => (acc1, []) -- If no "&" found, second list is empty + | "&" :: xs => match xs with + | [] => (acc1, []) -- If "&" is the last element, second list is empty + | y :: _ => (acc1, [y]) -- Add the next element after "&" to the second list + | x :: xs => loop (acc1 ++ [x]) xs -- Accumulate elements before "&" + loop [] input + mutual partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" @@ -39,15 +49,16 @@ mutual | Types.funcVal v => match v with | Fun.builtin name => evalFnNative newRef name results args - -- match evalFnNative newRef name results with - -- | Except.ok r => r - -- | Except.error e => evalFnNativeWithIO newRef name results | Fun.userDefined fref params body => - let keys: List String := match params with + let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] - let built := buildDictWithSymbols fref keys results - let merged := mergeDicts newRef built + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") @@ -174,6 +185,35 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) + partial def swapAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") + else + let first := lst[0]! + let fn := lst[1]! + let rest := lst.drop 2 + match fn with + | Types.funcVal _ => + match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, Types.atomVal (Atom.v res)) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, Types.atomVal (Atom.withmeta res meta)) + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: function") + + partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") + else + let ast := lst[0]! + evalTypes ref ast + partial def starts_with (lst: List Types) (symb: String) : Bool := if lst.length == 2 then match lst[0]! with @@ -205,6 +245,46 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast + partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := + match name with + | "+" => sum ref results + | "-" => sub ref results + | "*" => mul ref results + | "/" => div ref results + | "<" => lt ref results + | "<=" => lte ref results + | ">" => gt ref results + | ">=" => gte ref results + | "=" => eq ref results false + | "list" => Except.ok (ref, Types.listVal results) + | "count" => countFunc ref results + | "cons" => cons ref results + | "concat" => concat ref results + | "vec" => makeVec ref results + | "atom" => makeAtom ref results + | "deref" => derefAtom ref results + | "reset!" => resetAtom ref results args + | "swap!" => swapAtom ref results + | "prn" => prnFunc ref results + | "pr-str" => prStrFunc ref results + | "str" => strFunc ref results + | "println" => printlnFunc ref results + | "eval" => eval ref results + | "read-string" => match readString results ref with -- readString results Dict.empty + | Except.error e => Except.error (ref, e) + | Except.ok res => Except.ok (ref, res) + | _ => match results with + | [x] => match x with + | Types.listVal x => match name with + | "list?" => Except.ok (ref, Types.boolVal true) + | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) + | _ => Except.ok (ref, Types.boolVal false) + | Types.atomVal _ => match name with + | "atom?" => Except.ok (ref, Types.boolVal true) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.error (ref, s!"'{name}' not found") + end def READ (input : String): Except String Types := @@ -246,4 +326,4 @@ def main : IO Unit := do let (ref, val) := rep.{u} env value printLogs ref IO.println val - env := ref + env := resetLogs ref diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index 0052cb5282..445389619c 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -12,6 +12,16 @@ def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Ty let newfn := Fun.userDefined ref params body Except.ok (ref, Types.funcVal newfn) +def splitOnAmpersand (input : List String) : (List String × List String) := + let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := + match rest with + | [] => (acc1, []) -- If no "&" found, second list is empty + | "&" :: xs => match xs with + | [] => (acc1, []) -- If "&" is the last element, second list is empty + | y :: _ => (acc1, [y]) -- Add the next element after "&" to the second list + | x :: xs => loop (acc1 ++ [x]) xs -- Accumulate elements before "&" + loop [] input + mutual partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" @@ -42,18 +52,27 @@ mutual match evalFuncArgs ref args with | Except.error e => Except.error e | Except.ok (newRef, results) => - let keys: List String := match params with + let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] - let built := buildDictWithSymbols fref keys results - let merged := mergeDicts newRef built + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + evalTypes merged body | Fun.macroFn fref params body => - let keys: List String := match params with + let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] - let built := buildDictWithSymbols fref keys args - match evalTypes built body with + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := args.take keys.length + let variadicArg := args.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let merged := mergeDicts ref (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + + match evalTypes merged body with | Except.error e => Except.error e | Except.ok (_, newast) => evalTypes ref newast | _ => Except.error (ref, s!"`unexpected token, expected: function`") @@ -204,6 +223,35 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) + partial def swapAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") + else + let first := lst[0]! + let fn := lst[1]! + let rest := lst.drop 2 + match fn with + | Types.funcVal _ => + match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, Types.atomVal (Atom.v res)) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, Types.atomVal (Atom.withmeta res meta)) + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: function") + + partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") + else + let ast := lst[0]! + evalTypes ref ast + partial def starts_with (lst: List Types) (symb: String) : Bool := if lst.length == 2 then match lst[0]! with @@ -235,6 +283,49 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast + partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := + match name with + | "+" => sum ref results + | "-" => sub ref results + | "*" => mul ref results + | "/" => div ref results + | "<" => lt ref results + | "<=" => lte ref results + | ">" => gt ref results + | ">=" => gte ref results + | "=" => eq ref results false + | "list" => Except.ok (ref, Types.listVal results) + | "count" => countFunc ref results + | "cons" => cons ref results + | "concat" => concat ref results + | "vec" => makeVec ref results + | "nth" => nthSeq ref results + | "first" => firstSeq ref results + | "rest" => restSeq ref results + | "atom" => makeAtom ref results + | "deref" => derefAtom ref results + | "reset!" => resetAtom ref results args + -- | "swap!" => swapAtom ref results + | "prn" => prnFunc ref results + | "pr-str" => prStrFunc ref results + | "str" => strFunc ref results + | "println" => printlnFunc ref results + -- | "eval" => eval ref results + | "read-string" => match readString results ref with -- readString results Dict.empty + | Except.error e => Except.error (ref, e) + | Except.ok res => Except.ok (ref, res) + | _ => match results with + | [x] => match x with + | Types.listVal x => match name with + | "list?" => Except.ok (ref, Types.boolVal true) + | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) + | _ => Except.ok (ref, Types.boolVal false) + | Types.atomVal _ => match name with + | "atom?" => Except.ok (ref, Types.boolVal true) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.error (ref, s!"'{name}' not found") + end def READ (input : String): Except String Types := @@ -266,7 +357,8 @@ def loadMalFns (ref: Dict) (fndefs: List String): Dict × String := def fnDefs: List String := [ "(def! *host-language* \"Lean\")", - "(def! not (fn* (a) (if a false true)))" + "(def! not (fn* (a) (if a false true)))", + "(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)))))))", ] def main : IO Unit := do @@ -289,4 +381,4 @@ def main : IO Unit := do let (ref, val) := rep.{u} env value printLogs ref IO.println val - env := ref + env := resetLogs ref diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean new file mode 100644 index 0000000000..fff9a1a29f --- /dev/null +++ b/impls/lean/LeanMal/step9_try.lean @@ -0,0 +1,496 @@ +import LeanMal.reader +import LeanMal.printer +import LeanMal.core + +universe u + +def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let params := args[0]! + let body := args[1]! + let newfn := Fun.userDefined ref params body + Except.ok (ref, Types.funcVal newfn) + +def splitOnAmpersand (input : List String) : (List String × List String) := + let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := + match rest with + | [] => (acc1, []) -- If no "&" found, second list is empty + | "&" :: xs => match xs with + | [] => (acc1, []) -- If "&" is the last element, second list is empty + | y :: _ => (acc1, [y]) -- Add the next element after "&" to the second list + | x :: xs => loop (acc1 ++ [x]) xs -- Accumulate elements before "&" + loop [] input + +mutual + partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" + else _ref + match ast with + | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with + | some vi => Except.ok (ref, vi) + | none => Except.error (ref, s!"'{v}' not found") + | Types.listVal el => (evalList ref el) + | Types.vecVal el => (evalVec ref (toList el)) + | Types.dictVal el => (evalDict ref el) + | x => Except.ok (ref, x) + + partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + match evalTypes ref head with + | Except.error (newref, e) => Except.error (newref, e) + | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + + partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + evalFnNative newRef name results args + | Fun.userDefined fref params body => + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + + evalTypes merged body + | Fun.macroFn fref params body => + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := args.take keys.length + let variadicArg := args.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let merged := mergeDicts ref (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + + match evalTypes merged body with + | Except.error e => Except.error e + | Except.ok (_, newast) => evalTypes ref newast + | _ => Except.error (ref, s!"`unexpected token, expected: function`") + + partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + else + let head := lst[0]! + match head with + | Types.symbolVal v => match v with + | "def!" => evalDefn ref (lst.drop 1) + | "let*" => evalLet ref (lst.drop 1) + | "do" => evalDo ref (lst.drop 1) + | "if" => evalIf ref (lst.drop 1) + | "fn*" => makeFn ref (lst.drop 1) + | "try*" => evalTry ref (lst.drop 1) + | "quote" => + if lst.length < 2 then Except.error (ref, "quote: expected 1 argument") + else Except.ok (ref, lst[1]!) + | "quasiquote" => + if lst.length < 2 then Except.error (ref, "quasiquote: expected 1 argument") + else evalTypes ref (quasiquote lst[1]!) + | "defmacro!" => evalDefMacro ref (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + + partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + match evalFuncArgs ref elems with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + + partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + match evalDictInner ref lst with + | Except.error e => Except.error e + | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + + partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + match lst with + | Dict.empty => Except.ok (ref, lst) + | Dict.insert k v restDict => match evalTypes ref v with + | Except.error e => Except.error e + | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.error e => Except.error e + | Except.ok (updatedRef, updatedDict) => + let newDict := Dict.insert k newVal updatedDict + Except.ok (updatedRef, newDict) + + partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + match res with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") + | Except.ok (r, acc) => match evalTypes r x with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, acc ++ [res]) + ) (Except.ok (ref, [])) with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + + partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "def! unexpected syntax") + else + let key := args[0]! + let body := args[1]! + match (evalTypes ref body) with + | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") + | Except.ok (newRef, value) => + match key with + | Types.symbolVal v => + let refResult := addEntry newRef (KeyType.strKey v) value + Except.ok (refResult, value) + | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + + partial def evalDefMacro (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "def! unexpected syntax") + else + let key := args[0]! + let body := args[1]! + match (evalTypes ref body) with + | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") + | Except.ok (newRef, value) => + match key with + | Types.symbolVal v => + match value with + | Types.funcVal func => + match func with + | Fun.macroFn _ _ _ => + let refResult := addEntry newRef (KeyType.strKey v) value + Except.ok (refResult, value) + | Fun.userDefined fref params body => + let refResult := addEntry newRef (KeyType.strKey v) (Types.funcVal (Fun.macroFn fref params body)) + Except.ok (refResult, value) + | _ => Except.error (newRef, s!"defmacro!: unexpected builtin function") + | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") + | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + + partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + else + let pairs := args[0]! + let body := args[1]! + let result := match pairs with + | Types.listVal v => evalLetArgs ref v + | Types.vecVal v => evalLetArgs ref (toList v) + | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + + match result with + | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") + | Except.ok newRef => match evalTypes newRef body with + | Except.error e => Except.error e + -- we do not propagate the let* environment to the parent scope + | Except.ok (_, result) => Except.ok (ref, result) + + partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + match args with + | [] => Except.ok ref + | [_] => Except.error (ref, "let*: unexpected syntax") + | x :: y :: rest => + match x with + | Types.symbolVal key => match evalTypes ref y with + | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.ok (updatedRef, value) => + evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + | _ => Except.error (ref, "let*: unexpected syntax") + + partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + -- only return last computation result + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + if results.length == 0 then Except.ok (newRef, Types.Nil) + else Except.ok (newRef, results[results.length - 1]!) + + partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let condition := args[0]! + let thenExpr := args[1]! + let hasElse := args.length > 2 + + match evalTypes ref condition with + | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") + | Except.ok (newRef, condResp) => + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newRef thenExpr + else if hasElse then evalTypes newRef args[2]! + else Except.ok (newRef, Types.Nil) + + partial def evalTry (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "try*: unexpected syntax") + else + match evalTypes ref lst[0]! with + | Except.ok (newRef, result) => Except.ok (newRef, result) + | Except.error evalErr => + if lst.length < 2 then Except.error evalErr + else + match lst[1]! with + | Types.listVal catchBody => + if catchBody.length < 1 then Except.error (ref, "try*: unexpected syntax") + else + match catchBody[0]! with + | Types.symbolVal catchSymbol => + if catchSymbol == "catch*" then + if catchBody.length < 2 then Except.error (ref, "try*: unexpected syntax") + else + let es := catchBody[1]! + match es with + | Types.symbolVal errorSymbol => + let (errRef, errStr) := evalErr + let err := Types.strVal errStr + if catchBody.length < 2 then Except.error (errRef, "try*: unexpected syntax") + else + let toeval := catchBody[2]! + let built := buildDictWithSymbols ref [errorSymbol] [err] + let merged := mergeDicts ref built + evalTypes merged toeval + | _ => Except.error (ref, s!"unexpected return type, expected: symbol") + else Except.error evalErr + | _ => Except.error evalErr + -- | Types.vecVal v => -- TODO + | _ => Except.error evalErr + + partial def swapAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") + else + let first := lst[0]! + let fn := lst[1]! + let rest := lst.drop 2 + match fn with + | Types.funcVal _ => + match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, Types.atomVal (Atom.v res)) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, Types.atomVal (Atom.withmeta res meta)) + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: function") + + partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") + else + let ast := lst[0]! + evalTypes ref ast + + partial def starts_with (lst: List Types) (symb: String) : Bool := + if lst.length == 2 then + match lst[0]! with + | Types.symbolVal v => v == symb + | _ => false + else false + + partial def qq_loop (elt : Types) (acc: List Types): List Types := + match elt with + | Types.listVal v => + if starts_with v "splice-unquote" + then + [Types.symbolVal "concat", v[1]!, Types.listVal acc] + else + [Types.symbolVal "cons", quasiquote elt, Types.listVal acc] + | _ => [Types.symbolVal "cons", quasiquote elt, Types.listVal acc] + + partial def qq_foldr (lst : List Types): Types := + let res := lst.reverse.foldl (fun acc x => qq_loop x acc) [] + Types.listVal res + + partial def quasiquote (ast: Types) : Types := + match ast with + | Types.symbolVal _ => Types.listVal [Types.symbolVal "quote", ast] + | Types.dictVal _ => Types.listVal [Types.symbolVal "quote", ast] + | Types.listVal v => + if starts_with v "unquote" then v[1]! + else qq_foldr v + | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] + | _ => ast + + partial def nativeMapFnApply (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + match res with + | Except.error e => Except.error e + | Except.ok (r, acc) => + match evalFuncVal r fn [x] with + | Except.error e => Except.error e + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, acc ++ [res]) + ) (Except.ok (ref, [])) with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, Types.listVal results) + + partial def nativeMap (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "map: unexpected syntax") + else + let fn := lst[0]! + let params := lst[1]! + match fn with + | Types.funcVal _ => + match params with + | Types.listVal v => nativeMapFnApply ref fn v + | Types.vecVal v => nativeMapFnApply ref fn (toList v) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: function") + + partial def nativeApply (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "apply: unexpected syntax") + else + let fn := lst[0]! + let vecargs := lst[lst.length-1]! + let n := lst.length-2 + let firstargs := lst.drop 1 |>.take n + match vecargs with + | Types.listVal v => + evalFuncVal ref fn (firstargs ++ v) + | Types.vecVal v => + evalFuncVal ref fn (firstargs ++ (toList v)) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + + partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := + match name with + | "+" => sum ref results + | "-" => sub ref results + | "*" => mul ref results + | "/" => div ref results + | "<" => lt ref results + | "<=" => lte ref results + | ">" => gt ref results + | ">=" => gte ref results + | "=" => eq ref results false + | "list" => Except.ok (ref, Types.listVal results) + | "count" => countFunc ref results + | "cons" => cons ref results + | "concat" => concat ref results + | "map" => nativeMap ref results + | "apply" => nativeApply ref results + | "vec" => makeVec ref results + | "vector" => makeVector ref results + | "nth" => nthSeq ref results + | "first" => firstSeq ref results + | "rest" => restSeq ref results + | "conj" => conj ref results + | "seq" => seq ref results + | "hash-map" => makeDict ref results + | "assoc" => assocDict ref results + | "dissoc" => dissocDict ref results + | "get" => getDict ref results + | "contains?" => containsDict ref results + | "keys" => getKeysDict ref results + | "vals" => getValuesDict ref results + | "throw" => throwFn ref results + | "symbol" => makeSymbol ref results + | "keyword" => makeKeyword ref results + | "atom" => makeAtom ref results + | "deref" => derefAtom ref results + | "reset!" => resetAtom ref results args + | "swap!" => swapAtom ref results + | "prn" => prnFunc ref results + | "pr-str" => prStrFunc ref results + | "str" => strFunc ref results + | "println" => printlnFunc ref results + | "eval" => eval ref results + | "read-string" => match readString results ref with -- readString results Dict.empty + | Except.error e => Except.error (ref, e) + | Except.ok res => Except.ok (ref, res) + | _ => match results with + | [x] => match x with + | Types.Nil => if name == "nil?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.intVal _ => if name == "number?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.floatVal _ => if name == "number?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.strVal _ => if name == "string?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.symbolVal _ => if name == "symbol?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.keywordVal _ => if name == "keyword?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.dictVal _ => if name == "map?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.listVal x => match name with + | "list?" => Except.ok (ref, Types.boolVal true) + | "sequential?" => Except.ok (ref, Types.boolVal true) + | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) + | _ => Except.ok (ref, Types.boolVal false) + | Types.vecVal x => match name with + | "sequential?" => Except.ok (ref, Types.boolVal true) + | "vector?" => Except.ok (ref, Types.boolVal false) + | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) + | _ => Except.ok (ref, Types.boolVal false) + | Types.boolVal x => match name with + | "true?" => Except.ok (ref, Types.boolVal x) + | "false?" => Except.ok (ref, Types.boolVal !x) + | _ => Except.ok (ref, Types.boolVal false) + | Types.atomVal _ => match name with + | "atom?" => Except.ok (ref, Types.boolVal true) + | _ => Except.ok (ref, Types.boolVal false) + | Types.funcVal func => match name with + | "fn?" => Except.ok (ref, Types.boolVal true) + | "macro?" => match func with + | Fun.builtin _ => Except.ok (ref, Types.boolVal false) + | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal false) + | Fun.macroFn _ _ _ => Except.ok (ref, Types.boolVal true) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.error (ref, s!"'{name}' not found") + +end + +def READ (input : String): Except String Types := + read_str.{u} input + +def PRINT (ast : Types): String := + pr_str true ast + +def rep (ref: Dict) (input : String): Dict × String := + match READ.{u} input with + | Except.ok result => match evalTypes ref result with + | Except.error (newref, e) => (newref, s!"Error: {e}") + | Except.ok (newref, res) => (newref, PRINT res) + | Except.error err => (ref, s!"Parsing failed: {err}") + +def printLogs (ref : Dict) : IO Unit := + forM (getLogsInfo ref) (fun elem => + match elem with + | Types.strVal log => IO.println log + | x => IO.println (x.toString true) + ) + +def loadMalFns (ref: Dict) (fndefs: List String): Dict × String := + fndefs.foldl (fun (res : Dict × String) fndef => + let (ref, msg) := res + let (newref, newmsg) := rep.{u} ref fndef + (newref, s!"{msg}¬{newmsg}") + ) (ref, "") + +def fnDefs: List String := [ + "(def! *host-language* \"Lean\")", + "(def! not (fn* (a) (if a false true)))" + ] + +def main : IO Unit := do + IO.println "Welcome to Mal REPL!" + let (env0, _) := loadMalFns.{u} (loadFnNativeAll Dict.empty) fnDefs + let mut env := env0 + + let mut donext := true + while donext do + IO.print "user> " + let stdin ← IO.getStdin + let input ← stdin.getLine + let value := input.trim + if value = "exit" then + donext := false + IO.println "Exiting REPL." + if value.isEmpty then + donext := false + else + let (ref, val) := rep.{u} env value + printLogs ref + IO.println val + env := resetLogs ref diff --git a/impls/lean/LeanMal/types.lean b/impls/lean/LeanMal/types.lean index c44456c770..c6393e9e38 100644 --- a/impls/lean/LeanMal/types.lean +++ b/impls/lean/LeanMal/types.lean @@ -132,6 +132,14 @@ def buildDictWithSymbols (ref: Dict) (keys : List String) (values : List Types) let restDict := buildDictWithSymbols ref keyTail valueTail Dict.insert (KeyType.strKey key) val restDict +def buildDict (keys : List String) (values : List Types) : Dict := + match keys, values with + | [], _ => Dict.empty + | _, [] => Dict.empty + | key :: keyTail, value :: valueTail => + let restDict := buildDict keyTail valueTail + Dict.insert (KeyType.strKey key) value restDict + instance : Inhabited Dict where default := Dict.empty diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean index b3ae6e13d7..3ae2a9fd44 100644 --- a/impls/lean/lakefile.lean +++ b/impls/lean/lakefile.lean @@ -61,6 +61,11 @@ lean_exe "step8_macros" { root := `LeanMal.step8_macros } +@[default_target] +lean_exe "step9_try" { + root := `LeanMal.step9_try +} + @[default_target] lean_exe "mal" { root := `LeanMal.step1_read_print From a6070e5c265dd02fb6bf0cba719654fd2b1521b0 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Sat, 24 Aug 2024 17:35:34 +0200 Subject: [PATCH 11/39] lean: stepA_mal --- impls/lean/LeanMal/core.lean | 2 +- impls/lean/LeanMal/step2_eval.lean | 3 +- impls/lean/LeanMal/step3_env.lean | 3 +- impls/lean/LeanMal/step4_if_fn_do.lean | 3 +- impls/lean/LeanMal/step5_tco.lean | 3 +- impls/lean/LeanMal/step6_file.lean | 3 +- impls/lean/LeanMal/step7_quote.lean | 3 +- impls/lean/LeanMal/step8_macros.lean | 6 +- impls/lean/LeanMal/step9_try.lean | 15 +- impls/lean/LeanMal/stepA_mal.lean | 497 +++++++++++++++++++++++++ impls/lean/lakefile.lean | 5 + 11 files changed, 527 insertions(+), 16 deletions(-) create mode 100644 impls/lean/LeanMal/stepA_mal.lean diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 86c475d61c..db1287d53f 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -573,7 +573,7 @@ def coreFnSymbols: List String := [ "number?", "list", "list?", "empty?", "count", "concat", "cons", - "vec", "nth", "first", "rest", "vector", + "vec", "nth", "first", "rest", "vector", "vector?", "map", "apply", "conj", "seq", "sequential?", "hash-map", "assoc", "dissoc", "get", "contains?", "keys", "vals", "map?", diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean index d598edb1fd..33480e7eb9 100644 --- a/impls/lean/LeanMal/step2_eval.lean +++ b/impls/lean/LeanMal/step2_eval.lean @@ -80,7 +80,8 @@ mutual let keys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] - let merged := mergeDicts newRef (mergeDicts fref (buildDict keys results)) + let argsDict := (buildDict keys results) + let merged := mergeDicts (mergeDicts newRef fref) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error "macro not implemented" | _ => Except.error s!"`unexpected token, expected: function`" diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index d218908c0c..f345ef98be 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -79,7 +79,8 @@ mutual let keys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] - let merged := mergeDicts newRef (mergeDicts fref (buildDict keys results)) + let argsDict := (buildDict keys results) + let merged := mergeDicts (mergeDicts newRef fref) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error "macro not implemented" | _ => Except.error s!"`unexpected token, expected: function`" diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index 0ebf3f5c42..24c2ad2786 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -56,7 +56,8 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + let argsDict := (buildDict (keys ++ variadic) argVals) + let merged := mergeDicts (mergeDicts newRef fref) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index ae7e830bd1..e62b26a853 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -56,7 +56,8 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + let argsDict := (buildDict (keys ++ variadic) argVals) + let merged := mergeDicts (mergeDicts newRef fref) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index bb68728adb..6ea7bba8c8 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -57,7 +57,8 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + let argsDict := (buildDict (keys ++ variadic) argVals) + let merged := mergeDicts (mergeDicts newRef fref) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index f86bb87991..dd0f0f998e 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -57,7 +57,8 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + let argsDict := (buildDict (keys ++ variadic) argVals) + let merged := mergeDicts (mergeDicts newRef fref) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index 445389619c..e4f95f5b2d 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -59,7 +59,8 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + let argsDict := (buildDict (keys ++ variadic) argVals) + let merged := mergeDicts (mergeDicts newRef fref) argsDict evalTypes merged body | Fun.macroFn fref params body => @@ -70,7 +71,8 @@ mutual let normalArgs := args.take keys.length let variadicArg := args.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let merged := mergeDicts ref (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + let argsDict := (buildDict (keys ++ variadic) argVals) + let merged := mergeDicts (mergeDicts ref fref) argsDict match evalTypes merged body with | Except.error e => Except.error e diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index fff9a1a29f..816def9509 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -59,8 +59,8 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let merged := mergeDicts newRef (mergeDicts fref (buildDict (keys ++ variadic) argVals)) - + let argsDict := (buildDict (keys ++ variadic) argVals) + let merged := mergeDicts (mergeDicts newRef fref) argsDict evalTypes merged body | Fun.macroFn fref params body => let allkeys: List String := match params with @@ -70,7 +70,8 @@ mutual let normalArgs := args.take keys.length let variadicArg := args.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let merged := mergeDicts ref (mergeDicts fref (buildDict (keys ++ variadic) argVals)) + let argsDict := (buildDict (keys ++ variadic) argVals) + let merged := mergeDicts (mergeDicts ref fref) argsDict match evalTypes merged body with | Except.error e => Except.error e @@ -318,7 +319,7 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def nativeMapFnApply (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def nativeMapOverList (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => match res with | Except.error e => Except.error e @@ -339,8 +340,8 @@ mutual match fn with | Types.funcVal _ => match params with - | Types.listVal v => nativeMapFnApply ref fn v - | Types.vecVal v => nativeMapFnApply ref fn (toList v) + | Types.listVal v => nativeMapOverList ref fn v + | Types.vecVal v => nativeMapOverList ref fn (toList v) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: function") @@ -420,7 +421,7 @@ mutual | _ => Except.ok (ref, Types.boolVal false) | Types.vecVal x => match name with | "sequential?" => Except.ok (ref, Types.boolVal true) - | "vector?" => Except.ok (ref, Types.boolVal false) + | "vector?" => Except.ok (ref, Types.boolVal true) | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) | _ => Except.ok (ref, Types.boolVal false) | Types.boolVal x => match name with diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean new file mode 100644 index 0000000000..816def9509 --- /dev/null +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -0,0 +1,497 @@ +import LeanMal.reader +import LeanMal.printer +import LeanMal.core + +universe u + +def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let params := args[0]! + let body := args[1]! + let newfn := Fun.userDefined ref params body + Except.ok (ref, Types.funcVal newfn) + +def splitOnAmpersand (input : List String) : (List String × List String) := + let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := + match rest with + | [] => (acc1, []) -- If no "&" found, second list is empty + | "&" :: xs => match xs with + | [] => (acc1, []) -- If "&" is the last element, second list is empty + | y :: _ => (acc1, [y]) -- Add the next element after "&" to the second list + | x :: xs => loop (acc1 ++ [x]) xs -- Accumulate elements before "&" + loop [] input + +mutual + partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" + else _ref + match ast with + | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with + | some vi => Except.ok (ref, vi) + | none => Except.error (ref, s!"'{v}' not found") + | Types.listVal el => (evalList ref el) + | Types.vecVal el => (evalVec ref (toList el)) + | Types.dictVal el => (evalDict ref el) + | x => Except.ok (ref, x) + + partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + match evalTypes ref head with + | Except.error (newref, e) => Except.error (newref, e) + | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + + partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + evalFnNative newRef name results args + | Fun.userDefined fref params body => + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let argsDict := (buildDict (keys ++ variadic) argVals) + let merged := mergeDicts (mergeDicts newRef fref) argsDict + evalTypes merged body + | Fun.macroFn fref params body => + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := args.take keys.length + let variadicArg := args.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let argsDict := (buildDict (keys ++ variadic) argVals) + let merged := mergeDicts (mergeDicts ref fref) argsDict + + match evalTypes merged body with + | Except.error e => Except.error e + | Except.ok (_, newast) => evalTypes ref newast + | _ => Except.error (ref, s!"`unexpected token, expected: function`") + + partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + else + let head := lst[0]! + match head with + | Types.symbolVal v => match v with + | "def!" => evalDefn ref (lst.drop 1) + | "let*" => evalLet ref (lst.drop 1) + | "do" => evalDo ref (lst.drop 1) + | "if" => evalIf ref (lst.drop 1) + | "fn*" => makeFn ref (lst.drop 1) + | "try*" => evalTry ref (lst.drop 1) + | "quote" => + if lst.length < 2 then Except.error (ref, "quote: expected 1 argument") + else Except.ok (ref, lst[1]!) + | "quasiquote" => + if lst.length < 2 then Except.error (ref, "quasiquote: expected 1 argument") + else evalTypes ref (quasiquote lst[1]!) + | "defmacro!" => evalDefMacro ref (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + | _ => evalFunc ref head (lst.drop 1) + + partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + match evalFuncArgs ref elems with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + + partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + match evalDictInner ref lst with + | Except.error e => Except.error e + | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + + partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + match lst with + | Dict.empty => Except.ok (ref, lst) + | Dict.insert k v restDict => match evalTypes ref v with + | Except.error e => Except.error e + | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.error e => Except.error e + | Except.ok (updatedRef, updatedDict) => + let newDict := Dict.insert k newVal updatedDict + Except.ok (updatedRef, newDict) + + partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + match res with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") + | Except.ok (r, acc) => match evalTypes r x with + | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, acc ++ [res]) + ) (Except.ok (ref, [])) with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + + partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "def! unexpected syntax") + else + let key := args[0]! + let body := args[1]! + match (evalTypes ref body) with + | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") + | Except.ok (newRef, value) => + match key with + | Types.symbolVal v => + let refResult := addEntry newRef (KeyType.strKey v) value + Except.ok (refResult, value) + | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + + partial def evalDefMacro (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "def! unexpected syntax") + else + let key := args[0]! + let body := args[1]! + match (evalTypes ref body) with + | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") + | Except.ok (newRef, value) => + match key with + | Types.symbolVal v => + match value with + | Types.funcVal func => + match func with + | Fun.macroFn _ _ _ => + let refResult := addEntry newRef (KeyType.strKey v) value + Except.ok (refResult, value) + | Fun.userDefined fref params body => + let refResult := addEntry newRef (KeyType.strKey v) (Types.funcVal (Fun.macroFn fref params body)) + Except.ok (refResult, value) + | _ => Except.error (newRef, s!"defmacro!: unexpected builtin function") + | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") + | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + + partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + else + let pairs := args[0]! + let body := args[1]! + let result := match pairs with + | Types.listVal v => evalLetArgs ref v + | Types.vecVal v => evalLetArgs ref (toList v) + | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + + match result with + | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") + | Except.ok newRef => match evalTypes newRef body with + | Except.error e => Except.error e + -- we do not propagate the let* environment to the parent scope + | Except.ok (_, result) => Except.ok (ref, result) + + partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + match args with + | [] => Except.ok ref + | [_] => Except.error (ref, "let*: unexpected syntax") + | x :: y :: rest => + match x with + | Types.symbolVal key => match evalTypes ref y with + | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.ok (updatedRef, value) => + evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + | _ => Except.error (ref, "let*: unexpected syntax") + + partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + -- only return last computation result + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + if results.length == 0 then Except.ok (newRef, Types.Nil) + else Except.ok (newRef, results[results.length - 1]!) + + partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + if args.length < 2 then Except.error (ref, "unexpected syntax") + else + let condition := args[0]! + let thenExpr := args[1]! + let hasElse := args.length > 2 + + match evalTypes ref condition with + | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") + | Except.ok (newRef, condResp) => + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newRef thenExpr + else if hasElse then evalTypes newRef args[2]! + else Except.ok (newRef, Types.Nil) + + partial def evalTry (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "try*: unexpected syntax") + else + match evalTypes ref lst[0]! with + | Except.ok (newRef, result) => Except.ok (newRef, result) + | Except.error evalErr => + if lst.length < 2 then Except.error evalErr + else + match lst[1]! with + | Types.listVal catchBody => + if catchBody.length < 1 then Except.error (ref, "try*: unexpected syntax") + else + match catchBody[0]! with + | Types.symbolVal catchSymbol => + if catchSymbol == "catch*" then + if catchBody.length < 2 then Except.error (ref, "try*: unexpected syntax") + else + let es := catchBody[1]! + match es with + | Types.symbolVal errorSymbol => + let (errRef, errStr) := evalErr + let err := Types.strVal errStr + if catchBody.length < 2 then Except.error (errRef, "try*: unexpected syntax") + else + let toeval := catchBody[2]! + let built := buildDictWithSymbols ref [errorSymbol] [err] + let merged := mergeDicts ref built + evalTypes merged toeval + | _ => Except.error (ref, s!"unexpected return type, expected: symbol") + else Except.error evalErr + | _ => Except.error evalErr + -- | Types.vecVal v => -- TODO + | _ => Except.error evalErr + + partial def swapAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") + else + let first := lst[0]! + let fn := lst[1]! + let rest := lst.drop 2 + match fn with + | Types.funcVal _ => + match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, Types.atomVal (Atom.v res)) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, Types.atomVal (Atom.withmeta res meta)) + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: function") + + partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") + else + let ast := lst[0]! + evalTypes ref ast + + partial def starts_with (lst: List Types) (symb: String) : Bool := + if lst.length == 2 then + match lst[0]! with + | Types.symbolVal v => v == symb + | _ => false + else false + + partial def qq_loop (elt : Types) (acc: List Types): List Types := + match elt with + | Types.listVal v => + if starts_with v "splice-unquote" + then + [Types.symbolVal "concat", v[1]!, Types.listVal acc] + else + [Types.symbolVal "cons", quasiquote elt, Types.listVal acc] + | _ => [Types.symbolVal "cons", quasiquote elt, Types.listVal acc] + + partial def qq_foldr (lst : List Types): Types := + let res := lst.reverse.foldl (fun acc x => qq_loop x acc) [] + Types.listVal res + + partial def quasiquote (ast: Types) : Types := + match ast with + | Types.symbolVal _ => Types.listVal [Types.symbolVal "quote", ast] + | Types.dictVal _ => Types.listVal [Types.symbolVal "quote", ast] + | Types.listVal v => + if starts_with v "unquote" then v[1]! + else qq_foldr v + | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] + | _ => ast + + partial def nativeMapOverList (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + match res with + | Except.error e => Except.error e + | Except.ok (r, acc) => + match evalFuncVal r fn [x] with + | Except.error e => Except.error e + | Except.ok (updatedRef, res) => + Except.ok (updatedRef, acc ++ [res]) + ) (Except.ok (ref, [])) with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, Types.listVal results) + + partial def nativeMap (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "map: unexpected syntax") + else + let fn := lst[0]! + let params := lst[1]! + match fn with + | Types.funcVal _ => + match params with + | Types.listVal v => nativeMapOverList ref fn v + | Types.vecVal v => nativeMapOverList ref fn (toList v) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: function") + + partial def nativeApply (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + if lst.length < 2 then Except.error (ref, "apply: unexpected syntax") + else + let fn := lst[0]! + let vecargs := lst[lst.length-1]! + let n := lst.length-2 + let firstargs := lst.drop 1 |>.take n + match vecargs with + | Types.listVal v => + evalFuncVal ref fn (firstargs ++ v) + | Types.vecVal v => + evalFuncVal ref fn (firstargs ++ (toList v)) + | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + + partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := + match name with + | "+" => sum ref results + | "-" => sub ref results + | "*" => mul ref results + | "/" => div ref results + | "<" => lt ref results + | "<=" => lte ref results + | ">" => gt ref results + | ">=" => gte ref results + | "=" => eq ref results false + | "list" => Except.ok (ref, Types.listVal results) + | "count" => countFunc ref results + | "cons" => cons ref results + | "concat" => concat ref results + | "map" => nativeMap ref results + | "apply" => nativeApply ref results + | "vec" => makeVec ref results + | "vector" => makeVector ref results + | "nth" => nthSeq ref results + | "first" => firstSeq ref results + | "rest" => restSeq ref results + | "conj" => conj ref results + | "seq" => seq ref results + | "hash-map" => makeDict ref results + | "assoc" => assocDict ref results + | "dissoc" => dissocDict ref results + | "get" => getDict ref results + | "contains?" => containsDict ref results + | "keys" => getKeysDict ref results + | "vals" => getValuesDict ref results + | "throw" => throwFn ref results + | "symbol" => makeSymbol ref results + | "keyword" => makeKeyword ref results + | "atom" => makeAtom ref results + | "deref" => derefAtom ref results + | "reset!" => resetAtom ref results args + | "swap!" => swapAtom ref results + | "prn" => prnFunc ref results + | "pr-str" => prStrFunc ref results + | "str" => strFunc ref results + | "println" => printlnFunc ref results + | "eval" => eval ref results + | "read-string" => match readString results ref with -- readString results Dict.empty + | Except.error e => Except.error (ref, e) + | Except.ok res => Except.ok (ref, res) + | _ => match results with + | [x] => match x with + | Types.Nil => if name == "nil?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.intVal _ => if name == "number?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.floatVal _ => if name == "number?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.strVal _ => if name == "string?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.symbolVal _ => if name == "symbol?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.keywordVal _ => if name == "keyword?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.dictVal _ => if name == "map?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.listVal x => match name with + | "list?" => Except.ok (ref, Types.boolVal true) + | "sequential?" => Except.ok (ref, Types.boolVal true) + | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) + | _ => Except.ok (ref, Types.boolVal false) + | Types.vecVal x => match name with + | "sequential?" => Except.ok (ref, Types.boolVal true) + | "vector?" => Except.ok (ref, Types.boolVal true) + | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) + | _ => Except.ok (ref, Types.boolVal false) + | Types.boolVal x => match name with + | "true?" => Except.ok (ref, Types.boolVal x) + | "false?" => Except.ok (ref, Types.boolVal !x) + | _ => Except.ok (ref, Types.boolVal false) + | Types.atomVal _ => match name with + | "atom?" => Except.ok (ref, Types.boolVal true) + | _ => Except.ok (ref, Types.boolVal false) + | Types.funcVal func => match name with + | "fn?" => Except.ok (ref, Types.boolVal true) + | "macro?" => match func with + | Fun.builtin _ => Except.ok (ref, Types.boolVal false) + | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal false) + | Fun.macroFn _ _ _ => Except.ok (ref, Types.boolVal true) + | _ => Except.ok (ref, Types.boolVal false) + | _ => Except.error (ref, s!"'{name}' not found") + +end + +def READ (input : String): Except String Types := + read_str.{u} input + +def PRINT (ast : Types): String := + pr_str true ast + +def rep (ref: Dict) (input : String): Dict × String := + match READ.{u} input with + | Except.ok result => match evalTypes ref result with + | Except.error (newref, e) => (newref, s!"Error: {e}") + | Except.ok (newref, res) => (newref, PRINT res) + | Except.error err => (ref, s!"Parsing failed: {err}") + +def printLogs (ref : Dict) : IO Unit := + forM (getLogsInfo ref) (fun elem => + match elem with + | Types.strVal log => IO.println log + | x => IO.println (x.toString true) + ) + +def loadMalFns (ref: Dict) (fndefs: List String): Dict × String := + fndefs.foldl (fun (res : Dict × String) fndef => + let (ref, msg) := res + let (newref, newmsg) := rep.{u} ref fndef + (newref, s!"{msg}¬{newmsg}") + ) (ref, "") + +def fnDefs: List String := [ + "(def! *host-language* \"Lean\")", + "(def! not (fn* (a) (if a false true)))" + ] + +def main : IO Unit := do + IO.println "Welcome to Mal REPL!" + let (env0, _) := loadMalFns.{u} (loadFnNativeAll Dict.empty) fnDefs + let mut env := env0 + + let mut donext := true + while donext do + IO.print "user> " + let stdin ← IO.getStdin + let input ← stdin.getLine + let value := input.trim + if value = "exit" then + donext := false + IO.println "Exiting REPL." + if value.isEmpty then + donext := false + else + let (ref, val) := rep.{u} env value + printLogs ref + IO.println val + env := resetLogs ref diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean index 3ae2a9fd44..124e81549e 100644 --- a/impls/lean/lakefile.lean +++ b/impls/lean/lakefile.lean @@ -66,6 +66,11 @@ lean_exe "step9_try" { root := `LeanMal.step9_try } +@[default_target] +lean_exe "stepA_mal" { + root := `LeanMal.stepA_mal +} + @[default_target] lean_exe "mal" { root := `LeanMal.step1_read_print From 533ea11360a13458262a45e6cd185af703066743 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Sat, 24 Aug 2024 18:28:53 +0200 Subject: [PATCH 12/39] lean: fixes --- impls/lean/LeanMal/core.lean | 11 +++++-- impls/lean/LeanMal/step6_file.lean | 41 +++++++++++++---------- impls/lean/LeanMal/step7_quote.lean | 41 +++++++++++++---------- impls/lean/LeanMal/step8_macros.lean | 43 +++++++++++++----------- impls/lean/LeanMal/step9_try.lean | 49 ++++++++++++++++------------ impls/lean/LeanMal/stepA_mal.lean | 49 ++++++++++++++++------------ 6 files changed, 137 insertions(+), 97 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index db1287d53f..280fd33f9f 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -358,7 +358,9 @@ def makeDictInternal (initialDict : Dict) (lst: List Types) : Except String (Dic | [] => Except.ok acc | (Types.strVal k) :: v :: rest => loop rest (Dict.insert (KeyType.strKey k) v acc) - | _ => Except.error "Invalid list format: Expected alternating strVal and Types" + | (Types.keywordVal k) :: v :: rest => + loop rest (Dict.insert (KeyType.keywordKey k) v acc) + | _ => Except.error "Invalid list format: Expected alternating string/keyword and value" loop lst initialDict def makeDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := @@ -420,6 +422,10 @@ def getDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Typ match getEntry v (KeyType.strKey k) with | some val => Except.ok (ref, val) | none => Except.ok (ref, Types.Nil) + | Types.keywordVal k => + match getEntry v (KeyType.keywordKey k) with + | some val => Except.ok (ref, val) + | none => Except.ok (ref, Types.Nil) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: keyword or string") | Types.Nil => Except.ok (ref, Types.Nil) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") @@ -583,7 +589,8 @@ def coreFnSymbols: List String := [ "nil?", "true?", "false?", "fn?", "macro?", "prn", "pr-str", "str", "println", "read-string", "slurp", - "atom", "atom?", "deref", "reset!", + "atom", "atom?", "deref", "reset!", "swap!", + "eval", ] def loadFnNativeAll (ref: Dict) : Dict := diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 6ea7bba8c8..6d4574a02b 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -180,28 +180,33 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def swapAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + partial def swapAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! let fn := lst[1]! let rest := lst.drop 2 - match fn with - | Types.funcVal _ => - match first with - | Types.atomVal x => match x with - | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, Types.atomVal (Atom.v res)) - | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, Types.atomVal (Atom.withmeta res meta)) - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: function") + match args[0]! with + | Types.symbolVal sym => + match fn with + | Types.funcVal _ => + match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.v res)) + Except.ok (newRef, res) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newRef, res) + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") + | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") @@ -225,7 +230,7 @@ mutual | "atom" => makeAtom ref results | "deref" => derefAtom ref results | "reset!" => resetAtom ref results args - | "swap!" => swapAtom ref results + | "swap!" => swapAtom ref results args | "prn" => prnFunc ref results | "pr-str" => prStrFunc ref results | "str" => strFunc ref results diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index dd0f0f998e..3d3e01fd68 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -186,28 +186,33 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def swapAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + partial def swapAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! let fn := lst[1]! let rest := lst.drop 2 - match fn with - | Types.funcVal _ => - match first with - | Types.atomVal x => match x with - | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, Types.atomVal (Atom.v res)) - | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, Types.atomVal (Atom.withmeta res meta)) - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: function") + match args[0]! with + | Types.symbolVal sym => + match fn with + | Types.funcVal _ => + match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.v res)) + Except.ok (newRef, res) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newRef, res) + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") + | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") @@ -265,7 +270,7 @@ mutual | "atom" => makeAtom ref results | "deref" => derefAtom ref results | "reset!" => resetAtom ref results args - | "swap!" => swapAtom ref results + | "swap!" => swapAtom ref results args | "prn" => prnFunc ref results | "pr-str" => prStrFunc ref results | "str" => strFunc ref results diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index e4f95f5b2d..b0c71c4df8 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -225,28 +225,33 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def swapAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + partial def swapAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! let fn := lst[1]! let rest := lst.drop 2 - match fn with - | Types.funcVal _ => - match first with - | Types.atomVal x => match x with - | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, Types.atomVal (Atom.v res)) - | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, Types.atomVal (Atom.withmeta res meta)) - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: function") + match args[0]! with + | Types.symbolVal sym => + match fn with + | Types.funcVal _ => + match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.v res)) + Except.ok (newRef, res) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newRef, res) + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") + | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") @@ -307,12 +312,12 @@ mutual | "atom" => makeAtom ref results | "deref" => derefAtom ref results | "reset!" => resetAtom ref results args - -- | "swap!" => swapAtom ref results + | "swap!" => swapAtom ref results args | "prn" => prnFunc ref results | "pr-str" => prStrFunc ref results | "str" => strFunc ref results | "println" => printlnFunc ref results - -- | "eval" => eval ref results + | "eval" => eval ref results | "read-string" => match readString results ref with -- readString results Dict.empty | Except.error e => Except.error (ref, e) | Except.ok res => Except.ok (ref, res) diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index 816def9509..a680a462f4 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -7,8 +7,11 @@ universe u def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else - let params := args[0]! + let p := args[0]! let body := args[1]! + let params := match p with + | Types.vecVal x => Types.listVal (toList x) + | _ => p let newfn := Fun.userDefined ref params body Except.ok (ref, Types.funcVal newfn) @@ -259,28 +262,33 @@ mutual -- | Types.vecVal v => -- TODO | _ => Except.error evalErr - partial def swapAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + partial def swapAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! let fn := lst[1]! let rest := lst.drop 2 - match fn with - | Types.funcVal _ => - match first with - | Types.atomVal x => match x with - | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, Types.atomVal (Atom.v res)) - | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, Types.atomVal (Atom.withmeta res meta)) - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: function") + match args[0]! with + | Types.symbolVal sym => + match fn with + | Types.funcVal _ => + match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.v res)) + Except.ok (newRef, res) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newRef, res) + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") + | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") @@ -396,7 +404,7 @@ mutual | "atom" => makeAtom ref results | "deref" => derefAtom ref results | "reset!" => resetAtom ref results args - | "swap!" => swapAtom ref results + | "swap!" => swapAtom ref results args | "prn" => prnFunc ref results | "pr-str" => prStrFunc ref results | "str" => strFunc ref results @@ -471,7 +479,8 @@ def loadMalFns (ref: Dict) (fndefs: List String): Dict × String := def fnDefs: List String := [ "(def! *host-language* \"Lean\")", - "(def! not (fn* (a) (if a false true)))" + "(def! not (fn* (a) (if a false true)))", + "(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)))))))", ] def main : IO Unit := do diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index 816def9509..a680a462f4 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -7,8 +7,11 @@ universe u def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else - let params := args[0]! + let p := args[0]! let body := args[1]! + let params := match p with + | Types.vecVal x => Types.listVal (toList x) + | _ => p let newfn := Fun.userDefined ref params body Except.ok (ref, Types.funcVal newfn) @@ -259,28 +262,33 @@ mutual -- | Types.vecVal v => -- TODO | _ => Except.error evalErr - partial def swapAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + partial def swapAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! let fn := lst[1]! let rest := lst.drop 2 - match fn with - | Types.funcVal _ => - match first with - | Types.atomVal x => match x with - | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, Types.atomVal (Atom.v res)) - | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, Types.atomVal (Atom.withmeta res meta)) - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: function") + match args[0]! with + | Types.symbolVal sym => + match fn with + | Types.funcVal _ => + match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.v res)) + Except.ok (newRef, res) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (updatedRef, res) => + let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newRef, res) + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") + | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") @@ -396,7 +404,7 @@ mutual | "atom" => makeAtom ref results | "deref" => derefAtom ref results | "reset!" => resetAtom ref results args - | "swap!" => swapAtom ref results + | "swap!" => swapAtom ref results args | "prn" => prnFunc ref results | "pr-str" => prStrFunc ref results | "str" => strFunc ref results @@ -471,7 +479,8 @@ def loadMalFns (ref: Dict) (fndefs: List String): Dict × String := def fnDefs: List String := [ "(def! *host-language* \"Lean\")", - "(def! not (fn* (a) (if a false true)))" + "(def! not (fn* (a) (if a false true)))", + "(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)))))))", ] def main : IO Unit := do From ae0205919a287a3637722209e378580fe336902c Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Sun, 25 Aug 2024 00:58:27 +0200 Subject: [PATCH 13/39] lean: fixes --- impls/lean/LeanMal/core.lean | 23 ++++++++++++++--------- impls/lean/LeanMal/reader.lean | 3 ++- impls/lean/LeanMal/step2_eval.lean | 2 +- impls/lean/LeanMal/step3_env.lean | 2 +- impls/lean/LeanMal/step4_if_fn_do.lean | 2 +- impls/lean/LeanMal/step5_tco.lean | 2 +- impls/lean/LeanMal/step6_file.lean | 2 +- impls/lean/LeanMal/step7_quote.lean | 2 +- impls/lean/LeanMal/step8_macros.lean | 2 +- impls/lean/LeanMal/step9_try.lean | 9 ++++++--- impls/lean/LeanMal/stepA_mal.lean | 12 +++++++++--- impls/lean/LeanMal/types.lean | 15 +++++++++++---- 12 files changed, 49 insertions(+), 27 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 280fd33f9f..fd16997d8e 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -195,9 +195,9 @@ def KEY_LOGS_DEBUG := "LOGS_DEBUG" def KEY_DEBUG_EVAL := "DEBUG-EVAL" def resetLogs (ref: Dict): Dict := - ( - ref.insert (KeyType.strKey KEY_LOGS_INFO) (Types.listVal []) - ).insert (KeyType.strKey KEY_LOGS_DEBUG) (Types.listVal []) + addEntry ( + addEntry ref (KeyType.strKey KEY_LOGS_INFO) (Types.listVal []) + ) (KeyType.strKey KEY_LOGS_DEBUG) (Types.listVal []) def getLogs (ref: Dict) (type: String): List Types := match getEntry ref (KeyType.strKey type) with @@ -220,7 +220,7 @@ def getLogsInfo (ref: Dict): List Types := def logInfo (ref: Dict) (msg: String): Dict := let loglist := getLogs ref KEY_LOGS_INFO let newlogs := loglist ++ [(Types.strVal msg)] - ref.insert (KeyType.strKey KEY_LOGS_INFO) (Types.listVal newlogs) + addEntry ref (KeyType.strKey KEY_LOGS_INFO) (Types.listVal newlogs) def prStrFunc (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := let str := prStrInternal lst true " " @@ -353,15 +353,19 @@ def makeVector (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Except.ok (ref, Types.vecVal (listToVec lst)) def makeDictInternal (initialDict : Dict) (lst: List Types) : Except String (Dict) := - let rec loop (lst : List Types) (acc : Dict) : Except String Dict := + let rec loop (lst : List Types) (acckeys: List String) (acc : Dict) : Except String (Dict × List String) := match lst with - | [] => Except.ok acc + | [] => Except.ok (acc, acckeys) | (Types.strVal k) :: v :: rest => - loop rest (Dict.insert (KeyType.strKey k) v acc) + if acckeys.contains k then Except.ok (acc, acckeys) + else loop rest (acckeys ++ [k]) (Dict.insert (KeyType.strKey k) v acc) | (Types.keywordVal k) :: v :: rest => - loop rest (Dict.insert (KeyType.keywordKey k) v acc) + if acckeys.contains k then Except.ok (acc, acckeys) + else loop rest (acckeys ++ [k]) (Dict.insert (KeyType.keywordKey k) v acc) | _ => Except.error "Invalid list format: Expected alternating string/keyword and value" - loop lst initialDict + match loop lst [] initialDict with + | Except.error e => Except.error e + | Except.ok (v, _) => Except.ok v def makeDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := match makeDictInternal Dict.empty lst with @@ -591,6 +595,7 @@ def coreFnSymbols: List String := [ "read-string", "slurp", "atom", "atom?", "deref", "reset!", "swap!", "eval", + "time-ms", "meta", "with-meta" ] def loadFnNativeAll (ref: Dict) : Dict := diff --git a/impls/lean/LeanMal/reader.lean b/impls/lean/LeanMal/reader.lean index dfa716eb69..7ad3822a2f 100644 --- a/impls/lean/LeanMal/reader.lean +++ b/impls/lean/LeanMal/reader.lean @@ -142,11 +142,12 @@ def read_operator_or_number : Parsec Types := do | some c => if c.isWhitespace then return Types.symbolVal (String.singleton sign) else if c.isDigit then read_float_or_int_internal sign - else + else if is_symbol_char c then let rest ← read_symbol_val match rest with | Types.symbolVal x => return Types.symbolVal (String.singleton sign ++ x) | _ => return Types.symbolVal (String.singleton sign) + else return Types.symbolVal (String.singleton sign) | none => return Types.symbolVal (String.singleton sign) mutual diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean index 33480e7eb9..243fcad029 100644 --- a/impls/lean/LeanMal/step2_eval.lean +++ b/impls/lean/LeanMal/step2_eval.lean @@ -81,7 +81,7 @@ mutual | Types.listVal v => v.map fun x => x.toString false | _ => [] let argsDict := (buildDict keys results) - let merged := mergeDicts (mergeDicts newRef fref) argsDict + let merged := mergeDicts (mergeDicts fref newRef) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error "macro not implemented" | _ => Except.error s!"`unexpected token, expected: function`" diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index f345ef98be..b8285335b6 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -80,7 +80,7 @@ mutual | Types.listVal v => v.map fun x => x.toString false | _ => [] let argsDict := (buildDict keys results) - let merged := mergeDicts (mergeDicts newRef fref) argsDict + let merged := mergeDicts (mergeDicts fref newRef) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error "macro not implemented" | _ => Except.error s!"`unexpected token, expected: function`" diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index 24c2ad2786..78a4374e37 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -57,7 +57,7 @@ mutual let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts newRef fref) argsDict + let merged := mergeDicts (mergeDicts fref newRef) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index e62b26a853..96dd61c9e0 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -57,7 +57,7 @@ mutual let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts newRef fref) argsDict + let merged := mergeDicts (mergeDicts fref newRef) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 6d4574a02b..3551cf7221 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -58,7 +58,7 @@ mutual let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts newRef fref) argsDict + let merged := mergeDicts (mergeDicts fref newRef) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index 3d3e01fd68..9054729830 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -58,7 +58,7 @@ mutual let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts newRef fref) argsDict + let merged := mergeDicts (mergeDicts fref newRef) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index b0c71c4df8..113cd4c2a8 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -60,7 +60,7 @@ mutual let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts newRef fref) argsDict + let merged := mergeDicts (mergeDicts fref newRef) argsDict evalTypes merged body | Fun.macroFn fref params body => diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index a680a462f4..1b624a845e 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -63,7 +63,7 @@ mutual let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts newRef fref) argsDict + let merged := mergeDicts (mergeDicts fref newRef) argsDict evalTypes merged body | Fun.macroFn fref params body => let allkeys: List String := match params with @@ -74,7 +74,7 @@ mutual let variadicArg := args.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts ref fref) argsDict + let merged := mergeDicts (mergeDicts fref ref) argsDict match evalTypes merged body with | Except.error e => Except.error e @@ -440,7 +440,10 @@ mutual | "atom?" => Except.ok (ref, Types.boolVal true) | _ => Except.ok (ref, Types.boolVal false) | Types.funcVal func => match name with - | "fn?" => Except.ok (ref, Types.boolVal true) + | "fn?" => match func with + | Fun.builtin _ => Except.ok (ref, Types.boolVal true) + | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal true) + | Fun.macroFn _ _ _ => Except.ok (ref, Types.boolVal false) | "macro?" => match func with | Fun.builtin _ => Except.ok (ref, Types.boolVal false) | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal false) diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index a680a462f4..2c6957dd29 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -63,7 +63,7 @@ mutual let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts newRef fref) argsDict + let merged := mergeDicts (mergeDicts fref newRef) argsDict evalTypes merged body | Fun.macroFn fref params body => let allkeys: List String := match params with @@ -74,7 +74,7 @@ mutual let variadicArg := args.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts ref fref) argsDict + let merged := mergeDicts (mergeDicts fref ref) argsDict match evalTypes merged body with | Except.error e => Except.error e @@ -413,6 +413,9 @@ mutual | "read-string" => match readString results ref with -- readString results Dict.empty | Except.error e => Except.error (ref, e) | Except.ok res => Except.ok (ref, res) + | "time-ms" => Except.error (ref, "Not implemented") + | "meta" => Except.error (ref, "Not implemented") + | "with-meta" => Except.error (ref, "Not implemented") | _ => match results with | [x] => match x with | Types.Nil => if name == "nil?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) @@ -440,7 +443,10 @@ mutual | "atom?" => Except.ok (ref, Types.boolVal true) | _ => Except.ok (ref, Types.boolVal false) | Types.funcVal func => match name with - | "fn?" => Except.ok (ref, Types.boolVal true) + | "fn?" => match func with + | Fun.builtin _ => Except.ok (ref, Types.boolVal true) + | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal true) + | Fun.macroFn _ _ _ => Except.ok (ref, Types.boolVal false) | "macro?" => match func with | Fun.builtin _ => Except.ok (ref, Types.boolVal false) | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal false) diff --git a/impls/lean/LeanMal/types.lean b/impls/lean/LeanMal/types.lean index c6393e9e38..a2d2555d16 100644 --- a/impls/lean/LeanMal/types.lean +++ b/impls/lean/LeanMal/types.lean @@ -74,9 +74,6 @@ def getEntry : Dict → KeyType → Option Types | KeyType.strKey ks, KeyType.keywordKey keyg => if ks = keyg then some v else getEntry d key | KeyType.keywordKey ks, KeyType.strKey keyg => if ks = keyg then some v else getEntry d key -def addEntry : Dict → KeyType → Types → Dict - | d, k, v => Dict.insert k v d - def getKeys : Dict → List KeyType | Dict.empty => [] | Dict.insert k _ d => @@ -99,11 +96,21 @@ def removeKey (d : Dict) (key : KeyType) : Dict := | KeyType.strKey ks, KeyType.keywordKey keyg => if ks = keyg then removeKey rest key else Dict.insert k v (removeKey rest key) | KeyType.keywordKey ks, KeyType.strKey keyg => if ks = keyg then removeKey rest key else Dict.insert k v (removeKey rest key) + +def addEntry : Dict → KeyType → Types → Dict + | Dict.empty, key, value => Dict.insert key value Dict.empty + | Dict.insert k v d, key, value => + match k, key with + | KeyType.strKey ks, KeyType.strKey keyg => if ks = keyg then Dict.insert k value d else Dict.insert k v (addEntry d key value) + | KeyType.keywordKey ks, KeyType.keywordKey keyg => if ks = keyg then Dict.insert k value d else Dict.insert k v (addEntry d key value) + | KeyType.strKey ks, KeyType.keywordKey keyg => if ks = keyg then Dict.insert k value d else Dict.insert k v (addEntry d key value) + | KeyType.keywordKey ks, KeyType.strKey keyg => if ks = keyg then Dict.insert k value d else Dict.insert k v (addEntry d key value) + -- Function to merge two Dicts def mergeDicts : Dict → Dict → Dict | d1, Dict.empty => d1 -- If the second Dict is empty, return the first Dict | d1, Dict.insert k v rest => - let d1Updated := Dict.insert k v d1 + let d1Updated := addEntry d1 k v mergeDicts d1Updated rest -- Function to extract the string from a Types.symbolVal From 286461a2d66bb9bd4995b93cc8f2126942a4f99f Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 13:45:41 +0200 Subject: [PATCH 14/39] refactor Env, add environment levels, redo steps 1-4 --- impls/lean/LeanMal/core.lean | 192 ++++++++++++++----------- impls/lean/LeanMal/reader.lean | 2 +- impls/lean/LeanMal/step2_eval.lean | 44 +++--- impls/lean/LeanMal/step3_env.lean | 66 ++++----- impls/lean/LeanMal/step4_if_fn_do.lean | 91 +++++++----- impls/lean/LeanMal/types.lean | 167 ++++++++++++++------- 6 files changed, 335 insertions(+), 227 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index fd16997d8e..81a1254f17 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -5,7 +5,7 @@ import LeanMal.reader universe u -def sum (ref : Dict := Dict.empty) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def sum (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -14,7 +14,7 @@ def sum (ref : Dict := Dict.empty) (lst: List Types) : Except (Dict × String) ( | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x + y)) | _ => Except.error (ref, "+ operator not supported") -def sub (ref : Dict := Dict.empty) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def sub (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -23,7 +23,7 @@ def sub (ref : Dict := Dict.empty) (lst: List Types) : Except (Dict × String) ( | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x - y)) | _ => Except.error (ref, "- operator not supported") -def mul (ref : Dict := Dict.empty) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def mul (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -32,7 +32,7 @@ def mul (ref : Dict := Dict.empty) (lst: List Types) : Except (Dict × String) ( | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x * y)) | _ => Except.error (ref, "* operator not supported") -def div (ref : Dict := Dict.empty) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def div (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -50,7 +50,7 @@ def ltInternal (first: Types) (second: Types) (orEq: Bool) : Bool := | Types.strVal n, Types.strVal v => n < v || (if orEq then n == v else false) | _, _ => false -def lt (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def lt (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") else let first := lst[0]! @@ -58,7 +58,7 @@ def lt (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) : let res := ltInternal first second false Except.ok (ref, Types.boolVal res) -def lte (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def lte (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") else let first := lst[0]! @@ -75,7 +75,7 @@ def gtInternal (first: Types) (second: Types) (orEq: Bool) : Bool := | Types.strVal n, Types.strVal v => n > v || (if orEq then n == v else false) | _, _ => false -def gt (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def gt (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") else let first := lst[0]! @@ -83,7 +83,7 @@ def gt (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) : let res := gtInternal first second false Except.ok (ref, Types.boolVal res) -def gte (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def gte (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") else let first := lst[0]! @@ -109,13 +109,13 @@ mutual match n, v with | Dict.empty, Dict.empty => true | d1, d2 => - let keys1 := getKeys d1 - let keys2 := getKeys d2 + let keys1 := d1.keys + let keys2 := d2.keys if keys1.length != keys2.length then false else keys1.all (fun k => - match (getEntry d1 k, getEntry d2 k) with - | (some v1, some v2) => eqInternal v1 v2 strict + match (d1.get k, d2.get k) with + | (some (_, v1), some (_, v2)) => eqInternal v1 v2 strict | _ => false) partial def eqInternal (first: Types) (second: Types) (strict: Bool) : Bool := @@ -138,11 +138,19 @@ mutual if n.length != v.length then false else eqList n v strict | Types.dictVal n, Types.dictVal v => eqDict n v strict + | Types.listVal n, Types.vecVal vvec => if strict then false else + let v := toList vvec + if n.length != v.length then false + else eqList n v strict + | Types.vecVal nvec, Types.listVal v => if strict then false else + let n := toList nvec + if n.length != v.length then false + else eqList n v strict | _, _ => false end -def eq (ref: Dict) (lst: List Types) (strict: Bool) : Except (Dict × String) (Dict × Types) := +def eq (ref : Env) (lst: List Types) (strict: Bool) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") else let first := lst[0]! @@ -150,13 +158,13 @@ def eq (ref: Dict) (lst: List Types) (strict: Bool) : Except (Dict × String) (D let res := eqInternal first second strict Except.ok (ref, Types.boolVal res) -def makeAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def makeAtom (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "keyword: 1 argument required") else let first := lst[0]! Except.ok (ref, Types.atomVal (Atom.v first)) -def derefAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def derefAtom (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "deref: 1 argument required") else let first := lst[0]! @@ -166,7 +174,7 @@ def derefAtom (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × T | Atom.withmeta v _ => Except.ok (ref, v) | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") -def resetAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := +def resetAtom (ref : Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "reset!: 2 argument required") else let first := lst[0]! @@ -177,11 +185,19 @@ def resetAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × match first with | Types.atomVal x => match x with | Atom.v _ => - let newRef := addEntry ref (KeyType.strKey sym) (Types.atomVal (Atom.v second)) - Except.ok (newRef, second) + let oldRef := ref.get (KeyType.strKey sym) + match oldRef with + | none => Except.error (ref, s!"{sym} not found") + | some (level, _) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v second)) + Except.ok (newRef, second) | Atom.withmeta _ meta => - let newRef := addEntry ref (KeyType.strKey sym) (Types.atomVal (Atom.withmeta second meta)) - Except.ok (newRef, second) + let oldRef := ref.get (KeyType.strKey sym) + match oldRef with + | none => Except.error (ref, s!"{sym} not found") + | some (level, _) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta second meta)) + Except.ok (newRef, second) | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") | x => Except.error (ref, s!"deref: unexpected token: {x.toString true}, expected: symbol") @@ -194,58 +210,66 @@ def KEY_LOGS_INFO := "LOGS_INFO" def KEY_LOGS_DEBUG := "LOGS_DEBUG" def KEY_DEBUG_EVAL := "DEBUG-EVAL" -def resetLogs (ref: Dict): Dict := - addEntry ( - addEntry ref (KeyType.strKey KEY_LOGS_INFO) (Types.listVal []) - ) (KeyType.strKey KEY_LOGS_DEBUG) (Types.listVal []) +def resetLogs (ref : Env): Env := + ( + ref.add (KeyType.strKey KEY_LOGS_INFO) 0 (Types.listVal []) + ).add (KeyType.strKey KEY_LOGS_DEBUG) 0 (Types.listVal []) -def getLogs (ref: Dict) (type: String): List Types := - match getEntry ref (KeyType.strKey type) with - | some v => match v with +def getLogs (ref : Env) (type: String): List Types := + match ref.get (KeyType.strKey type) with + | some (_, v) => match v with | Types.listVal loglist => loglist | _ => [] | _ => [] -def getDebugEval (ref: Dict): Bool := - match getEntry ref (KeyType.strKey KEY_DEBUG_EVAL) with - | some v => match v with +def getDebugEval (ref : Env): Bool := + match ref.get (KeyType.strKey KEY_DEBUG_EVAL) with + | some (_, v) => match v with | Types.boolVal v => v | Types.Nil => false | _ => false | _ => false -def getLogsInfo (ref: Dict): List Types := +def getLogsInfo (ref : Env): List Types := getLogs ref KEY_LOGS_INFO -def logInfo (ref: Dict) (msg: String): Dict := +def forwardLogs (sourceRef : Env) (targetRef : Env): Env := + let infologs := getLogs sourceRef KEY_LOGS_INFO + let debuglogs := getLogs sourceRef KEY_LOGS_DEBUG + ( + targetRef.add (KeyType.strKey KEY_LOGS_INFO) 0 (Types.listVal infologs) + ).add (KeyType.strKey KEY_LOGS_DEBUG) 0 (Types.listVal debuglogs) + +def logInfo (ref : Env) (msg: String): Env := let loglist := getLogs ref KEY_LOGS_INFO let newlogs := loglist ++ [(Types.strVal msg)] - addEntry ref (KeyType.strKey KEY_LOGS_INFO) (Types.listVal newlogs) + ref.add (KeyType.strKey KEY_LOGS_INFO) 0 (Types.listVal newlogs) -def prStrFunc (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def prStrFunc (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := let str := prStrInternal lst true " " Except.ok (ref, Types.strVal str) -def prnFunc (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def prnFunc (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := let str := prStrInternal lst true " " let newRef := logInfo ref str Except.ok (newRef, Types.Nil) -def printlnFunc (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def printlnFunc (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := let str := prStrInternal lst false " " let newRef := logInfo ref str Except.ok (newRef, Types.Nil) -def strFunc (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def strFunc (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := let str := prStrInternal lst false "" Except.ok (ref, Types.strVal str) -def countFunc(ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def countFunc(ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "count: 1 argument required") else let x := lst[0]! match x with | Types.listVal v => Except.ok (ref, Types.intVal v.length) + | Types.vecVal v => Except.ok (ref, Types.intVal (toList v).length) | Types.Nil => Except.ok (ref, Types.intVal 0) | _ => Except.error (ref, "count called on non-sequence") @@ -257,7 +281,7 @@ def readString (lst: List Types) (envir: Dict := Dict.empty) : Except String Typ | Types.strVal v => read_types_with_env v envir | x => Except.error s!"unexpected symbol: {x.toString true}, expected: string" -def cons (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def cons (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "cons: >= 2 arguments required") else let elem := lst[0]! @@ -267,10 +291,10 @@ def cons (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) | Types.vecVal v => Except.ok (ref, (Types.listVal (elem :: (toList v)))) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") -def concat (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def concat (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.ok (ref, Types.listVal []) else - match lst.foldl (fun (acc: Except (Dict × String) (List Types)) x => + match lst.foldl (fun (acc: Except (Env × String) (List Types)) x => match acc with | Except.error e => Except.error e | Except.ok newlist => @@ -282,7 +306,7 @@ def concat (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Type | Except.error e => Except.error e | Except.ok v => Except.ok (ref, Types.listVal v) -def makeVec (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def makeVec (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "vec: 1 arguments required") else let first := lst[0]! @@ -291,7 +315,7 @@ def makeVec (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Typ | Types.listVal v => Except.ok (ref, Types.vecVal (listToVec v)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") -def nthSeq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def nthSeq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "nth: >= 2 arguments required") else let first := lst[0]! @@ -313,7 +337,7 @@ def nthSeq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Type | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: number") -def firstSeq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def firstSeq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "first: 1 arguments required") else let first := lst[0]! @@ -332,7 +356,7 @@ def firstSeq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Ty Except.ok (ref, elem) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") -def restSeq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def restSeq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "rest: 1 arguments required") else let first := lst[0]! @@ -349,7 +373,7 @@ def restSeq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Typ Except.ok (ref, Types.listVal (lv.drop 1)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") -def makeVector (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def makeVector (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := Except.ok (ref, Types.vecVal (listToVec lst)) def makeDictInternal (initialDict : Dict) (lst: List Types) : Except String (Dict) := @@ -358,21 +382,21 @@ def makeDictInternal (initialDict : Dict) (lst: List Types) : Except String (Dic | [] => Except.ok (acc, acckeys) | (Types.strVal k) :: v :: rest => if acckeys.contains k then Except.ok (acc, acckeys) - else loop rest (acckeys ++ [k]) (Dict.insert (KeyType.strKey k) v acc) + else loop rest (acckeys ++ [k]) (Dict.insert (KeyType.strKey k) 0 v acc) | (Types.keywordVal k) :: v :: rest => if acckeys.contains k then Except.ok (acc, acckeys) - else loop rest (acckeys ++ [k]) (Dict.insert (KeyType.keywordKey k) v acc) + else loop rest (acckeys ++ [k]) (Dict.insert (KeyType.keywordKey k) 0 v acc) | _ => Except.error "Invalid list format: Expected alternating string/keyword and value" match loop lst [] initialDict with | Except.error e => Except.error e | Except.ok (v, _) => Except.ok v -def makeDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def makeDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := match makeDictInternal Dict.empty lst with | Except.error e => Except.error (ref, e) | Except.ok (newDict) => Except.ok (ref, Types.dictVal newDict) -def assocDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def assocDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "assoc: >= 1 arguments required") else let first := lst[0]! @@ -391,15 +415,15 @@ def dissoc (dict : Dict) (keys : List Types) : Except String Dict := | key :: rest => match key with | Types.strVal v => - let newDict := removeKey acc (KeyType.strKey v) + let newDict := acc.remove (KeyType.strKey v) loop rest newDict | Types.keywordVal v => - let newDict := removeKey acc (KeyType.strKey v) + let newDict := acc.remove (KeyType.strKey v) loop rest newDict | x => Except.error s!"unexpected symbol: {x.toString true}, expected: keyword or string" loop keys dict -def dissocDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def dissocDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "dissoc: >= 1 arguments required") else let first := lst[0]! @@ -411,7 +435,7 @@ def dissocDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × | Except.ok newDict => Except.ok (ref, Types.dictVal newDict) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") -def getDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def getDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "get: >= 1 arguments required") else let first := lst[0]! @@ -423,18 +447,18 @@ def getDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Typ | _ => match (rest[0]!) with | Types.strVal k => - match getEntry v (KeyType.strKey k) with - | some val => Except.ok (ref, val) + match v.get (KeyType.strKey k) with + | some (_, val) => Except.ok (ref, val) | none => Except.ok (ref, Types.Nil) | Types.keywordVal k => - match getEntry v (KeyType.keywordKey k) with - | some val => Except.ok (ref, val) + match v.get (KeyType.keywordKey k) with + | some (_, val) => Except.ok (ref, val) | none => Except.ok (ref, Types.Nil) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: keyword or string") | Types.Nil => Except.ok (ref, Types.Nil) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") -def containsDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def containsDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "contains?: >= 1 arguments required") else let first := lst[0]! @@ -446,24 +470,24 @@ def containsDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict | _ => match (rest[0]!) with | Types.strVal k => - match getEntry v (KeyType.strKey k) with + match v.get (KeyType.strKey k) with | some _ => Except.ok (ref, Types.boolVal true) | none => Except.ok (ref, Types.boolVal false) | Types.keywordVal k => - match getEntry v (KeyType.strKey k) with + match v.get (KeyType.strKey k) with | some _ => Except.ok (ref, Types.boolVal true) | none => Except.ok (ref, Types.boolVal false) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: keyword or string") | Types.Nil => Except.ok (ref, Types.boolVal false) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") -def getKeysDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def getKeysDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "keys: 1 arguments required") else let first := lst[0]! match first with | Types.dictVal v => - let keys := getKeys v + let keys := v.keys let result := keys.map (fun k => match k with | KeyType.strKey v => (Types.strVal v) @@ -472,17 +496,17 @@ def getKeysDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Except.ok (ref, (Types.listVal result)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") -def getValuesDict (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def getValuesDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "get: 1 arguments required") else let first := lst[0]! match first with | Types.dictVal v => - let values := getValues v + let values := v.values Except.ok (ref, (Types.listVal values)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") -def makeSymbol (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def makeSymbol (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "symbol: 1 argument required") else let first := lst[0]! @@ -491,7 +515,7 @@ def makeSymbol (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × | Types.strVal v => Except.ok (ref, Types.symbolVal v) | x => Except.error (ref, s!"symbol: unexpected symbol: {x.toString true}, expected: string") -def makeKeyword (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def makeKeyword (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "keyword: 1 argument required") else let first := lst[0]! @@ -500,7 +524,7 @@ def makeKeyword (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × | Types.strVal v => Except.ok (ref, Types.keywordVal v) | x => Except.error (ref, s!"keyword: unexpected symbol: {x.toString true}, expected: string") -def conj (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def conj (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "conj: >= 1 arguments required") else let first := lst[0]! @@ -510,7 +534,7 @@ def conj (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) | Types.vecVal v => Except.ok (ref, Types.vecVal (listToVec ((toList v) ++ rest))) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") -def seq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := +def seq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "conj: 1 arguments required") else let first := lst[0]! @@ -527,7 +551,7 @@ def seq (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) Except.ok (ref, Types.listVal lv) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list, vector or string") -partial def throwFn (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := +partial def throwFn (ref : Env) (lst : List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "panic") else let a := lst[0]! @@ -538,7 +562,7 @@ partial def throwFn (ref: Dict) (lst : List Types) : Except (Dict × String) (Di def readFileContent (filePath : String) : IO String := do IO.FS.readFile filePath -def slurp (ref: Dict) (lst: List Types) : IO (Except (Dict × String) (Dict × Types)) := do +def slurp (ref : Env) (lst: List Types) : IO (Except (Env × String) (Env × Types)) := do if lst.length < 1 then return Except.error (ref, "slurp: 2 arguments required") else @@ -554,7 +578,7 @@ def slurp (ref: Dict) (lst: List Types) : IO (Except (Dict × String) (Dict × T | _ => return Except.error (ref, "slurp: filename must be a string") -def slurp2 (ref: Dict) (lst: List Types) : IO (Dict × Types) := do +def slurp2 (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "slurp: 2 arguments required") else @@ -566,15 +590,15 @@ def slurp2 (ref: Dict) (lst: List Types) : IO (Dict × Types) := do throw (IO.userError "slurp: filename must be a string") -- IO monad limits some of the formal proving capabilities that Lean offers because IO introduces side effects that are inherently non-deterministic and impure, such as reading from files -def evalFnNativeWithIO (ref : Dict := Dict.empty) (name: String) (results: List Types): IO (Except (Dict × String) (Dict × Types)) := +def evalFnNativeWithIO (ref : Env) (name: String) (results: List Types): IO (Except (Env × String) (Env × Types)) := match name with | "slurp" => slurp ref results | _ => return Except.error (ref, s!"'{name}' not found") -def loadFnNative (ref: Dict) (name: String) : Dict := - ref.insert (KeyType.strKey name) (Types.funcVal (Fun.builtin name)) +def loadFnNative (ref : Env) (name: String) : Env := + ref.add (KeyType.strKey name) 0 (Types.funcVal (Fun.builtin name)) -def loadFnNativeFold (ref: Dict) (fnNames : List String) : Dict := +def loadFnNativeFold (ref : Env) (fnNames : List String) : Env := fnNames.foldl loadFnNative ref def coreFnSymbols: List String := [ @@ -598,13 +622,13 @@ def coreFnSymbols: List String := [ "time-ms", "meta", "with-meta" ] -def loadFnNativeAll (ref: Dict) : Dict := - let newRef := loadFnNativeFold ref coreFnSymbols - (( - newRef.insert (KeyType.strKey KEY_LOGS_INFO) (Types.listVal []) - ).insert (KeyType.strKey KEY_LOGS_DEBUG) (Types.listVal []) - ).insert (KeyType.strKey KEY_DEBUG_EVAL) (Types.boolVal false) +def loadFnNativeAll (ref : Env) : Env := + ((( + loadFnNativeFold ref coreFnSymbols + ).add (KeyType.strKey KEY_LOGS_INFO) 0 (Types.listVal []) + ).add (KeyType.strKey KEY_LOGS_DEBUG) 0 (Types.listVal []) + ).add (KeyType.strKey KEY_DEBUG_EVAL) 0 (Types.boolVal false) -def setSymbol (ref: Dict) (name: String) (value: Types): Dict := +def setSymbol (ref : Env) (name: String) (value: Types): Env := let newRef := loadFnNative ref name - newRef.insert (KeyType.strKey name) value + newRef.add (KeyType.strKey name) 0 value diff --git a/impls/lean/LeanMal/reader.lean b/impls/lean/LeanMal/reader.lean index 7ad3822a2f..26a323d570 100644 --- a/impls/lean/LeanMal/reader.lean +++ b/impls/lean/LeanMal/reader.lean @@ -193,7 +193,7 @@ mutual let _ ← optional wspace_or_comma_strict let dict := Array.foldl (fun m (k, v) => - m.insert k v + m.insert k 0 v ) (Dict.empty) els return Types.dictVal dict diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean index 243fcad029..2f563705f7 100644 --- a/impls/lean/LeanMal/step2_eval.lean +++ b/impls/lean/LeanMal/step2_eval.lean @@ -6,7 +6,7 @@ universe u def READ (input : String): Except String Types := read_str.{u} input -def sum (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := +def sum (ref : Env) (lst: List Types) : Except String (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -15,7 +15,7 @@ def sum (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Ty | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x + y)) | _ => Except.error "+ operator not supported" -def sub (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := +def sub (ref : Env) (lst: List Types) : Except String (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -24,7 +24,7 @@ def sub (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Ty | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x - y)) | _ => Except.error "- operator not supported" -def mul (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := +def mul (ref : Env) (lst: List Types) : Except String (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -33,7 +33,7 @@ def mul (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Ty | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x * y)) | _ => Except.error "* operator not supported" -def div (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := +def div (ref : Env) (lst: List Types) : Except String (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -42,32 +42,32 @@ def div (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Ty | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x / y)) | _ => Except.error "/ operator not supported" -def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types): Except String (Dict × Types) := +def evalFnNative (ref : Env) (name: String) (results: List Types): Except String (Env × Types) := match name with | "+" => sum ref results | "-" => sub ref results | "*" => mul ref results | "/" => div ref results - | _ => Except.error s!"function not found: {name}" + | _ => Except.error s!"'{name}' not found" mutual - partial def evalTypes (ref : Dict := Dict.empty) (ast : Types) : Except String (Dict × Types) := + partial def evalTypes (ref : Env) (ast : Types) : Except String (Env × Types) := match ast with - | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with - | some vi => Except.ok (ref, vi) + | Types.symbolVal v => match ref.get (KeyType.strKey v) with + | some (_, vi) => Except.ok (ref, vi) | none => Except.ok (ref, Types.symbolVal v ) | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except String (Dict × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except String (Env × Types) := match evalTypes ref head with | Except.error e => Except.error s!"error evaluating function: {head.toString true}: {e}" | Except.ok (ref2, fn) => evalFuncVal ref2 fn args - partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except String (Dict × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except String (Env × Types) := -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -80,13 +80,13 @@ mutual let keys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] - let argsDict := (buildDict keys results) - let merged := mergeDicts (mergeDicts fref newRef) argsDict + let argsDict := (buildDict 0 keys results) + let merged := (newRef.merge fref).mergeDict (fref.getLevel + 1) argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error "macro not implemented" | _ => Except.error s!"`unexpected token, expected: function`" - partial def evalList (ref: Dict) (lst : List Types) : Except String (Dict × Types) := + partial def evalList (ref: Env) (lst : List Types) : Except String (Env × Types) := if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -95,29 +95,29 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Dict) (elems : List Types) : Except String (Dict × Types) := + partial def evalVec (ref: Env) (elems : List Types) : Except String (Env × Types) := match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Dict) (lst : Dict) : Except String (Dict × Types) := + partial def evalDict (ref: Env) (lst : Dict) : Except String (Env × Types) := match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Dict) (lst : Dict) : Except String (Dict × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : Except String (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) - | Dict.insert k v restDict => match evalTypes ref v with + | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k newVal updatedDict + let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Dict) (args: List Types) : Except String (Dict × List Types) := - match args.foldl (fun (res : Except String (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except String (Env × List Types) := + match args.foldl (fun (res : Except String (Env × List Types)) x => match res with | Except.error e => Except.error s!"error evaluating function argument accumulator: {x.toString true}: {e}" | Except.ok (r, acc) => match evalTypes r x with @@ -134,7 +134,7 @@ def PRINT (ast : Types): String := def rep (input : String): String := match READ.{u} input with - | Except.ok result => match evalTypes Dict.empty result with + | Except.ok result => match evalTypes (Env.data 0 Dict.empty) result with | Except.error e => e | Except.ok (_, res) => PRINT res | Except.error err => diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index b8285335b6..98e7d925c6 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -1,12 +1,13 @@ import LeanMal.reader import LeanMal.printer +import LeanMal.types universe u def READ (input : String): Except String Types := read_str.{u} input -def sum (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := +def sum (ref : Env) (lst: List Types) : Except String (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -15,7 +16,7 @@ def sum (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Ty | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x + y)) | _ => Except.error "+ operator not supported" -def sub (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := +def sub (ref : Env) (lst: List Types) : Except String (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -24,7 +25,7 @@ def sub (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Ty | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x - y)) | _ => Except.error "- operator not supported" -def mul (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := +def mul (ref : Env) (lst: List Types) : Except String (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -33,7 +34,7 @@ def mul (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Ty | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x * y)) | _ => Except.error "* operator not supported" -def div (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Types) := +def div (ref : Env) (lst: List Types) : Except String (Env × Types) := match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -42,7 +43,7 @@ def div (ref : Dict := Dict.empty) (lst: List Types) : Except String (Dict × Ty | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x / y)) | _ => Except.error "/ operator not supported" -def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types): Except String (Dict × Types) := +def evalFnNative (ref : Env) (name: String) (results: List Types): Except String (Env × Types) := match name with | "+" => sum ref results | "-" => sub ref results @@ -52,22 +53,22 @@ def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) mutual - partial def evalTypes (ref : Dict := Dict.empty) (ast : Types) : Except String (Dict × Types) := + partial def evalTypes (ref : Env) (ast : Types) : Except String (Env × Types) := match ast with - | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with - | some vi => Except.ok (ref, vi) + | Types.symbolVal v => match ref.get (KeyType.strKey v) with + | some (_, vi) => Except.ok (ref, vi) | none => Except.error s!"'{v}' not found" | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except String (Dict × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except String (Env × Types) := match evalTypes ref head with | Except.error e => Except.error s!"error evaluating function: {head.toString true}: {e}" | Except.ok (ref2, fn) => evalFuncVal ref2 fn args - partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except String (Dict × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except String (Env × Types) := -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -79,13 +80,14 @@ mutual let keys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] - let argsDict := (buildDict keys results) - let merged := mergeDicts (mergeDicts fref newRef) argsDict + let argsLevel := fref.getLevel + 1 + let argsDict := (buildDict argsLevel keys results) + let merged := (newRef.merge fref).mergeDict argsLevel argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error "macro not implemented" | _ => Except.error s!"`unexpected token, expected: function`" - partial def evalList (ref: Dict) (lst : List Types) : Except String (Dict × Types) := + partial def evalList (ref: Env) (lst : List Types) : Except String (Env × Types) := if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -96,29 +98,29 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Dict) (elems : List Types) : Except String (Dict × Types) := + partial def evalVec (ref: Env) (elems : List Types) : Except String (Env × Types) := match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Dict) (lst : Dict) : Except String (Dict × Types) := + partial def evalDict (ref: Env) (lst : Dict) : Except String (Env × Types) := match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Dict) (lst : Dict) : Except String (Dict × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : Except String (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) - | Dict.insert k v restDict => match evalTypes ref v with + | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k newVal updatedDict + let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Dict) (args: List Types) : Except String (Dict × List Types) := - match args.foldl (fun (res : Except String (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except String (Env × List Types) := + match args.foldl (fun (res : Except String (Env × List Types)) x => match res with | Except.error e => Except.error s!"error evaluating function argument accumulator: {x.toString true}: {e}" | Except.ok (r, acc) => match evalTypes r x with @@ -129,7 +131,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Dict) (args : List Types) : Except String (Dict × Types) := + partial def evalDefn (ref: Env) (args : List Types) : Except String (Env × Types) := if args.length < 2 then Except.error "def! unexpected syntax" else let key := args[0]! @@ -139,18 +141,18 @@ mutual | Except.ok (newRef, value) => match key with | Types.symbolVal v => - let refResult := addEntry newRef (KeyType.strKey v) value + let refResult := newRef.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | _ => Except.error s!"def! unexpected token, expected: symbol" - partial def evalLet (ref: Dict) (args : List Types) : Except String (Dict × Types) := + partial def evalLet (ref: Env) (args : List Types) : Except String (Env × Types) := if args.length < 2 then Except.error "let*: unexpected syntax" else let pairs := args[0]! let body := args[1]! let result := match pairs with - | Types.listVal v => evalLetArgs ref v - | Types.vecVal v => evalLetArgs ref (toList v) + | Types.listVal v => evalLetArgs ref.increment v + | Types.vecVal v => evalLetArgs ref.increment (toList v) | _ => Except.error s!"unexpected token type: ${pairs.toString true}, expected: list or vector" match result with @@ -160,7 +162,7 @@ mutual -- we do not propagate the let* environment to the parent scope | Except.ok (_, result) => Except.ok (ref, result) - partial def evalLetArgs (ref: Dict) (args : List Types) : Except String Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except String Env := match args with | [] => Except.ok ref | [_] => Except.error "let*: unexpected syntax" @@ -169,14 +171,14 @@ mutual | Types.symbolVal key => match evalTypes ref y with | Except.error e => Except.error s!"error evaluating function argument: {key}: {e}" | Except.ok (updatedRef, value) => - evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error "let*: unexpected syntax" end -def loadFnNative (ref: Dict) (name: String) : Dict := - ref.insert (KeyType.strKey name) (Types.funcVal (Fun.builtin name)) +def loadFnNative (ref : Env) (name: String) : Env := + ref.add (KeyType.strKey name) 0 (Types.funcVal (Fun.builtin name)) -def loadFnNativeAll (ref: Dict) : Dict := +def loadFnNativeAll (ref: Env) : Env := loadFnNative ( loadFnNative ( loadFnNative ( @@ -188,7 +190,7 @@ def loadFnNativeAll (ref: Dict) : Dict := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Dict) (input : String): Dict × String := +def rep (ref: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error e => (ref, e) @@ -197,7 +199,7 @@ def rep (ref: Dict) (input : String): Dict × String := def main : IO Unit := do IO.println "Welcome to Mal REPL!" - let mut env := loadFnNativeAll Dict.empty + let mut env := loadFnNativeAll (Env.data 0 Dict.empty) let mut donext := true while donext do IO.print "user> " diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index 78a4374e37..0f69a237dc 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -4,12 +4,15 @@ import LeanMal.core universe u -def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := +def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else - let params := args[0]! + let p := args[0]! let body := args[1]! - let newfn := Fun.userDefined ref params body + let params := match p with + | Types.vecVal x => Types.listVal (toList x) + | _ => p + let newfn := Fun.userDefined ref.increment params body Except.ok (ref, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := @@ -23,24 +26,29 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with - | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with - | some vi => Except.ok (ref, vi) + | Types.symbolVal v => match ref.get (KeyType.strKey v) with + | some (_, vi) => Except.ok (ref, vi) | none => Except.error (ref, s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") - | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + | Except.ok (ref2, fn) => + match evalFuncVal ref2 fn args with + | Except.error e => Except.error e + | Except.ok (fref, res) => + -- only propagate logs after executing a function + Except.ok (forwardLogs fref ref, res) - partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -56,14 +64,16 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts fref newRef) argsDict + let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newRef.merge fref).mergeDict argsLevel argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") - partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -77,29 +87,29 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) - | Dict.insert k v restDict => match evalTypes ref v with + | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k newVal updatedDict + let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := + match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -110,7 +120,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -120,18 +130,18 @@ mutual | Except.ok (newRef, value) => match key with | Types.symbolVal v => - let refResult := addEntry newRef (KeyType.strKey v) value + let refResult := newRef.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! let result := match pairs with - | Types.listVal v => evalLetArgs ref v - | Types.vecVal v => evalLetArgs ref (toList v) + | Types.listVal v => evalLetArgs ref.increment v + | Types.vecVal v => evalLetArgs ref.increment (toList v) | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with @@ -141,7 +151,7 @@ mutual -- we do not propagate the let* environment to the parent scope | Except.ok (_, result) => Except.ok (ref, result) - partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -150,10 +160,10 @@ mutual | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => - evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -161,7 +171,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -179,7 +189,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types): Except (Dict × String) (Dict × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types): Except (Env × String) (Env × Types) := match name with | "+" => sum ref results | "-" => sub ref results @@ -202,6 +212,9 @@ mutual | "list?" => Except.ok (ref, Types.boolVal true) | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) | _ => Except.ok (ref, Types.boolVal false) + | Types.vecVal x => match name with + | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) + | _ => Except.ok (ref, Types.boolVal false) | _ => Except.ok (ref, Types.boolVal false) | _ => Except.error (ref, s!"'{name}' not found") @@ -213,23 +226,35 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Dict) (input : String): Dict × String := +def rep (ref: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, e) | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Dict) : IO Unit := +def printLogs (ref : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log | x => IO.println (x.toString true) ) +def loadMalFns (ref: Env) (fndefs: List String): Env × String := + fndefs.foldl (fun (res : Env × String) fndef => + let (ref, msg) := res + let (newref, newmsg) := rep.{u} ref fndef + (newref, s!"{msg}¬{newmsg}") + ) (ref, "") + +def fnDefs: List String := [ + "(def! not (fn* (a) (if a false true)))", + ] + def main : IO Unit := do IO.println "Welcome to Mal REPL!" - let mut env := loadFnNativeAll Dict.empty + let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let mut env := env0 let mut donext := true while donext do IO.print "user> " @@ -245,4 +270,4 @@ def main : IO Unit := do let (ref, val) := rep.{u} env value printLogs ref IO.println val - env := ref + env := resetLogs ref diff --git a/impls/lean/LeanMal/types.lean b/impls/lean/LeanMal/types.lean index a2d2555d16..fc3bc5c346 100644 --- a/impls/lean/LeanMal/types.lean +++ b/impls/lean/LeanMal/types.lean @@ -50,14 +50,17 @@ mutual inductive Fun : Type u | builtin (name : String) - | userDefined (ref: Dict) (params : Types) (body : Types) - | macroFn (ref: Dict) (params : Types) (body : Types) + | userDefined (ref: Env) (params : Types) (body : Types) + | macroFn (ref: Env) (params : Types) (body : Types) inductive Dict: Type u | empty : Dict - | insert: KeyType → Types → Dict → Dict + | insert: KeyType → Nat → Types → Dict → Dict deriving Repr + inductive Env: Type u + | data: Nat → Dict → Env + inductive Atom | v : Types -> Atom | withmeta : Types → Types → Atom @@ -65,53 +68,75 @@ mutual end -def getEntry : Dict → KeyType → Option Types +instance : Inhabited Env where + default := Env.data 0 Dict.empty + +instance : Inhabited Dict where + default := Dict.empty + +instance : Inhabited Types where + default := Types.Nil + +instance : Inhabited (List Types) where + default := [] + +instance : Inhabited (Dict × Types) where + default := (default, default) + +def Dict.get : Dict → KeyType → Option (Nat × Types) | Dict.empty, _ => default - | Dict.insert k v d, key => + | Dict.insert k l v d, key => match k, key with - | KeyType.strKey ks, KeyType.strKey keyg => if ks = keyg then some v else getEntry d key - | KeyType.keywordKey ks, KeyType.keywordKey keyg => if ks = keyg then some v else getEntry d key - | KeyType.strKey ks, KeyType.keywordKey keyg => if ks = keyg then some v else getEntry d key - | KeyType.keywordKey ks, KeyType.strKey keyg => if ks = keyg then some v else getEntry d key + | KeyType.strKey ks, KeyType.strKey keyg => if ks = keyg then some (l, v) else d.get key + | KeyType.keywordKey ks, KeyType.keywordKey keyg => if ks = keyg then some (l, v) else d.get key + | KeyType.strKey ks, KeyType.keywordKey keyg => if ks = keyg then some (l, v) else d.get key + | KeyType.keywordKey ks, KeyType.strKey keyg => if ks = keyg then some (l, v) else d.get key -def getKeys : Dict → List KeyType +def Dict.keys : Dict → List KeyType | Dict.empty => [] - | Dict.insert k _ d => - let restKeys := getKeys d + | Dict.insert k _ _ d => + let restKeys := d.keys k :: restKeys -def getValues : Dict → List Types +def Dict.values : Dict → List Types | Dict.empty => [] - | Dict.insert _ v d => - let restValues := getValues d + | Dict.insert _ _ v d => + let restValues := d.values v :: restValues -def removeKey (d : Dict) (key : KeyType) : Dict := +def Dict.remove (d : Dict) (key : KeyType) : Dict := match d with | Dict.empty => Dict.empty - | Dict.insert k v rest => + | Dict.insert k l v rest => match k, key with - | KeyType.strKey ks, KeyType.strKey keyg => if ks = keyg then removeKey rest key else Dict.insert k v (removeKey rest key) - | KeyType.keywordKey ks, KeyType.keywordKey keyg => if ks = keyg then removeKey rest key else Dict.insert k v (removeKey rest key) - | KeyType.strKey ks, KeyType.keywordKey keyg => if ks = keyg then removeKey rest key else Dict.insert k v (removeKey rest key) - | KeyType.keywordKey ks, KeyType.strKey keyg => if ks = keyg then removeKey rest key else Dict.insert k v (removeKey rest key) - - -def addEntry : Dict → KeyType → Types → Dict - | Dict.empty, key, value => Dict.insert key value Dict.empty - | Dict.insert k v d, key, value => + | KeyType.strKey ks, KeyType.strKey keyg => if ks = keyg then rest.remove key else Dict.insert k l v (rest.remove key) + | KeyType.keywordKey ks, KeyType.keywordKey keyg => if ks = keyg then rest.remove key else Dict.insert k l v (rest.remove key) + | KeyType.strKey ks, KeyType.keywordKey keyg => if ks = keyg then rest.remove key else Dict.insert k l v (rest.remove key) + | KeyType.keywordKey ks, KeyType.strKey keyg => if ks = keyg then rest.remove key else Dict.insert k l v (rest.remove key) + +def Dict.add : Dict → KeyType → Nat → Types → Dict + | Dict.empty, key, level, value => Dict.insert key level value Dict.empty + | Dict.insert k _ v d, key, level, value => match k, key with - | KeyType.strKey ks, KeyType.strKey keyg => if ks = keyg then Dict.insert k value d else Dict.insert k v (addEntry d key value) - | KeyType.keywordKey ks, KeyType.keywordKey keyg => if ks = keyg then Dict.insert k value d else Dict.insert k v (addEntry d key value) - | KeyType.strKey ks, KeyType.keywordKey keyg => if ks = keyg then Dict.insert k value d else Dict.insert k v (addEntry d key value) - | KeyType.keywordKey ks, KeyType.strKey keyg => if ks = keyg then Dict.insert k value d else Dict.insert k v (addEntry d key value) + | KeyType.strKey ks, KeyType.strKey keyg => if ks = keyg then Dict.insert k level value d else Dict.insert k level v (d.add key level value) + | KeyType.keywordKey ks, KeyType.keywordKey keyg => if ks = keyg then Dict.insert k level value d else Dict.insert k level v (d.add key level value) + | KeyType.strKey ks, KeyType.keywordKey keyg => if ks = keyg then Dict.insert k level value d else Dict.insert k level v (d.add key level value) + | KeyType.keywordKey ks, KeyType.strKey keyg => if ks = keyg then Dict.insert k level value d else Dict.insert k level v (d.add key level value) + +-- Helper function to fold over all elements in a Dict +partial def Dict.fold (d : Dict) (init : α) (f : KeyType → Nat → Types → α → α) : α := + match d with + | Dict.empty => init + | Dict.insert k l v d' => d'.fold (f k l v init) f -- Function to merge two Dicts -def mergeDicts : Dict → Dict → Dict - | d1, Dict.empty => d1 -- If the second Dict is empty, return the first Dict - | d1, Dict.insert k v rest => - let d1Updated := addEntry d1 k v - mergeDicts d1Updated rest +def Dict.merge (baseDict newDict : Dict) : Dict := + let merged := newDict.fold baseDict (fun key l v acc => + match acc.get key with + | some (lBase, _) => + if l > lBase then acc.add key l v else acc + | none => acc.add key l v) + merged -- Function to extract the string from a Types.symbolVal def getSymbol (t : Types) : Option String := @@ -124,40 +149,58 @@ def getKeyword (t : Types) : Option String := | Types.keywordVal key => some key | _ => none -def buildDictWithSymbols (ref: Dict) (keys : List String) (values : List Types) : Dict := +def buildDictWithSymbols (ref: Dict) (level: Nat) (keys : List String) (values : List Types) : Dict := match keys, values with | [], _ => Dict.empty | _, [] => Dict.empty | key :: keyTail, value :: valueTail => let val := match value with | Types.symbolVal v => - let entry := getEntry ref (KeyType.strKey v) + let entry := ref.get (KeyType.strKey v) match entry with - | some v => v + | some (_, v) => v | none => Types.Nil | _ => value - let restDict := buildDictWithSymbols ref keyTail valueTail - Dict.insert (KeyType.strKey key) val restDict + let restDict := buildDictWithSymbols ref level keyTail valueTail + Dict.insert (KeyType.strKey key) level val restDict -def buildDict (keys : List String) (values : List Types) : Dict := +def buildDict (level: Nat) (keys : List String) (values : List Types) : Dict := match keys, values with | [], _ => Dict.empty | _, [] => Dict.empty | key :: keyTail, value :: valueTail => - let restDict := buildDict keyTail valueTail - Dict.insert (KeyType.strKey key) value restDict + let restDict := buildDict level keyTail valueTail + Dict.insert (KeyType.strKey key) level value restDict -instance : Inhabited Dict where - default := Dict.empty +def Env.getLevel : Env → Nat + | Env.data l _ => l -instance : Inhabited Types where - default := Types.Nil +def Env.getDict : Env → Dict + | Env.data _ d => d -instance : Inhabited (List Types) where - default := [] +def Env.get : Env → KeyType → Option (Nat × Types) + | Env.data _ d, key => d.get key -instance : Inhabited (Dict × Types) where - default := (default, default) +def Env.keys : Env → List KeyType + | Env.data _ d => d.keys + +def Env.values : Env → List KeyType + | Env.data _ d => d.keys + +def Env.remove : Env → KeyType → Dict + | Env.data _ d, key => d.remove key + +def Env.add : Env → KeyType → Nat → Types → Env + | Env.data l d, key, level, value => Env.data l (d.add key level value) + +def Env.increment : Env → Env + | Env.data l d => Env.data (l + 1) d + +def Env.merge : Env → Env → Env + | Env.data _ d, e2 => Env.data e2.getLevel (d.merge e2.getDict) + +def Env.mergeDict : Env → Nat → Dict → Env + | Env.data _ d, level2, d2 => Env.data level2 (d.merge d2) def Types.toBool: Types -> Bool | Types.boolVal v => if v then true else false @@ -216,16 +259,30 @@ mutual partial def Dict.toString (readably: Bool) (d:Dict) : String := match d with | Dict.empty => "" - | Dict.insert key value Dict.empty => + | Dict.insert key _ value Dict.empty => match key with | KeyType.strKey k => s!"\"{k}\" {Types.toString readably value}" | KeyType.keywordKey k => s!":{k} {Types.toString readably value}" - | Dict.insert key value rest => + | Dict.insert key _ value rest => let restStr := Dict.toString readably rest match key with | KeyType.strKey k => s!"{restStr} \"{k}\" {Types.toString readably value}" | KeyType.keywordKey k => s!"{restStr} :{k} {Types.toString readably value}" - - + partial def Dict.toStringWithLevels (readably: Bool) (d:Dict) : String := + match d with + | Dict.empty => "" + | Dict.insert key l value Dict.empty => + match key with + | KeyType.strKey k => s!"\"{k}\" ({l}) {Types.toString readably value}" + | KeyType.keywordKey k => s!":{k} ({l}) {Types.toString readably value}" + | Dict.insert key l value rest => + let restStr := Dict.toStringWithLevels readably rest + match key with + | KeyType.strKey k => s!"{restStr} \"{k}\" ({l}) {Types.toString readably value}" + | KeyType.keywordKey k => s!"{restStr} :{k} ({l}) {Types.toString readably value}" end + +def Env.toString (readably: Bool) (e:Env) : String := + match e with + | Env.data l d => s!"level: {l} dict: {d.toStringWithLevels readably}" From 347410c72bde2b941c638aa811bb00437af9026d Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 14:12:11 +0200 Subject: [PATCH 15/39] replacing Dict -> Env steps 5-10 --- impls/lean/LeanMal/step5_tco.lean | 34 +++++++++--------- impls/lean/LeanMal/step6_file.lean | 38 ++++++++++---------- impls/lean/LeanMal/step7_quote.lean | 38 ++++++++++---------- impls/lean/LeanMal/step8_macros.lean | 44 +++++++++++------------ impls/lean/LeanMal/step9_try.lean | 54 ++++++++++++++-------------- impls/lean/LeanMal/stepA_mal.lean | 54 ++++++++++++++-------------- 6 files changed, 131 insertions(+), 131 deletions(-) diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index 96dd61c9e0..1197bbb44f 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := +def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let params := args[0]! @@ -23,7 +23,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -35,12 +35,12 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => evalFuncVal ref2 fn args - partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -63,7 +63,7 @@ mutual | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") - partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -77,17 +77,17 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k v restDict => match evalTypes ref v with @@ -98,8 +98,8 @@ mutual let newDict := Dict.insert k newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -110,7 +110,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -124,7 +124,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -141,7 +141,7 @@ mutual -- we do not propagate the let* environment to the parent scope | Except.ok (_, result) => Except.ok (ref, result) - partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -153,7 +153,7 @@ mutual evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -161,7 +161,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -179,7 +179,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types): Except (Dict × String) (Dict × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types): Except (Env × String) (Env × Types) := match name with | "+" => sum ref results | "-" => sub ref results @@ -212,7 +212,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Dict) (input : String): Dict × String := +def rep (ref: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, e) diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 3551cf7221..5fb948ccfa 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := +def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let params := args[0]! @@ -23,7 +23,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -35,12 +35,12 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => evalFuncVal ref2 fn args - partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -64,7 +64,7 @@ mutual | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") - partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -78,17 +78,17 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k v restDict => match evalTypes ref v with @@ -99,8 +99,8 @@ mutual let newDict := Dict.insert k newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -111,7 +111,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -125,7 +125,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -142,7 +142,7 @@ mutual -- we do not propagate the let* environment to the parent scope | Except.ok (_, result) => Except.ok (ref, result) - partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -154,7 +154,7 @@ mutual evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -162,7 +162,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -180,7 +180,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def swapAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! @@ -208,13 +208,13 @@ mutual | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def eval (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") else let ast := lst[0]! evalTypes ref ast - partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := match name with | "+" => sum ref results | "-" => sub ref results @@ -258,7 +258,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Dict) (input : String): Dict × String := +def rep (ref: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, e) diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index 9054729830..00bef37240 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := +def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let params := args[0]! @@ -23,7 +23,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -35,12 +35,12 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => evalFuncVal ref2 fn args - partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -64,7 +64,7 @@ mutual | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") - partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -84,17 +84,17 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k v restDict => match evalTypes ref v with @@ -105,8 +105,8 @@ mutual let newDict := Dict.insert k newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -117,7 +117,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -131,7 +131,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -148,7 +148,7 @@ mutual -- we do not propagate the let* environment to the parent scope | Except.ok (_, result) => Except.ok (ref, result) - partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -160,7 +160,7 @@ mutual evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -168,7 +168,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -186,7 +186,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def swapAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! @@ -214,7 +214,7 @@ mutual | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def eval (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") else let ast := lst[0]! @@ -251,7 +251,7 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := match name with | "+" => sum ref results | "-" => sub ref results @@ -299,7 +299,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Dict) (input : String): Dict × String := +def rep (ref: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, e) diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index 113cd4c2a8..d321300bdd 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := +def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let params := args[0]! @@ -23,7 +23,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -35,12 +35,12 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => evalFuncVal ref2 fn args - partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := match fn with | Types.funcVal v => match v with | Fun.builtin name => @@ -79,7 +79,7 @@ mutual | Except.ok (_, newast) => evalTypes ref newast | _ => Except.error (ref, s!"`unexpected token, expected: function`") - partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -100,17 +100,17 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k v restDict => match evalTypes ref v with @@ -121,8 +121,8 @@ mutual let newDict := Dict.insert k newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -133,7 +133,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -147,7 +147,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalDefMacro (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDefMacro (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -170,7 +170,7 @@ mutual | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -187,7 +187,7 @@ mutual -- we do not propagate the let* environment to the parent scope | Except.ok (_, result) => Except.ok (ref, result) - partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -199,7 +199,7 @@ mutual evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -207,7 +207,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -225,7 +225,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def swapAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! @@ -253,7 +253,7 @@ mutual | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def eval (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") else let ast := lst[0]! @@ -290,7 +290,7 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := match name with | "+" => sum ref results | "-" => sub ref results @@ -341,7 +341,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Dict) (input : String): Dict × String := +def rep (ref: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, e) @@ -355,8 +355,8 @@ def printLogs (ref : Dict) : IO Unit := | x => IO.println (x.toString true) ) -def loadMalFns (ref: Dict) (fndefs: List String): Dict × String := - fndefs.foldl (fun (res : Dict × String) fndef => +def loadMalFns (ref: Env) (fndefs: List String): Env × String := + fndefs.foldl (fun (res : Env × String) fndef => let (ref, msg) := res let (newref, newmsg) := rep.{u} ref fndef (newref, s!"{msg}¬{newmsg}") diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index 1b624a845e..2b6273f79c 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := +def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let p := args[0]! @@ -26,7 +26,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -38,12 +38,12 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, e) | Except.ok (ref2, fn) => evalFuncVal ref2 fn args - partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := match fn with | Types.funcVal v => match v with | Fun.builtin name => @@ -81,7 +81,7 @@ mutual | Except.ok (_, newast) => evalTypes ref newast | _ => Except.error (ref, s!"`unexpected token, expected: function`") - partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -103,17 +103,17 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k v restDict => match evalTypes ref v with @@ -124,8 +124,8 @@ mutual let newDict := Dict.insert k newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -136,7 +136,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -150,7 +150,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalDefMacro (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDefMacro (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -173,7 +173,7 @@ mutual | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -190,7 +190,7 @@ mutual -- we do not propagate the let* environment to the parent scope | Except.ok (_, result) => Except.ok (ref, result) - partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -202,7 +202,7 @@ mutual evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -210,7 +210,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -228,7 +228,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def evalTry (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalTry (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "try*: unexpected syntax") else match evalTypes ref lst[0]! with @@ -262,7 +262,7 @@ mutual -- | Types.vecVal v => -- TODO | _ => Except.error evalErr - partial def swapAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! @@ -290,7 +290,7 @@ mutual | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def eval (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") else let ast := lst[0]! @@ -327,8 +327,8 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def nativeMapOverList (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := - match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := + match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => match res with | Except.error e => Except.error e | Except.ok (r, acc) => @@ -340,7 +340,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.listVal results) - partial def nativeMap (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + partial def nativeMap (ref: Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "map: unexpected syntax") else let fn := lst[0]! @@ -353,7 +353,7 @@ mutual | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: function") - partial def nativeApply (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def nativeApply (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "apply: unexpected syntax") else let fn := lst[0]! @@ -367,7 +367,7 @@ mutual evalFuncVal ref fn (firstargs ++ (toList v)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") - partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := match name with | "+" => sum ref results | "-" => sub ref results @@ -459,7 +459,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Dict) (input : String): Dict × String := +def rep (ref: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, s!"Error: {e}") @@ -473,8 +473,8 @@ def printLogs (ref : Dict) : IO Unit := | x => IO.println (x.toString true) ) -def loadMalFns (ref: Dict) (fndefs: List String): Dict × String := - fndefs.foldl (fun (res : Dict × String) fndef => +def loadMalFns (ref: Env) (fndefs: List String): Env × String := + fndefs.foldl (fun (res : Env × String) fndef => let (ref, msg) := res let (newref, newmsg) := rep.{u} ref fndef (newref, s!"{msg}¬{newmsg}") diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index 2c6957dd29..caa04e16ae 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := +def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let p := args[0]! @@ -26,7 +26,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Dict := Dict.empty) (ast : Types) : Except (Dict × String) (Dict × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -38,12 +38,12 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Dict) (head : Types) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, e) | Except.ok (ref2, fn) => evalFuncVal ref2 fn args - partial def evalFuncVal (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := match fn with | Types.funcVal v => match v with | Fun.builtin name => @@ -81,7 +81,7 @@ mutual | Except.ok (_, newast) => evalTypes ref newast | _ => Except.error (ref, s!"`unexpected token, expected: function`") - partial def evalList (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -103,17 +103,17 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Dict) (elems : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Types) := + partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Dict) (lst : Dict) : Except (Dict × String) (Dict × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k v restDict => match evalTypes ref v with @@ -124,8 +124,8 @@ mutual let newDict := Dict.insert k newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Dict) (args: List Types) : Except (Dict × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := + match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -136,7 +136,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -150,7 +150,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalDefMacro (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDefMacro (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -173,7 +173,7 @@ mutual | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -190,7 +190,7 @@ mutual -- we do not propagate the let* environment to the parent scope | Except.ok (_, result) => Except.ok (ref, result) - partial def evalLetArgs (ref: Dict) (args : List Types) : Except (Dict × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -202,7 +202,7 @@ mutual evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -210,7 +210,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Dict) (args : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -228,7 +228,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def evalTry (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def evalTry (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "try*: unexpected syntax") else match evalTypes ref lst[0]! with @@ -262,7 +262,7 @@ mutual -- | Types.vecVal v => -- TODO | _ => Except.error evalErr - partial def swapAtom (ref: Dict) (lst: List Types) (args: List Types) : Except (Dict × String) (Dict × Types) := + partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! @@ -290,7 +290,7 @@ mutual | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def eval (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") else let ast := lst[0]! @@ -327,8 +327,8 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def nativeMapOverList (ref: Dict) (fn: Types) (args: List Types) : Except (Dict × String) (Dict × Types) := - match args.foldl (fun (res : Except (Dict × String) (Dict × List Types)) x => + partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := + match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => match res with | Except.error e => Except.error e | Except.ok (r, acc) => @@ -340,7 +340,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.listVal results) - partial def nativeMap (ref: Dict) (lst: List Types) : Except (Dict × String) (Dict × Types) := + partial def nativeMap (ref: Env) (lst: List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "map: unexpected syntax") else let fn := lst[0]! @@ -353,7 +353,7 @@ mutual | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: function") - partial def nativeApply (ref: Dict) (lst : List Types) : Except (Dict × String) (Dict × Types) := + partial def nativeApply (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := if lst.length < 2 then Except.error (ref, "apply: unexpected syntax") else let fn := lst[0]! @@ -367,7 +367,7 @@ mutual evalFuncVal ref fn (firstargs ++ (toList v)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") - partial def evalFnNative (ref : Dict := Dict.empty) (name: String) (results: List Types) (args: List Types): Except (Dict × String) (Dict × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := match name with | "+" => sum ref results | "-" => sub ref results @@ -462,7 +462,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Dict) (input : String): Dict × String := +def rep (ref: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, s!"Error: {e}") @@ -476,8 +476,8 @@ def printLogs (ref : Dict) : IO Unit := | x => IO.println (x.toString true) ) -def loadMalFns (ref: Dict) (fndefs: List String): Dict × String := - fndefs.foldl (fun (res : Dict × String) fndef => +def loadMalFns (ref: Env) (fndefs: List String): Env × String := + fndefs.foldl (fun (res : Env × String) fndef => let (ref, msg) := res let (newref, newmsg) := rep.{u} ref fndef (newref, s!"{msg}¬{newmsg}") From 359bf52ae9da73245bed723c12a33ba678055446 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 14:13:31 +0200 Subject: [PATCH 16/39] refactor step 5 --- impls/lean/LeanMal/step5_tco.lean | 61 ++++++++++++++++++++++--------- 1 file changed, 43 insertions(+), 18 deletions(-) diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index 1197bbb44f..4d6f3317c0 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -7,9 +7,12 @@ universe u def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else - let params := args[0]! + let p := args[0]! let body := args[1]! - let newfn := Fun.userDefined ref params body + let params := match p with + | Types.vecVal x => Types.listVal (toList x) + | _ => p + let newfn := Fun.userDefined ref.increment params body Except.ok (ref, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := @@ -27,8 +30,8 @@ mutual let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with - | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with - | some vi => Except.ok (ref, vi) + | Types.symbolVal v => match ref.get (KeyType.strKey v) with + | some (_, vi) => Except.ok (ref, vi) | none => Except.error (ref, s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) @@ -38,7 +41,12 @@ mutual partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") - | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + | Except.ok (ref2, fn) => + match evalFuncVal ref2 fn args with + | Except.error e => Except.error e + | Except.ok (fref, res) => + -- only propagate logs after executing a function + Except.ok (forwardLogs fref ref, res) partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := -- first execute each function argument - reduce computation @@ -56,8 +64,10 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts fref newRef) argsDict + let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newRef.merge fref).mergeDict argsLevel argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") @@ -90,16 +100,16 @@ mutual partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) - | Dict.insert k v restDict => match evalTypes ref v with + | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k newVal updatedDict + let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := + match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -120,7 +130,7 @@ mutual | Except.ok (newRef, value) => match key with | Types.symbolVal v => - let refResult := addEntry newRef (KeyType.strKey v) value + let refResult := newRef.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") @@ -130,8 +140,8 @@ mutual let pairs := args[0]! let body := args[1]! let result := match pairs with - | Types.listVal v => evalLetArgs ref v - | Types.vecVal v => evalLetArgs ref (toList v) + | Types.listVal v => evalLetArgs ref.increment v + | Types.vecVal v => evalLetArgs ref.increment (toList v) | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with @@ -141,7 +151,7 @@ mutual -- we do not propagate the let* environment to the parent scope | Except.ok (_, result) => Except.ok (ref, result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -150,7 +160,7 @@ mutual | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => - evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := @@ -202,6 +212,9 @@ mutual | "list?" => Except.ok (ref, Types.boolVal true) | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) | _ => Except.ok (ref, Types.boolVal false) + | Types.vecVal x => match name with + | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) + | _ => Except.ok (ref, Types.boolVal false) | _ => Except.ok (ref, Types.boolVal false) | _ => Except.error (ref, s!"'{name}' not found") end @@ -219,16 +232,28 @@ def rep (ref: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Dict) : IO Unit := +def printLogs (ref : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log | x => IO.println (x.toString true) ) +def loadMalFns (ref: Env) (fndefs: List String): Env × String := + fndefs.foldl (fun (res : Env × String) fndef => + let (ref, msg) := res + let (newref, newmsg) := rep.{u} ref fndef + (newref, s!"{msg}¬{newmsg}") + ) (ref, "") + +def fnDefs: List String := [ + "(def! not (fn* (a) (if a false true)))", + ] + def main : IO Unit := do IO.println "Welcome to Mal REPL!" - let mut env := loadFnNativeAll Dict.empty + let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let mut env := env0 let mut donext := true while donext do IO.print "user> " From aef3b16d5ae84e9d6f56db68a3803acfe273fdb5 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 16:32:28 +0200 Subject: [PATCH 17/39] lean: refactor step6 --- impls/lean/LeanMal/core.lean | 46 ++++++----- impls/lean/LeanMal/step2_eval.lean | 2 +- impls/lean/LeanMal/step3_env.lean | 2 +- impls/lean/LeanMal/step4_if_fn_do.lean | 9 +-- impls/lean/LeanMal/step5_tco.lean | 4 +- impls/lean/LeanMal/step6_file.lean | 101 ++++++++++++++++--------- 6 files changed, 98 insertions(+), 66 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 81a1254f17..e831c1af82 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -182,24 +182,18 @@ def resetAtom (ref : Env) (lst: List Types) (args: List Types) : Except (Env × let atomSymbol := args[0]! match atomSymbol with | Types.symbolVal sym => - match first with - | Types.atomVal x => match x with - | Atom.v _ => - let oldRef := ref.get (KeyType.strKey sym) - match oldRef with - | none => Except.error (ref, s!"{sym} not found") - | some (level, _) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v second)) - Except.ok (newRef, second) - | Atom.withmeta _ meta => - let oldRef := ref.get (KeyType.strKey sym) - match oldRef with - | none => Except.error (ref, s!"{sym} not found") - | some (level, _) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta second meta)) - Except.ok (newRef, second) - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"deref: unexpected token: {x.toString true}, expected: symbol") + match ref.get (KeyType.strKey sym) with + | none => Except.error (ref, s!"{sym} not found") + | some (level, _) => match first with + | Types.atomVal x => match x with + | Atom.v _ => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v second)) + Except.ok (newRef, second) + | Atom.withmeta _ meta => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta second meta)) + Except.ok (newRef, second) + | x => Except.error (ref, s!"reset!: unexpected symbol: {x.toString true}, expected: atom") + | x => Except.error (ref, s!"reset!: unexpected token: {x.toString true}, expected: symbol") def prStrInternal (lst: List Types) (printReadably: Bool) (sep: String) : String := let elems := lst.map (fun x => x.toString printReadably) @@ -273,12 +267,12 @@ def countFunc(ref : Env) (lst: List Types) : Except (Env × String) (Env × Type | Types.Nil => Except.ok (ref, Types.intVal 0) | _ => Except.error (ref, "count called on non-sequence") -def readString (lst: List Types) (envir: Dict := Dict.empty) : Except String Types := +def readString (lst: List Types) (envir: Env) : Except String Types := if lst.length < 1 then Except.error "read-string: 1 arguments required" else let first := lst[0]! match first with - | Types.strVal v => read_types_with_env v envir + | Types.strVal v => read_types_with_env v envir.getDict -- Dict.empty | x => Except.error s!"unexpected symbol: {x.toString true}, expected: string" def cons (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := @@ -632,3 +626,15 @@ def loadFnNativeAll (ref : Env) : Env := def setSymbol (ref : Env) (name: String) (value: Types): Env := let newRef := loadFnNative ref name newRef.add (KeyType.strKey name) 0 value + +-- forward mutated atoms defined in the outer environments +-- outer environments always have a lower level index +def forwardMutatedAtoms (refSource: Env) (refOuter: Env): Env := + refSource.getDict.fold refOuter (fun key l v acc => + if l > acc.getLevel then acc + else + match acc.get key with + | none => acc + | some (lOuter, _) => + if l != lOuter then acc else acc.add key l v + ) diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean index 2f563705f7..3e46d5869d 100644 --- a/impls/lean/LeanMal/step2_eval.lean +++ b/impls/lean/LeanMal/step2_eval.lean @@ -65,7 +65,7 @@ mutual partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except String (Env × Types) := match evalTypes ref head with | Except.error e => Except.error s!"error evaluating function: {head.toString true}: {e}" - | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + | Except.ok (_, fn) => evalFuncVal ref fn args partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except String (Env × Types) := -- first execute each function argument - reduce computation diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index 98e7d925c6..04f86838ea 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -66,7 +66,7 @@ mutual partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except String (Env × Types) := match evalTypes ref head with | Except.error e => Except.error s!"error evaluating function: {head.toString true}: {e}" - | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + | Except.ok (_, fn) => evalFuncVal ref fn args partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except String (Env × Types) := -- first execute each function argument - reduce computation diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index 0f69a237dc..76ccc98c6f 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -44,9 +44,8 @@ mutual | Except.ok (ref2, fn) => match evalFuncVal ref2 fn args with | Except.error e => Except.error e - | Except.ok (fref, res) => - -- only propagate logs after executing a function - Except.ok (forwardLogs fref ref, res) + -- only propagate logs after executing a function + | Except.ok (fref, res) => Except.ok (forwardLogs fref ref, res) partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := -- first execute each function argument - reduce computation @@ -148,8 +147,8 @@ mutual | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") | Except.ok newRef => match evalTypes newRef body with | Except.error e => Except.error e - -- we do not propagate the let* environment to the parent scope - | Except.ok (_, result) => Except.ok (ref, result) + -- only propagate logs from the let* environment to the parent scope + | Except.ok (letref, result) => Except.ok (forwardLogs letref ref, result) partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := match args with diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index 4d6f3317c0..7eb90737de 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -148,8 +148,8 @@ mutual | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") | Except.ok newRef => match evalTypes newRef body with | Except.error e => Except.error e - -- we do not propagate the let* environment to the parent scope - | Except.ok (_, result) => Except.ok (ref, result) + -- only propagate logs from the let* environment to the parent scope + | Except.ok (letref, result) => Except.ok (forwardLogs letref ref, result) partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := match args with diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 5fb948ccfa..281455c234 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -7,9 +7,12 @@ universe u def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else - let params := args[0]! + let p := args[0]! let body := args[1]! - let newfn := Fun.userDefined ref params body + let params := match p with + | Types.vecVal x => Types.listVal (toList x) + | _ => p + let newfn := Fun.userDefined ref.increment params body Except.ok (ref, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := @@ -27,8 +30,8 @@ mutual let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with - | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with - | some vi => Except.ok (ref, vi) + | Types.symbolVal v => match ref.get (KeyType.strKey v) with + | some (_, vi) => Except.ok (ref, vi) | none => Except.error (ref, s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) @@ -38,7 +41,12 @@ mutual partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") - | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + | Except.ok (ref2, fn) => + match evalFuncVal ref2 fn args with + | Except.error e => Except.error e + | Except.ok (fref, res) => + -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope + Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := -- first execute each function argument - reduce computation @@ -47,8 +55,7 @@ mutual | Except.ok (newRef, results) => match fn with | Types.funcVal v => match v with - | Fun.builtin name => - evalFnNative newRef name results args + | Fun.builtin name => evalFnNative newRef name results args | Fun.userDefined fref params body => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false @@ -57,8 +64,10 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts fref newRef) argsDict + let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newRef.merge fref).mergeDict argsLevel argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") @@ -91,16 +100,16 @@ mutual partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) - | Dict.insert k v restDict => match evalTypes ref v with + | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k newVal updatedDict + let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := + match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -121,7 +130,7 @@ mutual | Except.ok (newRef, value) => match key with | Types.symbolVal v => - let refResult := addEntry newRef (KeyType.strKey v) value + let refResult := newRef.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") @@ -131,18 +140,19 @@ mutual let pairs := args[0]! let body := args[1]! let result := match pairs with - | Types.listVal v => evalLetArgs ref v - | Types.vecVal v => evalLetArgs ref (toList v) + | Types.listVal v => evalLetArgs ref.increment v + | Types.vecVal v => evalLetArgs ref.increment (toList v) | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") | Except.ok newRef => match evalTypes newRef body with | Except.error e => Except.error e - -- we do not propagate the let* environment to the parent scope - | Except.ok (_, result) => Except.ok (ref, result) + -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope + | Except.ok (letref, result) => + Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -151,7 +161,7 @@ mutual | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => - evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := @@ -190,21 +200,23 @@ mutual | Types.symbolVal sym => match fn with | Types.funcVal _ => - match first with - | Types.atomVal x => match x with - | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.v res)) - Except.ok (newRef, res) - | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newRef, res) - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + match ref.get (KeyType.strKey sym) with + | none => Except.error (ref, s!"{sym} not found") + | some (level, _) => match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (_, res) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + Except.ok (newRef, res) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (_, res) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newRef, res) + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") @@ -245,6 +257,9 @@ mutual | "list?" => Except.ok (ref, Types.boolVal true) | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) | _ => Except.ok (ref, Types.boolVal false) + | Types.vecVal x => match name with + | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) + | _ => Except.ok (ref, Types.boolVal false) | Types.atomVal _ => match name with | "atom?" => Except.ok (ref, Types.boolVal true) | _ => Except.ok (ref, Types.boolVal false) @@ -265,16 +280,28 @@ def rep (ref: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Dict) : IO Unit := +def printLogs (ref : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log | x => IO.println (x.toString true) ) +def loadMalFns (ref: Env) (fndefs: List String): Env × String := + fndefs.foldl (fun (res : Env × String) fndef => + let (ref, msg) := res + let (newref, newmsg) := rep.{u} ref fndef + (newref, s!"{msg}¬{newmsg}") + ) (ref, "") + +def fnDefs: List String := [ + "(def! not (fn* (a) (if a false true)))", + ] + def main : IO Unit := do IO.println "Welcome to Mal REPL!" - let mut env := loadFnNativeAll Dict.empty + let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let mut env := env0 let mut donext := true while donext do IO.print "user> " From 32fd818e063b9c333f1deae09ece1cf7f105838d Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 16:52:26 +0200 Subject: [PATCH 18/39] lean: refactor step 7 --- impls/lean/LeanMal/step7_quote.lean | 102 +++++++++++++++++----------- 1 file changed, 64 insertions(+), 38 deletions(-) diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index 00bef37240..0feb88e8ae 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -7,9 +7,12 @@ universe u def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else - let params := args[0]! + let p := args[0]! let body := args[1]! - let newfn := Fun.userDefined ref params body + let params := match p with + | Types.vecVal x => Types.listVal (toList x) + | _ => p + let newfn := Fun.userDefined ref.increment params body Except.ok (ref, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := @@ -27,8 +30,8 @@ mutual let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with - | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with - | some vi => Except.ok (ref, vi) + | Types.symbolVal v => match ref.get (KeyType.strKey v) with + | some (_, vi) => Except.ok (ref, vi) | none => Except.error (ref, s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) @@ -38,7 +41,12 @@ mutual partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") - | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + | Except.ok (ref2, fn) => + match evalFuncVal ref2 fn args with + | Except.error e => Except.error e + | Except.ok (fref, res) => + -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope + Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := -- first execute each function argument - reduce computation @@ -47,8 +55,7 @@ mutual | Except.ok (newRef, results) => match fn with | Types.funcVal v => match v with - | Fun.builtin name => - evalFnNative newRef name results args + | Fun.builtin name => evalFnNative newRef name results args | Fun.userDefined fref params body => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false @@ -57,8 +64,10 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts fref newRef) argsDict + let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newRef.merge fref).mergeDict argsLevel argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") @@ -97,16 +106,16 @@ mutual partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) - | Dict.insert k v restDict => match evalTypes ref v with + | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k newVal updatedDict + let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := + match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -127,7 +136,7 @@ mutual | Except.ok (newRef, value) => match key with | Types.symbolVal v => - let refResult := addEntry newRef (KeyType.strKey v) value + let refResult := newRef.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") @@ -137,18 +146,19 @@ mutual let pairs := args[0]! let body := args[1]! let result := match pairs with - | Types.listVal v => evalLetArgs ref v - | Types.vecVal v => evalLetArgs ref (toList v) + | Types.listVal v => evalLetArgs ref.increment v + | Types.vecVal v => evalLetArgs ref.increment (toList v) | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") | Except.ok newRef => match evalTypes newRef body with | Except.error e => Except.error e - -- we do not propagate the let* environment to the parent scope - | Except.ok (_, result) => Except.ok (ref, result) + -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope + | Except.ok (letref, result) => + Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -157,7 +167,7 @@ mutual | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => - evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := @@ -196,21 +206,23 @@ mutual | Types.symbolVal sym => match fn with | Types.funcVal _ => - match first with - | Types.atomVal x => match x with - | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.v res)) - Except.ok (newRef, res) - | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newRef, res) - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + match ref.get (KeyType.strKey sym) with + | none => Except.error (ref, s!"{sym} not found") + | some (level, _) => match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (_, res) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + Except.ok (newRef, res) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (_, res) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newRef, res) + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") @@ -285,6 +297,9 @@ mutual | "list?" => Except.ok (ref, Types.boolVal true) | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) | _ => Except.ok (ref, Types.boolVal false) + | Types.vecVal x => match name with + | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) + | _ => Except.ok (ref, Types.boolVal false) | Types.atomVal _ => match name with | "atom?" => Except.ok (ref, Types.boolVal true) | _ => Except.ok (ref, Types.boolVal false) @@ -306,17 +321,28 @@ def rep (ref: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Dict) : IO Unit := +def printLogs (ref : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log | x => IO.println (x.toString true) ) +def loadMalFns (ref: Env) (fndefs: List String): Env × String := + fndefs.foldl (fun (res : Env × String) fndef => + let (ref, msg) := res + let (newref, newmsg) := rep.{u} ref fndef + (newref, s!"{msg}¬{newmsg}") + ) (ref, "") + +def fnDefs: List String := [ + "(def! not (fn* (a) (if a false true)))", + ] + def main : IO Unit := do IO.println "Welcome to Mal REPL!" - let mut env := loadFnNativeAll Dict.empty - + let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let mut env := env0 let mut donext := true while donext do IO.print "user> " From bde987cd85a4dea1862675f0870d4088ad2a0cfd Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 17:04:30 +0200 Subject: [PATCH 19/39] lean: refactor step 8 --- impls/lean/LeanMal/step8_macros.lean | 102 ++++++++++++++++----------- 1 file changed, 59 insertions(+), 43 deletions(-) diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index d321300bdd..a8c0e11e76 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -7,9 +7,12 @@ universe u def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := if args.length < 2 then Except.error (ref, "unexpected syntax") else - let params := args[0]! + let p := args[0]! let body := args[1]! - let newfn := Fun.userDefined ref params body + let params := match p with + | Types.vecVal x => Types.listVal (toList x) + | _ => p + let newfn := Fun.userDefined ref.increment params body Except.ok (ref, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := @@ -27,8 +30,8 @@ mutual let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with - | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with - | some vi => Except.ok (ref, vi) + | Types.symbolVal v => match ref.get (KeyType.strKey v) with + | some (_, vi) => Except.ok (ref, vi) | none => Except.error (ref, s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) @@ -38,7 +41,12 @@ mutual partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") - | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + | Except.ok (ref2, fn) => + match evalFuncVal ref2 fn args with + | Except.error e => Except.error e + | Except.ok (fref, res) => + -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope + Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := match fn with @@ -59,20 +67,23 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts fref newRef) argsDict + let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newRef.merge fref).mergeDict argsLevel argsDict evalTypes merged body | Fun.macroFn fref params body => let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys let normalArgs := args.take keys.length let variadicArg := args.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts ref fref) argsDict + let argsLevel := if fref.getLevel >= ref.getLevel then fref.getLevel + 1 else ref.getLevel + 1 + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (ref.merge fref).mergeDict argsLevel argsDict match evalTypes merged body with | Except.error e => Except.error e @@ -113,16 +124,16 @@ mutual partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) - | Dict.insert k v restDict => match evalTypes ref v with + | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k newVal updatedDict + let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := + match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -143,7 +154,7 @@ mutual | Except.ok (newRef, value) => match key with | Types.symbolVal v => - let refResult := addEntry newRef (KeyType.strKey v) value + let refResult := newRef.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") @@ -161,10 +172,10 @@ mutual | Types.funcVal func => match func with | Fun.macroFn _ _ _ => - let refResult := addEntry newRef (KeyType.strKey v) value + let refResult := newRef.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | Fun.userDefined fref params body => - let refResult := addEntry newRef (KeyType.strKey v) (Types.funcVal (Fun.macroFn fref params body)) + let refResult := newRef.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) Except.ok (refResult, value) | _ => Except.error (newRef, s!"defmacro!: unexpected builtin function") | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") @@ -176,18 +187,19 @@ mutual let pairs := args[0]! let body := args[1]! let result := match pairs with - | Types.listVal v => evalLetArgs ref v - | Types.vecVal v => evalLetArgs ref (toList v) + | Types.listVal v => evalLetArgs ref.increment v + | Types.vecVal v => evalLetArgs ref.increment (toList v) | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") | Except.ok newRef => match evalTypes newRef body with | Except.error e => Except.error e - -- we do not propagate the let* environment to the parent scope - | Except.ok (_, result) => Except.ok (ref, result) + -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope + | Except.ok (letref, result) => + Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -196,7 +208,7 @@ mutual | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => - evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := @@ -235,21 +247,23 @@ mutual | Types.symbolVal sym => match fn with | Types.funcVal _ => - match first with - | Types.atomVal x => match x with - | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.v res)) - Except.ok (newRef, res) - | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newRef, res) - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + match ref.get (KeyType.strKey sym) with + | none => Except.error (ref, s!"{sym} not found") + | some (level, _) => match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (_, res) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + Except.ok (newRef, res) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (_, res) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newRef, res) + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") @@ -327,6 +341,9 @@ mutual | "list?" => Except.ok (ref, Types.boolVal true) | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) | _ => Except.ok (ref, Types.boolVal false) + | Types.vecVal x => match name with + | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) + | _ => Except.ok (ref, Types.boolVal false) | Types.atomVal _ => match name with | "atom?" => Except.ok (ref, Types.boolVal true) | _ => Except.ok (ref, Types.boolVal false) @@ -348,7 +365,7 @@ def rep (ref: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Dict) : IO Unit := +def printLogs (ref : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log @@ -370,9 +387,8 @@ def fnDefs: List String := [ def main : IO Unit := do IO.println "Welcome to Mal REPL!" - let (env0, _) := loadMalFns.{u} (loadFnNativeAll Dict.empty) fnDefs + let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let mut env := env0 - let mut donext := true while donext do IO.print "user> " From 550bd474aba9f5c7e08646ff35a7a1f3cf56a132 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 17:18:36 +0200 Subject: [PATCH 20/39] lean: refactor step 9 --- impls/lean/LeanMal/step9_try.lean | 105 +++++++++++++++++------------- 1 file changed, 58 insertions(+), 47 deletions(-) diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index 2b6273f79c..59cd100124 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -12,7 +12,7 @@ def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types let params := match p with | Types.vecVal x => Types.listVal (toList x) | _ => p - let newfn := Fun.userDefined ref params body + let newfn := Fun.userDefined ref.increment params body Except.ok (ref, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := @@ -30,18 +30,23 @@ mutual let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with - | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with - | some vi => Except.ok (ref, vi) + | Types.symbolVal v => match ref.get (KeyType.strKey v) with + | some (_, vi) => Except.ok (ref, vi) | none => Except.error (ref, s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with - | Except.error (newref, e) => Except.error (newref, e) - | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + | Except.error e => Except.error e + | Except.ok (ref2, fn) => + match evalFuncVal ref2 fn args with + | Except.error e => Except.error e + | Except.ok (fref, res) => + -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope + Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := match fn with @@ -62,19 +67,23 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts fref newRef) argsDict + let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newRef.merge fref).mergeDict argsLevel argsDict + evalTypes merged body | Fun.macroFn fref params body => let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys let normalArgs := args.take keys.length let variadicArg := args.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts fref ref) argsDict + let argsLevel := if fref.getLevel >= ref.getLevel then fref.getLevel + 1 else ref.getLevel + 1 + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (ref.merge fref).mergeDict argsLevel argsDict match evalTypes merged body with | Except.error e => Except.error e @@ -116,16 +125,16 @@ mutual partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) - | Dict.insert k v restDict => match evalTypes ref v with + | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k newVal updatedDict + let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := + match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -146,7 +155,7 @@ mutual | Except.ok (newRef, value) => match key with | Types.symbolVal v => - let refResult := addEntry newRef (KeyType.strKey v) value + let refResult := newRef.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") @@ -164,10 +173,10 @@ mutual | Types.funcVal func => match func with | Fun.macroFn _ _ _ => - let refResult := addEntry newRef (KeyType.strKey v) value + let refResult := newRef.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | Fun.userDefined fref params body => - let refResult := addEntry newRef (KeyType.strKey v) (Types.funcVal (Fun.macroFn fref params body)) + let refResult := newRef.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) Except.ok (refResult, value) | _ => Except.error (newRef, s!"defmacro!: unexpected builtin function") | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") @@ -179,18 +188,19 @@ mutual let pairs := args[0]! let body := args[1]! let result := match pairs with - | Types.listVal v => evalLetArgs ref v - | Types.vecVal v => evalLetArgs ref (toList v) + | Types.listVal v => evalLetArgs ref.increment v + | Types.vecVal v => evalLetArgs ref.increment (toList v) | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") | Except.ok newRef => match evalTypes newRef body with | Except.error e => Except.error e - -- we do not propagate the let* environment to the parent scope - | Except.ok (_, result) => Except.ok (ref, result) + -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope + | Except.ok (letref, result) => + Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -199,7 +209,7 @@ mutual | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => - evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := @@ -253,8 +263,8 @@ mutual if catchBody.length < 2 then Except.error (errRef, "try*: unexpected syntax") else let toeval := catchBody[2]! - let built := buildDictWithSymbols ref [errorSymbol] [err] - let merged := mergeDicts ref built + let built := buildDictWithSymbols ref.getDict ref.getLevel [errorSymbol] [err] + let merged := ref.mergeDict (ref.getLevel + 1) built evalTypes merged toeval | _ => Except.error (ref, s!"unexpected return type, expected: symbol") else Except.error evalErr @@ -272,21 +282,23 @@ mutual | Types.symbolVal sym => match fn with | Types.funcVal _ => - match first with - | Types.atomVal x => match x with - | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.v res)) - Except.ok (newRef, res) - | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newRef, res) - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + match ref.get (KeyType.strKey sym) with + | none => Except.error (ref, s!"{sym} not found") + | some (level, _) => match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (_, res) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + Except.ok (newRef, res) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (_, res) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newRef, res) + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") @@ -328,7 +340,7 @@ mutual | _ => ast partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := - match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => + match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => match res with | Except.error e => Except.error e | Except.ok (r, acc) => @@ -466,7 +478,7 @@ def rep (ref: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Dict) : IO Unit := +def printLogs (ref : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log @@ -488,9 +500,8 @@ def fnDefs: List String := [ def main : IO Unit := do IO.println "Welcome to Mal REPL!" - let (env0, _) := loadMalFns.{u} (loadFnNativeAll Dict.empty) fnDefs + let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let mut env := env0 - let mut donext := true while donext do IO.print "user> " From 45e3fd424224ac01e090d8cda4786ec58cd76b9e Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 17:23:55 +0200 Subject: [PATCH 21/39] lean: refactor stepA --- impls/lean/LeanMal/stepA_mal.lean | 105 +++++++++++++++++------------- 1 file changed, 58 insertions(+), 47 deletions(-) diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index caa04e16ae..b3faa30166 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -12,7 +12,7 @@ def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types let params := match p with | Types.vecVal x => Types.listVal (toList x) | _ => p - let newfn := Fun.userDefined ref params body + let newfn := Fun.userDefined ref.increment params body Except.ok (ref, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := @@ -30,18 +30,23 @@ mutual let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with - | Types.symbolVal v => match getEntry ref (KeyType.strKey v) with - | some vi => Except.ok (ref, vi) + | Types.symbolVal v => match ref.get (KeyType.strKey v) with + | some (_, vi) => Except.ok (ref, vi) | none => Except.error (ref, s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := match evalTypes ref head with - | Except.error (newref, e) => Except.error (newref, e) - | Except.ok (ref2, fn) => evalFuncVal ref2 fn args + | Except.error e => Except.error e + | Except.ok (ref2, fn) => + match evalFuncVal ref2 fn args with + | Except.error e => Except.error e + | Except.ok (fref, res) => + -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope + Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := match fn with @@ -62,19 +67,23 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts fref newRef) argsDict + let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newRef.merge fref).mergeDict argsLevel argsDict + evalTypes merged body | Fun.macroFn fref params body => let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys let normalArgs := args.take keys.length let variadicArg := args.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsDict := (buildDict (keys ++ variadic) argVals) - let merged := mergeDicts (mergeDicts fref ref) argsDict + let argsLevel := if fref.getLevel >= ref.getLevel then fref.getLevel + 1 else ref.getLevel + 1 + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (ref.merge fref).mergeDict argsLevel argsDict match evalTypes merged body with | Except.error e => Except.error e @@ -116,16 +125,16 @@ mutual partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) - | Dict.insert k v restDict => match evalTypes ref v with + | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k newVal updatedDict + let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Dict × List Types) := - match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := + match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -146,7 +155,7 @@ mutual | Except.ok (newRef, value) => match key with | Types.symbolVal v => - let refResult := addEntry newRef (KeyType.strKey v) value + let refResult := newRef.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") @@ -164,10 +173,10 @@ mutual | Types.funcVal func => match func with | Fun.macroFn _ _ _ => - let refResult := addEntry newRef (KeyType.strKey v) value + let refResult := newRef.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | Fun.userDefined fref params body => - let refResult := addEntry newRef (KeyType.strKey v) (Types.funcVal (Fun.macroFn fref params body)) + let refResult := newRef.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) Except.ok (refResult, value) | _ => Except.error (newRef, s!"defmacro!: unexpected builtin function") | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") @@ -179,18 +188,19 @@ mutual let pairs := args[0]! let body := args[1]! let result := match pairs with - | Types.listVal v => evalLetArgs ref v - | Types.vecVal v => evalLetArgs ref (toList v) + | Types.listVal v => evalLetArgs ref.increment v + | Types.vecVal v => evalLetArgs ref.increment (toList v) | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") | Except.ok newRef => match evalTypes newRef body with | Except.error e => Except.error e - -- we do not propagate the let* environment to the parent scope - | Except.ok (_, result) => Except.ok (ref, result) + -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope + | Except.ok (letref, result) => + Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Dict := + partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := match args with | [] => Except.ok ref | [_] => Except.error (ref, "let*: unexpected syntax") @@ -199,7 +209,7 @@ mutual | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => - evalLetArgs (addEntry updatedRef (KeyType.strKey key) value) rest + evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := @@ -253,8 +263,8 @@ mutual if catchBody.length < 2 then Except.error (errRef, "try*: unexpected syntax") else let toeval := catchBody[2]! - let built := buildDictWithSymbols ref [errorSymbol] [err] - let merged := mergeDicts ref built + let built := buildDictWithSymbols ref.getDict ref.getLevel [errorSymbol] [err] + let merged := ref.mergeDict (ref.getLevel + 1) built evalTypes merged toeval | _ => Except.error (ref, s!"unexpected return type, expected: symbol") else Except.error evalErr @@ -272,21 +282,23 @@ mutual | Types.symbolVal sym => match fn with | Types.funcVal _ => - match first with - | Types.atomVal x => match x with - | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.v res)) - Except.ok (newRef, res) - | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") - | Except.ok (updatedRef, res) => - let newRef := addEntry updatedRef (KeyType.strKey sym) (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newRef, res) - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + match ref.get (KeyType.strKey sym) with + | none => Except.error (ref, s!"{sym} not found") + | some (level, _) => match first with + | Types.atomVal x => match x with + | Atom.v v => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (_, res) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + Except.ok (newRef, res) + | Atom.withmeta v meta => + match evalFuncVal ref fn ([v] ++ rest) with + | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.ok (_, res) => + let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newRef, res) + | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") @@ -328,7 +340,7 @@ mutual | _ => ast partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := - match args.foldl (fun (res : Except (Env × String) (Dict × List Types)) x => + match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => match res with | Except.error e => Except.error e | Except.ok (r, acc) => @@ -469,7 +481,7 @@ def rep (ref: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Dict) : IO Unit := +def printLogs (ref : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log @@ -491,9 +503,8 @@ def fnDefs: List String := [ def main : IO Unit := do IO.println "Welcome to Mal REPL!" - let (env0, _) := loadMalFns.{u} (loadFnNativeAll Dict.empty) fnDefs + let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let mut env := env0 - let mut donext := true while donext do IO.print "user> " From d800351e9f4c4145d146d7e568c3375520e5acff Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 18:01:10 +0200 Subject: [PATCH 22/39] lean: eval function fixes --- impls/lean/LeanMal/step9_try.lean | 61 +++++++++++++++++-------------- impls/lean/LeanMal/stepA_mal.lean | 61 +++++++++++++++++-------------- 2 files changed, 68 insertions(+), 54 deletions(-) diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index 59cd100124..712100dae2 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -42,37 +42,44 @@ mutual match evalTypes ref head with | Except.error e => Except.error e | Except.ok (ref2, fn) => - match evalFuncVal ref2 fn args with + match evalFuncVal ref2 fn args true with | Except.error e => Except.error e | Except.ok (fref, res) => -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : Except (Env × String) (Env × Types) := match fn with | Types.funcVal v => match v with | Fun.builtin name => - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newRef, results) => - evalFnNative newRef name results args + match if !evaluateArgs then Except.ok (ref, args) else + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + with + | Except.error e => Except.error e + | Except.ok (newRef, results) => evalFnNative newRef name results args | Fun.userDefined fref params body => - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newRef, results) => - let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys - let normalArgs := results.take keys.length - let variadicArg := results.drop keys.length - let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 - - let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newRef.merge fref).mergeDict argsLevel argsDict - - evalTypes merged body + match if !evaluateArgs then Except.ok (ref, args) else + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newRef.merge fref).mergeDict argsLevel argsDict + + evalTypes merged body | Fun.macroFn fref params body => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false @@ -287,13 +294,13 @@ mutual | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with + match evalFuncVal ref fn ([v] ++ rest) false with | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") | Except.ok (_, res) => let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) Except.ok (newRef, res) | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with + match evalFuncVal ref fn ([v] ++ rest) false with | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") | Except.ok (_, res) => let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) @@ -344,7 +351,7 @@ mutual match res with | Except.error e => Except.error e | Except.ok (r, acc) => - match evalFuncVal r fn [x] with + match evalFuncVal r fn [x] false with | Except.error e => Except.error e | Except.ok (updatedRef, res) => Except.ok (updatedRef, acc ++ [res]) @@ -374,9 +381,9 @@ mutual let firstargs := lst.drop 1 |>.take n match vecargs with | Types.listVal v => - evalFuncVal ref fn (firstargs ++ v) + evalFuncVal ref fn (firstargs ++ v) false | Types.vecVal v => - evalFuncVal ref fn (firstargs ++ (toList v)) + evalFuncVal ref fn (firstargs ++ (toList v)) false | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index b3faa30166..eff384f8e2 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -42,37 +42,44 @@ mutual match evalTypes ref head with | Except.error e => Except.error e | Except.ok (ref2, fn) => - match evalFuncVal ref2 fn args with + match evalFuncVal ref2 fn args true with | Except.error e => Except.error e | Except.ok (fref, res) => -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : Except (Env × String) (Env × Types) := match fn with | Types.funcVal v => match v with | Fun.builtin name => - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newRef, results) => - evalFnNative newRef name results args + match if !evaluateArgs then Except.ok (ref, args) else + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + with + | Except.error e => Except.error e + | Except.ok (newRef, results) => evalFnNative newRef name results args | Fun.userDefined fref params body => - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newRef, results) => - let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys - let normalArgs := results.take keys.length - let variadicArg := results.drop keys.length - let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 - - let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newRef.merge fref).mergeDict argsLevel argsDict - - evalTypes merged body + match if !evaluateArgs then Except.ok (ref, args) else + match evalFuncArgs ref args with + | Except.error e => Except.error e + | Except.ok (newRef, results) => Except.ok (newRef, results) + with + | Except.error e => Except.error e + | Except.ok (newRef, results) => + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newRef.merge fref).mergeDict argsLevel argsDict + + evalTypes merged body | Fun.macroFn fref params body => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false @@ -287,13 +294,13 @@ mutual | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with + match evalFuncVal ref fn ([v] ++ rest) false with | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") | Except.ok (_, res) => let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) Except.ok (newRef, res) | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with + match evalFuncVal ref fn ([v] ++ rest) false with | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") | Except.ok (_, res) => let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) @@ -344,7 +351,7 @@ mutual match res with | Except.error e => Except.error e | Except.ok (r, acc) => - match evalFuncVal r fn [x] with + match evalFuncVal r fn [x] false with | Except.error e => Except.error e | Except.ok (updatedRef, res) => Except.ok (updatedRef, acc ++ [res]) @@ -374,9 +381,9 @@ mutual let firstargs := lst.drop 1 |>.take n match vecargs with | Types.listVal v => - evalFuncVal ref fn (firstargs ++ v) + evalFuncVal ref fn (firstargs ++ v) false | Types.vecVal v => - evalFuncVal ref fn (firstargs ++ (toList v)) + evalFuncVal ref fn (firstargs ++ (toList v)) false | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := From ca9d2c30d39d4e2ba34435dc5f9921ddc5301970 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 18:11:50 +0200 Subject: [PATCH 23/39] lean: fix conj --- impls/lean/LeanMal/core.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index e831c1af82..514629787e 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -524,7 +524,7 @@ def conj (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) : let first := lst[0]! let rest := lst.drop 1 match first with - | Types.listVal v => Except.ok (ref, Types.listVal (v ++ rest)) + | Types.listVal v => Except.ok (ref, Types.listVal ( rest.reverse ++ v)) | Types.vecVal v => Except.ok (ref, Types.vecVal (listToVec ((toList v) ++ rest))) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") From 562f84e48167ff0bb3dd0fe296fcefeb0f78363e Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 21:15:47 +0200 Subject: [PATCH 24/39] add *ARGV* --- impls/lean/LeanMal/core.lean | 3 +-- impls/lean/LeanMal/step6_file.lean | 5 +++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 514629787e..f11f9c34b3 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -624,8 +624,7 @@ def loadFnNativeAll (ref : Env) : Env := ).add (KeyType.strKey KEY_DEBUG_EVAL) 0 (Types.boolVal false) def setSymbol (ref : Env) (name: String) (value: Types): Env := - let newRef := loadFnNative ref name - newRef.add (KeyType.strKey name) 0 value + ref.add (KeyType.strKey name) 0 value -- forward mutated atoms defined in the outer environments -- outer environments always have a lower level index diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 281455c234..1054e0c48e 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -298,10 +298,11 @@ def fnDefs: List String := [ "(def! not (fn* (a) (if a false true)))", ] -def main : IO Unit := do +def main (args : List String) : IO Unit := do IO.println "Welcome to Mal REPL!" let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let mut env := env0 + let astArgs := (args.map (fun arg => Types.strVal arg)) + let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) let mut donext := true while donext do IO.print "user> " From ed09a9de4e4eaa227f7736a3674d0c7667e30641 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 21:41:51 +0200 Subject: [PATCH 25/39] lean: cli args & main loop changes --- impls/lean/LeanMal/step0_repl.lean | 1 - impls/lean/LeanMal/step1_read_print.lean | 1 - impls/lean/LeanMal/step2_eval.lean | 1 - impls/lean/LeanMal/step3_env.lean | 1 - impls/lean/LeanMal/step4_if_fn_do.lean | 1 - impls/lean/LeanMal/step5_tco.lean | 1 - impls/lean/LeanMal/step6_file.lean | 8 +++++++- impls/lean/LeanMal/step7_quote.lean | 13 ++++++++++--- impls/lean/LeanMal/step8_macros.lean | 13 ++++++++++--- impls/lean/LeanMal/step9_try.lean | 13 ++++++++++--- impls/lean/LeanMal/stepA_mal.lean | 18 +++++++++++++++--- 11 files changed, 52 insertions(+), 19 deletions(-) diff --git a/impls/lean/LeanMal/step0_repl.lean b/impls/lean/LeanMal/step0_repl.lean index 33bc7b379d..b582913979 100644 --- a/impls/lean/LeanMal/step0_repl.lean +++ b/impls/lean/LeanMal/step0_repl.lean @@ -10,7 +10,6 @@ def rep (input : String): String := PRINT (EVAL (READ input) "") def main : IO Unit := do - IO.println "Welcome to Mal REPL!" let mut donext := true while donext do IO.print "user> " diff --git a/impls/lean/LeanMal/step1_read_print.lean b/impls/lean/LeanMal/step1_read_print.lean index 282a5c3e72..7c3f4f5b75 100644 --- a/impls/lean/LeanMal/step1_read_print.lean +++ b/impls/lean/LeanMal/step1_read_print.lean @@ -19,7 +19,6 @@ def rep (input : String): String := s!"Parsing failed: {err}" def main : IO Unit := do - IO.println "Welcome to Mal REPL!" let mut donext := true while donext do IO.print "user> " diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean index 3e46d5869d..0f225c0458 100644 --- a/impls/lean/LeanMal/step2_eval.lean +++ b/impls/lean/LeanMal/step2_eval.lean @@ -141,7 +141,6 @@ def rep (input : String): String := s!"Parsing failed: {err}" def main : IO Unit := do - IO.println "Welcome to Mal REPL!" let mut donext := true while donext do IO.print "user> " diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index 04f86838ea..a2aefe23c8 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -198,7 +198,6 @@ def rep (ref: Env) (input : String): Env × String := | Except.error err => (ref, s!"Parsing failed: {err}") def main : IO Unit := do - IO.println "Welcome to Mal REPL!" let mut env := loadFnNativeAll (Env.data 0 Dict.empty) let mut donext := true while donext do diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index 76ccc98c6f..d3128b93d7 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -251,7 +251,6 @@ def fnDefs: List String := [ ] def main : IO Unit := do - IO.println "Welcome to Mal REPL!" let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let mut env := env0 let mut donext := true diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index 7eb90737de..c9f697da42 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -251,7 +251,6 @@ def fnDefs: List String := [ ] def main : IO Unit := do - IO.println "Welcome to Mal REPL!" let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let mut env := env0 let mut donext := true diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 1054e0c48e..b411ad9ca6 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -299,10 +299,16 @@ def fnDefs: List String := [ ] def main (args : List String) : IO Unit := do - IO.println "Welcome to Mal REPL!" let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let astArgs := (args.map (fun arg => Types.strVal arg)) let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) + + if args.length > 0 then + let (ref, val) := rep.{u} env s!"(load-file \"{args[0]!}\")" + printLogs ref + IO.println val + else + let mut donext := true while donext do IO.print "user> " diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index 0feb88e8ae..f6ed16f680 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -339,10 +339,17 @@ def fnDefs: List String := [ "(def! not (fn* (a) (if a false true)))", ] -def main : IO Unit := do - IO.println "Welcome to Mal REPL!" +def main (args : List String) : IO Unit := do let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let mut env := env0 + let astArgs := (args.map (fun arg => Types.strVal arg)) + let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) + + if args.length > 0 then + let (ref, val) := rep.{u} env s!"(load-file \"{args[0]!}\")" + printLogs ref + IO.println val + else + let mut donext := true while donext do IO.print "user> " diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index a8c0e11e76..736af8a9a6 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -385,10 +385,17 @@ def fnDefs: List String := [ "(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)))))))", ] -def main : IO Unit := do - IO.println "Welcome to Mal REPL!" +def main (args : List String) : IO Unit := do let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let mut env := env0 + let astArgs := (args.map (fun arg => Types.strVal arg)) + let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) + + if args.length > 0 then + let (ref, val) := rep.{u} env s!"(load-file \"{args[0]!}\")" + printLogs ref + IO.println val + else + let mut donext := true while donext do IO.print "user> " diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index 712100dae2..a9d5f31da7 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -505,10 +505,17 @@ def fnDefs: List String := [ "(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)))))))", ] -def main : IO Unit := do - IO.println "Welcome to Mal REPL!" +def main (args : List String) : IO Unit := do let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let mut env := env0 + let astArgs := (args.map (fun arg => Types.strVal arg)) + let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) + + if args.length > 0 then + let (ref, val) := rep.{u} env s!"(load-file \"{args[0]!}\")" + printLogs ref + IO.println val + else + let mut donext := true while donext do IO.print "user> " diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index eff384f8e2..925d5dd375 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -508,10 +508,22 @@ def fnDefs: List String := [ "(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)))))))", ] -def main : IO Unit := do - IO.println "Welcome to Mal REPL!" +def main (args : List String) : IO Unit := do let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let mut env := env0 + let astArgs := (args.map (fun arg => Types.strVal arg)) + let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) + + if args.length > 0 then + let (ref, val) := rep.{u} env s!"(load-file \"{args[0]!}\")" + printLogs ref + IO.println val + return + else + + let (ref, val) := rep.{u} env s!"(println (str \"Mal [\" *host-language* \"]\"))" + printLogs ref + IO.println val + let mut donext := true while donext do IO.print "user> " From a326937f0c265dd02689b111f860f06dbed2fc7c Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 21:56:48 +0200 Subject: [PATCH 26/39] replace Except with IO --- impls/lean/LeanMal/core.lean | 72 +++++++++++++------------- impls/lean/LeanMal/step2_eval.lean | 22 ++++---- impls/lean/LeanMal/step3_env.lean | 70 ++++++++++++------------- impls/lean/LeanMal/step4_if_fn_do.lean | 24 ++++----- impls/lean/LeanMal/step5_tco.lean | 24 ++++----- impls/lean/LeanMal/step6_file.lean | 28 +++++----- impls/lean/LeanMal/step7_quote.lean | 28 +++++----- impls/lean/LeanMal/step8_macros.lean | 30 +++++------ impls/lean/LeanMal/step9_try.lean | 38 +++++++------- impls/lean/LeanMal/stepA_mal.lean | 38 +++++++------- 10 files changed, 187 insertions(+), 187 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index f11f9c34b3..3aa10096fb 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -5,7 +5,7 @@ import LeanMal.reader universe u -def sum (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def sum (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -14,7 +14,7 @@ def sum (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x + y)) | _ => Except.error (ref, "+ operator not supported") -def sub (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def sub (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -23,7 +23,7 @@ def sub (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x - y)) | _ => Except.error (ref, "- operator not supported") -def mul (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def mul (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -32,7 +32,7 @@ def mul (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x * y)) | _ => Except.error (ref, "* operator not supported") -def div (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def div (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -50,7 +50,7 @@ def ltInternal (first: Types) (second: Types) (orEq: Bool) : Bool := | Types.strVal n, Types.strVal v => n < v || (if orEq then n == v else false) | _, _ => false -def lt (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def lt (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") else let first := lst[0]! @@ -58,7 +58,7 @@ def lt (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := let res := ltInternal first second false Except.ok (ref, Types.boolVal res) -def lte (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def lte (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") else let first := lst[0]! @@ -75,7 +75,7 @@ def gtInternal (first: Types) (second: Types) (orEq: Bool) : Bool := | Types.strVal n, Types.strVal v => n > v || (if orEq then n == v else false) | _, _ => false -def gt (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def gt (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") else let first := lst[0]! @@ -83,7 +83,7 @@ def gt (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := let res := gtInternal first second false Except.ok (ref, Types.boolVal res) -def gte (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def gte (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") else let first := lst[0]! @@ -150,7 +150,7 @@ mutual end -def eq (ref : Env) (lst: List Types) (strict: Bool) : Except (Env × String) (Env × Types) := +def eq (ref : Env) (lst: List Types) (strict: Bool) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") else let first := lst[0]! @@ -158,13 +158,13 @@ def eq (ref : Env) (lst: List Types) (strict: Bool) : Except (Env × String) (En let res := eqInternal first second strict Except.ok (ref, Types.boolVal res) -def makeAtom (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def makeAtom (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "keyword: 1 argument required") else let first := lst[0]! Except.ok (ref, Types.atomVal (Atom.v first)) -def derefAtom (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def derefAtom (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "deref: 1 argument required") else let first := lst[0]! @@ -174,7 +174,7 @@ def derefAtom (ref : Env) (lst: List Types) : Except (Env × String) (Env × Typ | Atom.withmeta v _ => Except.ok (ref, v) | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") -def resetAtom (ref : Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := +def resetAtom (ref : Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "reset!: 2 argument required") else let first := lst[0]! @@ -239,25 +239,25 @@ def logInfo (ref : Env) (msg: String): Env := let newlogs := loglist ++ [(Types.strVal msg)] ref.add (KeyType.strKey KEY_LOGS_INFO) 0 (Types.listVal newlogs) -def prStrFunc (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def prStrFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do let str := prStrInternal lst true " " Except.ok (ref, Types.strVal str) -def prnFunc (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def prnFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do let str := prStrInternal lst true " " let newRef := logInfo ref str Except.ok (newRef, Types.Nil) -def printlnFunc (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def printlnFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do let str := prStrInternal lst false " " let newRef := logInfo ref str Except.ok (newRef, Types.Nil) -def strFunc (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def strFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do let str := prStrInternal lst false "" Except.ok (ref, Types.strVal str) -def countFunc(ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def countFunc(ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "count: 1 argument required") else let x := lst[0]! @@ -275,7 +275,7 @@ def readString (lst: List Types) (envir: Env) : Except String Types := | Types.strVal v => read_types_with_env v envir.getDict -- Dict.empty | x => Except.error s!"unexpected symbol: {x.toString true}, expected: string" -def cons (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def cons (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "cons: >= 2 arguments required") else let elem := lst[0]! @@ -285,7 +285,7 @@ def cons (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) : | Types.vecVal v => Except.ok (ref, (Types.listVal (elem :: (toList v)))) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") -def concat (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def concat (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.ok (ref, Types.listVal []) else match lst.foldl (fun (acc: Except (Env × String) (List Types)) x => @@ -300,7 +300,7 @@ def concat (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) | Except.error e => Except.error e | Except.ok v => Except.ok (ref, Types.listVal v) -def makeVec (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def makeVec (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "vec: 1 arguments required") else let first := lst[0]! @@ -309,7 +309,7 @@ def makeVec (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types | Types.listVal v => Except.ok (ref, Types.vecVal (listToVec v)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") -def nthSeq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def nthSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "nth: >= 2 arguments required") else let first := lst[0]! @@ -331,7 +331,7 @@ def nthSeq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: number") -def firstSeq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def firstSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "first: 1 arguments required") else let first := lst[0]! @@ -350,7 +350,7 @@ def firstSeq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Type Except.ok (ref, elem) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") -def restSeq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def restSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "rest: 1 arguments required") else let first := lst[0]! @@ -367,7 +367,7 @@ def restSeq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types Except.ok (ref, Types.listVal (lv.drop 1)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") -def makeVector (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def makeVector (ref : Env) (lst: List Types) : IO (Env × Types) := do Except.ok (ref, Types.vecVal (listToVec lst)) def makeDictInternal (initialDict : Dict) (lst: List Types) : Except String (Dict) := @@ -385,12 +385,12 @@ def makeDictInternal (initialDict : Dict) (lst: List Types) : Except String (Dic | Except.error e => Except.error e | Except.ok (v, _) => Except.ok v -def makeDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def makeDict (ref : Env) (lst: List Types) : IO (Env × Types) := do match makeDictInternal Dict.empty lst with | Except.error e => Except.error (ref, e) | Except.ok (newDict) => Except.ok (ref, Types.dictVal newDict) -def assocDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def assocDict (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "assoc: >= 1 arguments required") else let first := lst[0]! @@ -417,7 +417,7 @@ def dissoc (dict : Dict) (keys : List Types) : Except String Dict := | x => Except.error s!"unexpected symbol: {x.toString true}, expected: keyword or string" loop keys dict -def dissocDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def dissocDict (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "dissoc: >= 1 arguments required") else let first := lst[0]! @@ -429,7 +429,7 @@ def dissocDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Ty | Except.ok newDict => Except.ok (ref, Types.dictVal newDict) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") -def getDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def getDict (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "get: >= 1 arguments required") else let first := lst[0]! @@ -452,7 +452,7 @@ def getDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types | Types.Nil => Except.ok (ref, Types.Nil) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") -def containsDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def containsDict (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "contains?: >= 1 arguments required") else let first := lst[0]! @@ -475,7 +475,7 @@ def containsDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × | Types.Nil => Except.ok (ref, Types.boolVal false) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") -def getKeysDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def getKeysDict (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "keys: 1 arguments required") else let first := lst[0]! @@ -490,7 +490,7 @@ def getKeysDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × T Except.ok (ref, (Types.listVal result)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") -def getValuesDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def getValuesDict (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "get: 1 arguments required") else let first := lst[0]! @@ -500,7 +500,7 @@ def getValuesDict (ref : Env) (lst: List Types) : Except (Env × String) (Env × Except.ok (ref, (Types.listVal values)) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") -def makeSymbol (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def makeSymbol (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "symbol: 1 argument required") else let first := lst[0]! @@ -509,7 +509,7 @@ def makeSymbol (ref : Env) (lst: List Types) : Except (Env × String) (Env × Ty | Types.strVal v => Except.ok (ref, Types.symbolVal v) | x => Except.error (ref, s!"symbol: unexpected symbol: {x.toString true}, expected: string") -def makeKeyword (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def makeKeyword (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "keyword: 1 argument required") else let first := lst[0]! @@ -518,7 +518,7 @@ def makeKeyword (ref : Env) (lst: List Types) : Except (Env × String) (Env × T | Types.strVal v => Except.ok (ref, Types.keywordVal v) | x => Except.error (ref, s!"keyword: unexpected symbol: {x.toString true}, expected: string") -def conj (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def conj (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "conj: >= 1 arguments required") else let first := lst[0]! @@ -528,7 +528,7 @@ def conj (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) : | Types.vecVal v => Except.ok (ref, Types.vecVal (listToVec ((toList v) ++ rest))) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") -def seq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := +def seq (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "conj: 1 arguments required") else let first := lst[0]! @@ -545,7 +545,7 @@ def seq (ref : Env) (lst: List Types) : Except (Env × String) (Env × Types) := Except.ok (ref, Types.listVal lv) | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list, vector or string") -partial def throwFn (ref : Env) (lst : List Types) : Except (Env × String) (Env × Types) := +partial def throwFn (ref : Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "panic") else let a := lst[0]! diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean index 0f225c0458..e7a0a7719a 100644 --- a/impls/lean/LeanMal/step2_eval.lean +++ b/impls/lean/LeanMal/step2_eval.lean @@ -6,7 +6,7 @@ universe u def READ (input : String): Except String Types := read_str.{u} input -def sum (ref : Env) (lst: List Types) : Except String (Env × Types) := +def sum (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -15,7 +15,7 @@ def sum (ref : Env) (lst: List Types) : Except String (Env × Types) := | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x + y)) | _ => Except.error "+ operator not supported" -def sub (ref : Env) (lst: List Types) : Except String (Env × Types) := +def sub (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -24,7 +24,7 @@ def sub (ref : Env) (lst: List Types) : Except String (Env × Types) := | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x - y)) | _ => Except.error "- operator not supported" -def mul (ref : Env) (lst: List Types) : Except String (Env × Types) := +def mul (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -33,7 +33,7 @@ def mul (ref : Env) (lst: List Types) : Except String (Env × Types) := | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x * y)) | _ => Except.error "* operator not supported" -def div (ref : Env) (lst: List Types) : Except String (Env × Types) := +def div (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with | [] => Except.ok (ref, Types.intVal 0) | [Types.intVal x] => Except.ok (ref, Types.intVal x) @@ -42,7 +42,7 @@ def div (ref : Env) (lst: List Types) : Except String (Env × Types) := | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x / y)) | _ => Except.error "/ operator not supported" -def evalFnNative (ref : Env) (name: String) (results: List Types): Except String (Env × Types) := +def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results @@ -52,7 +52,7 @@ def evalFnNative (ref : Env) (name: String) (results: List Types): Except String mutual - partial def evalTypes (ref : Env) (ast : Types) : Except String (Env × Types) := + partial def evalTypes (ref : Env) (ast : Types) : IO (Env × Types) := do match ast with | Types.symbolVal v => match ref.get (KeyType.strKey v) with | some (_, vi) => Except.ok (ref, vi) @@ -62,12 +62,12 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except String (Env × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error e => Except.error s!"error evaluating function: {head.toString true}: {e}" | Except.ok (_, fn) => evalFuncVal ref fn args - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except String (Env × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -86,7 +86,7 @@ mutual | Fun.macroFn _ _ _ => Except.error "macro not implemented" | _ => Except.error s!"`unexpected token, expected: function`" - partial def evalList (ref: Env) (lst : List Types) : Except String (Env × Types) := + partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -95,12 +95,12 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : Except String (Env × Types) := + partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : Except String (Env × Types) := + partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index a2aefe23c8..b98e3e36d1 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -7,43 +7,43 @@ universe u def READ (input : String): Except String Types := read_str.{u} input -def sum (ref : Env) (lst: List Types) : Except String (Env × Types) := +def sum (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x + y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x + y)) + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x + y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x + y)) | _ => Except.error "+ operator not supported" -def sub (ref : Env) (lst: List Types) : Except String (Env × Types) := +def sub (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x - y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x - y)) + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x - y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x - y)) | _ => Except.error "- operator not supported" -def mul (ref : Env) (lst: List Types) : Except String (Env × Types) := +def mul (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x * y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x * y)) + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x * y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x * y)) | _ => Except.error "* operator not supported" -def div (ref : Env) (lst: List Types) : Except String (Env × Types) := +def div (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x / y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x / y)) + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x / y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x / y)) | _ => Except.error "/ operator not supported" -def evalFnNative (ref : Env) (name: String) (results: List Types): Except String (Env × Types) := +def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results @@ -53,22 +53,22 @@ def evalFnNative (ref : Env) (name: String) (results: List Types): Except String mutual - partial def evalTypes (ref : Env) (ast : Types) : Except String (Env × Types) := + partial def evalTypes (ref : Env) (ast : Types) : IO (Env × Types) := do match ast with | Types.symbolVal v => match ref.get (KeyType.strKey v) with - | some (_, vi) => Except.ok (ref, vi) + | some (_, vi) => return (ref, vi) | none => Except.error s!"'{v}' not found" | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) - | x => Except.ok (ref, x) + | x => return (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except String (Env × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error e => Except.error s!"error evaluating function: {head.toString true}: {e}" | Except.ok (_, fn) => evalFuncVal ref fn args - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except String (Env × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -87,7 +87,7 @@ mutual | Fun.macroFn _ _ _ => Except.error "macro not implemented" | _ => Except.error s!"`unexpected token, expected: function`" - partial def evalList (ref: Env) (lst : List Types) : Except String (Env × Types) := + partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -98,12 +98,12 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : Except String (Env × Types) := + partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : Except String (Env × Types) := + partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) @@ -131,7 +131,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Env) (args : List Types) : Except String (Env × Types) := + partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error "def! unexpected syntax" else let key := args[0]! @@ -145,7 +145,7 @@ mutual Except.ok (refResult, value) | _ => Except.error s!"def! unexpected token, expected: symbol" - partial def evalLet (ref: Env) (args : List Types) : Except String (Env × Types) := + partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error "let*: unexpected syntax" else let pairs := args[0]! diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index d3128b93d7..e1e64954cc 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := +def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let p := args[0]! @@ -26,7 +26,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => @@ -47,7 +47,7 @@ mutual -- only propagate logs after executing a function | Except.ok (fref, res) => Except.ok (forwardLogs fref ref, res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -72,7 +72,7 @@ mutual | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -86,12 +86,12 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := + partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := + partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) @@ -119,7 +119,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -133,7 +133,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -162,7 +162,7 @@ mutual evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -170,7 +170,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -188,7 +188,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def evalFnNative (ref : Env) (name: String) (results: List Types): Except (Env × String) (Env × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index c9f697da42..593b7c759e 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := +def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let p := args[0]! @@ -26,7 +26,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => @@ -48,7 +48,7 @@ mutual -- only propagate logs after executing a function Except.ok (forwardLogs fref ref, res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -73,7 +73,7 @@ mutual | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -87,12 +87,12 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := + partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := + partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) @@ -120,7 +120,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -134,7 +134,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -163,7 +163,7 @@ mutual evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -171,7 +171,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -189,7 +189,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def evalFnNative (ref : Env) (name: String) (results: List Types): Except (Env × String) (Env × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index b411ad9ca6..f224ee9b9d 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := +def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let p := args[0]! @@ -26,7 +26,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => @@ -48,7 +48,7 @@ mutual -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -73,7 +73,7 @@ mutual | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -87,12 +87,12 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := + partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := + partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) @@ -120,7 +120,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -134,7 +134,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -164,7 +164,7 @@ mutual evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -172,7 +172,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -190,7 +190,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! @@ -220,13 +220,13 @@ mutual | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") else let ast := lst[0]! evalTypes ref ast - partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index f6ed16f680..f65697f26c 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := +def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let p := args[0]! @@ -26,7 +26,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => @@ -48,7 +48,7 @@ mutual -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e @@ -73,7 +73,7 @@ mutual | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") | _ => Except.error (newRef, s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -93,12 +93,12 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := + partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := + partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) @@ -126,7 +126,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -140,7 +140,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -170,7 +170,7 @@ mutual evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -178,7 +178,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -196,7 +196,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! @@ -226,7 +226,7 @@ mutual | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") else let ast := lst[0]! @@ -263,7 +263,7 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index 736af8a9a6..d7cf4abb3b 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := +def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let p := args[0]! @@ -26,7 +26,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => @@ -48,7 +48,7 @@ mutual -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do match fn with | Types.funcVal v => match v with | Fun.builtin name => @@ -90,7 +90,7 @@ mutual | Except.ok (_, newast) => evalTypes ref newast | _ => Except.error (ref, s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -111,12 +111,12 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := + partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := + partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) @@ -144,7 +144,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -158,7 +158,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalDefMacro (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDefMacro (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -181,7 +181,7 @@ mutual | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -211,7 +211,7 @@ mutual evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -219,7 +219,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -237,7 +237,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! @@ -267,7 +267,7 @@ mutual | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") else let ast := lst[0]! @@ -304,7 +304,7 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index a9d5f31da7..6bd71d2ceb 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := +def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let p := args[0]! @@ -26,7 +26,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error e => Except.error e | Except.ok (ref2, fn) => @@ -48,7 +48,7 @@ mutual -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : Except (Env × String) (Env × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : IO (Env × Types) := do match fn with | Types.funcVal v => match v with | Fun.builtin name => @@ -97,7 +97,7 @@ mutual | Except.ok (_, newast) => evalTypes ref newast | _ => Except.error (ref, s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -119,12 +119,12 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := + partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := + partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) @@ -152,7 +152,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -166,7 +166,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalDefMacro (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDefMacro (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -189,7 +189,7 @@ mutual | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -219,7 +219,7 @@ mutual evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -227,7 +227,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -245,7 +245,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def evalTry (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def evalTry (ref: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "try*: unexpected syntax") else match evalTypes ref lst[0]! with @@ -279,7 +279,7 @@ mutual -- | Types.vecVal v => -- TODO | _ => Except.error evalErr - partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! @@ -309,7 +309,7 @@ mutual | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") else let ast := lst[0]! @@ -346,7 +346,7 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => match res with | Except.error e => Except.error e @@ -359,7 +359,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.listVal results) - partial def nativeMap (ref: Env) (lst: List Types) : Except (Env × String) (Env × Types) := + partial def nativeMap (ref: Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "map: unexpected syntax") else let fn := lst[0]! @@ -372,7 +372,7 @@ mutual | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: function") - partial def nativeApply (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def nativeApply (ref: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "apply: unexpected syntax") else let fn := lst[0]! @@ -386,7 +386,7 @@ mutual evalFuncVal ref fn (firstargs ++ (toList v)) false | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") - partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index 925d5dd375..3a9ef847f7 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := +def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let p := args[0]! @@ -26,7 +26,7 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : Except (Env × String) (Env × Types) := + partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" else _ref match ast with @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error e => Except.error e | Except.ok (ref2, fn) => @@ -48,7 +48,7 @@ mutual -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : Except (Env × String) (Env × Types) := + partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : IO (Env × Types) := do match fn with | Types.funcVal v => match v with | Fun.builtin name => @@ -97,7 +97,7 @@ mutual | Except.ok (_, newast) => evalTypes ref newast | _ => Except.error (ref, s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -119,12 +119,12 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : Except (Env × String) (Env × Types) := + partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : Except (Env × String) (Env × Types) := + partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) @@ -152,7 +152,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, results) - partial def evalDefn (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -166,7 +166,7 @@ mutual Except.ok (refResult, value) | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalDefMacro (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDefMacro (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "def! unexpected syntax") else let key := args[0]! @@ -189,7 +189,7 @@ mutual | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "let*: unexpected syntax") else let pairs := args[0]! @@ -219,7 +219,7 @@ mutual evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => Except.error (ref, "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e @@ -227,7 +227,7 @@ mutual if results.length == 0 then Except.ok (newRef, Types.Nil) else Except.ok (newRef, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : Except (Env × String) (Env × Types) := + partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error (ref, "unexpected syntax") else let condition := args[0]! @@ -245,7 +245,7 @@ mutual else if hasElse then evalTypes newRef args[2]! else Except.ok (newRef, Types.Nil) - partial def evalTry (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def evalTry (ref: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "try*: unexpected syntax") else match evalTypes ref lst[0]! with @@ -279,7 +279,7 @@ mutual -- | Types.vecVal v => -- TODO | _ => Except.error evalErr - partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") else let first := lst[0]! @@ -309,7 +309,7 @@ mutual | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") else let ast := lst[0]! @@ -346,7 +346,7 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : Except (Env × String) (Env × Types) := + partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => match res with | Except.error e => Except.error e @@ -359,7 +359,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, results) => Except.ok (newRef, Types.listVal results) - partial def nativeMap (ref: Env) (lst: List Types) : Except (Env × String) (Env × Types) := + partial def nativeMap (ref: Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "map: unexpected syntax") else let fn := lst[0]! @@ -372,7 +372,7 @@ mutual | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: function") - partial def nativeApply (ref: Env) (lst : List Types) : Except (Env × String) (Env × Types) := + partial def nativeApply (ref: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 2 then Except.error (ref, "apply: unexpected syntax") else let fn := lst[0]! @@ -386,7 +386,7 @@ mutual evalFuncVal ref fn (firstargs ++ (toList v)) false | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") - partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): Except (Env × String) (Env × Types) := + partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results From 3e48bef7bc74a3bd048477c69fd33af9c86ce6f1 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 23:08:19 +0200 Subject: [PATCH 27/39] use IO --- impls/lean/LeanMal/core.lean | 168 ++++++++++++------------- impls/lean/LeanMal/step2_eval.lean | 64 +++++----- impls/lean/LeanMal/step3_env.lean | 18 +-- impls/lean/LeanMal/step4_if_fn_do.lean | 26 ++-- impls/lean/LeanMal/step5_tco.lean | 26 ++-- impls/lean/LeanMal/step6_file.lean | 40 +++--- impls/lean/LeanMal/step7_quote.lean | 44 +++---- impls/lean/LeanMal/step8_macros.lean | 48 +++---- impls/lean/LeanMal/step9_try.lean | 68 +++++----- impls/lean/LeanMal/stepA_mal.lean | 74 +++++------ 10 files changed, 288 insertions(+), 288 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 3aa10096fb..fd662498b7 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -7,39 +7,39 @@ universe u def sum (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x + y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x + y)) - | _ => Except.error (ref, "+ operator not supported") + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x + y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x + y)) + | _ => throw (IO.userError "+ operator not supported") def sub (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x - y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x - y)) - | _ => Except.error (ref, "- operator not supported") + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x - y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x - y)) + | _ => throw (IO.userError "- operator not supported") def mul (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x * y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x * y)) - | _ => Except.error (ref, "* operator not supported") + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x * y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x * y)) + | _ => throw (IO.userError "* operator not supported") def div (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x / y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x / y)) - | _ => Except.error (ref, "/ operator not supported") + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x / y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x / y)) + | _ => throw (IO.userError "/ operator not supported") def ltInternal (first: Types) (second: Types) (orEq: Bool) : Bool := match first, second with @@ -51,7 +51,7 @@ def ltInternal (first: Types) (second: Types) (orEq: Bool) : Bool := | _, _ => false def lt (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") + if lst.length < 2 then throw (IO.userError "eq: 2 arguments required") else let first := lst[0]! let second := lst[1]! @@ -59,7 +59,7 @@ def lt (ref : Env) (lst: List Types) : IO (Env × Types) := do Except.ok (ref, Types.boolVal res) def lte (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") + if lst.length < 2 then throw (IO.userError "eq: 2 arguments required") else let first := lst[0]! let second := lst[1]! @@ -76,7 +76,7 @@ def gtInternal (first: Types) (second: Types) (orEq: Bool) : Bool := | _, _ => false def gt (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") + if lst.length < 2 then throw (IO.userError "eq: 2 arguments required") else let first := lst[0]! let second := lst[1]! @@ -84,7 +84,7 @@ def gt (ref : Env) (lst: List Types) : IO (Env × Types) := do Except.ok (ref, Types.boolVal res) def gte (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") + if lst.length < 2 then throw (IO.userError "eq: 2 arguments required") else let first := lst[0]! let second := lst[1]! @@ -151,7 +151,7 @@ mutual end def eq (ref : Env) (lst: List Types) (strict: Bool) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "eq: 2 arguments required") + if lst.length < 2 then throw (IO.userError "eq: 2 arguments required") else let first := lst[0]! let second := lst[1]! @@ -159,23 +159,23 @@ def eq (ref : Env) (lst: List Types) (strict: Bool) : IO (Env × Types) := do Except.ok (ref, Types.boolVal res) def makeAtom (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "keyword: 1 argument required") + if lst.length < 1 then throw (IO.userError "keyword: 1 argument required") else let first := lst[0]! Except.ok (ref, Types.atomVal (Atom.v first)) def derefAtom (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "deref: 1 argument required") + if lst.length < 1 then throw (IO.userError "deref: 1 argument required") else let first := lst[0]! match first with | Types.atomVal x => match x with | Atom.v v => Except.ok (ref, v) | Atom.withmeta v _ => Except.ok (ref, v) - | x => Except.error (ref, s!"deref: unexpected symbol: {x.toString true}, expected: atom") + | x => throw (IO.userError s!"deref: unexpected symbol: {x.toString true}, expected: atom") def resetAtom (ref : Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "reset!: 2 argument required") + if lst.length < 2 then throw (IO.userError "reset!: 2 argument required") else let first := lst[0]! let second := lst[1]! @@ -183,7 +183,7 @@ def resetAtom (ref : Env) (lst: List Types) (args: List Types) : IO (Env × Type match atomSymbol with | Types.symbolVal sym => match ref.get (KeyType.strKey sym) with - | none => Except.error (ref, s!"{sym} not found") + | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v _ => @@ -192,8 +192,8 @@ def resetAtom (ref : Env) (lst: List Types) (args: List Types) : IO (Env × Type | Atom.withmeta _ meta => let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta second meta)) Except.ok (newRef, second) - | x => Except.error (ref, s!"reset!: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"reset!: unexpected token: {x.toString true}, expected: symbol") + | x => throw (IO.userError s!"reset!: unexpected symbol: {x.toString true}, expected: atom") + | x => throw (IO.userError s!"reset!: unexpected token: {x.toString true}, expected: symbol") def prStrInternal (lst: List Types) (printReadably: Bool) (sep: String) : String := let elems := lst.map (fun x => x.toString printReadably) @@ -258,14 +258,14 @@ def strFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do Except.ok (ref, Types.strVal str) def countFunc(ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "count: 1 argument required") + if lst.length < 1 then throw (IO.userError "count: 1 argument required") else let x := lst[0]! match x with | Types.listVal v => Except.ok (ref, Types.intVal v.length) | Types.vecVal v => Except.ok (ref, Types.intVal (toList v).length) | Types.Nil => Except.ok (ref, Types.intVal 0) - | _ => Except.error (ref, "count called on non-sequence") + | _ => throw (IO.userError "count called on non-sequence") def readString (lst: List Types) (envir: Env) : Except String Types := if lst.length < 1 then Except.error "read-string: 1 arguments required" @@ -276,14 +276,14 @@ def readString (lst: List Types) (envir: Env) : Except String Types := | x => Except.error s!"unexpected symbol: {x.toString true}, expected: string" def cons (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "cons: >= 2 arguments required") + if lst.length < 2 then throw (IO.userError "cons: >= 2 arguments required") else let elem := lst[0]! let seq := lst[1]! match seq with | Types.listVal v => Except.ok (ref, (Types.listVal (elem :: v))) | Types.vecVal v => Except.ok (ref, (Types.listVal (elem :: (toList v)))) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") def concat (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then Except.ok (ref, Types.listVal []) @@ -301,16 +301,16 @@ def concat (ref : Env) (lst: List Types) : IO (Env × Types) := do | Except.ok v => Except.ok (ref, Types.listVal v) def makeVec (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "vec: 1 arguments required") + if lst.length < 1 then throw (IO.userError "vec: 1 arguments required") else let first := lst[0]! match first with | Types.vecVal v => Except.ok (ref, Types.vecVal v) | Types.listVal v => Except.ok (ref, Types.vecVal (listToVec v)) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") def nthSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "nth: >= 2 arguments required") + if lst.length < 2 then throw (IO.userError "nth: >= 2 arguments required") else let first := lst[0]! let indx := lst[1]! @@ -321,18 +321,18 @@ def nthSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do let lv := toList v match lv.get? i.toNat with | some v => Except.ok (ref, v) - | none => Except.error (ref, "nth: index out of range") + | none => throw (IO.userError "nth: index out of range") | Types.listVal lv => - if lv.length <= i then Except.error (ref, s!"nth: index out of range: {i}") + if lv.length <= i then throw (IO.userError s!"nth: index out of range: {i}") else match lv.get? i.toNat with | some v => Except.ok (ref, v) - | none => Except.error (ref, "nth: index out of range") - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: number") + | none => throw (IO.userError "nth: index out of range") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: number") def firstSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "first: 1 arguments required") + if lst.length < 1 then throw (IO.userError "first: 1 arguments required") else let first := lst[0]! match first with @@ -348,10 +348,10 @@ def firstSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do else let elem := lv[0]! Except.ok (ref, elem) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") def restSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "rest: 1 arguments required") + if lst.length < 1 then throw (IO.userError "rest: 1 arguments required") else let first := lst[0]! match first with @@ -365,7 +365,7 @@ def restSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do if lv.length < 1 then Except.ok (ref, Types.listVal []) else Except.ok (ref, Types.listVal (lv.drop 1)) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") def makeVector (ref : Env) (lst: List Types) : IO (Env × Types) := do Except.ok (ref, Types.vecVal (listToVec lst)) @@ -387,20 +387,20 @@ def makeDictInternal (initialDict : Dict) (lst: List Types) : Except String (Dic def makeDict (ref : Env) (lst: List Types) : IO (Env × Types) := do match makeDictInternal Dict.empty lst with - | Except.error e => Except.error (ref, e) + | Except.error e => throw (IO.userError e) | Except.ok (newDict) => Except.ok (ref, Types.dictVal newDict) def assocDict (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "assoc: >= 1 arguments required") + if lst.length < 1 then throw (IO.userError "assoc: >= 1 arguments required") else let first := lst[0]! let rest := lst.drop 1 match first with | Types.dictVal v => match makeDictInternal v rest with - | Except.error e => Except.error (ref, e) + | Except.error e => throw (IO.userError e) | Except.ok (newDict) => Except.ok (ref, Types.dictVal newDict) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") def dissoc (dict : Dict) (keys : List Types) : Except String Dict := let rec loop (keys : List Types) (acc : Dict) : Except String Dict := @@ -418,19 +418,19 @@ def dissoc (dict : Dict) (keys : List Types) : Except String Dict := loop keys dict def dissocDict (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "dissoc: >= 1 arguments required") + if lst.length < 1 then throw (IO.userError "dissoc: >= 1 arguments required") else let first := lst[0]! let rest := lst.drop 1 match first with | Types.dictVal v => match dissoc v rest with - | Except.error e => Except.error (ref, e) + | Except.error e => throw (IO.userError e) | Except.ok newDict => Except.ok (ref, Types.dictVal newDict) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") def getDict (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "get: >= 1 arguments required") + if lst.length < 1 then throw (IO.userError "get: >= 1 arguments required") else let first := lst[0]! let rest := lst.drop 1 @@ -448,12 +448,12 @@ def getDict (ref : Env) (lst: List Types) : IO (Env × Types) := do match v.get (KeyType.keywordKey k) with | some (_, val) => Except.ok (ref, val) | none => Except.ok (ref, Types.Nil) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: keyword or string") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: keyword or string") | Types.Nil => Except.ok (ref, Types.Nil) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") def containsDict (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "contains?: >= 1 arguments required") + if lst.length < 1 then throw (IO.userError "contains?: >= 1 arguments required") else let first := lst[0]! let rest := lst.drop 1 @@ -471,12 +471,12 @@ def containsDict (ref : Env) (lst: List Types) : IO (Env × Types) := do match v.get (KeyType.strKey k) with | some _ => Except.ok (ref, Types.boolVal true) | none => Except.ok (ref, Types.boolVal false) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: keyword or string") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: keyword or string") | Types.Nil => Except.ok (ref, Types.boolVal false) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") def getKeysDict (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "keys: 1 arguments required") + if lst.length < 1 then throw (IO.userError "keys: 1 arguments required") else let first := lst[0]! match first with @@ -488,48 +488,48 @@ def getKeysDict (ref : Env) (lst: List Types) : IO (Env × Types) := do | KeyType.keywordKey v => (Types.keywordVal v) ) Except.ok (ref, (Types.listVal result)) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") def getValuesDict (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "get: 1 arguments required") + if lst.length < 1 then throw (IO.userError "get: 1 arguments required") else let first := lst[0]! match first with | Types.dictVal v => let values := v.values Except.ok (ref, (Types.listVal values)) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: hash-map") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") def makeSymbol (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "symbol: 1 argument required") + if lst.length < 1 then throw (IO.userError "symbol: 1 argument required") else let first := lst[0]! match first with | Types.symbolVal v => Except.ok (ref, Types.symbolVal v) | Types.strVal v => Except.ok (ref, Types.symbolVal v) - | x => Except.error (ref, s!"symbol: unexpected symbol: {x.toString true}, expected: string") + | x => throw (IO.userError s!"symbol: unexpected symbol: {x.toString true}, expected: string") def makeKeyword (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "keyword: 1 argument required") + if lst.length < 1 then throw (IO.userError "keyword: 1 argument required") else let first := lst[0]! match first with | Types.keywordVal v => Except.ok (ref, Types.keywordVal v) | Types.strVal v => Except.ok (ref, Types.keywordVal v) - | x => Except.error (ref, s!"keyword: unexpected symbol: {x.toString true}, expected: string") + | x => throw (IO.userError s!"keyword: unexpected symbol: {x.toString true}, expected: string") def conj (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "conj: >= 1 arguments required") + if lst.length < 1 then throw (IO.userError "conj: >= 1 arguments required") else let first := lst[0]! let rest := lst.drop 1 match first with | Types.listVal v => Except.ok (ref, Types.listVal ( rest.reverse ++ v)) | Types.vecVal v => Except.ok (ref, Types.vecVal (listToVec ((toList v) ++ rest))) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") def seq (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "conj: 1 arguments required") + if lst.length < 1 then throw (IO.userError "conj: 1 arguments required") else let first := lst[0]! match first with @@ -543,22 +543,22 @@ def seq (ref : Env) (lst: List Types) : IO (Env × Types) := do else let lv := v.toList.map (fun x => Types.strVal (String.singleton x)) Except.ok (ref, Types.listVal lv) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list, vector or string") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list, vector or string") partial def throwFn (ref : Env) (lst : List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "panic") + if lst.length < 1 then throw (IO.userError "panic") else let a := lst[0]! match a with - | Types.strVal v => Except.error (ref, v) - | x => Except.error (ref, x.toString true) + | Types.strVal v => throw (IO.userError v) + | x => throw (IO.userError x.toString true) def readFileContent (filePath : String) : IO String := do IO.FS.readFile filePath def slurp (ref : Env) (lst: List Types) : IO (Except (Env × String) (Env × Types)) := do if lst.length < 1 then - return Except.error (ref, "slurp: 2 arguments required") + return throw (IO.userError "slurp: 2 arguments required") else match lst[0]! with | Types.strVal filename => do @@ -566,11 +566,11 @@ def slurp (ref : Env) (lst: List Types) : IO (Except (Env × String) (Env × Typ let content ← readFileContent filename return Except.ok (ref, Types.strVal content) catch e => - return Except.error (ref, s!"slurp: failed to read file: {e.toString}") + return throw (IO.userError s!"slurp: failed to read file: {e.toString}") -- return result | _ => - return Except.error (ref, "slurp: filename must be a string") + return throw (IO.userError "slurp: filename must be a string") def slurp2 (ref : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then @@ -587,7 +587,7 @@ def slurp2 (ref : Env) (lst: List Types) : IO (Env × Types) := do def evalFnNativeWithIO (ref : Env) (name: String) (results: List Types): IO (Except (Env × String) (Env × Types)) := match name with | "slurp" => slurp ref results - | _ => return Except.error (ref, s!"'{name}' not found") + | _ => return throw (IO.userError s!"'{name}' not found") def loadFnNative (ref : Env) (name: String) : Env := ref.add (KeyType.strKey name) 0 (Types.funcVal (Fun.builtin name)) diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean index e7a0a7719a..2b76c46a23 100644 --- a/impls/lean/LeanMal/step2_eval.lean +++ b/impls/lean/LeanMal/step2_eval.lean @@ -8,39 +8,39 @@ def READ (input : String): Except String Types := def sum (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x + y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x + y)) - | _ => Except.error "+ operator not supported" + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x + y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x + y)) + | _ => throw (IO.userError "+ operator not supported") def sub (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x - y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x - y)) - | _ => Except.error "- operator not supported" + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x - y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x - y)) + | _ => throw (IO.userError "- operator not supported") def mul (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x * y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x * y)) - | _ => Except.error "* operator not supported" + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x * y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x * y)) + | _ => throw (IO.userError "* operator not supported") def div (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => Except.ok (ref, Types.intVal 0) - | [Types.intVal x] => Except.ok (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => Except.ok (ref, Types.intVal (x / y)) - | [Types.floatVal x] => Except.ok (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => Except.ok (ref, Types.floatVal (x / y)) - | _ => Except.error "/ operator not supported" + | [] => return (ref, Types.intVal 0) + | [Types.intVal x] => return (ref, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x / y)) + | [Types.floatVal x] => return (ref, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x / y)) + | _ => throw (IO.userError "/ operator not supported") def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with @@ -48,19 +48,19 @@ def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Ty | "-" => sub ref results | "*" => mul ref results | "/" => div ref results - | _ => Except.error s!"'{name}' not found" + | _ => throw (IO.userError s!"'{name}' not found") mutual partial def evalTypes (ref : Env) (ast : Types) : IO (Env × Types) := do match ast with | Types.symbolVal v => match ref.get (KeyType.strKey v) with - | some (_, vi) => Except.ok (ref, vi) - | none => Except.ok (ref, Types.symbolVal v ) + | some (_, vi) => return (ref, vi) + | none => return (ref, Types.symbolVal v ) | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) - | x => Except.ok (ref, x) + | x => return (ref, x) partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with @@ -105,7 +105,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : Except String (Env × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Types) := do match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with @@ -116,8 +116,8 @@ mutual let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except String (Env × List Types) := - match args.foldl (fun (res : Except String (Env × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := do + match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error e => Except.error s!"error evaluating function argument accumulator: {x.toString true}: {e}" | Except.ok (r, acc) => match evalTypes r x with @@ -132,7 +132,7 @@ end def PRINT (ast : Types): String := pr_str true ast -def rep (input : String): String := +def rep (input : String): IO String := match READ.{u} input with | Except.ok result => match evalTypes (Env.data 0 Dict.empty) result with | Except.error e => e diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index b98e3e36d1..b96760c45a 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -14,7 +14,7 @@ def sum (ref : Env) (lst: List Types) : IO (Env × Types) := do | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x + y)) | [Types.floatVal x] => return (ref, Types.floatVal x) | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x + y)) - | _ => Except.error "+ operator not supported" + | _ => throw (IO.userError "+ operator not supported") def sub (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with @@ -23,7 +23,7 @@ def sub (ref : Env) (lst: List Types) : IO (Env × Types) := do | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x - y)) | [Types.floatVal x] => return (ref, Types.floatVal x) | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x - y)) - | _ => Except.error "- operator not supported" + | _ => throw (IO.userError "- operator not supported") def mul (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with @@ -32,7 +32,7 @@ def mul (ref : Env) (lst: List Types) : IO (Env × Types) := do | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x * y)) | [Types.floatVal x] => return (ref, Types.floatVal x) | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x * y)) - | _ => Except.error "* operator not supported" + | _ => throw (IO.userError "* operator not supported") def div (ref : Env) (lst: List Types) : IO (Env × Types) := do match lst with @@ -41,7 +41,7 @@ def div (ref : Env) (lst: List Types) : IO (Env × Types) := do | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x / y)) | [Types.floatVal x] => return (ref, Types.floatVal x) | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x / y)) - | _ => Except.error "/ operator not supported" + | _ => throw (IO.userError "/ operator not supported") def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with @@ -49,7 +49,7 @@ def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Ty | "-" => sub ref results | "*" => mul ref results | "/" => div ref results - | _ => Except.error s!"'{name}' not found" + | _ => throw (IO.userError s!"'{name}' not found") mutual @@ -57,7 +57,7 @@ mutual match ast with | Types.symbolVal v => match ref.get (KeyType.strKey v) with | some (_, vi) => return (ref, vi) - | none => Except.error s!"'{v}' not found" + | none => throw (IO.userError s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) @@ -108,7 +108,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : Except String (Env × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Types) := do match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with @@ -119,8 +119,8 @@ mutual let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except String (Env × List Types) := - match args.foldl (fun (res : Except String (Env × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := do + match args.foldl (fun (res : IO (Dict × List Types)) x => match res with | Except.error e => Except.error s!"error evaluating function argument accumulator: {x.toString true}: {e}" | Except.ok (r, acc) => match evalTypes r x with diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index e1e64954cc..c2cbc81e89 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -5,7 +5,7 @@ import LeanMal.core universe u def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! let body := args[1]! @@ -32,7 +32,7 @@ mutual match ast with | Types.symbolVal v => match ref.get (KeyType.strKey v) with | some (_, vi) => Except.ok (ref, vi) - | none => Except.error (ref, s!"'{v}' not found") + | none => throw (IO.userError s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) @@ -96,7 +96,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with @@ -107,8 +107,8 @@ mutual let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := - match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -120,7 +120,7 @@ mutual | Except.ok (newRef, results) => Except.ok (newRef, results) partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "def! unexpected syntax") + if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! @@ -134,14 +134,14 @@ mutual | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! let result := match pairs with | Types.listVal v => evalLetArgs ref.increment v | Types.vecVal v => evalLetArgs ref.increment (toList v) - | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") @@ -150,17 +150,17 @@ mutual -- only propagate logs from the let* environment to the parent scope | Except.ok (letref, result) => Except.ok (forwardLogs letref ref, result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := + partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref - | [_] => Except.error (ref, "let*: unexpected syntax") + | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest - | _ => Except.error (ref, "let*: unexpected syntax") + | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result @@ -171,7 +171,7 @@ mutual else Except.ok (newRef, results[results.length - 1]!) partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! let thenExpr := args[1]! @@ -215,7 +215,7 @@ mutual | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) | _ => Except.ok (ref, Types.boolVal false) | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.error (ref, s!"'{name}' not found") + | _ => throw (IO.userError s!"'{name}' not found") end diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index 593b7c759e..d0a6309e32 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -5,7 +5,7 @@ import LeanMal.core universe u def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! let body := args[1]! @@ -32,7 +32,7 @@ mutual match ast with | Types.symbolVal v => match ref.get (KeyType.strKey v) with | some (_, vi) => Except.ok (ref, vi) - | none => Except.error (ref, s!"'{v}' not found") + | none => throw (IO.userError s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) @@ -97,7 +97,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with @@ -108,8 +108,8 @@ mutual let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := - match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -121,7 +121,7 @@ mutual | Except.ok (newRef, results) => Except.ok (newRef, results) partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "def! unexpected syntax") + if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! @@ -135,14 +135,14 @@ mutual | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! let result := match pairs with | Types.listVal v => evalLetArgs ref.increment v | Types.vecVal v => evalLetArgs ref.increment (toList v) - | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") @@ -151,17 +151,17 @@ mutual -- only propagate logs from the let* environment to the parent scope | Except.ok (letref, result) => Except.ok (forwardLogs letref ref, result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := + partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref - | [_] => Except.error (ref, "let*: unexpected syntax") + | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest - | _ => Except.error (ref, "let*: unexpected syntax") + | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result @@ -172,7 +172,7 @@ mutual else Except.ok (newRef, results[results.length - 1]!) partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! let thenExpr := args[1]! @@ -216,7 +216,7 @@ mutual | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) | _ => Except.ok (ref, Types.boolVal false) | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.error (ref, s!"'{name}' not found") + | _ => throw (IO.userError s!"'{name}' not found") end def READ (input : String): Except String Types := diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index f224ee9b9d..18512ad7b5 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -5,7 +5,7 @@ import LeanMal.core universe u def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! let body := args[1]! @@ -32,7 +32,7 @@ mutual match ast with | Types.symbolVal v => match ref.get (KeyType.strKey v) with | some (_, vi) => Except.ok (ref, vi) - | none => Except.error (ref, s!"'{v}' not found") + | none => throw (IO.userError s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) @@ -97,7 +97,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with @@ -108,8 +108,8 @@ mutual let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := - match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -121,7 +121,7 @@ mutual | Except.ok (newRef, results) => Except.ok (newRef, results) partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "def! unexpected syntax") + if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! @@ -135,14 +135,14 @@ mutual | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! let result := match pairs with | Types.listVal v => evalLetArgs ref.increment v | Types.vecVal v => evalLetArgs ref.increment (toList v) - | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") @@ -152,17 +152,17 @@ mutual | Except.ok (letref, result) => Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := + partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref - | [_] => Except.error (ref, "let*: unexpected syntax") + | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest - | _ => Except.error (ref, "let*: unexpected syntax") + | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result @@ -173,7 +173,7 @@ mutual else Except.ok (newRef, results[results.length - 1]!) partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! let thenExpr := args[1]! @@ -191,7 +191,7 @@ mutual else Except.ok (newRef, Types.Nil) partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") + if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") else let first := lst[0]! let fn := lst[1]! @@ -201,7 +201,7 @@ mutual match fn with | Types.funcVal _ => match ref.get (KeyType.strKey sym) with - | none => Except.error (ref, s!"{sym} not found") + | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => @@ -216,12 +216,12 @@ mutual | Except.ok (_, res) => let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) Except.ok (newRef, res) - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") - | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") + | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") + | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") + if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! evalTypes ref ast @@ -249,7 +249,7 @@ mutual | "println" => printlnFunc ref results | "eval" => eval ref results | "read-string" => match readString results ref with -- readString results Dict.empty - | Except.error e => Except.error (ref, e) + | Except.error e => throw (IO.userError e) | Except.ok res => Except.ok (ref, res) | _ => match results with | [x] => match x with @@ -264,7 +264,7 @@ mutual | "atom?" => Except.ok (ref, Types.boolVal true) | _ => Except.ok (ref, Types.boolVal false) | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.error (ref, s!"'{name}' not found") + | _ => throw (IO.userError s!"'{name}' not found") end def READ (input : String): Except String Types := diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index f65697f26c..fc1a639d66 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -5,7 +5,7 @@ import LeanMal.core universe u def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! let body := args[1]! @@ -32,7 +32,7 @@ mutual match ast with | Types.symbolVal v => match ref.get (KeyType.strKey v) with | some (_, vi) => Except.ok (ref, vi) - | none => Except.error (ref, s!"'{v}' not found") + | none => throw (IO.userError s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) @@ -85,10 +85,10 @@ mutual | "if" => evalIf ref (lst.drop 1) | "fn*" => makeFn ref (lst.drop 1) | "quote" => - if lst.length < 2 then Except.error (ref, "quote: expected 1 argument") + if lst.length < 2 then throw (IO.userError "quote: expected 1 argument") else Except.ok (ref, lst[1]!) | "quasiquote" => - if lst.length < 2 then Except.error (ref, "quasiquote: expected 1 argument") + if lst.length < 2 then throw (IO.userError "quasiquote: expected 1 argument") else evalTypes ref (quasiquote lst[1]!) | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) @@ -103,7 +103,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with @@ -114,8 +114,8 @@ mutual let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := - match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -127,7 +127,7 @@ mutual | Except.ok (newRef, results) => Except.ok (newRef, results) partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "def! unexpected syntax") + if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! @@ -141,14 +141,14 @@ mutual | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! let result := match pairs with | Types.listVal v => evalLetArgs ref.increment v | Types.vecVal v => evalLetArgs ref.increment (toList v) - | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") @@ -158,17 +158,17 @@ mutual | Except.ok (letref, result) => Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := + partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref - | [_] => Except.error (ref, "let*: unexpected syntax") + | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest - | _ => Except.error (ref, "let*: unexpected syntax") + | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result @@ -179,7 +179,7 @@ mutual else Except.ok (newRef, results[results.length - 1]!) partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! let thenExpr := args[1]! @@ -197,7 +197,7 @@ mutual else Except.ok (newRef, Types.Nil) partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") + if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") else let first := lst[0]! let fn := lst[1]! @@ -207,7 +207,7 @@ mutual match fn with | Types.funcVal _ => match ref.get (KeyType.strKey sym) with - | none => Except.error (ref, s!"{sym} not found") + | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => @@ -222,12 +222,12 @@ mutual | Except.ok (_, res) => let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) Except.ok (newRef, res) - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") - | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") + | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") + | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") + if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! evalTypes ref ast @@ -289,7 +289,7 @@ mutual | "println" => printlnFunc ref results | "eval" => eval ref results | "read-string" => match readString results ref with -- readString results Dict.empty - | Except.error e => Except.error (ref, e) + | Except.error e => throw (IO.userError e) | Except.ok res => Except.ok (ref, res) | _ => match results with | [x] => match x with @@ -304,7 +304,7 @@ mutual | "atom?" => Except.ok (ref, Types.boolVal true) | _ => Except.ok (ref, Types.boolVal false) | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.error (ref, s!"'{name}' not found") + | _ => throw (IO.userError s!"'{name}' not found") end diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index d7cf4abb3b..66b0a295b1 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -5,7 +5,7 @@ import LeanMal.core universe u def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! let body := args[1]! @@ -32,7 +32,7 @@ mutual match ast with | Types.symbolVal v => match ref.get (KeyType.strKey v) with | some (_, vi) => Except.ok (ref, vi) - | none => Except.error (ref, s!"'{v}' not found") + | none => throw (IO.userError s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) @@ -88,7 +88,7 @@ mutual match evalTypes merged body with | Except.error e => Except.error e | Except.ok (_, newast) => evalTypes ref newast - | _ => Except.error (ref, s!"`unexpected token, expected: function`") + | _ => throw (IO.userError s!"`unexpected token, expected: function`") partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) @@ -102,10 +102,10 @@ mutual | "if" => evalIf ref (lst.drop 1) | "fn*" => makeFn ref (lst.drop 1) | "quote" => - if lst.length < 2 then Except.error (ref, "quote: expected 1 argument") + if lst.length < 2 then throw (IO.userError "quote: expected 1 argument") else Except.ok (ref, lst[1]!) | "quasiquote" => - if lst.length < 2 then Except.error (ref, "quasiquote: expected 1 argument") + if lst.length < 2 then throw (IO.userError "quasiquote: expected 1 argument") else evalTypes ref (quasiquote lst[1]!) | "defmacro!" => evalDefMacro ref (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) @@ -121,7 +121,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with @@ -132,8 +132,8 @@ mutual let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := - match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -145,7 +145,7 @@ mutual | Except.ok (newRef, results) => Except.ok (newRef, results) partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "def! unexpected syntax") + if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! @@ -159,7 +159,7 @@ mutual | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") partial def evalDefMacro (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "def! unexpected syntax") + if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! @@ -182,14 +182,14 @@ mutual | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! let result := match pairs with | Types.listVal v => evalLetArgs ref.increment v | Types.vecVal v => evalLetArgs ref.increment (toList v) - | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") @@ -199,17 +199,17 @@ mutual | Except.ok (letref, result) => Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := + partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref - | [_] => Except.error (ref, "let*: unexpected syntax") + | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest - | _ => Except.error (ref, "let*: unexpected syntax") + | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result @@ -220,7 +220,7 @@ mutual else Except.ok (newRef, results[results.length - 1]!) partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! let thenExpr := args[1]! @@ -238,7 +238,7 @@ mutual else Except.ok (newRef, Types.Nil) partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") + if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") else let first := lst[0]! let fn := lst[1]! @@ -248,7 +248,7 @@ mutual match fn with | Types.funcVal _ => match ref.get (KeyType.strKey sym) with - | none => Except.error (ref, s!"{sym} not found") + | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => @@ -263,12 +263,12 @@ mutual | Except.ok (_, res) => let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) Except.ok (newRef, res) - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") - | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") + | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") + | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") + if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! evalTypes ref ast @@ -333,7 +333,7 @@ mutual | "println" => printlnFunc ref results | "eval" => eval ref results | "read-string" => match readString results ref with -- readString results Dict.empty - | Except.error e => Except.error (ref, e) + | Except.error e => throw (IO.userError e) | Except.ok res => Except.ok (ref, res) | _ => match results with | [x] => match x with @@ -348,7 +348,7 @@ mutual | "atom?" => Except.ok (ref, Types.boolVal true) | _ => Except.ok (ref, Types.boolVal false) | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.error (ref, s!"'{name}' not found") + | _ => throw (IO.userError s!"'{name}' not found") end diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index 6bd71d2ceb..325bf4a213 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -5,7 +5,7 @@ import LeanMal.core universe u def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! let body := args[1]! @@ -32,7 +32,7 @@ mutual match ast with | Types.symbolVal v => match ref.get (KeyType.strKey v) with | some (_, vi) => Except.ok (ref, vi) - | none => Except.error (ref, s!"'{v}' not found") + | none => throw (IO.userError s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) @@ -95,7 +95,7 @@ mutual match evalTypes merged body with | Except.error e => Except.error e | Except.ok (_, newast) => evalTypes ref newast - | _ => Except.error (ref, s!"`unexpected token, expected: function`") + | _ => throw (IO.userError s!"`unexpected token, expected: function`") partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) @@ -110,10 +110,10 @@ mutual | "fn*" => makeFn ref (lst.drop 1) | "try*" => evalTry ref (lst.drop 1) | "quote" => - if lst.length < 2 then Except.error (ref, "quote: expected 1 argument") + if lst.length < 2 then throw (IO.userError "quote: expected 1 argument") else Except.ok (ref, lst[1]!) | "quasiquote" => - if lst.length < 2 then Except.error (ref, "quasiquote: expected 1 argument") + if lst.length < 2 then throw (IO.userError "quasiquote: expected 1 argument") else evalTypes ref (quasiquote lst[1]!) | "defmacro!" => evalDefMacro ref (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) @@ -129,7 +129,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with @@ -140,8 +140,8 @@ mutual let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := - match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -153,7 +153,7 @@ mutual | Except.ok (newRef, results) => Except.ok (newRef, results) partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "def! unexpected syntax") + if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! @@ -167,7 +167,7 @@ mutual | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") partial def evalDefMacro (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "def! unexpected syntax") + if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! @@ -190,14 +190,14 @@ mutual | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! let result := match pairs with | Types.listVal v => evalLetArgs ref.increment v | Types.vecVal v => evalLetArgs ref.increment (toList v) - | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") @@ -207,17 +207,17 @@ mutual | Except.ok (letref, result) => Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := + partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref - | [_] => Except.error (ref, "let*: unexpected syntax") + | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest - | _ => Except.error (ref, "let*: unexpected syntax") + | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result @@ -228,7 +228,7 @@ mutual else Except.ok (newRef, results[results.length - 1]!) partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! let thenExpr := args[1]! @@ -246,7 +246,7 @@ mutual else Except.ok (newRef, Types.Nil) partial def evalTry (ref: Env) (lst : List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "try*: unexpected syntax") + if lst.length < 1 then throw (IO.userError "try*: unexpected syntax") else match evalTypes ref lst[0]! with | Except.ok (newRef, result) => Except.ok (newRef, result) @@ -255,12 +255,12 @@ mutual else match lst[1]! with | Types.listVal catchBody => - if catchBody.length < 1 then Except.error (ref, "try*: unexpected syntax") + if catchBody.length < 1 then throw (IO.userError "try*: unexpected syntax") else match catchBody[0]! with | Types.symbolVal catchSymbol => if catchSymbol == "catch*" then - if catchBody.length < 2 then Except.error (ref, "try*: unexpected syntax") + if catchBody.length < 2 then throw (IO.userError "try*: unexpected syntax") else let es := catchBody[1]! match es with @@ -273,14 +273,14 @@ mutual let built := buildDictWithSymbols ref.getDict ref.getLevel [errorSymbol] [err] let merged := ref.mergeDict (ref.getLevel + 1) built evalTypes merged toeval - | _ => Except.error (ref, s!"unexpected return type, expected: symbol") + | _ => throw (IO.userError s!"unexpected return type, expected: symbol") else Except.error evalErr | _ => Except.error evalErr -- | Types.vecVal v => -- TODO | _ => Except.error evalErr partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") + if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") else let first := lst[0]! let fn := lst[1]! @@ -290,7 +290,7 @@ mutual match fn with | Types.funcVal _ => match ref.get (KeyType.strKey sym) with - | none => Except.error (ref, s!"{sym} not found") + | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => @@ -305,12 +305,12 @@ mutual | Except.ok (_, res) => let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) Except.ok (newRef, res) - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") - | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") + | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") + | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") + if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! evalTypes ref ast @@ -347,7 +347,7 @@ mutual | _ => ast partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do - match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => + match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error e => Except.error e | Except.ok (r, acc) => @@ -360,7 +360,7 @@ mutual | Except.ok (newRef, results) => Except.ok (newRef, Types.listVal results) partial def nativeMap (ref: Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "map: unexpected syntax") + if lst.length < 2 then throw (IO.userError "map: unexpected syntax") else let fn := lst[0]! let params := lst[1]! @@ -369,11 +369,11 @@ mutual match params with | Types.listVal v => nativeMapOverList ref fn v | Types.vecVal v => nativeMapOverList ref fn (toList v) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: function") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: function") partial def nativeApply (ref: Env) (lst : List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "apply: unexpected syntax") + if lst.length < 2 then throw (IO.userError "apply: unexpected syntax") else let fn := lst[0]! let vecargs := lst[lst.length-1]! @@ -384,7 +384,7 @@ mutual evalFuncVal ref fn (firstargs ++ v) false | Types.vecVal v => evalFuncVal ref fn (firstargs ++ (toList v)) false - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with @@ -430,7 +430,7 @@ mutual | "println" => printlnFunc ref results | "eval" => eval ref results | "read-string" => match readString results ref with -- readString results Dict.empty - | Except.error e => Except.error (ref, e) + | Except.error e => throw (IO.userError e) | Except.ok res => Except.ok (ref, res) | _ => match results with | [x] => match x with @@ -468,7 +468,7 @@ mutual | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal false) | Fun.macroFn _ _ _ => Except.ok (ref, Types.boolVal true) | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.error (ref, s!"'{name}' not found") + | _ => throw (IO.userError s!"'{name}' not found") end diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index 3a9ef847f7..2d90968fd7 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -5,7 +5,7 @@ import LeanMal.core universe u def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! let body := args[1]! @@ -32,7 +32,7 @@ mutual match ast with | Types.symbolVal v => match ref.get (KeyType.strKey v) with | some (_, vi) => Except.ok (ref, vi) - | none => Except.error (ref, s!"'{v}' not found") + | none => throw (IO.userError s!"'{v}' not found") | Types.listVal el => (evalList ref el) | Types.vecVal el => (evalVec ref (toList el)) | Types.dictVal el => (evalDict ref el) @@ -95,7 +95,7 @@ mutual match evalTypes merged body with | Except.error e => Except.error e | Except.ok (_, newast) => evalTypes ref newast - | _ => Except.error (ref, s!"`unexpected token, expected: function`") + | _ => throw (IO.userError s!"`unexpected token, expected: function`") partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) @@ -110,10 +110,10 @@ mutual | "fn*" => makeFn ref (lst.drop 1) | "try*" => evalTry ref (lst.drop 1) | "quote" => - if lst.length < 2 then Except.error (ref, "quote: expected 1 argument") + if lst.length < 2 then throw (IO.userError "quote: expected 1 argument") else Except.ok (ref, lst[1]!) | "quasiquote" => - if lst.length < 2 then Except.error (ref, "quasiquote: expected 1 argument") + if lst.length < 2 then throw (IO.userError "quasiquote: expected 1 argument") else evalTypes ref (quasiquote lst[1]!) | "defmacro!" => evalDefMacro ref (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) @@ -129,7 +129,7 @@ mutual | Except.error e => Except.error e | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : Except (Env × String) (Env × Dict) := + partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with @@ -140,8 +140,8 @@ mutual let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : Except (Env × String) (Env × List Types) := - match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => + partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") | Except.ok (r, acc) => match evalTypes r x with @@ -153,7 +153,7 @@ mutual | Except.ok (newRef, results) => Except.ok (newRef, results) partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "def! unexpected syntax") + if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! @@ -167,7 +167,7 @@ mutual | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") partial def evalDefMacro (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "def! unexpected syntax") + if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! @@ -190,14 +190,14 @@ mutual | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "let*: unexpected syntax") + if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! let result := match pairs with | Types.listVal v => evalLetArgs ref.increment v | Types.vecVal v => evalLetArgs ref.increment (toList v) - | _ => Except.error (ref, s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") @@ -207,17 +207,17 @@ mutual | Except.ok (letref, result) => Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except (Env × String) Env := + partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref - | [_] => Except.error (ref, "let*: unexpected syntax") + | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest - | _ => Except.error (ref, "let*: unexpected syntax") + | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result @@ -228,7 +228,7 @@ mutual else Except.ok (newRef, results[results.length - 1]!) partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error (ref, "unexpected syntax") + if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! let thenExpr := args[1]! @@ -246,7 +246,7 @@ mutual else Except.ok (newRef, Types.Nil) partial def evalTry (ref: Env) (lst : List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "try*: unexpected syntax") + if lst.length < 1 then throw (IO.userError "try*: unexpected syntax") else match evalTypes ref lst[0]! with | Except.ok (newRef, result) => Except.ok (newRef, result) @@ -255,12 +255,12 @@ mutual else match lst[1]! with | Types.listVal catchBody => - if catchBody.length < 1 then Except.error (ref, "try*: unexpected syntax") + if catchBody.length < 1 then throw (IO.userError "try*: unexpected syntax") else match catchBody[0]! with | Types.symbolVal catchSymbol => if catchSymbol == "catch*" then - if catchBody.length < 2 then Except.error (ref, "try*: unexpected syntax") + if catchBody.length < 2 then throw (IO.userError "try*: unexpected syntax") else let es := catchBody[1]! match es with @@ -273,14 +273,14 @@ mutual let built := buildDictWithSymbols ref.getDict ref.getLevel [errorSymbol] [err] let merged := ref.mergeDict (ref.getLevel + 1) built evalTypes merged toeval - | _ => Except.error (ref, s!"unexpected return type, expected: symbol") + | _ => throw (IO.userError s!"unexpected return type, expected: symbol") else Except.error evalErr | _ => Except.error evalErr -- | Types.vecVal v => -- TODO | _ => Except.error evalErr partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "swap!: >= 2 argument required") + if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") else let first := lst[0]! let fn := lst[1]! @@ -290,7 +290,7 @@ mutual match fn with | Types.funcVal _ => match ref.get (KeyType.strKey sym) with - | none => Except.error (ref, s!"{sym} not found") + | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => @@ -305,12 +305,12 @@ mutual | Except.ok (_, res) => let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) Except.ok (newRef, res) - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: atom") - | x => Except.error (ref, s!"swap!: unexpected symbol: {x.toString true}, expected: function") - | x => Except.error (ref, s!"swap!: unexpected token: {x.toString true}, expected: symbol") + | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") + | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") + | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.error (ref, "eval: unexpected syntax") + if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! evalTypes ref ast @@ -347,7 +347,7 @@ mutual | _ => ast partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do - match args.foldl (fun (res : Except (Env × String) (Env × List Types)) x => + match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error e => Except.error e | Except.ok (r, acc) => @@ -360,7 +360,7 @@ mutual | Except.ok (newRef, results) => Except.ok (newRef, Types.listVal results) partial def nativeMap (ref: Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "map: unexpected syntax") + if lst.length < 2 then throw (IO.userError "map: unexpected syntax") else let fn := lst[0]! let params := lst[1]! @@ -369,11 +369,11 @@ mutual match params with | Types.listVal v => nativeMapOverList ref fn v | Types.vecVal v => nativeMapOverList ref fn (toList v) - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: function") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: function") partial def nativeApply (ref: Env) (lst : List Types) : IO (Env × Types) := do - if lst.length < 2 then Except.error (ref, "apply: unexpected syntax") + if lst.length < 2 then throw (IO.userError "apply: unexpected syntax") else let fn := lst[0]! let vecargs := lst[lst.length-1]! @@ -384,7 +384,7 @@ mutual evalFuncVal ref fn (firstargs ++ v) false | Types.vecVal v => evalFuncVal ref fn (firstargs ++ (toList v)) false - | x => Except.error (ref, s!"unexpected symbol: {x.toString true}, expected: list or vector") + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with @@ -430,11 +430,11 @@ mutual | "println" => printlnFunc ref results | "eval" => eval ref results | "read-string" => match readString results ref with -- readString results Dict.empty - | Except.error e => Except.error (ref, e) + | Except.error e => throw (IO.userError e) | Except.ok res => Except.ok (ref, res) - | "time-ms" => Except.error (ref, "Not implemented") - | "meta" => Except.error (ref, "Not implemented") - | "with-meta" => Except.error (ref, "Not implemented") + | "time-ms" => throw (IO.userError "Not implemented") + | "meta" => throw (IO.userError "Not implemented") + | "with-meta" => throw (IO.userError "Not implemented") | _ => match results with | [x] => match x with | Types.Nil => if name == "nil?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) @@ -471,7 +471,7 @@ mutual | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal false) | Fun.macroFn _ _ _ => Except.ok (ref, Types.boolVal true) | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.error (ref, s!"'{name}' not found") + | _ => throw (IO.userError s!"'{name}' not found") end From 4115533eb897f8ff7338cd140f401c72adda10ba Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Mon, 26 Aug 2024 23:52:52 +0200 Subject: [PATCH 28/39] use IO, refactor step2 --- impls/lean/LeanMal/core.lean | 16 ++-- impls/lean/LeanMal/step2_eval.lean | 114 +++++++++++------------ impls/lean/LeanMal/step3_env.lean | 44 ++++----- impls/lean/LeanMal/step4_if_fn_do.lean | 78 ++++++++-------- impls/lean/LeanMal/step5_tco.lean | 78 ++++++++-------- impls/lean/LeanMal/step6_file.lean | 94 +++++++++---------- impls/lean/LeanMal/step7_quote.lean | 94 +++++++++---------- impls/lean/LeanMal/step8_macros.lean | 106 +++++++++++----------- impls/lean/LeanMal/step9_try.lean | 120 ++++++++++++------------- impls/lean/LeanMal/stepA_mal.lean | 120 ++++++++++++------------- impls/lean/LeanMal/types.lean | 4 +- 11 files changed, 430 insertions(+), 438 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index fd662498b7..0021294e8c 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -187,11 +187,11 @@ def resetAtom (ref : Env) (lst: List Types) (args: List Types) : IO (Env × Type | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v _ => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v second)) - Except.ok (newRef, second) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v second)) + Except.ok (newEnv, second) | Atom.withmeta _ meta => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta second meta)) - Except.ok (newRef, second) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta second meta)) + Except.ok (newEnv, second) | x => throw (IO.userError s!"reset!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"reset!: unexpected token: {x.toString true}, expected: symbol") @@ -245,13 +245,13 @@ def prStrFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do def prnFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do let str := prStrInternal lst true " " - let newRef := logInfo ref str - Except.ok (newRef, Types.Nil) + let newEnv := logInfo ref str + Except.ok (newEnv, Types.Nil) def printlnFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do let str := prStrInternal lst false " " - let newRef := logInfo ref str - Except.ok (newRef, Types.Nil) + let newEnv := logInfo ref str + Except.ok (newEnv, Types.Nil) def strFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do let str := prStrInternal lst false "" diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean index 2b76c46a23..155bf80778 100644 --- a/impls/lean/LeanMal/step2_eval.lean +++ b/impls/lean/LeanMal/step2_eval.lean @@ -62,83 +62,74 @@ mutual | Types.dictVal el => (evalDict ref el) | x => return (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do - match evalTypes ref head with - | Except.error e => Except.error s!"error evaluating function: {head.toString true}: {e}" - | Except.ok (_, fn) => evalFuncVal ref fn args + partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do + let (_, fn) ← evalTypes env head + evalFuncVal env fn args - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do + partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newRef, results) => - match fn with - | Types.symbolVal name => evalFnNative newRef name results - | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newRef name results - | Fun.userDefined fref params body => - let keys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let argsDict := (buildDict 0 keys results) - let merged := (newRef.merge fref).mergeDict (fref.getLevel + 1) argsDict - evalTypes merged body - | Fun.macroFn _ _ _ => Except.error "macro not implemented" - | _ => Except.error s!"`unexpected token, expected: function`" - - partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do - if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + let (newEnv, results) ← evalFuncArgs env args + match fn with + | Types.symbolVal name => evalFnNative newEnv name results + | Types.funcVal v => match v with + | Fun.builtin name => evalFnNative newEnv name results + | Fun.userDefined fref params body => + let keys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let argsDict := (buildDict 0 keys results) + let merged := (newEnv.merge fref).mergeDict (fref.getLevel + 1) argsDict + evalTypes merged body + | Fun.macroFn _ _ _ => throw (IO.userError "macro not implemented") + | _ => throw (IO.userError s!"`unexpected token, expected: function`") + + partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do + if List.length lst == 0 then return (env, Types.listVal lst) else let head := lst[0]! match lst[0]! with | Types.symbolVal v => match v with - | _ => evalFunc ref head (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do - match evalFuncArgs ref elems with - | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do + let (newEnv, results) ← evalFuncArgs env elems + return (newEnv, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do - match evalDictInner ref lst with - | Except.error e => Except.error e - | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do + let (newEnv, newDict) ← evalDictInner env lst + return (newEnv, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Types) := do + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := do match lst with - | Dict.empty => Except.ok (ref, lst) - | Dict.insert k _ v restDict => match evalTypes ref v with - | Except.error e => Except.error e - | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with - | Except.error e => Except.error e - | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k 0 newVal updatedDict - Except.ok (updatedRef, newDict) - - partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := do - match args.foldl (fun (res : IO (Env × List Types)) x => - match res with - | Except.error e => Except.error s!"error evaluating function argument accumulator: {x.toString true}: {e}" - | Except.ok (r, acc) => match evalTypes r x with - | Except.error e => Except.error s!"error evaluating function argument: {x.toString true}: {e}" - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, acc ++ [res]) - ) (Except.ok (ref, [])) with - | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Dict.empty => return (env, lst) + | Dict.insert k _ v restDict => + let (newEnv, newVal) ← evalTypes env v + let (updatedEnv, updatedDict) ← evalDictInner newEnv restDict + let newDict := Dict.insert k 0 newVal updatedDict + return (updatedEnv, newDict) + + partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := do + args.foldlM (fun (res : Env × List Types) (x : Types) => do + let (r, acc) := res + let (updatedRef, res) ← evalTypes r x + return (updatedRef, acc ++ [res]) + ) (env, []) end def PRINT (ast : Types): String := pr_str true ast -def rep (input : String): IO String := +def rep (input : String): IO String := do match READ.{u} input with - | Except.ok result => match evalTypes (Env.data 0 Dict.empty) result with - | Except.error e => e - | Except.ok (_, res) => PRINT res + | Except.ok result => + try + let (_, res) ← evalTypes (Env.data 0 Dict.empty) result + return PRINT res + catch + | e => return s!"Error: {e}" | Except.error err => - s!"Parsing failed: {err}" + return s!"Parsing failed: {err}" def main : IO Unit := do let mut donext := true @@ -153,4 +144,5 @@ def main : IO Unit := do if value.isEmpty then donext := false else - IO.println (rep.{u} value) + let output ← rep.{u} value + IO.println output diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index b96760c45a..95909e5a13 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -63,31 +63,31 @@ mutual | Types.dictVal el => (evalDict ref el) | x => return (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do + partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error e => Except.error s!"error evaluating function: {head.toString true}: {e}" | Except.ok (_, fn) => evalFuncVal ref fn args - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do + partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => + | Except.ok (newEnv, results) => match fn with | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newRef name results + | Fun.builtin name => evalFnNative newEnv name results | Fun.userDefined fref params body => let keys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] let argsLevel := fref.getLevel + 1 let argsDict := (buildDict argsLevel keys results) - let merged := (newRef.merge fref).mergeDict argsLevel argsDict + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict evalTypes merged body | Fun.macroFn _ _ _ => Except.error "macro not implemented" | _ => Except.error s!"`unexpected token, expected: function`" - partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -98,28 +98,28 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do + partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do + partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e - | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Types) := do + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Types) := do match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e - | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := do + partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := do match args.foldl (fun (res : IO (Dict × List Types)) x => match res with | Except.error e => Except.error s!"error evaluating function argument accumulator: {x.toString true}: {e}" @@ -129,23 +129,23 @@ mutual Except.ok (updatedRef, acc ++ [res]) ) (Except.ok (ref, [])) with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) - partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error "def! unexpected syntax" else let key := args[0]! let body := args[1]! match (evalTypes ref body) with | Except.error e => Except.error s!"def!: {e}" - | Except.ok (newRef, value) => + | Except.ok (newEnv, value) => match key with | Types.symbolVal v => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel value + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | _ => Except.error s!"def! unexpected token, expected: symbol" - partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then Except.error "let*: unexpected syntax" else let pairs := args[0]! @@ -157,12 +157,12 @@ mutual match result with | Except.error e => Except.error s!"let*: {e}" - | Except.ok newRef => match evalTypes newRef body with + | Except.ok newEnv => match evalTypes newEnv body with | Except.error e => Except.error e -- we do not propagate the let* environment to the parent scope | Except.ok (_, result) => Except.ok (ref, result) - partial def evalLetArgs (ref: Env) (args : List Types) : Except String Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref | [_] => Except.error "let*: unexpected syntax" @@ -178,7 +178,7 @@ end def loadFnNative (ref : Env) (name: String) : Env := ref.add (KeyType.strKey name) 0 (Types.funcVal (Fun.builtin name)) -def loadFnNativeAll (ref: Env) : Env := +def loadFnNativeAll (env: Env) : Env := loadFnNative ( loadFnNative ( loadFnNative ( @@ -190,7 +190,7 @@ def loadFnNativeAll (ref: Env) : Env := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Env) (input : String): Env × String := +def rep (env: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error e => (ref, e) diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index c2cbc81e89..2090d8a82d 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do +def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do + partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => @@ -47,14 +47,14 @@ mutual -- only propagate logs after executing a function | Except.ok (fref, res) => Except.ok (forwardLogs fref ref, res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do + partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => + | Except.ok (newEnv, results) => match fn with | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newRef name results + | Fun.builtin name => evalFnNative newEnv name results | Fun.userDefined fref params body => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false @@ -63,16 +63,16 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newRef.merge fref).mergeDict argsLevel argsDict + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict evalTypes merged body - | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") - | _ => Except.error (newRef, s!"`unexpected token, expected: function`") + | Fun.macroFn _ _ _ => Except.error (newEnv, "macro not implemented") + | _ => Except.error (newEnv, s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -86,28 +86,28 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do + partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do + partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e - | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e - | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") @@ -117,23 +117,23 @@ mutual Except.ok (updatedRef, acc ++ [res]) ) (Except.ok (ref, [])) with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) - partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! match (evalTypes ref body) with | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newRef, value) => + | Except.ok (newEnv, value) => match key with | Types.symbolVal v => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel value + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) - | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! @@ -144,33 +144,33 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with - | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") - | Except.ok newRef => match evalTypes newRef body with + | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") + | Except.ok newEnv => match evalTypes newEnv body with | Except.error e => Except.error e -- only propagate logs from the let* environment to the parent scope | Except.ok (letref, result) => Except.ok (forwardLogs letref ref, result) - partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with - | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => - if results.length == 0 then Except.ok (newRef, Types.Nil) - else Except.ok (newRef, results[results.length - 1]!) + | Except.ok (newEnv, results) => + if results.length == 0 then Except.ok (newEnv, Types.Nil) + else Except.ok (newEnv, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! @@ -178,15 +178,15 @@ mutual let hasElse := args.length > 2 match evalTypes ref condition with - | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") - | Except.ok (newRef, condResp) => + | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") + | Except.ok (newEnv, condResp) => let cond := match condResp with | Types.boolVal v => v | Types.Nil => false | _ => true - if cond then evalTypes newRef thenExpr - else if hasElse then evalTypes newRef args[2]! - else Except.ok (newRef, Types.Nil) + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else Except.ok (newEnv, Types.Nil) partial def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with @@ -225,7 +225,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Env) (input : String): Env × String := +def rep (env: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, e) @@ -239,7 +239,7 @@ def printLogs (ref : Env) : IO Unit := | x => IO.println (x.toString true) ) -def loadMalFns (ref: Env) (fndefs: List String): Env × String := +def loadMalFns (env: Env) (fndefs: List String): Env × String := fndefs.foldl (fun (res : Env × String) fndef => let (ref, msg) := res let (newref, newmsg) := rep.{u} ref fndef diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index d0a6309e32..0a80bf67e1 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do +def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do + partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => @@ -48,14 +48,14 @@ mutual -- only propagate logs after executing a function Except.ok (forwardLogs fref ref, res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do + partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => + | Except.ok (newEnv, results) => match fn with | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newRef name results + | Fun.builtin name => evalFnNative newEnv name results | Fun.userDefined fref params body => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false @@ -64,16 +64,16 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newRef.merge fref).mergeDict argsLevel argsDict + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict evalTypes merged body - | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") - | _ => Except.error (newRef, s!"`unexpected token, expected: function`") + | Fun.macroFn _ _ _ => Except.error (newEnv, "macro not implemented") + | _ => Except.error (newEnv, s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -87,28 +87,28 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do + partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do + partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e - | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e - | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") @@ -118,23 +118,23 @@ mutual Except.ok (updatedRef, acc ++ [res]) ) (Except.ok (ref, [])) with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) - partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! match (evalTypes ref body) with | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newRef, value) => + | Except.ok (newEnv, value) => match key with | Types.symbolVal v => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel value + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) - | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! @@ -145,33 +145,33 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with - | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") - | Except.ok newRef => match evalTypes newRef body with + | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") + | Except.ok newEnv => match evalTypes newEnv body with | Except.error e => Except.error e -- only propagate logs from the let* environment to the parent scope | Except.ok (letref, result) => Except.ok (forwardLogs letref ref, result) - partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with - | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => - if results.length == 0 then Except.ok (newRef, Types.Nil) - else Except.ok (newRef, results[results.length - 1]!) + | Except.ok (newEnv, results) => + if results.length == 0 then Except.ok (newEnv, Types.Nil) + else Except.ok (newEnv, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! @@ -179,15 +179,15 @@ mutual let hasElse := args.length > 2 match evalTypes ref condition with - | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") - | Except.ok (newRef, condResp) => + | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") + | Except.ok (newEnv, condResp) => let cond := match condResp with | Types.boolVal v => v | Types.Nil => false | _ => true - if cond then evalTypes newRef thenExpr - else if hasElse then evalTypes newRef args[2]! - else Except.ok (newRef, Types.Nil) + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else Except.ok (newEnv, Types.Nil) partial def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with @@ -225,7 +225,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Env) (input : String): Env × String := +def rep (env: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, e) @@ -239,7 +239,7 @@ def printLogs (ref : Env) : IO Unit := | x => IO.println (x.toString true) ) -def loadMalFns (ref: Env) (fndefs: List String): Env × String := +def loadMalFns (env: Env) (fndefs: List String): Env × String := fndefs.foldl (fun (res : Env × String) fndef => let (ref, msg) := res let (newref, newmsg) := rep.{u} ref fndef diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 18512ad7b5..9d4b9b6478 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do +def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do + partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => @@ -48,14 +48,14 @@ mutual -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do + partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => + | Except.ok (newEnv, results) => match fn with | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newRef name results args + | Fun.builtin name => evalFnNative newEnv name results args | Fun.userDefined fref params body => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false @@ -64,16 +64,16 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newRef.merge fref).mergeDict argsLevel argsDict + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict evalTypes merged body - | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") - | _ => Except.error (newRef, s!"`unexpected token, expected: function`") + | Fun.macroFn _ _ _ => Except.error (newEnv, "macro not implemented") + | _ => Except.error (newEnv, s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -87,28 +87,28 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do + partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do + partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e - | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e - | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") @@ -118,23 +118,23 @@ mutual Except.ok (updatedRef, acc ++ [res]) ) (Except.ok (ref, [])) with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) - partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! match (evalTypes ref body) with | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newRef, value) => + | Except.ok (newEnv, value) => match key with | Types.symbolVal v => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel value + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) - | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! @@ -145,34 +145,34 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with - | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") - | Except.ok newRef => match evalTypes newRef body with + | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") + | Except.ok newEnv => match evalTypes newEnv body with | Except.error e => Except.error e -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope | Except.ok (letref, result) => Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with - | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => - if results.length == 0 then Except.ok (newRef, Types.Nil) - else Except.ok (newRef, results[results.length - 1]!) + | Except.ok (newEnv, results) => + if results.length == 0 then Except.ok (newEnv, Types.Nil) + else Except.ok (newEnv, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! @@ -180,17 +180,17 @@ mutual let hasElse := args.length > 2 match evalTypes ref condition with - | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") - | Except.ok (newRef, condResp) => + | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") + | Except.ok (newEnv, condResp) => let cond := match condResp with | Types.boolVal v => v | Types.Nil => false | _ => true - if cond then evalTypes newRef thenExpr - else if hasElse then evalTypes newRef args[2]! - else Except.ok (newRef, Types.Nil) + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else Except.ok (newEnv, Types.Nil) - partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do + partial def swapAtom (env: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") else let first := lst[0]! @@ -206,21 +206,21 @@ mutual | Types.atomVal x => match x with | Atom.v v => match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") | Except.ok (_, res) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) - Except.ok (newRef, res) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + Except.ok (newEnv, res) | Atom.withmeta v meta => match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") | Except.ok (_, res) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newRef, res) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newEnv, res) | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def eval (env: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! @@ -273,7 +273,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Env) (input : String): Env × String := +def rep (env: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, e) @@ -287,7 +287,7 @@ def printLogs (ref : Env) : IO Unit := | x => IO.println (x.toString true) ) -def loadMalFns (ref: Env) (fndefs: List String): Env × String := +def loadMalFns (env: Env) (fndefs: List String): Env × String := fndefs.foldl (fun (res : Env × String) fndef => let (ref, msg) := res let (newref, newmsg) := rep.{u} ref fndef diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index fc1a639d66..643d1e1b60 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do +def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do + partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => @@ -48,14 +48,14 @@ mutual -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do + partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => + | Except.ok (newEnv, results) => match fn with | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newRef name results args + | Fun.builtin name => evalFnNative newEnv name results args | Fun.userDefined fref params body => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false @@ -64,16 +64,16 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newRef.merge fref).mergeDict argsLevel argsDict + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict evalTypes merged body - | Fun.macroFn _ _ _ => Except.error (newRef, "macro not implemented") - | _ => Except.error (newRef, s!"`unexpected token, expected: function`") + | Fun.macroFn _ _ _ => Except.error (newEnv, "macro not implemented") + | _ => Except.error (newEnv, s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -93,28 +93,28 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do + partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do + partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e - | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e - | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") @@ -124,23 +124,23 @@ mutual Except.ok (updatedRef, acc ++ [res]) ) (Except.ok (ref, [])) with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) - partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! match (evalTypes ref body) with | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newRef, value) => + | Except.ok (newEnv, value) => match key with | Types.symbolVal v => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel value + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) - | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! @@ -151,34 +151,34 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with - | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") - | Except.ok newRef => match evalTypes newRef body with + | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") + | Except.ok newEnv => match evalTypes newEnv body with | Except.error e => Except.error e -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope | Except.ok (letref, result) => Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with - | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => - if results.length == 0 then Except.ok (newRef, Types.Nil) - else Except.ok (newRef, results[results.length - 1]!) + | Except.ok (newEnv, results) => + if results.length == 0 then Except.ok (newEnv, Types.Nil) + else Except.ok (newEnv, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! @@ -186,17 +186,17 @@ mutual let hasElse := args.length > 2 match evalTypes ref condition with - | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") - | Except.ok (newRef, condResp) => + | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") + | Except.ok (newEnv, condResp) => let cond := match condResp with | Types.boolVal v => v | Types.Nil => false | _ => true - if cond then evalTypes newRef thenExpr - else if hasElse then evalTypes newRef args[2]! - else Except.ok (newRef, Types.Nil) + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else Except.ok (newEnv, Types.Nil) - partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do + partial def swapAtom (env: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") else let first := lst[0]! @@ -212,21 +212,21 @@ mutual | Types.atomVal x => match x with | Atom.v v => match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") | Except.ok (_, res) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) - Except.ok (newRef, res) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + Except.ok (newEnv, res) | Atom.withmeta v meta => match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") | Except.ok (_, res) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newRef, res) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newEnv, res) | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def eval (env: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! @@ -314,7 +314,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Env) (input : String): Env × String := +def rep (env: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, e) @@ -328,7 +328,7 @@ def printLogs (ref : Env) : IO Unit := | x => IO.println (x.toString true) ) -def loadMalFns (ref: Env) (fndefs: List String): Env × String := +def loadMalFns (env: Env) (fndefs: List String): Env × String := fndefs.foldl (fun (res : Env × String) fndef => let (ref, msg) := res let (newref, newmsg) := rep.{u} ref fndef diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index 66b0a295b1..0e4825c11e 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do +def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do + partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") | Except.ok (ref2, fn) => @@ -48,18 +48,18 @@ mutual -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do + partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do match fn with | Types.funcVal v => match v with | Fun.builtin name => match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => - evalFnNative newRef name results args + | Except.ok (newEnv, results) => + evalFnNative newEnv name results args | Fun.userDefined fref params body => match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => + | Except.ok (newEnv, results) => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] @@ -67,10 +67,10 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newRef.merge fref).mergeDict argsLevel argsDict + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict evalTypes merged body | Fun.macroFn fref params body => @@ -90,7 +90,7 @@ mutual | Except.ok (_, newast) => evalTypes ref newast | _ => throw (IO.userError s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -111,28 +111,28 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do + partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do + partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e - | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e - | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") @@ -142,46 +142,46 @@ mutual Except.ok (updatedRef, acc ++ [res]) ) (Except.ok (ref, [])) with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) - partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! match (evalTypes ref body) with | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newRef, value) => + | Except.ok (newEnv, value) => match key with | Types.symbolVal v => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel value + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) - | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") - partial def evalDefMacro (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDefMacro (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! match (evalTypes ref body) with | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newRef, value) => + | Except.ok (newEnv, value) => match key with | Types.symbolVal v => match value with | Types.funcVal func => match func with | Fun.macroFn _ _ _ => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel value + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | Fun.userDefined fref params body => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) Except.ok (refResult, value) - | _ => Except.error (newRef, s!"defmacro!: unexpected builtin function") - | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") - | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + | _ => Except.error (newEnv, s!"defmacro!: unexpected builtin function") + | x => Except.error (newEnv, s!"unexpected token type: {x.toString true}, expected: function") + | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! @@ -192,34 +192,34 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with - | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") - | Except.ok newRef => match evalTypes newRef body with + | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") + | Except.ok newEnv => match evalTypes newEnv body with | Except.error e => Except.error e -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope | Except.ok (letref, result) => Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with - | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => - if results.length == 0 then Except.ok (newRef, Types.Nil) - else Except.ok (newRef, results[results.length - 1]!) + | Except.ok (newEnv, results) => + if results.length == 0 then Except.ok (newEnv, Types.Nil) + else Except.ok (newEnv, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! @@ -227,17 +227,17 @@ mutual let hasElse := args.length > 2 match evalTypes ref condition with - | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") - | Except.ok (newRef, condResp) => + | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") + | Except.ok (newEnv, condResp) => let cond := match condResp with | Types.boolVal v => v | Types.Nil => false | _ => true - if cond then evalTypes newRef thenExpr - else if hasElse then evalTypes newRef args[2]! - else Except.ok (newRef, Types.Nil) + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else Except.ok (newEnv, Types.Nil) - partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do + partial def swapAtom (env: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") else let first := lst[0]! @@ -253,21 +253,21 @@ mutual | Types.atomVal x => match x with | Atom.v v => match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") | Except.ok (_, res) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) - Except.ok (newRef, res) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + Except.ok (newEnv, res) | Atom.withmeta v meta => match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") | Except.ok (_, res) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newRef, res) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newEnv, res) | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def eval (env: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! @@ -358,7 +358,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Env) (input : String): Env × String := +def rep (env: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, e) @@ -372,7 +372,7 @@ def printLogs (ref : Env) : IO Unit := | x => IO.println (x.toString true) ) -def loadMalFns (ref: Env) (fndefs: List String): Env × String := +def loadMalFns (env: Env) (fndefs: List String): Env × String := fndefs.foldl (fun (res : Env × String) fndef => let (ref, msg) := res let (newref, newmsg) := rep.{u} ref fndef diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index 325bf4a213..c68a6ccf49 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do +def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do + partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error e => Except.error e | Except.ok (ref2, fn) => @@ -48,25 +48,25 @@ mutual -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : IO (Env × Types) := do + partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : IO (Env × Types) := do match fn with | Types.funcVal v => match v with | Fun.builtin name => match if !evaluateArgs then Except.ok (ref, args) else match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) with | Except.error e => Except.error e - | Except.ok (newRef, results) => evalFnNative newRef name results args + | Except.ok (newEnv, results) => evalFnNative newEnv name results args | Fun.userDefined fref params body => match if !evaluateArgs then Except.ok (ref, args) else match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) with | Except.error e => Except.error e - | Except.ok (newRef, results) => + | Except.ok (newEnv, results) => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] @@ -74,10 +74,10 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newRef.merge fref).mergeDict argsLevel argsDict + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict evalTypes merged body | Fun.macroFn fref params body => @@ -97,7 +97,7 @@ mutual | Except.ok (_, newast) => evalTypes ref newast | _ => throw (IO.userError s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -119,28 +119,28 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do + partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do + partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e - | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e - | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") @@ -150,46 +150,46 @@ mutual Except.ok (updatedRef, acc ++ [res]) ) (Except.ok (ref, [])) with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) - partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! match (evalTypes ref body) with | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newRef, value) => + | Except.ok (newEnv, value) => match key with | Types.symbolVal v => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel value + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) - | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") - partial def evalDefMacro (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDefMacro (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! match (evalTypes ref body) with | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newRef, value) => + | Except.ok (newEnv, value) => match key with | Types.symbolVal v => match value with | Types.funcVal func => match func with | Fun.macroFn _ _ _ => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel value + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | Fun.userDefined fref params body => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) Except.ok (refResult, value) - | _ => Except.error (newRef, s!"defmacro!: unexpected builtin function") - | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") - | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + | _ => Except.error (newEnv, s!"defmacro!: unexpected builtin function") + | x => Except.error (newEnv, s!"unexpected token type: {x.toString true}, expected: function") + | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! @@ -200,34 +200,34 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with - | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") - | Except.ok newRef => match evalTypes newRef body with + | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") + | Except.ok newEnv => match evalTypes newEnv body with | Except.error e => Except.error e -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope | Except.ok (letref, result) => Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with - | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => - if results.length == 0 then Except.ok (newRef, Types.Nil) - else Except.ok (newRef, results[results.length - 1]!) + | Except.ok (newEnv, results) => + if results.length == 0 then Except.ok (newEnv, Types.Nil) + else Except.ok (newEnv, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! @@ -235,21 +235,21 @@ mutual let hasElse := args.length > 2 match evalTypes ref condition with - | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") - | Except.ok (newRef, condResp) => + | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") + | Except.ok (newEnv, condResp) => let cond := match condResp with | Types.boolVal v => v | Types.Nil => false | _ => true - if cond then evalTypes newRef thenExpr - else if hasElse then evalTypes newRef args[2]! - else Except.ok (newRef, Types.Nil) + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else Except.ok (newEnv, Types.Nil) - partial def evalTry (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def evalTry (env: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "try*: unexpected syntax") else match evalTypes ref lst[0]! with - | Except.ok (newRef, result) => Except.ok (newRef, result) + | Except.ok (newEnv, result) => Except.ok (newEnv, result) | Except.error evalErr => if lst.length < 2 then Except.error evalErr else @@ -279,7 +279,7 @@ mutual -- | Types.vecVal v => -- TODO | _ => Except.error evalErr - partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do + partial def swapAtom (env: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") else let first := lst[0]! @@ -295,21 +295,21 @@ mutual | Types.atomVal x => match x with | Atom.v v => match evalFuncVal ref fn ([v] ++ rest) false with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") | Except.ok (_, res) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) - Except.ok (newRef, res) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + Except.ok (newEnv, res) | Atom.withmeta v meta => match evalFuncVal ref fn ([v] ++ rest) false with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") | Except.ok (_, res) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newRef, res) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newEnv, res) | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def eval (env: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! @@ -346,7 +346,7 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do + partial def nativeMapOverList (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error e => Except.error e @@ -357,9 +357,9 @@ mutual Except.ok (updatedRef, acc ++ [res]) ) (Except.ok (ref, [])) with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, Types.listVal results) + | Except.ok (newEnv, results) => Except.ok (newEnv, Types.listVal results) - partial def nativeMap (ref: Env) (lst: List Types) : IO (Env × Types) := do + partial def nativeMap (env: Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "map: unexpected syntax") else let fn := lst[0]! @@ -372,7 +372,7 @@ mutual | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: function") - partial def nativeApply (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def nativeApply (env: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "apply: unexpected syntax") else let fn := lst[0]! @@ -478,7 +478,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Env) (input : String): Env × String := +def rep (env: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, s!"Error: {e}") @@ -492,7 +492,7 @@ def printLogs (ref : Env) : IO Unit := | x => IO.println (x.toString true) ) -def loadMalFns (ref: Env) (fndefs: List String): Env × String := +def loadMalFns (env: Env) (fndefs: List String): Env × String := fndefs.foldl (fun (res : Env × String) fndef => let (ref, msg) := res let (newref, newmsg) := rep.{u} ref fndef diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index 2d90968fd7..dfaec64009 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -4,7 +4,7 @@ import LeanMal.core universe u -def makeFn (ref: Env) (args : List Types) : IO (Env × Types) := do +def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let p := args[0]! @@ -38,7 +38,7 @@ mutual | Types.dictVal el => (evalDict ref el) | x => Except.ok (ref, x) - partial def evalFunc (ref: Env) (head : Types) (args : List Types) : IO (Env × Types) := do + partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do match evalTypes ref head with | Except.error e => Except.error e | Except.ok (ref2, fn) => @@ -48,25 +48,25 @@ mutual -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) - partial def evalFuncVal (ref: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : IO (Env × Types) := do + partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : IO (Env × Types) := do match fn with | Types.funcVal v => match v with | Fun.builtin name => match if !evaluateArgs then Except.ok (ref, args) else match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) with | Except.error e => Except.error e - | Except.ok (newRef, results) => evalFnNative newRef name results args + | Except.ok (newEnv, results) => evalFnNative newEnv name results args | Fun.userDefined fref params body => match if !evaluateArgs then Except.ok (ref, args) else match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) with | Except.error e => Except.error e - | Except.ok (newRef, results) => + | Except.ok (newEnv, results) => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] @@ -74,10 +74,10 @@ mutual let normalArgs := results.take keys.length let variadicArg := results.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newRef.getLevel then fref.getLevel + 1 else newRef.getLevel + 1 + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newRef.merge fref).mergeDict argsLevel argsDict + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict evalTypes merged body | Fun.macroFn fref params body => @@ -97,7 +97,7 @@ mutual | Except.ok (_, newast) => evalTypes ref newast | _ => throw (IO.userError s!"`unexpected token, expected: function`") - partial def evalList (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do if List.length lst == 0 then Except.ok (ref, Types.listVal lst) else let head := lst[0]! @@ -119,28 +119,28 @@ mutual | _ => evalFunc ref head (lst.drop 1) | _ => evalFunc ref head (lst.drop 1) - partial def evalVec (ref: Env) (elems : List Types) : IO (Env × Types) := do + partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do match evalFuncArgs ref elems with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, Types.vecVal (listToVec results)) + | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) - partial def evalDict (ref: Env) (lst : Dict) : IO (Env × Types) := do + partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do match evalDictInner ref lst with | Except.error e => Except.error e - | Except.ok (newRef, newDict) => Except.ok (newRef, Types.dictVal newDict) + | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) - partial def evalDictInner (ref: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := match lst with | Dict.empty => Except.ok (ref, lst) | Dict.insert k _ v restDict => match evalTypes ref v with | Except.error e => Except.error e - | Except.ok (newRef, newVal) => match evalDictInner newRef restDict with + | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with | Except.error e => Except.error e | Except.ok (updatedRef, updatedDict) => let newDict := Dict.insert k 0 newVal updatedDict Except.ok (updatedRef, newDict) - partial def evalFuncArgs (ref: Env) (args: List Types) : IO (Env × List Types) := + partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") @@ -150,46 +150,46 @@ mutual Except.ok (updatedRef, acc ++ [res]) ) (Except.ok (ref, [])) with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, results) + | Except.ok (newEnv, results) => Except.ok (newEnv, results) - partial def evalDefn (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! match (evalTypes ref body) with | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newRef, value) => + | Except.ok (newEnv, value) => match key with | Types.symbolVal v => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel value + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) - | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") - partial def evalDefMacro (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDefMacro (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! match (evalTypes ref body) with | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newRef, value) => + | Except.ok (newEnv, value) => match key with | Types.symbolVal v => match value with | Types.funcVal func => match func with | Fun.macroFn _ _ _ => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel value + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value Except.ok (refResult, value) | Fun.userDefined fref params body => - let refResult := newRef.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) + let refResult := newEnv.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) Except.ok (refResult, value) - | _ => Except.error (newRef, s!"defmacro!: unexpected builtin function") - | x => Except.error (newRef, s!"unexpected token type: {x.toString true}, expected: function") - | _ => Except.error (newRef, s!"def! unexpected token, expected: symbol") + | _ => Except.error (newEnv, s!"defmacro!: unexpected builtin function") + | x => Except.error (newEnv, s!"unexpected token type: {x.toString true}, expected: function") + | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") - partial def evalLet (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! @@ -200,34 +200,34 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") match result with - | Except.error (newRef, e) => Except.error (newRef, s!"let*: {e}") - | Except.ok newRef => match evalTypes newRef body with + | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") + | Except.ok newEnv => match evalTypes newEnv body with | Except.error e => Except.error e -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope | Except.ok (letref, result) => Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) - partial def evalLetArgs (ref: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := match args with | [] => Except.ok ref | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with | Types.symbolVal key => match evalTypes ref y with - | Except.error (newRef, e) => Except.error (newRef, s!"error evaluating function argument: {key}: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") | Except.ok (updatedRef, value) => evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") - partial def evalDo (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result match evalFuncArgs ref args with | Except.error e => Except.error e - | Except.ok (newRef, results) => - if results.length == 0 then Except.ok (newRef, Types.Nil) - else Except.ok (newRef, results[results.length - 1]!) + | Except.ok (newEnv, results) => + if results.length == 0 then Except.ok (newEnv, Types.Nil) + else Except.ok (newEnv, results[results.length - 1]!) - partial def evalIf (ref: Env) (args : List Types) : IO (Env × Types) := do + partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") else let condition := args[0]! @@ -235,21 +235,21 @@ mutual let hasElse := args.length > 2 match evalTypes ref condition with - | Except.error (newRef, e) => Except.error (newRef, s!"if: {e}") - | Except.ok (newRef, condResp) => + | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") + | Except.ok (newEnv, condResp) => let cond := match condResp with | Types.boolVal v => v | Types.Nil => false | _ => true - if cond then evalTypes newRef thenExpr - else if hasElse then evalTypes newRef args[2]! - else Except.ok (newRef, Types.Nil) + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else Except.ok (newEnv, Types.Nil) - partial def evalTry (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def evalTry (env: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "try*: unexpected syntax") else match evalTypes ref lst[0]! with - | Except.ok (newRef, result) => Except.ok (newRef, result) + | Except.ok (newEnv, result) => Except.ok (newEnv, result) | Except.error evalErr => if lst.length < 2 then Except.error evalErr else @@ -279,7 +279,7 @@ mutual -- | Types.vecVal v => -- TODO | _ => Except.error evalErr - partial def swapAtom (ref: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do + partial def swapAtom (env: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") else let first := lst[0]! @@ -295,21 +295,21 @@ mutual | Types.atomVal x => match x with | Atom.v v => match evalFuncVal ref fn ([v] ++ rest) false with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") | Except.ok (_, res) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) - Except.ok (newRef, res) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + Except.ok (newEnv, res) | Atom.withmeta v meta => match evalFuncVal ref fn ([v] ++ rest) false with - | Except.error (newRef, e) => Except.error (newRef, s!"swap! evaluate function: {e}") + | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") | Except.ok (_, res) => - let newRef := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newRef, res) + let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + Except.ok (newEnv, res) | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") - partial def eval (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def eval (env: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! @@ -346,7 +346,7 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def nativeMapOverList (ref: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do + partial def nativeMapOverList (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do match args.foldl (fun (res : IO (Env × List Types)) x => match res with | Except.error e => Except.error e @@ -357,9 +357,9 @@ mutual Except.ok (updatedRef, acc ++ [res]) ) (Except.ok (ref, [])) with | Except.error e => Except.error e - | Except.ok (newRef, results) => Except.ok (newRef, Types.listVal results) + | Except.ok (newEnv, results) => Except.ok (newEnv, Types.listVal results) - partial def nativeMap (ref: Env) (lst: List Types) : IO (Env × Types) := do + partial def nativeMap (env: Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "map: unexpected syntax") else let fn := lst[0]! @@ -372,7 +372,7 @@ mutual | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: function") - partial def nativeApply (ref: Env) (lst : List Types) : IO (Env × Types) := do + partial def nativeApply (env: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "apply: unexpected syntax") else let fn := lst[0]! @@ -481,7 +481,7 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (ref: Env) (input : String): Env × String := +def rep (env: Env) (input : String): Env × String := match READ.{u} input with | Except.ok result => match evalTypes ref result with | Except.error (newref, e) => (newref, s!"Error: {e}") @@ -495,7 +495,7 @@ def printLogs (ref : Env) : IO Unit := | x => IO.println (x.toString true) ) -def loadMalFns (ref: Env) (fndefs: List String): Env × String := +def loadMalFns (env: Env) (fndefs: List String): Env × String := fndefs.foldl (fun (res : Env × String) fndef => let (ref, msg) := res let (newref, newmsg) := rep.{u} ref fndef diff --git a/impls/lean/LeanMal/types.lean b/impls/lean/LeanMal/types.lean index fc3bc5c346..8932a257d4 100644 --- a/impls/lean/LeanMal/types.lean +++ b/impls/lean/LeanMal/types.lean @@ -50,8 +50,8 @@ mutual inductive Fun : Type u | builtin (name : String) - | userDefined (ref: Env) (params : Types) (body : Types) - | macroFn (ref: Env) (params : Types) (body : Types) + | userDefined (env: Env) (params : Types) (body : Types) + | macroFn (env: Env) (params : Types) (body : Types) inductive Dict: Type u | empty : Dict From 707cc911cbdd832d2050bff87fdeb10336994251 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Tue, 27 Aug 2024 00:31:36 +0200 Subject: [PATCH 29/39] use IO, refactor step 3 --- impls/lean/LeanMal/step3_env.lean | 159 ++++++++++++++---------------- 1 file changed, 72 insertions(+), 87 deletions(-) diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index 95909e5a13..e5bda60656 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -64,115 +64,97 @@ mutual | x => return (ref, x) partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do - match evalTypes ref head with - | Except.error e => Except.error s!"error evaluating function: {head.toString true}: {e}" - | Except.ok (_, fn) => evalFuncVal ref fn args + let (_, fn) ← evalTypes env head + evalFuncVal env fn args partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - match fn with - | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newEnv name results - | Fun.userDefined fref params body => - let keys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let argsLevel := fref.getLevel + 1 - let argsDict := (buildDict argsLevel keys results) - let merged := (newEnv.merge fref).mergeDict argsLevel argsDict - evalTypes merged body - | Fun.macroFn _ _ _ => Except.error "macro not implemented" - | _ => Except.error s!"`unexpected token, expected: function`" + let (newEnv, results) ← evalFuncArgs env args + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => evalFnNative newEnv name results + | Fun.userDefined fref params body => + let keys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let argsLevel := fref.getLevel + 1 + let argsDict := (buildDict argsLevel keys results) + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict + evalTypes merged body + | Fun.macroFn _ _ _ => throw (IO.userError "macro not implemented") + | _ => throw (IO.userError s!"`unexpected token, expected: function`") partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do - if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + if List.length lst == 0 then return (env, Types.listVal lst) else let head := lst[0]! match lst[0]! with | Types.symbolVal v => match v with - | "def!" => evalDefn ref (lst.drop 1) - | "let*" => evalLet ref (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) + | "def!" => evalDefn env (lst.drop 1) + | "let*" => evalLet env (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do - match evalFuncArgs ref elems with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) + let (newEnv, results) ← evalFuncArgs env elems + return (newEnv, Types.vecVal (listToVec results)) partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do - match evalDictInner ref lst with - | Except.error e => Except.error e - | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) + let (newEnv, newDict) ← evalDictInner env lst + return (newEnv, Types.dictVal newDict) - partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Types) := do + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := do match lst with - | Dict.empty => Except.ok (ref, lst) - | Dict.insert k _ v restDict => match evalTypes ref v with - | Except.error e => Except.error e - | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with - | Except.error e => Except.error e - | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k 0 newVal updatedDict - Except.ok (updatedRef, newDict) + | Dict.empty => return (env, lst) + | Dict.insert k _ v restDict => + let (newEnv, newVal) ← evalTypes env v + let (updatedEnv, updatedDict) ← evalDictInner newEnv restDict + let newDict := Dict.insert k 0 newVal updatedDict + return (updatedEnv, newDict) partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := do - match args.foldl (fun (res : IO (Dict × List Types)) x => - match res with - | Except.error e => Except.error s!"error evaluating function argument accumulator: {x.toString true}: {e}" - | Except.ok (r, acc) => match evalTypes r x with - | Except.error e => Except.error s!"error evaluating function argument: {x.toString true}: {e}" - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, acc ++ [res]) - ) (Except.ok (ref, [])) with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) + args.foldlM (fun (res : Env × List Types) (x : Types) => do + let (r, acc) := res + let (updatedRef, res) ← evalTypes r x + return (updatedRef, acc ++ [res]) + ) (env, []) partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error "def! unexpected syntax" + if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! - match (evalTypes ref body) with - | Except.error e => Except.error s!"def!: {e}" - | Except.ok (newEnv, value) => - match key with - | Types.symbolVal v => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value - Except.ok (refResult, value) - | _ => Except.error s!"def! unexpected token, expected: symbol" + let (newEnv, value) ← (evalTypes env body) + match key with + | Types.symbolVal v => + let envResult := newEnv.add (KeyType.strKey v) env.getLevel value + return (envResult, value) + | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then Except.error "let*: unexpected syntax" + if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! - let result := match pairs with - | Types.listVal v => evalLetArgs ref.increment v - | Types.vecVal v => evalLetArgs ref.increment (toList v) - | _ => Except.error s!"unexpected token type: ${pairs.toString true}, expected: list or vector" - - match result with - | Except.error e => Except.error s!"let*: {e}" - | Except.ok newEnv => match evalTypes newEnv body with - | Except.error e => Except.error e - -- we do not propagate the let* environment to the parent scope - | Except.ok (_, result) => Except.ok (ref, result) - - partial def evalLetArgs (env: Env) (args : List Types) : IO Env := + let newEnv ← match pairs with + | Types.listVal v => evalLetArgs env.increment v + | Types.vecVal v => evalLetArgs env.increment (toList v) + | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") + + -- we do not propagate the let* environment to the parent scope + let (_, result) ← evalTypes newEnv body + return (env, result) + + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with - | [] => Except.ok ref - | [_] => Except.error "let*: unexpected syntax" + | [] => return env + | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with - | Types.symbolVal key => match evalTypes ref y with - | Except.error e => Except.error s!"error evaluating function argument: {key}: {e}" - | Except.ok (updatedRef, value) => - evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest - | _ => Except.error "let*: unexpected syntax" + | Types.symbolVal key => + let (updatedRef, value) ← evalTypes env y + evalLetArgs (updatedRef.add (KeyType.strKey key) env.getLevel value) rest + | _ => throw (IO.userError "let*: unexpected syntax") end def loadFnNative (ref : Env) (name: String) : Env := @@ -182,7 +164,7 @@ def loadFnNativeAll (env: Env) : Env := loadFnNative ( loadFnNative ( loadFnNative ( - loadFnNative ref "+" + loadFnNative env "+" ) "-" ) "*" ) "/" @@ -190,12 +172,15 @@ def loadFnNativeAll (env: Env) : Env := def PRINT (ast : Types): String := pr_str true ast -def rep (env: Env) (input : String): Env × String := +def rep (env: Env) (input : String): IO (Env × String) := do match READ.{u} input with - | Except.ok result => match evalTypes ref result with - | Except.error e => (ref, e) - | Except.ok (newref, res) => (newref, PRINT res) - | Except.error err => (ref, s!"Parsing failed: {err}") + | Except.ok result => + try + let (newenv, res) ← evalTypes env result + return (newenv, PRINT res) + catch + | e => return (env, s!"Error: {e}") + | Except.error err => return (env, s!"Parsing failed: {err}") def main : IO Unit := do let mut env := loadFnNativeAll (Env.data 0 Dict.empty) @@ -211,6 +196,6 @@ def main : IO Unit := do if value.isEmpty then donext := false else - let (ref, val) := rep.{u} env value + let (newenv, val) ← rep.{u} env value IO.println val - env := ref + env := newenv From 497c135d7f22bbee66719ddb587c1da43fd5b371 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Tue, 27 Aug 2024 01:25:14 +0200 Subject: [PATCH 30/39] use IO, refactor step 4 --- impls/lean/LeanMal/core.lean | 355 +++++++++++-------------- impls/lean/LeanMal/step2_eval.lean | 86 +++--- impls/lean/LeanMal/step3_env.lean | 94 +++---- impls/lean/LeanMal/step4_if_fn_do.lean | 278 +++++++++---------- impls/lean/LeanMal/step5_tco.lean | 4 +- impls/lean/LeanMal/step6_file.lean | 4 +- impls/lean/LeanMal/step7_quote.lean | 4 +- impls/lean/LeanMal/step8_macros.lean | 4 +- impls/lean/LeanMal/step9_try.lean | 4 +- impls/lean/LeanMal/stepA_mal.lean | 4 +- 10 files changed, 386 insertions(+), 451 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 0021294e8c..226900f4e5 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -5,40 +5,40 @@ import LeanMal.reader universe u -def sum (ref : Env) (lst: List Types) : IO (Env × Types) := do +def sum (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x + y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x + y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x + y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x + y)) | _ => throw (IO.userError "+ operator not supported") -def sub (ref : Env) (lst: List Types) : IO (Env × Types) := do +def sub (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x - y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x - y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x - y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x - y)) | _ => throw (IO.userError "- operator not supported") -def mul (ref : Env) (lst: List Types) : IO (Env × Types) := do +def mul (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x * y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x * y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x * y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x * y)) | _ => throw (IO.userError "* operator not supported") -def div (ref : Env) (lst: List Types) : IO (Env × Types) := do +def div (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x / y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x / y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x / y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x / y)) | _ => throw (IO.userError "/ operator not supported") def ltInternal (first: Types) (second: Types) (orEq: Bool) : Bool := @@ -50,21 +50,21 @@ def ltInternal (first: Types) (second: Types) (orEq: Bool) : Bool := | Types.strVal n, Types.strVal v => n < v || (if orEq then n == v else false) | _, _ => false -def lt (ref : Env) (lst: List Types) : IO (Env × Types) := do +def lt (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "eq: 2 arguments required") else let first := lst[0]! let second := lst[1]! let res := ltInternal first second false - Except.ok (ref, Types.boolVal res) + return (env, Types.boolVal res) -def lte (ref : Env) (lst: List Types) : IO (Env × Types) := do +def lte (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "eq: 2 arguments required") else let first := lst[0]! let second := lst[1]! let res := ltInternal first second true - Except.ok (ref, Types.boolVal res) + return (env, Types.boolVal res) def gtInternal (first: Types) (second: Types) (orEq: Bool) : Bool := match first, second with @@ -75,21 +75,21 @@ def gtInternal (first: Types) (second: Types) (orEq: Bool) : Bool := | Types.strVal n, Types.strVal v => n > v || (if orEq then n == v else false) | _, _ => false -def gt (ref : Env) (lst: List Types) : IO (Env × Types) := do +def gt (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "eq: 2 arguments required") else let first := lst[0]! let second := lst[1]! let res := gtInternal first second false - Except.ok (ref, Types.boolVal res) + return (env, Types.boolVal res) -def gte (ref : Env) (lst: List Types) : IO (Env × Types) := do +def gte (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "eq: 2 arguments required") else let first := lst[0]! let second := lst[1]! let res := gtInternal first second true - Except.ok (ref, Types.boolVal res) + return (env, Types.boolVal res) mutual partial def eqList (n: List Types) (v: List Types) (strict: Bool) : Bool := @@ -150,31 +150,31 @@ mutual end -def eq (ref : Env) (lst: List Types) (strict: Bool) : IO (Env × Types) := do +def eq (env : Env) (lst: List Types) (strict: Bool) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "eq: 2 arguments required") else let first := lst[0]! let second := lst[1]! let res := eqInternal first second strict - Except.ok (ref, Types.boolVal res) + return (env, Types.boolVal res) -def makeAtom (ref : Env) (lst: List Types) : IO (Env × Types) := do +def makeAtom (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "keyword: 1 argument required") else let first := lst[0]! - Except.ok (ref, Types.atomVal (Atom.v first)) + return (env, Types.atomVal (Atom.v first)) -def derefAtom (ref : Env) (lst: List Types) : IO (Env × Types) := do +def derefAtom (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "deref: 1 argument required") else let first := lst[0]! match first with | Types.atomVal x => match x with - | Atom.v v => Except.ok (ref, v) - | Atom.withmeta v _ => Except.ok (ref, v) + | Atom.v v => return (env, v) + | Atom.withmeta v _ => return (env, v) | x => throw (IO.userError s!"deref: unexpected symbol: {x.toString true}, expected: atom") -def resetAtom (ref : Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do +def resetAtom (env : Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "reset!: 2 argument required") else let first := lst[0]! @@ -182,16 +182,16 @@ def resetAtom (ref : Env) (lst: List Types) (args: List Types) : IO (Env × Type let atomSymbol := args[0]! match atomSymbol with | Types.symbolVal sym => - match ref.get (KeyType.strKey sym) with + match env.get (KeyType.strKey sym) with | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v _ => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v second)) - Except.ok (newEnv, second) + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.v second)) + return (newEnv, second) | Atom.withmeta _ meta => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta second meta)) - Except.ok (newEnv, second) + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta second meta)) + return (newEnv, second) | x => throw (IO.userError s!"reset!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"reset!: unexpected token: {x.toString true}, expected: symbol") @@ -199,72 +199,42 @@ def prStrInternal (lst: List Types) (printReadably: Bool) (sep: String) : String let elems := lst.map (fun x => x.toString printReadably) String.intercalate sep elems --- we avoid introducing the IO monad for logging, by just collecting the logs in the environment Dict -def KEY_LOGS_INFO := "LOGS_INFO" -def KEY_LOGS_DEBUG := "LOGS_DEBUG" def KEY_DEBUG_EVAL := "DEBUG-EVAL" -def resetLogs (ref : Env): Env := - ( - ref.add (KeyType.strKey KEY_LOGS_INFO) 0 (Types.listVal []) - ).add (KeyType.strKey KEY_LOGS_DEBUG) 0 (Types.listVal []) - -def getLogs (ref : Env) (type: String): List Types := - match ref.get (KeyType.strKey type) with - | some (_, v) => match v with - | Types.listVal loglist => loglist - | _ => [] - | _ => [] - -def getDebugEval (ref : Env): Bool := - match ref.get (KeyType.strKey KEY_DEBUG_EVAL) with +def getDebugEval (env : Env): Bool := + match env.get (KeyType.strKey KEY_DEBUG_EVAL) with | some (_, v) => match v with | Types.boolVal v => v | Types.Nil => false | _ => false | _ => false -def getLogsInfo (ref : Env): List Types := - getLogs ref KEY_LOGS_INFO - -def forwardLogs (sourceRef : Env) (targetRef : Env): Env := - let infologs := getLogs sourceRef KEY_LOGS_INFO - let debuglogs := getLogs sourceRef KEY_LOGS_DEBUG - ( - targetRef.add (KeyType.strKey KEY_LOGS_INFO) 0 (Types.listVal infologs) - ).add (KeyType.strKey KEY_LOGS_DEBUG) 0 (Types.listVal debuglogs) - -def logInfo (ref : Env) (msg: String): Env := - let loglist := getLogs ref KEY_LOGS_INFO - let newlogs := loglist ++ [(Types.strVal msg)] - ref.add (KeyType.strKey KEY_LOGS_INFO) 0 (Types.listVal newlogs) - -def prStrFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do +def prStrFunc (env : Env) (lst: List Types) : IO (Env × Types) := do let str := prStrInternal lst true " " - Except.ok (ref, Types.strVal str) + return (env, Types.strVal str) -def prnFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do +def prnFunc (env : Env) (lst: List Types) : IO (Env × Types) := do let str := prStrInternal lst true " " - let newEnv := logInfo ref str - Except.ok (newEnv, Types.Nil) + IO.println str + return (env, Types.Nil) -def printlnFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do +def printlnFunc (env : Env) (lst: List Types) : IO (Env × Types) := do let str := prStrInternal lst false " " - let newEnv := logInfo ref str - Except.ok (newEnv, Types.Nil) + IO.println str + return (env, Types.Nil) -def strFunc (ref : Env) (lst: List Types) : IO (Env × Types) := do +def strFunc (env : Env) (lst: List Types) : IO (Env × Types) := do let str := prStrInternal lst false "" - Except.ok (ref, Types.strVal str) + return (env, Types.strVal str) -def countFunc(ref : Env) (lst: List Types) : IO (Env × Types) := do +def countFunc(env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "count: 1 argument required") else let x := lst[0]! match x with - | Types.listVal v => Except.ok (ref, Types.intVal v.length) - | Types.vecVal v => Except.ok (ref, Types.intVal (toList v).length) - | Types.Nil => Except.ok (ref, Types.intVal 0) + | Types.listVal v => return (env, Types.intVal v.length) + | Types.vecVal v => return (env, Types.intVal (toList v).length) + | Types.Nil => return (env, Types.intVal 0) | _ => throw (IO.userError "count called on non-sequence") def readString (lst: List Types) (envir: Env) : Except String Types := @@ -275,41 +245,38 @@ def readString (lst: List Types) (envir: Env) : Except String Types := | Types.strVal v => read_types_with_env v envir.getDict -- Dict.empty | x => Except.error s!"unexpected symbol: {x.toString true}, expected: string" -def cons (ref : Env) (lst: List Types) : IO (Env × Types) := do +def cons (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "cons: >= 2 arguments required") else let elem := lst[0]! let seq := lst[1]! match seq with - | Types.listVal v => Except.ok (ref, (Types.listVal (elem :: v))) - | Types.vecVal v => Except.ok (ref, (Types.listVal (elem :: (toList v)))) + | Types.listVal v => return (env, (Types.listVal (elem :: v))) + | Types.vecVal v => return (env, (Types.listVal (elem :: (toList v)))) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") -def concat (ref : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then Except.ok (ref, Types.listVal []) +def concat (env : Env) (lst: List Types) : IO (Env × Types) := do + if lst.length < 1 then return (env, Types.listVal []) else - match lst.foldl (fun (acc: Except (Env × String) (List Types)) x => - match acc with - | Except.error e => Except.error e - | Except.ok newlist => - match x with - | Types.listVal v => Except.ok (newlist ++ v) - | Types.vecVal v => Except.ok (newlist ++ (toList v)) - | x => Except.ok (newlist ++ [x]) - ) (Except.ok []) with - | Except.error e => Except.error e - | Except.ok v => Except.ok (ref, Types.listVal v) - -def makeVec (ref : Env) (lst: List Types) : IO (Env × Types) := do + let v ← lst.foldlM (fun (acc: List Types) x => + match x with + | Types.listVal v => return acc ++ v + | Types.vecVal v => return acc ++ (toList v) + | x => return acc ++ [x] + ) [] + return (env, Types.listVal v) + + +def makeVec (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "vec: 1 arguments required") else let first := lst[0]! match first with - | Types.vecVal v => Except.ok (ref, Types.vecVal v) - | Types.listVal v => Except.ok (ref, Types.vecVal (listToVec v)) + | Types.vecVal v => return (env, Types.vecVal v) + | Types.listVal v => return (env, Types.vecVal (listToVec v)) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") -def nthSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do +def nthSeq (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "nth: >= 2 arguments required") else let first := lst[0]! @@ -320,77 +287,77 @@ def nthSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do | Types.vecVal v => let lv := toList v match lv.get? i.toNat with - | some v => Except.ok (ref, v) + | some v => return (env, v) | none => throw (IO.userError "nth: index out of range") | Types.listVal lv => if lv.length <= i then throw (IO.userError s!"nth: index out of range: {i}") else match lv.get? i.toNat with - | some v => Except.ok (ref, v) + | some v => return (env, v) | none => throw (IO.userError "nth: index out of range") | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: number") -def firstSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do +def firstSeq (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "first: 1 arguments required") else let first := lst[0]! match first with - | Types.Nil => Except.ok (ref, Types.Nil) + | Types.Nil => return (env, Types.Nil) | Types.vecVal v => let lv := toList v - if lv.length == 0 then Except.ok (ref, Types.Nil) + if lv.length == 0 then return (env, Types.Nil) else let elem := lv[0]! - Except.ok (ref, elem) + return (env, elem) | Types.listVal lv => - if lv.length == 0 then Except.ok (ref, Types.Nil) + if lv.length == 0 then return (env, Types.Nil) else let elem := lv[0]! - Except.ok (ref, elem) + return (env, elem) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") -def restSeq (ref : Env) (lst: List Types) : IO (Env × Types) := do +def restSeq (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "rest: 1 arguments required") else let first := lst[0]! match first with - | Types.Nil => Except.ok (ref, Types.listVal []) + | Types.Nil => return (env, Types.listVal []) | Types.vecVal v => let lv := toList v - if lv.length < 1 then Except.ok (ref, Types.listVal []) + if lv.length < 1 then return (env, Types.listVal []) else - Except.ok (ref, Types.listVal (lv.drop 1)) + return (env, Types.listVal (lv.drop 1)) | Types.listVal lv => - if lv.length < 1 then Except.ok (ref, Types.listVal []) + if lv.length < 1 then return (env, Types.listVal []) else - Except.ok (ref, Types.listVal (lv.drop 1)) + return (env, Types.listVal (lv.drop 1)) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") -def makeVector (ref : Env) (lst: List Types) : IO (Env × Types) := do - Except.ok (ref, Types.vecVal (listToVec lst)) +def makeVector (env : Env) (lst: List Types) : IO (Env × Types) := do + return (env, Types.vecVal (listToVec lst)) def makeDictInternal (initialDict : Dict) (lst: List Types) : Except String (Dict) := let rec loop (lst : List Types) (acckeys: List String) (acc : Dict) : Except String (Dict × List String) := match lst with - | [] => Except.ok (acc, acckeys) + | [] => return (acc, acckeys) | (Types.strVal k) :: v :: rest => - if acckeys.contains k then Except.ok (acc, acckeys) + if acckeys.contains k then return (acc, acckeys) else loop rest (acckeys ++ [k]) (Dict.insert (KeyType.strKey k) 0 v acc) | (Types.keywordVal k) :: v :: rest => - if acckeys.contains k then Except.ok (acc, acckeys) + if acckeys.contains k then return (acc, acckeys) else loop rest (acckeys ++ [k]) (Dict.insert (KeyType.keywordKey k) 0 v acc) | _ => Except.error "Invalid list format: Expected alternating string/keyword and value" match loop lst [] initialDict with | Except.error e => Except.error e | Except.ok (v, _) => Except.ok v -def makeDict (ref : Env) (lst: List Types) : IO (Env × Types) := do +def makeDict (env : Env) (lst: List Types) : IO (Env × Types) := do match makeDictInternal Dict.empty lst with | Except.error e => throw (IO.userError e) - | Except.ok (newDict) => Except.ok (ref, Types.dictVal newDict) + | Except.ok (newDict) => return (env, Types.dictVal newDict) -def assocDict (ref : Env) (lst: List Types) : IO (Env × Types) := do +def assocDict (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "assoc: >= 1 arguments required") else let first := lst[0]! @@ -399,7 +366,7 @@ def assocDict (ref : Env) (lst: List Types) : IO (Env × Types) := do | Types.dictVal v => match makeDictInternal v rest with | Except.error e => throw (IO.userError e) - | Except.ok (newDict) => Except.ok (ref, Types.dictVal newDict) + | Except.ok (newDict) => return (env, Types.dictVal newDict) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") def dissoc (dict : Dict) (keys : List Types) : Except String Dict := @@ -417,7 +384,7 @@ def dissoc (dict : Dict) (keys : List Types) : Except String Dict := | x => Except.error s!"unexpected symbol: {x.toString true}, expected: keyword or string" loop keys dict -def dissocDict (ref : Env) (lst: List Types) : IO (Env × Types) := do +def dissocDict (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "dissoc: >= 1 arguments required") else let first := lst[0]! @@ -426,10 +393,10 @@ def dissocDict (ref : Env) (lst: List Types) : IO (Env × Types) := do | Types.dictVal v => match dissoc v rest with | Except.error e => throw (IO.userError e) - | Except.ok newDict => Except.ok (ref, Types.dictVal newDict) + | Except.ok newDict => return (env, Types.dictVal newDict) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") -def getDict (ref : Env) (lst: List Types) : IO (Env × Types) := do +def getDict (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "get: >= 1 arguments required") else let first := lst[0]! @@ -437,22 +404,22 @@ def getDict (ref : Env) (lst: List Types) : IO (Env × Types) := do match first with | Types.dictVal v => match rest with - | [] => Except.ok (ref, Types.Nil) + | [] => return (env, Types.Nil) | _ => match (rest[0]!) with | Types.strVal k => match v.get (KeyType.strKey k) with - | some (_, val) => Except.ok (ref, val) - | none => Except.ok (ref, Types.Nil) + | some (_, val) => return (env, val) + | none => return (env, Types.Nil) | Types.keywordVal k => match v.get (KeyType.keywordKey k) with - | some (_, val) => Except.ok (ref, val) - | none => Except.ok (ref, Types.Nil) + | some (_, val) => return (env, val) + | none => return (env, Types.Nil) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: keyword or string") - | Types.Nil => Except.ok (ref, Types.Nil) + | Types.Nil => return (env, Types.Nil) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") -def containsDict (ref : Env) (lst: List Types) : IO (Env × Types) := do +def containsDict (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "contains?: >= 1 arguments required") else let first := lst[0]! @@ -460,22 +427,22 @@ def containsDict (ref : Env) (lst: List Types) : IO (Env × Types) := do match first with | Types.dictVal v => match rest with - | [] => Except.ok (ref, Types.boolVal false) + | [] => return (env, Types.boolVal false) | _ => match (rest[0]!) with | Types.strVal k => match v.get (KeyType.strKey k) with - | some _ => Except.ok (ref, Types.boolVal true) - | none => Except.ok (ref, Types.boolVal false) + | some _ => return (env, Types.boolVal true) + | none => return (env, Types.boolVal false) | Types.keywordVal k => match v.get (KeyType.strKey k) with - | some _ => Except.ok (ref, Types.boolVal true) - | none => Except.ok (ref, Types.boolVal false) + | some _ => return (env, Types.boolVal true) + | none => return (env, Types.boolVal false) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: keyword or string") - | Types.Nil => Except.ok (ref, Types.boolVal false) + | Types.Nil => return (env, Types.boolVal false) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") -def getKeysDict (ref : Env) (lst: List Types) : IO (Env × Types) := do +def getKeysDict (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "keys: 1 arguments required") else let first := lst[0]! @@ -487,113 +454,113 @@ def getKeysDict (ref : Env) (lst: List Types) : IO (Env × Types) := do | KeyType.strKey v => (Types.strVal v) | KeyType.keywordKey v => (Types.keywordVal v) ) - Except.ok (ref, (Types.listVal result)) + return (env, (Types.listVal result)) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") -def getValuesDict (ref : Env) (lst: List Types) : IO (Env × Types) := do +def getValuesDict (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "get: 1 arguments required") else let first := lst[0]! match first with | Types.dictVal v => let values := v.values - Except.ok (ref, (Types.listVal values)) + return (env, (Types.listVal values)) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") -def makeSymbol (ref : Env) (lst: List Types) : IO (Env × Types) := do +def makeSymbol (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "symbol: 1 argument required") else let first := lst[0]! match first with - | Types.symbolVal v => Except.ok (ref, Types.symbolVal v) - | Types.strVal v => Except.ok (ref, Types.symbolVal v) + | Types.symbolVal v => return (env, Types.symbolVal v) + | Types.strVal v => return (env, Types.symbolVal v) | x => throw (IO.userError s!"symbol: unexpected symbol: {x.toString true}, expected: string") -def makeKeyword (ref : Env) (lst: List Types) : IO (Env × Types) := do +def makeKeyword (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "keyword: 1 argument required") else let first := lst[0]! match first with - | Types.keywordVal v => Except.ok (ref, Types.keywordVal v) - | Types.strVal v => Except.ok (ref, Types.keywordVal v) + | Types.keywordVal v => return (env, Types.keywordVal v) + | Types.strVal v => return (env, Types.keywordVal v) | x => throw (IO.userError s!"keyword: unexpected symbol: {x.toString true}, expected: string") -def conj (ref : Env) (lst: List Types) : IO (Env × Types) := do +def conj (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "conj: >= 1 arguments required") else let first := lst[0]! let rest := lst.drop 1 match first with - | Types.listVal v => Except.ok (ref, Types.listVal ( rest.reverse ++ v)) - | Types.vecVal v => Except.ok (ref, Types.vecVal (listToVec ((toList v) ++ rest))) + | Types.listVal v => return (env, Types.listVal ( rest.reverse ++ v)) + | Types.vecVal v => return (env, Types.vecVal (listToVec ((toList v) ++ rest))) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") -def seq (ref : Env) (lst: List Types) : IO (Env × Types) := do +def seq (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "conj: 1 arguments required") else let first := lst[0]! match first with - | Types.Nil => Except.ok (ref, Types.Nil) - | Types.listVal v => if v.length == 0 then Except.ok (ref, Types.Nil) else Except.ok (ref, Types.listVal v) + | Types.Nil => return (env, Types.Nil) + | Types.listVal v => if v.length == 0 then return (env, Types.Nil) else return (env, Types.listVal v) | Types.vecVal vv => let v := toList vv - if v.length == 0 then Except.ok (ref, Types.Nil) else Except.ok (ref, Types.listVal v) + if v.length == 0 then return (env, Types.Nil) else return (env, Types.listVal v) | Types.strVal v => - if v.length == 0 then Except.ok (ref, Types.Nil) + if v.length == 0 then return (env, Types.Nil) else let lv := v.toList.map (fun x => Types.strVal (String.singleton x)) - Except.ok (ref, Types.listVal lv) + return (env, Types.listVal lv) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list, vector or string") -partial def throwFn (ref : Env) (lst : List Types) : IO (Env × Types) := do +partial def throwFn (_ : Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "panic") else let a := lst[0]! match a with | Types.strVal v => throw (IO.userError v) - | x => throw (IO.userError x.toString true) + | x => throw (IO.userError (x.toString true)) def readFileContent (filePath : String) : IO String := do IO.FS.readFile filePath -def slurp (ref : Env) (lst: List Types) : IO (Except (Env × String) (Env × Types)) := do +def slurp (env : Env) (lst: List Types) : IO (Except (Env × String) (Env × Types)) := do if lst.length < 1 then - return throw (IO.userError "slurp: 2 arguments required") + throw (IO.userError "slurp: 2 arguments required") else match lst[0]! with | Types.strVal filename => do let result ← try let content ← readFileContent filename - return Except.ok (ref, Types.strVal content) + return return (env, Types.strVal content) catch e => - return throw (IO.userError s!"slurp: failed to read file: {e.toString}") + throw (IO.userError s!"slurp: failed to read file: {e.toString}") -- return result | _ => - return throw (IO.userError "slurp: filename must be a string") + throw (IO.userError "slurp: filename must be a string") -def slurp2 (ref : Env) (lst: List Types) : IO (Env × Types) := do +def slurp2 (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "slurp: 2 arguments required") else match lst[0]! with | Types.strVal filename => do let content ← readFileContent filename - return (ref, Types.strVal content) + return (env, Types.strVal content) | _ => throw (IO.userError "slurp: filename must be a string") -- IO monad limits some of the formal proving capabilities that Lean offers because IO introduces side effects that are inherently non-deterministic and impure, such as reading from files -def evalFnNativeWithIO (ref : Env) (name: String) (results: List Types): IO (Except (Env × String) (Env × Types)) := +def evalFnNativeWithIO (env : Env) (name: String) (results: List Types): IO (Except (Env × String) (Env × Types)) := match name with - | "slurp" => slurp ref results - | _ => return throw (IO.userError s!"'{name}' not found") + | "slurp" => slurp env results + | _ => throw (IO.userError s!"'{name}' not found") -def loadFnNative (ref : Env) (name: String) : Env := - ref.add (KeyType.strKey name) 0 (Types.funcVal (Fun.builtin name)) +def loadFnNative (env : Env) (name: String) : Env := + env.add (KeyType.strKey name) 0 (Types.funcVal (Fun.builtin name)) -def loadFnNativeFold (ref : Env) (fnNames : List String) : Env := - fnNames.foldl loadFnNative ref +def loadFnNativeFold (env : Env) (fnNames : List String) : Env := + fnNames.foldl loadFnNative env def coreFnSymbols: List String := [ "+", "-", "*", "/", @@ -616,20 +583,18 @@ def coreFnSymbols: List String := [ "time-ms", "meta", "with-meta" ] -def loadFnNativeAll (ref : Env) : Env := - ((( - loadFnNativeFold ref coreFnSymbols - ).add (KeyType.strKey KEY_LOGS_INFO) 0 (Types.listVal []) - ).add (KeyType.strKey KEY_LOGS_DEBUG) 0 (Types.listVal []) +def loadFnNativeAll (env : Env) : Env := + ( + loadFnNativeFold env coreFnSymbols ).add (KeyType.strKey KEY_DEBUG_EVAL) 0 (Types.boolVal false) -def setSymbol (ref : Env) (name: String) (value: Types): Env := - ref.add (KeyType.strKey name) 0 value +def setSymbol (env : Env) (name: String) (value: Types): Env := + env.add (KeyType.strKey name) 0 value -- forward mutated atoms defined in the outer environments -- outer environments always have a lower level index -def forwardMutatedAtoms (refSource: Env) (refOuter: Env): Env := - refSource.getDict.fold refOuter (fun key l v acc => +def forwardMutatedAtoms (envSource: Env) (envOuter: Env): Env := + envSource.getDict.fold envOuter (fun key l v acc => if l > acc.getLevel then acc else match acc.get key with diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean index 155bf80778..d85b214edd 100644 --- a/impls/lean/LeanMal/step2_eval.lean +++ b/impls/lean/LeanMal/step2_eval.lean @@ -6,65 +6,65 @@ universe u def READ (input : String): Except String Types := read_str.{u} input -def sum (ref : Env) (lst: List Types) : IO (Env × Types) := do +def sum (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x + y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x + y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x + y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x + y)) | _ => throw (IO.userError "+ operator not supported") -def sub (ref : Env) (lst: List Types) : IO (Env × Types) := do +def sub (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x - y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x - y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x - y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x - y)) | _ => throw (IO.userError "- operator not supported") -def mul (ref : Env) (lst: List Types) : IO (Env × Types) := do +def mul (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x * y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x * y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x * y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x * y)) | _ => throw (IO.userError "* operator not supported") -def div (ref : Env) (lst: List Types) : IO (Env × Types) := do +def div (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x / y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x / y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x / y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x / y)) | _ => throw (IO.userError "/ operator not supported") -def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do +def evalFnNative (env : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with - | "+" => sum ref results - | "-" => sub ref results - | "*" => mul ref results - | "/" => div ref results + | "+" => sum env results + | "-" => sub env results + | "*" => mul env results + | "/" => div env results | _ => throw (IO.userError s!"'{name}' not found") mutual - partial def evalTypes (ref : Env) (ast : Types) : IO (Env × Types) := do + partial def evalTypes (env : Env) (ast : Types) : IO (Env × Types) := do match ast with - | Types.symbolVal v => match ref.get (KeyType.strKey v) with - | some (_, vi) => return (ref, vi) - | none => return (ref, Types.symbolVal v ) - | Types.listVal el => (evalList ref el) - | Types.vecVal el => (evalVec ref (toList el)) - | Types.dictVal el => (evalDict ref el) - | x => return (ref, x) + | Types.symbolVal v => match env.get (KeyType.strKey v) with + | some (_, vi) => return (env, vi) + | none => return (env, Types.symbolVal v ) + | Types.listVal el => (evalList env el) + | Types.vecVal el => (evalVec env (toList el)) + | Types.dictVal el => (evalDict env el) + | x => return (env, x) partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do - let (_, fn) ← evalTypes env head - evalFuncVal env fn args + let (env2, fn) ← evalTypes env head + evalFuncVal env2 fn args partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation @@ -73,12 +73,12 @@ mutual | Types.symbolVal name => evalFnNative newEnv name results | Types.funcVal v => match v with | Fun.builtin name => evalFnNative newEnv name results - | Fun.userDefined fref params body => + | Fun.userDefined fenv params body => let keys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] let argsDict := (buildDict 0 keys results) - let merged := (newEnv.merge fref).mergeDict (fref.getLevel + 1) argsDict + let merged := (newEnv.merge fenv).mergeDict (fenv.getLevel + 1) argsDict evalTypes merged body | Fun.macroFn _ _ _ => throw (IO.userError "macro not implemented") | _ => throw (IO.userError s!"`unexpected token, expected: function`") @@ -112,8 +112,8 @@ mutual partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := do args.foldlM (fun (res : Env × List Types) (x : Types) => do let (r, acc) := res - let (updatedRef, res) ← evalTypes r x - return (updatedRef, acc ++ [res]) + let (updatedenv, res) ← evalTypes r x + return (updatedenv, acc ++ [res]) ) (env, []) end diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index e5bda60656..868b63bcf3 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -7,65 +7,65 @@ universe u def READ (input : String): Except String Types := read_str.{u} input -def sum (ref : Env) (lst: List Types) : IO (Env × Types) := do +def sum (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x + y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x + y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x + y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x + y)) | _ => throw (IO.userError "+ operator not supported") -def sub (ref : Env) (lst: List Types) : IO (Env × Types) := do +def sub (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x - y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x - y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x - y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x - y)) | _ => throw (IO.userError "- operator not supported") -def mul (ref : Env) (lst: List Types) : IO (Env × Types) := do +def mul (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x * y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x * y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x * y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x * y)) | _ => throw (IO.userError "* operator not supported") -def div (ref : Env) (lst: List Types) : IO (Env × Types) := do +def div (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with - | [] => return (ref, Types.intVal 0) - | [Types.intVal x] => return (ref, Types.intVal x) - | [Types.intVal x, Types.intVal y] => return (ref, Types.intVal (x / y)) - | [Types.floatVal x] => return (ref, Types.floatVal x) - | [Types.floatVal x, Types.floatVal y] => return (ref, Types.floatVal (x / y)) + | [] => return (env, Types.intVal 0) + | [Types.intVal x] => return (env, Types.intVal x) + | [Types.intVal x, Types.intVal y] => return (env, Types.intVal (x / y)) + | [Types.floatVal x] => return (env, Types.floatVal x) + | [Types.floatVal x, Types.floatVal y] => return (env, Types.floatVal (x / y)) | _ => throw (IO.userError "/ operator not supported") -def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do +def evalFnNative (env : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with - | "+" => sum ref results - | "-" => sub ref results - | "*" => mul ref results - | "/" => div ref results + | "+" => sum env results + | "-" => sub env results + | "*" => mul env results + | "/" => div env results | _ => throw (IO.userError s!"'{name}' not found") mutual - partial def evalTypes (ref : Env) (ast : Types) : IO (Env × Types) := do + partial def evalTypes (env : Env) (ast : Types) : IO (Env × Types) := do match ast with - | Types.symbolVal v => match ref.get (KeyType.strKey v) with - | some (_, vi) => return (ref, vi) + | Types.symbolVal v => match env.get (KeyType.strKey v) with + | some (_, vi) => return (env, vi) | none => throw (IO.userError s!"'{v}' not found") - | Types.listVal el => (evalList ref el) - | Types.vecVal el => (evalVec ref (toList el)) - | Types.dictVal el => (evalDict ref el) - | x => return (ref, x) + | Types.listVal el => (evalList env el) + | Types.vecVal el => (evalVec env (toList el)) + | Types.dictVal el => (evalDict env el) + | x => return (env, x) partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do - let (_, fn) ← evalTypes env head - evalFuncVal env fn args + let (env2, fn) ← evalTypes env head + evalFuncVal env2 fn args partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation @@ -73,13 +73,13 @@ mutual match fn with | Types.funcVal v => match v with | Fun.builtin name => evalFnNative newEnv name results - | Fun.userDefined fref params body => + | Fun.userDefined fenv params body => let keys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] - let argsLevel := fref.getLevel + 1 + let argsLevel := fenv.getLevel + 1 let argsDict := (buildDict argsLevel keys results) - let merged := (newEnv.merge fref).mergeDict argsLevel argsDict + let merged := (newEnv.merge fenv).mergeDict argsLevel argsDict evalTypes merged body | Fun.macroFn _ _ _ => throw (IO.userError "macro not implemented") | _ => throw (IO.userError s!"`unexpected token, expected: function`") @@ -115,8 +115,8 @@ mutual partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := do args.foldlM (fun (res : Env × List Types) (x : Types) => do let (r, acc) := res - let (updatedRef, res) ← evalTypes r x - return (updatedRef, acc ++ [res]) + let (updatedenv, res) ← evalTypes r x + return (updatedenv, acc ++ [res]) ) (env, []) partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do @@ -152,13 +152,13 @@ mutual | x :: y :: rest => match x with | Types.symbolVal key => - let (updatedRef, value) ← evalTypes env y - evalLetArgs (updatedRef.add (KeyType.strKey key) env.getLevel value) rest + let (updatedEnv, value) ← evalTypes env y + evalLetArgs (updatedEnv.add (KeyType.strKey key) env.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") end -def loadFnNative (ref : Env) (name: String) : Env := - ref.add (KeyType.strKey name) 0 (Types.funcVal (Fun.builtin name)) +def loadFnNative (env : Env) (name: String) : Env := + env.add (KeyType.strKey name) 0 (Types.funcVal (Fun.builtin name)) def loadFnNativeAll (env: Env) : Env := loadFnNative ( diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index 2090d8a82d..4c9147a426 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -12,8 +12,8 @@ def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do let params := match p with | Types.vecVal x => Types.listVal (toList x) | _ => p - let newfn := Fun.userDefined ref.increment params body - Except.ok (ref, Types.funcVal newfn) + let newfn := Fun.userDefined env.increment params body + return (env, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := @@ -26,149 +26,126 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do - let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" - else _ref + partial def evalTypes (env : Env) (ast : Types) : IO (Env × Types) := do + if getDebugEval env then IO.println s!"EVAL:{pr_str true ast}" match ast with - | Types.symbolVal v => match ref.get (KeyType.strKey v) with - | some (_, vi) => Except.ok (ref, vi) + | Types.symbolVal v => match env.get (KeyType.strKey v) with + | some (_, vi) => return (env, vi) | none => throw (IO.userError s!"'{v}' not found") - | Types.listVal el => (evalList ref el) - | Types.vecVal el => (evalVec ref (toList el)) - | Types.dictVal el => (evalDict ref el) - | x => Except.ok (ref, x) + | Types.listVal el => (evalList env el) + | Types.vecVal el => (evalVec env (toList el)) + | Types.dictVal el => (evalDict env el) + | x => return (env, x) partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do - match evalTypes ref head with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") - | Except.ok (ref2, fn) => - match evalFuncVal ref2 fn args with - | Except.error e => Except.error e - -- only propagate logs after executing a function - | Except.ok (fref, res) => Except.ok (forwardLogs fref ref, res) + let (env2, fn) ← evalTypes env head + -- only propagate logs after executing a function + let (_, res) ← evalFuncVal env2 fn args + return (env, res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - match fn with - | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newEnv name results - | Fun.userDefined fref params body => - let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys - let normalArgs := results.take keys.length - let variadicArg := results.drop keys.length - let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 - - let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newEnv.merge fref).mergeDict argsLevel argsDict - - evalTypes merged body - | Fun.macroFn _ _ _ => Except.error (newEnv, "macro not implemented") - | _ => Except.error (newEnv, s!"`unexpected token, expected: function`") + let (newEnv, results) ← evalFuncArgs env args + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => evalFnNative newEnv name results + | Fun.userDefined fref params body => + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict + + evalTypes merged body + | Fun.macroFn _ _ _ => throw (IO.userError "macro not implemented") + | _ => throw (IO.userError s!"`unexpected token, expected: function`") partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do - if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + if List.length lst == 0 then return (env, Types.listVal lst) else let head := lst[0]! match lst[0]! with | Types.symbolVal v => match v with - | "def!" => evalDefn ref (lst.drop 1) - | "let*" => evalLet ref (lst.drop 1) - | "do" => evalDo ref (lst.drop 1) - | "if" => evalIf ref (lst.drop 1) - | "fn*" => makeFn ref (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) + | "def!" => evalDefn env (lst.drop 1) + | "let*" => evalLet env (lst.drop 1) + | "do" => evalDo env (lst.drop 1) + | "if" => evalIf env (lst.drop 1) + | "fn*" => makeFn env (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do - match evalFuncArgs ref elems with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) + let (newEnv, results) ← evalFuncArgs env elems + return (newEnv, Types.vecVal (listToVec results)) partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do - match evalDictInner ref lst with - | Except.error e => Except.error e - | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) + let (newEnv, newDict) ← evalDictInner env lst + return (newEnv, Types.dictVal newDict) - partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := do match lst with - | Dict.empty => Except.ok (ref, lst) - | Dict.insert k _ v restDict => match evalTypes ref v with - | Except.error e => Except.error e - | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with - | Except.error e => Except.error e - | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k 0 newVal updatedDict - Except.ok (updatedRef, newDict) + | Dict.empty => return (env, lst) + | Dict.insert k _ v restDict => + let (newEnv, newVal) ← evalTypes env v + let (updatedEnv, updatedDict) ← evalDictInner newEnv restDict + let newDict := Dict.insert k 0 newVal updatedDict + return (updatedEnv, newDict) partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := - match args.foldl (fun (res : IO (Env × List Types)) x => - match res with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") - | Except.ok (r, acc) => match evalTypes r x with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, acc ++ [res]) - ) (Except.ok (ref, [])) with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) + args.foldlM (fun (res : Env × List Types) (x : Types) => do + let (r, acc) := res + let (updatedenv, res) ← evalTypes r x + return (updatedenv, acc ++ [res]) + ) (env, []) partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! - match (evalTypes ref body) with - | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newEnv, value) => - match key with + let (newEnv, value) ← (evalTypes env body) + match key with | Types.symbolVal v => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value - Except.ok (refResult, value) - | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") + let refResult := newEnv.add (KeyType.strKey v) env.getLevel value + return (refResult, value) + | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! - let result := match pairs with - | Types.listVal v => evalLetArgs ref.increment v - | Types.vecVal v => evalLetArgs ref.increment (toList v) + let newEnv ← match pairs with + | Types.listVal v => evalLetArgs env.increment v + | Types.vecVal v => evalLetArgs env.increment (toList v) | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") - match result with - | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") - | Except.ok newEnv => match evalTypes newEnv body with - | Except.error e => Except.error e - -- only propagate logs from the let* environment to the parent scope - | Except.ok (letref, result) => Except.ok (forwardLogs letref ref, result) + -- only propagate logs from the let* environment to the parent scope + let (_, result) ← evalTypes newEnv body + return (env, result) - partial def evalLetArgs (env: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with - | [] => Except.ok ref + | [] => return env | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with - | Types.symbolVal key => match evalTypes ref y with - | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") - | Except.ok (updatedRef, value) => - evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest + | Types.symbolVal key => + let (updatedEnv, value) ← evalTypes env y + evalLetArgs (updatedEnv.add (KeyType.strKey key) env.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - if results.length == 0 then Except.ok (newEnv, Types.Nil) - else Except.ok (newEnv, results[results.length - 1]!) + let (newEnv, results) ← evalFuncArgs env args + if results.length == 0 then return (newEnv, Types.Nil) + else return (newEnv, results[results.length - 1]!) partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") @@ -177,44 +154,42 @@ mutual let thenExpr := args[1]! let hasElse := args.length > 2 - match evalTypes ref condition with - | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") - | Except.ok (newEnv, condResp) => - let cond := match condResp with - | Types.boolVal v => v - | Types.Nil => false - | _ => true - if cond then evalTypes newEnv thenExpr - else if hasElse then evalTypes newEnv args[2]! - else Except.ok (newEnv, Types.Nil) + let (newEnv, condResp) ← evalTypes env condition + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else return (newEnv, Types.Nil) - partial def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do + partial def evalFnNative (env : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with - | "+" => sum ref results - | "-" => sub ref results - | "*" => mul ref results - | "/" => div ref results - | "<" => lt ref results - | "<=" => lte ref results - | ">" => gt ref results - | ">=" => gte ref results - | "=" => eq ref results false - | "prn" => prnFunc ref results - | "pr-str" => prStrFunc ref results - | "str" => strFunc ref results - | "println" => printlnFunc ref results - | "list" => Except.ok (ref, Types.listVal results) - | "count" => countFunc ref results + | "+" => sum env results + | "-" => sub env results + | "*" => mul env results + | "/" => div env results + | "<" => lt env results + | "<=" => lte env results + | ">" => gt env results + | ">=" => gte env results + | "=" => eq env results false + | "prn" => prnFunc env results + | "pr-str" => prStrFunc env results + | "str" => strFunc env results + | "println" => printlnFunc env results + | "list" => return (env, Types.listVal results) + | "count" => countFunc env results | _ => match results with | [x] => match x with | Types.listVal x => match name with - | "list?" => Except.ok (ref, Types.boolVal true) - | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "list?" => return (env, Types.boolVal true) + | "empty?" => return (env, Types.boolVal (x.length == 0)) + | _ => return (env, Types.boolVal false) | Types.vecVal x => match name with - | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) - | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.ok (ref, Types.boolVal false) + | "empty?" => return (env, Types.boolVal ((toList x).length == 0)) + | _ => return (env, Types.boolVal false) + | _ => return (env, Types.boolVal false) | _ => throw (IO.userError s!"'{name}' not found") end @@ -225,33 +200,29 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (env: Env) (input : String): Env × String := +def rep (env: Env) (input : String): IO (Env × String) := do match READ.{u} input with - | Except.ok result => match evalTypes ref result with - | Except.error (newref, e) => (newref, e) - | Except.ok (newref, res) => (newref, PRINT res) - | Except.error err => (ref, s!"Parsing failed: {err}") - -def printLogs (ref : Env) : IO Unit := - forM (getLogsInfo ref) (fun elem => - match elem with - | Types.strVal log => IO.println log - | x => IO.println (x.toString true) - ) - -def loadMalFns (env: Env) (fndefs: List String): Env × String := - fndefs.foldl (fun (res : Env × String) fndef => + | Except.ok result => + try + let (newenv, res) ← evalTypes env result + return (newenv, PRINT res) + catch + | e => return (env, s!"Error: {e}") + | Except.error err => return (env, s!"Parsing failed: {err}") + +def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do + fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) := rep.{u} ref fndef - (newref, s!"{msg}¬{newmsg}") - ) (ref, "") + let (newref, newmsg) ← rep.{u} ref fndef + return (newref, s!"{msg}¬{newmsg}") + ) (env, "") def fnDefs: List String := [ "(def! not (fn* (a) (if a false true)))", ] def main : IO Unit := do - let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let mut env := env0 let mut donext := true while donext do @@ -265,7 +236,6 @@ def main : IO Unit := do if value.isEmpty then donext := false else - let (ref, val) := rep.{u} env value - printLogs ref + let (newenv, val) ← rep.{u} env value IO.println val - env := resetLogs ref + env := newenv diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index 0a80bf67e1..6ecdb00475 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -189,7 +189,7 @@ mutual else if hasElse then evalTypes newEnv args[2]! else Except.ok (newEnv, Types.Nil) - partial def evalFnNative (ref : Env) (name: String) (results: List Types): IO (Env × Types) := do + partial def evalFnNative (env : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results @@ -232,7 +232,7 @@ def rep (env: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Env) : IO Unit := +def printLogs (env : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 9d4b9b6478..385854851a 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -226,7 +226,7 @@ mutual let ast := lst[0]! evalTypes ref ast - partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do + partial def evalFnNative (env : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results @@ -280,7 +280,7 @@ def rep (env: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Env) : IO Unit := +def printLogs (env : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index 643d1e1b60..1994ff8c07 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -263,7 +263,7 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do + partial def evalFnNative (env : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results @@ -321,7 +321,7 @@ def rep (env: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Env) : IO Unit := +def printLogs (env : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index 0e4825c11e..938ca3da51 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -304,7 +304,7 @@ mutual | Types.vecVal v => Types.listVal [Types.symbolVal "vec", qq_foldr (toList v)] | _ => ast - partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do + partial def evalFnNative (env : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results @@ -365,7 +365,7 @@ def rep (env: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Env) : IO Unit := +def printLogs (env : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index c68a6ccf49..c66112891d 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -386,7 +386,7 @@ mutual evalFuncVal ref fn (firstargs ++ (toList v)) false | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") - partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do + partial def evalFnNative (env : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results @@ -485,7 +485,7 @@ def rep (env: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Env) : IO Unit := +def printLogs (env : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index dfaec64009..52a2c58cb5 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -386,7 +386,7 @@ mutual evalFuncVal ref fn (firstargs ++ (toList v)) false | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") - partial def evalFnNative (ref : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do + partial def evalFnNative (env : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with | "+" => sum ref results | "-" => sub ref results @@ -488,7 +488,7 @@ def rep (env: Env) (input : String): Env × String := | Except.ok (newref, res) => (newref, PRINT res) | Except.error err => (ref, s!"Parsing failed: {err}") -def printLogs (ref : Env) : IO Unit := +def printLogs (env : Env) : IO Unit := forM (getLogsInfo ref) (fun elem => match elem with | Types.strVal log => IO.println log From 1c5c2d514c757e81fffd4053f69e655caf750b6f Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Tue, 27 Aug 2024 01:28:57 +0200 Subject: [PATCH 31/39] IO refactor: step 5 --- impls/lean/LeanMal/step5_tco.lean | 274 +++++++++++++----------------- 1 file changed, 121 insertions(+), 153 deletions(-) diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index 6ecdb00475..e8d7a1c15d 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -12,8 +12,8 @@ def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do let params := match p with | Types.vecVal x => Types.listVal (toList x) | _ => p - let newfn := Fun.userDefined ref.increment params body - Except.ok (ref, Types.funcVal newfn) + let newfn := Fun.userDefined env.increment params body + return (env, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := @@ -26,150 +26,125 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do - let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" - else _ref + partial def evalTypes (env : Env) (ast : Types) : IO (Env × Types) := do + if getDebugEval env then IO.println s!"EVAL:{pr_str true ast}" match ast with - | Types.symbolVal v => match ref.get (KeyType.strKey v) with - | some (_, vi) => Except.ok (ref, vi) + | Types.symbolVal v => match env.get (KeyType.strKey v) with + | some (_, vi) => return (env, vi) | none => throw (IO.userError s!"'{v}' not found") - | Types.listVal el => (evalList ref el) - | Types.vecVal el => (evalVec ref (toList el)) - | Types.dictVal el => (evalDict ref el) - | x => Except.ok (ref, x) + | Types.listVal el => (evalList env el) + | Types.vecVal el => (evalVec env (toList el)) + | Types.dictVal el => (evalDict env el) + | x => return (env, x) partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do - match evalTypes ref head with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") - | Except.ok (ref2, fn) => - match evalFuncVal ref2 fn args with - | Except.error e => Except.error e - | Except.ok (fref, res) => - -- only propagate logs after executing a function - Except.ok (forwardLogs fref ref, res) + let (env2, fn) ← evalTypes env head + let (_, res) ← evalFuncVal env2 fn args + return (env, res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - match fn with - | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newEnv name results - | Fun.userDefined fref params body => - let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys - let normalArgs := results.take keys.length - let variadicArg := results.drop keys.length - let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 + let (newEnv, results) ← evalFuncArgs env args + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => evalFnNative newEnv name results + | Fun.userDefined fref params body => + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict + + evalTypes merged body + | Fun.macroFn _ _ _ => throw (IO.userError "macro not implemented") + | _ => throw (IO.userError s!"`unexpected token, expected: function`") - let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newEnv.merge fref).mergeDict argsLevel argsDict - - evalTypes merged body - | Fun.macroFn _ _ _ => Except.error (newEnv, "macro not implemented") - | _ => Except.error (newEnv, s!"`unexpected token, expected: function`") partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do - if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + if List.length lst == 0 then return (env, Types.listVal lst) else let head := lst[0]! match lst[0]! with | Types.symbolVal v => match v with - | "def!" => evalDefn ref (lst.drop 1) - | "let*" => evalLet ref (lst.drop 1) - | "do" => evalDo ref (lst.drop 1) - | "if" => evalIf ref (lst.drop 1) - | "fn*" => makeFn ref (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) + | "def!" => evalDefn env (lst.drop 1) + | "let*" => evalLet env (lst.drop 1) + | "do" => evalDo env (lst.drop 1) + | "if" => evalIf env (lst.drop 1) + | "fn*" => makeFn env (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do - match evalFuncArgs ref elems with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) + let (newEnv, results) ← evalFuncArgs env elems + return (newEnv, Types.vecVal (listToVec results)) partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do - match evalDictInner ref lst with - | Except.error e => Except.error e - | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) + let (newEnv, newDict) ← evalDictInner env lst + return (newEnv, Types.dictVal newDict) - partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := do match lst with - | Dict.empty => Except.ok (ref, lst) - | Dict.insert k _ v restDict => match evalTypes ref v with - | Except.error e => Except.error e - | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with - | Except.error e => Except.error e - | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k 0 newVal updatedDict - Except.ok (updatedRef, newDict) + | Dict.empty => return (env, lst) + | Dict.insert k _ v restDict => + let (newEnv, newVal) ← evalTypes env v + let (updatedEnv, updatedDict) ← evalDictInner newEnv restDict + let newDict := Dict.insert k 0 newVal updatedDict + return (updatedEnv, newDict) partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := - match args.foldl (fun (res : IO (Env × List Types)) x => - match res with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") - | Except.ok (r, acc) => match evalTypes r x with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, acc ++ [res]) - ) (Except.ok (ref, [])) with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) + args.foldlM (fun (res : Env × List Types) (x : Types) => do + let (r, acc) := res + let (updatedenv, res) ← evalTypes r x + return (updatedenv, acc ++ [res]) + ) (env, []) partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! - match (evalTypes ref body) with - | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newEnv, value) => - match key with + let (newEnv, value) ← (evalTypes env body) + match key with | Types.symbolVal v => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value - Except.ok (refResult, value) - | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") + let refResult := newEnv.add (KeyType.strKey v) env.getLevel value + return (refResult, value) + | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! - let result := match pairs with - | Types.listVal v => evalLetArgs ref.increment v - | Types.vecVal v => evalLetArgs ref.increment (toList v) + let newEnv ← match pairs with + | Types.listVal v => evalLetArgs env.increment v + | Types.vecVal v => evalLetArgs env.increment (toList v) | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") - match result with - | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") - | Except.ok newEnv => match evalTypes newEnv body with - | Except.error e => Except.error e - -- only propagate logs from the let* environment to the parent scope - | Except.ok (letref, result) => Except.ok (forwardLogs letref ref, result) + let (_, result) ← evalTypes newEnv body + return (env, result) - partial def evalLetArgs (env: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with - | [] => Except.ok ref + | [] => return env | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with - | Types.symbolVal key => match evalTypes ref y with - | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") - | Except.ok (updatedRef, value) => - evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest + | Types.symbolVal key => + let (updatedEnv, value) ← evalTypes env y + evalLetArgs (updatedEnv.add (KeyType.strKey key) env.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - if results.length == 0 then Except.ok (newEnv, Types.Nil) - else Except.ok (newEnv, results[results.length - 1]!) + let (newEnv, results) ← evalFuncArgs env args + if results.length == 0 then return (newEnv, Types.Nil) + else return (newEnv, results[results.length - 1]!) partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") @@ -178,44 +153,42 @@ mutual let thenExpr := args[1]! let hasElse := args.length > 2 - match evalTypes ref condition with - | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") - | Except.ok (newEnv, condResp) => - let cond := match condResp with - | Types.boolVal v => v - | Types.Nil => false - | _ => true - if cond then evalTypes newEnv thenExpr - else if hasElse then evalTypes newEnv args[2]! - else Except.ok (newEnv, Types.Nil) + let (newEnv, condResp) ← evalTypes env condition + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else return (newEnv, Types.Nil) partial def evalFnNative (env : Env) (name: String) (results: List Types): IO (Env × Types) := do match name with - | "+" => sum ref results - | "-" => sub ref results - | "*" => mul ref results - | "/" => div ref results - | "<" => lt ref results - | "<=" => lte ref results - | ">" => gt ref results - | ">=" => gte ref results - | "=" => eq ref results false - | "prn" => prnFunc ref results - | "pr-str" => prStrFunc ref results - | "str" => strFunc ref results - | "println" => printlnFunc ref results - | "list" => Except.ok (ref, Types.listVal results) - | "count" => countFunc ref results + | "+" => sum env results + | "-" => sub env results + | "*" => mul env results + | "/" => div env results + | "<" => lt env results + | "<=" => lte env results + | ">" => gt env results + | ">=" => gte env results + | "=" => eq env results false + | "prn" => prnFunc env results + | "pr-str" => prStrFunc env results + | "str" => strFunc env results + | "println" => printlnFunc env results + | "list" => return (env, Types.listVal results) + | "count" => countFunc env results | _ => match results with | [x] => match x with | Types.listVal x => match name with - | "list?" => Except.ok (ref, Types.boolVal true) - | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "list?" => return (env, Types.boolVal true) + | "empty?" => return (env, Types.boolVal (x.length == 0)) + | _ => return (env, Types.boolVal false) | Types.vecVal x => match name with - | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) - | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.ok (ref, Types.boolVal false) + | "empty?" => return (env, Types.boolVal ((toList x).length == 0)) + | _ => return (env, Types.boolVal false) + | _ => return (env, Types.boolVal false) | _ => throw (IO.userError s!"'{name}' not found") end @@ -225,33 +198,29 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (env: Env) (input : String): Env × String := +def rep (env: Env) (input : String): IO (Env × String) := do match READ.{u} input with - | Except.ok result => match evalTypes ref result with - | Except.error (newref, e) => (newref, e) - | Except.ok (newref, res) => (newref, PRINT res) - | Except.error err => (ref, s!"Parsing failed: {err}") - -def printLogs (env : Env) : IO Unit := - forM (getLogsInfo ref) (fun elem => - match elem with - | Types.strVal log => IO.println log - | x => IO.println (x.toString true) - ) - -def loadMalFns (env: Env) (fndefs: List String): Env × String := - fndefs.foldl (fun (res : Env × String) fndef => + | Except.ok result => + try + let (newenv, res) ← evalTypes env result + return (newenv, PRINT res) + catch + | e => return (env, s!"Error: {e}") + | Except.error err => return (env, s!"Parsing failed: {err}") + +def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do + fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) := rep.{u} ref fndef - (newref, s!"{msg}¬{newmsg}") - ) (ref, "") + let (newref, newmsg) ← rep.{u} ref fndef + return (newref, s!"{msg}¬{newmsg}") + ) (env, "") def fnDefs: List String := [ "(def! not (fn* (a) (if a false true)))", ] def main : IO Unit := do - let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let mut env := env0 let mut donext := true while donext do @@ -265,7 +234,6 @@ def main : IO Unit := do if value.isEmpty then donext := false else - let (ref, val) := rep.{u} env value - printLogs ref + let (newenv, val) ← rep.{u} env value IO.println val - env := resetLogs ref + env := newenv From 2720ed69a3e95d16db6e8c5a09cd910f17ee0c59 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Tue, 27 Aug 2024 02:04:00 +0200 Subject: [PATCH 32/39] IO refactor: step6 --- impls/lean/LeanMal/core.lean | 67 ++---- impls/lean/LeanMal/step6_file.lean | 323 +++++++++++++---------------- 2 files changed, 167 insertions(+), 223 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 226900f4e5..4457ef25df 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -237,13 +237,15 @@ def countFunc(env : Env) (lst: List Types) : IO (Env × Types) := do | Types.Nil => return (env, Types.intVal 0) | _ => throw (IO.userError "count called on non-sequence") -def readString (lst: List Types) (envir: Env) : Except String Types := - if lst.length < 1 then Except.error "read-string: 1 arguments required" +def readString (lst: List Types) (envir: Env) : IO Types := do + if lst.length < 1 then throw (IO.userError "read-string: 1 arguments required") else let first := lst[0]! match first with - | Types.strVal v => read_types_with_env v envir.getDict -- Dict.empty - | x => Except.error s!"unexpected symbol: {x.toString true}, expected: string" + | Types.strVal v => match read_types_with_env v envir.getDict with -- Dict.empty + | Except.error e => throw (IO.userError e) + | Except.ok res => return res + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: string") def cons (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "cons: >= 2 arguments required") @@ -337,8 +339,8 @@ def restSeq (env : Env) (lst: List Types) : IO (Env × Types) := do def makeVector (env : Env) (lst: List Types) : IO (Env × Types) := do return (env, Types.vecVal (listToVec lst)) -def makeDictInternal (initialDict : Dict) (lst: List Types) : Except String (Dict) := - let rec loop (lst : List Types) (acckeys: List String) (acc : Dict) : Except String (Dict × List String) := +def makeDictInternal (initialDict : Dict) (lst: List Types) : IO (Dict) := do + let rec loop (lst : List Types) (acckeys: List String) (acc : Dict) : IO (Dict × List String) := match lst with | [] => return (acc, acckeys) | (Types.strVal k) :: v :: rest => @@ -347,15 +349,13 @@ def makeDictInternal (initialDict : Dict) (lst: List Types) : Except String (Dic | (Types.keywordVal k) :: v :: rest => if acckeys.contains k then return (acc, acckeys) else loop rest (acckeys ++ [k]) (Dict.insert (KeyType.keywordKey k) 0 v acc) - | _ => Except.error "Invalid list format: Expected alternating string/keyword and value" - match loop lst [] initialDict with - | Except.error e => Except.error e - | Except.ok (v, _) => Except.ok v + | _ => throw (IO.userError "Invalid list format: Expected alternating string/keyword and value") + let (v, _) ← loop lst [] initialDict + return v def makeDict (env : Env) (lst: List Types) : IO (Env × Types) := do - match makeDictInternal Dict.empty lst with - | Except.error e => throw (IO.userError e) - | Except.ok (newDict) => return (env, Types.dictVal newDict) + let newDict ← makeDictInternal Dict.empty lst + return (env, Types.dictVal newDict) def assocDict (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "assoc: >= 1 arguments required") @@ -364,15 +364,14 @@ def assocDict (env : Env) (lst: List Types) : IO (Env × Types) := do let rest := lst.drop 1 match first with | Types.dictVal v => - match makeDictInternal v rest with - | Except.error e => throw (IO.userError e) - | Except.ok (newDict) => return (env, Types.dictVal newDict) + let newDict ← makeDictInternal v rest + return (env, Types.dictVal newDict) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") -def dissoc (dict : Dict) (keys : List Types) : Except String Dict := - let rec loop (keys : List Types) (acc : Dict) : Except String Dict := +def dissoc (dict : Dict) (keys : List Types) : IO Dict := + let rec loop (keys : List Types) (acc : Dict) : IO Dict := match keys with - | [] => Except.ok acc + | [] => return acc | key :: rest => match key with | Types.strVal v => @@ -381,7 +380,7 @@ def dissoc (dict : Dict) (keys : List Types) : Except String Dict := | Types.keywordVal v => let newDict := acc.remove (KeyType.strKey v) loop rest newDict - | x => Except.error s!"unexpected symbol: {x.toString true}, expected: keyword or string" + | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: keyword or string") loop keys dict def dissocDict (env : Env) (lst: List Types) : IO (Env × Types) := do @@ -391,9 +390,8 @@ def dissocDict (env : Env) (lst: List Types) : IO (Env × Types) := do let rest := lst.drop 1 match first with | Types.dictVal v => - match dissoc v rest with - | Except.error e => throw (IO.userError e) - | Except.ok newDict => return (env, Types.dictVal newDict) + let newDict ← dissoc v rest + return (env, Types.dictVal newDict) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: hash-map") def getDict (env : Env) (lst: List Types) : IO (Env × Types) := do @@ -523,7 +521,7 @@ partial def throwFn (_ : Env) (lst : List Types) : IO (Env × Types) := do def readFileContent (filePath : String) : IO String := do IO.FS.readFile filePath -def slurp (env : Env) (lst: List Types) : IO (Except (Env × String) (Env × Types)) := do +def slurp (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "slurp: 2 arguments required") else @@ -531,31 +529,12 @@ def slurp (env : Env) (lst: List Types) : IO (Except (Env × String) (Env × Typ | Types.strVal filename => do let result ← try let content ← readFileContent filename - return return (env, Types.strVal content) + return (env, Types.strVal content) catch e => throw (IO.userError s!"slurp: failed to read file: {e.toString}") - - -- return result | _ => throw (IO.userError "slurp: filename must be a string") -def slurp2 (env : Env) (lst: List Types) : IO (Env × Types) := do - if lst.length < 1 then - throw (IO.userError "slurp: 2 arguments required") - else - match lst[0]! with - | Types.strVal filename => do - let content ← readFileContent filename - return (env, Types.strVal content) - | _ => - throw (IO.userError "slurp: filename must be a string") - --- IO monad limits some of the formal proving capabilities that Lean offers because IO introduces side effects that are inherently non-deterministic and impure, such as reading from files -def evalFnNativeWithIO (env : Env) (name: String) (results: List Types): IO (Except (Env × String) (Env × Types)) := - match name with - | "slurp" => slurp env results - | _ => throw (IO.userError s!"'{name}' not found") - def loadFnNative (env : Env) (name: String) : Env := env.add (KeyType.strKey name) 0 (Types.funcVal (Fun.builtin name)) diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 385854851a..ec88c5039c 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -12,8 +12,8 @@ def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do let params := match p with | Types.vecVal x => Types.listVal (toList x) | _ => p - let newfn := Fun.userDefined ref.increment params body - Except.ok (ref, Types.funcVal newfn) + let newfn := Fun.userDefined env.increment params body + return (env, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := @@ -26,151 +26,126 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do - let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" - else _ref + partial def evalTypes (env : Env) (ast : Types) : IO (Env × Types) := do + if getDebugEval env then IO.println s!"EVAL:{pr_str true ast}" match ast with - | Types.symbolVal v => match ref.get (KeyType.strKey v) with - | some (_, vi) => Except.ok (ref, vi) + | Types.symbolVal v => match env.get (KeyType.strKey v) with + | some (_, vi) => return (env, vi) | none => throw (IO.userError s!"'{v}' not found") - | Types.listVal el => (evalList ref el) - | Types.vecVal el => (evalVec ref (toList el)) - | Types.dictVal el => (evalDict ref el) - | x => Except.ok (ref, x) + | Types.listVal el => (evalList env el) + | Types.vecVal el => (evalVec env (toList el)) + | Types.dictVal el => (evalDict env el) + | x => return (env, x) partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do - match evalTypes ref head with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") - | Except.ok (ref2, fn) => - match evalFuncVal ref2 fn args with - | Except.error e => Except.error e - | Except.ok (fref, res) => - -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope - Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) + let (env2, fn) ← evalTypes env head + let (fref, res) ← evalFuncVal env2 fn args + -- after executing a function, propagate atoms (defined in outer environments) to the parent scope + return ((forwardMutatedAtoms fref env), res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - match fn with - | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newEnv name results args - | Fun.userDefined fref params body => - let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys - let normalArgs := results.take keys.length - let variadicArg := results.drop keys.length - let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 - - let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newEnv.merge fref).mergeDict argsLevel argsDict - - evalTypes merged body - | Fun.macroFn _ _ _ => Except.error (newEnv, "macro not implemented") - | _ => Except.error (newEnv, s!"`unexpected token, expected: function`") + let (newEnv, results) ← evalFuncArgs env args + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => evalFnNative newEnv name results args + | Fun.userDefined fref params body => + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict + + evalTypes merged body + | Fun.macroFn _ _ _ => throw (IO.userError "macro not implemented") + | _ => throw (IO.userError s!"`unexpected token, expected: function`") partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do - if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + if List.length lst == 0 then return (env, Types.listVal lst) else let head := lst[0]! match lst[0]! with | Types.symbolVal v => match v with - | "def!" => evalDefn ref (lst.drop 1) - | "let*" => evalLet ref (lst.drop 1) - | "do" => evalDo ref (lst.drop 1) - | "if" => evalIf ref (lst.drop 1) - | "fn*" => makeFn ref (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) + | "def!" => evalDefn env (lst.drop 1) + | "let*" => evalLet env (lst.drop 1) + | "do" => evalDo env (lst.drop 1) + | "if" => evalIf env (lst.drop 1) + | "fn*" => makeFn env (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do - match evalFuncArgs ref elems with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) + let (newEnv, results) ← evalFuncArgs env elems + return (newEnv, Types.vecVal (listToVec results)) partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do - match evalDictInner ref lst with - | Except.error e => Except.error e - | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) + let (newEnv, newDict) ← evalDictInner env lst + return (newEnv, Types.dictVal newDict) - partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := do match lst with - | Dict.empty => Except.ok (ref, lst) - | Dict.insert k _ v restDict => match evalTypes ref v with - | Except.error e => Except.error e - | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with - | Except.error e => Except.error e - | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k 0 newVal updatedDict - Except.ok (updatedRef, newDict) + | Dict.empty => return (env, lst) + | Dict.insert k _ v restDict => + let (newEnv, newVal) ← evalTypes env v + let (updatedEnv, updatedDict) ← evalDictInner newEnv restDict + let newDict := Dict.insert k 0 newVal updatedDict + return (updatedEnv, newDict) partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := - match args.foldl (fun (res : IO (Env × List Types)) x => - match res with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") - | Except.ok (r, acc) => match evalTypes r x with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, acc ++ [res]) - ) (Except.ok (ref, [])) with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) + args.foldlM (fun (res : Env × List Types) (x : Types) => do + let (r, acc) := res + let (updatedenv, res) ← evalTypes r x + return (updatedenv, acc ++ [res]) + ) (env, []) partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! - match (evalTypes ref body) with - | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newEnv, value) => - match key with + let (newEnv, value) ← (evalTypes env body) + match key with | Types.symbolVal v => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value - Except.ok (refResult, value) - | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") + let refResult := newEnv.add (KeyType.strKey v) env.getLevel value + return (refResult, value) + | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! - let result := match pairs with - | Types.listVal v => evalLetArgs ref.increment v - | Types.vecVal v => evalLetArgs ref.increment (toList v) + let newEnv ← match pairs with + | Types.listVal v => evalLetArgs env.increment v + | Types.vecVal v => evalLetArgs env.increment (toList v) | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") - match result with - | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") - | Except.ok newEnv => match evalTypes newEnv body with - | Except.error e => Except.error e - -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope - | Except.ok (letref, result) => - Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) + let (letref, result) ← evalTypes newEnv body + -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope + return ((forwardMutatedAtoms letref env), result) - partial def evalLetArgs (env: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with - | [] => Except.ok ref + | [] => return env | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with - | Types.symbolVal key => match evalTypes ref y with - | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") - | Except.ok (updatedRef, value) => - evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest + | Types.symbolVal key => + let (updatedEnv, value) ← evalTypes env y + evalLetArgs (updatedEnv.add (KeyType.strKey key) env.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - if results.length == 0 then Except.ok (newEnv, Types.Nil) - else Except.ok (newEnv, results[results.length - 1]!) + let (newEnv, results) ← evalFuncArgs env args + if results.length == 0 then return (newEnv, Types.Nil) + else return (newEnv, results[results.length - 1]!) partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") @@ -179,16 +154,14 @@ mutual let thenExpr := args[1]! let hasElse := args.length > 2 - match evalTypes ref condition with - | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") - | Except.ok (newEnv, condResp) => - let cond := match condResp with - | Types.boolVal v => v - | Types.Nil => false - | _ => true - if cond then evalTypes newEnv thenExpr - else if hasElse then evalTypes newEnv args[2]! - else Except.ok (newEnv, Types.Nil) + let (newEnv, condResp) ← evalTypes env condition + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else return (newEnv, Types.Nil) partial def swapAtom (env: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") @@ -200,22 +173,18 @@ mutual | Types.symbolVal sym => match fn with | Types.funcVal _ => - match ref.get (KeyType.strKey sym) with + match env.get (KeyType.strKey sym) with | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") - | Except.ok (_, res) => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) - Except.ok (newEnv, res) + let (_, res) ← evalFuncVal env fn ([v] ++ rest) + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + return (newEnv, res) | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") - | Except.ok (_, res) => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newEnv, res) + let (_, res) ← evalFuncVal env fn ([v] ++ rest) + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + return (newEnv, res) | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") @@ -224,46 +193,47 @@ mutual if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! - evalTypes ref ast + evalTypes env ast partial def evalFnNative (env : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with - | "+" => sum ref results - | "-" => sub ref results - | "*" => mul ref results - | "/" => div ref results - | "<" => lt ref results - | "<=" => lte ref results - | ">" => gt ref results - | ">=" => gte ref results - | "=" => eq ref results false - | "list" => Except.ok (ref, Types.listVal results) - | "count" => countFunc ref results - | "atom" => makeAtom ref results - | "deref" => derefAtom ref results - | "reset!" => resetAtom ref results args - | "swap!" => swapAtom ref results args - | "prn" => prnFunc ref results - | "pr-str" => prStrFunc ref results - | "str" => strFunc ref results - | "println" => printlnFunc ref results - | "eval" => eval ref results - | "read-string" => match readString results ref with -- readString results Dict.empty - | Except.error e => throw (IO.userError e) - | Except.ok res => Except.ok (ref, res) + | "+" => sum env results + | "-" => sub env results + | "*" => mul env results + | "/" => div env results + | "<" => lt env results + | "<=" => lte env results + | ">" => gt env results + | ">=" => gte env results + | "=" => eq env results false + | "list" => return (env, Types.listVal results) + | "count" => countFunc env results + | "atom" => makeAtom env results + | "deref" => derefAtom env results + | "reset!" => resetAtom env results args + | "swap!" => swapAtom env results args + | "prn" => prnFunc env results + | "pr-str" => prStrFunc env results + | "str" => strFunc env results + | "println" => printlnFunc env results + | "eval" => eval env results + | "slurp" => slurp env results + | "read-string" => + let res ← readString results env -- readString results Dict.empty + return (env, res) | _ => match results with | [x] => match x with | Types.listVal x => match name with - | "list?" => Except.ok (ref, Types.boolVal true) - | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "list?" => return (env, Types.boolVal true) + | "empty?" => return (env, Types.boolVal (x.length == 0)) + | _ => return (env, Types.boolVal false) | Types.vecVal x => match name with - | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "empty?" => return (env, Types.boolVal ((toList x).length == 0)) + | _ => return (env, Types.boolVal false) | Types.atomVal _ => match name with - | "atom?" => Except.ok (ref, Types.boolVal true) - | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.ok (ref, Types.boolVal false) + | "atom?" => return (env, Types.boolVal true) + | _ => return (env, Types.boolVal false) + | _ => return (env, Types.boolVal false) | _ => throw (IO.userError s!"'{name}' not found") end @@ -273,39 +243,35 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (env: Env) (input : String): Env × String := +def rep (env: Env) (input : String): IO (Env × String) := do match READ.{u} input with - | Except.ok result => match evalTypes ref result with - | Except.error (newref, e) => (newref, e) - | Except.ok (newref, res) => (newref, PRINT res) - | Except.error err => (ref, s!"Parsing failed: {err}") - -def printLogs (env : Env) : IO Unit := - forM (getLogsInfo ref) (fun elem => - match elem with - | Types.strVal log => IO.println log - | x => IO.println (x.toString true) - ) - -def loadMalFns (env: Env) (fndefs: List String): Env × String := - fndefs.foldl (fun (res : Env × String) fndef => + | Except.ok result => + try + let (newenv, res) ← evalTypes env result + return (newenv, PRINT res) + catch + | e => return (env, s!"Error: {e}") + | Except.error err => return (env, s!"Parsing failed: {err}") + +def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do + fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) := rep.{u} ref fndef - (newref, s!"{msg}¬{newmsg}") - ) (ref, "") + let (newref, newmsg) ← rep.{u} ref fndef + return (newref, s!"{msg}¬{newmsg}") + ) (env, "") def fnDefs: List String := [ "(def! not (fn* (a) (if a false true)))", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", ] def main (args : List String) : IO Unit := do - let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let astArgs := (args.map (fun arg => Types.strVal arg)) let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) if args.length > 0 then - let (ref, val) := rep.{u} env s!"(load-file \"{args[0]!}\")" - printLogs ref + let (_, val) ← rep.{u} env s!"(load-file \"{args[0]!}\")" IO.println val else @@ -321,7 +287,6 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (ref, val) := rep.{u} env value - printLogs ref + let (newenv, val) ← rep.{u} env value IO.println val - env := resetLogs ref + env := newenv From ffe0ba68b767b2c71e58f2d73731b0c42f4b8300 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Tue, 27 Aug 2024 17:38:36 +0200 Subject: [PATCH 33/39] use IO, refactor step 7 --- impls/lean/LeanMal/step6_file.lean | 2 +- impls/lean/LeanMal/step7_quote.lean | 332 +++++++++++++--------------- 2 files changed, 149 insertions(+), 185 deletions(-) diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index ec88c5039c..88ea0703cf 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -127,7 +127,7 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") let (letref, result) ← evalTypes newEnv body - -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope + -- after executing let*, propagate atoms (defined in outer environments) to the parent scope return ((forwardMutatedAtoms letref env), result) partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index 1994ff8c07..d50cecbd78 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -12,8 +12,8 @@ def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do let params := match p with | Types.vecVal x => Types.listVal (toList x) | _ => p - let newfn := Fun.userDefined ref.increment params body - Except.ok (ref, Types.funcVal newfn) + let newfn := Fun.userDefined env.increment params body + return (env, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := @@ -26,157 +26,132 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do - let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" - else _ref + partial def evalTypes (env : Env) (ast : Types) : IO (Env × Types) := do + if getDebugEval env then IO.println s!"EVAL:{pr_str true ast}" match ast with - | Types.symbolVal v => match ref.get (KeyType.strKey v) with - | some (_, vi) => Except.ok (ref, vi) + | Types.symbolVal v => match env.get (KeyType.strKey v) with + | some (_, vi) => return (env, vi) | none => throw (IO.userError s!"'{v}' not found") - | Types.listVal el => (evalList ref el) - | Types.vecVal el => (evalVec ref (toList el)) - | Types.dictVal el => (evalDict ref el) - | x => Except.ok (ref, x) + | Types.listVal el => (evalList env el) + | Types.vecVal el => (evalVec env (toList el)) + | Types.dictVal el => (evalDict env el) + | x => return (env, x) partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do - match evalTypes ref head with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") - | Except.ok (ref2, fn) => - match evalFuncVal ref2 fn args with - | Except.error e => Except.error e - | Except.ok (fref, res) => - -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope - Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) + let (env2, fn) ← evalTypes env head + let (fref, res) ← evalFuncVal env2 fn args + -- after executing a function, propagate atoms (defined in outer environments) to the parent scope + return ((forwardMutatedAtoms fref env), res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - match fn with - | Types.funcVal v => match v with - | Fun.builtin name => evalFnNative newEnv name results args - | Fun.userDefined fref params body => - let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys - let normalArgs := results.take keys.length - let variadicArg := results.drop keys.length - let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 - - let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newEnv.merge fref).mergeDict argsLevel argsDict - - evalTypes merged body - | Fun.macroFn _ _ _ => Except.error (newEnv, "macro not implemented") - | _ => Except.error (newEnv, s!"`unexpected token, expected: function`") + let (newEnv, results) ← evalFuncArgs env args + match fn with + | Types.funcVal v => match v with + | Fun.builtin name => evalFnNative newEnv name results args + | Fun.userDefined fref params body => + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 + + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict + + evalTypes merged body + | Fun.macroFn _ _ _ => throw (IO.userError "macro not implemented") + | _ => throw (IO.userError s!"`unexpected token, expected: function`") partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do - if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + if List.length lst == 0 then return (env, Types.listVal lst) else let head := lst[0]! match lst[0]! with | Types.symbolVal v => match v with - | "def!" => evalDefn ref (lst.drop 1) - | "let*" => evalLet ref (lst.drop 1) - | "do" => evalDo ref (lst.drop 1) - | "if" => evalIf ref (lst.drop 1) - | "fn*" => makeFn ref (lst.drop 1) + | "def!" => evalDefn env (lst.drop 1) + | "let*" => evalLet env (lst.drop 1) + | "do" => evalDo env (lst.drop 1) + | "if" => evalIf env (lst.drop 1) + | "fn*" => makeFn env (lst.drop 1) | "quote" => if lst.length < 2 then throw (IO.userError "quote: expected 1 argument") - else Except.ok (ref, lst[1]!) + else return (env, lst[1]!) | "quasiquote" => if lst.length < 2 then throw (IO.userError "quasiquote: expected 1 argument") - else evalTypes ref (quasiquote lst[1]!) - | _ => evalFunc ref head (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) + else evalTypes env (quasiquote lst[1]!) + | _ => evalFunc env head (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do - match evalFuncArgs ref elems with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) + let (newEnv, results) ← evalFuncArgs env elems + return (newEnv, Types.vecVal (listToVec results)) partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do - match evalDictInner ref lst with - | Except.error e => Except.error e - | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) + let (newEnv, newDict) ← evalDictInner env lst + return (newEnv, Types.dictVal newDict) - partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := do match lst with - | Dict.empty => Except.ok (ref, lst) - | Dict.insert k _ v restDict => match evalTypes ref v with - | Except.error e => Except.error e - | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with - | Except.error e => Except.error e - | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k 0 newVal updatedDict - Except.ok (updatedRef, newDict) + | Dict.empty => return (env, lst) + | Dict.insert k _ v restDict => + let (newEnv, newVal) ← evalTypes env v + let (updatedEnv, updatedDict) ← evalDictInner newEnv restDict + let newDict := Dict.insert k 0 newVal updatedDict + return (updatedEnv, newDict) partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := - match args.foldl (fun (res : IO (Env × List Types)) x => - match res with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") - | Except.ok (r, acc) => match evalTypes r x with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, acc ++ [res]) - ) (Except.ok (ref, [])) with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) + args.foldlM (fun (res : Env × List Types) (x : Types) => do + let (r, acc) := res + let (updatedenv, res) ← evalTypes r x + return (updatedenv, acc ++ [res]) + ) (env, []) partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! - match (evalTypes ref body) with - | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newEnv, value) => - match key with + let (newEnv, value) ← (evalTypes env body) + match key with | Types.symbolVal v => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value - Except.ok (refResult, value) - | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") + let refResult := newEnv.add (KeyType.strKey v) env.getLevel value + return (refResult, value) + | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! - let result := match pairs with - | Types.listVal v => evalLetArgs ref.increment v - | Types.vecVal v => evalLetArgs ref.increment (toList v) + let newEnv ← match pairs with + | Types.listVal v => evalLetArgs env.increment v + | Types.vecVal v => evalLetArgs env.increment (toList v) | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") - match result with - | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") - | Except.ok newEnv => match evalTypes newEnv body with - | Except.error e => Except.error e - -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope - | Except.ok (letref, result) => - Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) + let (letref, result) ← evalTypes newEnv body + -- after executing let*, propagate atoms (defined in outer environments) to the parent scope + return ((forwardMutatedAtoms letref env), result) - partial def evalLetArgs (env: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with - | [] => Except.ok ref + | [] => return env | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with - | Types.symbolVal key => match evalTypes ref y with - | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") - | Except.ok (updatedRef, value) => - evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest + | Types.symbolVal key => + let (updatedEnv, value) ← evalTypes env y + evalLetArgs (updatedEnv.add (KeyType.strKey key) env.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - if results.length == 0 then Except.ok (newEnv, Types.Nil) - else Except.ok (newEnv, results[results.length - 1]!) + let (newEnv, results) ← evalFuncArgs env args + if results.length == 0 then return (newEnv, Types.Nil) + else return (newEnv, results[results.length - 1]!) partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") @@ -185,16 +160,14 @@ mutual let thenExpr := args[1]! let hasElse := args.length > 2 - match evalTypes ref condition with - | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") - | Except.ok (newEnv, condResp) => - let cond := match condResp with - | Types.boolVal v => v - | Types.Nil => false - | _ => true - if cond then evalTypes newEnv thenExpr - else if hasElse then evalTypes newEnv args[2]! - else Except.ok (newEnv, Types.Nil) + let (newEnv, condResp) ← evalTypes env condition + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else return (newEnv, Types.Nil) partial def swapAtom (env: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") @@ -206,22 +179,18 @@ mutual | Types.symbolVal sym => match fn with | Types.funcVal _ => - match ref.get (KeyType.strKey sym) with + match env.get (KeyType.strKey sym) with | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") - | Except.ok (_, res) => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) - Except.ok (newEnv, res) + let (_, res) ← evalFuncVal env fn ([v] ++ rest) + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + return (newEnv, res) | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") - | Except.ok (_, res) => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newEnv, res) + let (_, res) ← evalFuncVal env fn ([v] ++ rest) + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + return (newEnv, res) | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") @@ -230,7 +199,7 @@ mutual if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! - evalTypes ref ast + evalTypes env ast partial def starts_with (lst: List Types) (symb: String) : Bool := if lst.length == 2 then @@ -265,45 +234,45 @@ mutual partial def evalFnNative (env : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with - | "+" => sum ref results - | "-" => sub ref results - | "*" => mul ref results - | "/" => div ref results - | "<" => lt ref results - | "<=" => lte ref results - | ">" => gt ref results - | ">=" => gte ref results - | "=" => eq ref results false - | "list" => Except.ok (ref, Types.listVal results) - | "count" => countFunc ref results - | "cons" => cons ref results - | "concat" => concat ref results - | "vec" => makeVec ref results - | "atom" => makeAtom ref results - | "deref" => derefAtom ref results - | "reset!" => resetAtom ref results args - | "swap!" => swapAtom ref results args - | "prn" => prnFunc ref results - | "pr-str" => prStrFunc ref results - | "str" => strFunc ref results - | "println" => printlnFunc ref results - | "eval" => eval ref results - | "read-string" => match readString results ref with -- readString results Dict.empty - | Except.error e => throw (IO.userError e) - | Except.ok res => Except.ok (ref, res) + | "+" => sum env results + | "-" => sub env results + | "*" => mul env results + | "/" => div env results + | "<" => lt env results + | "<=" => lte env results + | ">" => gt env results + | ">=" => gte env results + | "=" => eq env results false + | "list" => return (env, Types.listVal results) + | "count" => countFunc env results + | "cons" => cons env results + | "concat" => concat env results + | "vec" => makeVec env results + | "atom" => makeAtom env results + | "deref" => derefAtom env results + | "reset!" => resetAtom env results args + | "swap!" => swapAtom env results args + | "prn" => prnFunc env results + | "pr-str" => prStrFunc env results + | "str" => strFunc env results + | "println" => printlnFunc env results + | "eval" => eval env results + | "read-string" => + let res ← readString results env -- readString results Dict.empty + return (env, res) | _ => match results with | [x] => match x with | Types.listVal x => match name with - | "list?" => Except.ok (ref, Types.boolVal true) - | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "list?" => return (env, Types.boolVal true) + | "empty?" => return (env, Types.boolVal (x.length == 0)) + | _ => return (env, Types.boolVal false) | Types.vecVal x => match name with - | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "empty?" => return (env, Types.boolVal ((toList x).length == 0)) + | _ => return (env, Types.boolVal false) | Types.atomVal _ => match name with - | "atom?" => Except.ok (ref, Types.boolVal true) - | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.ok (ref, Types.boolVal false) + | "atom?" => return (env, Types.boolVal true) + | _ => return (env, Types.boolVal false) + | _ => return (env, Types.boolVal false) | _ => throw (IO.userError s!"'{name}' not found") end @@ -314,39 +283,35 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (env: Env) (input : String): Env × String := +def rep (env: Env) (input : String): IO (Env × String) := do match READ.{u} input with - | Except.ok result => match evalTypes ref result with - | Except.error (newref, e) => (newref, e) - | Except.ok (newref, res) => (newref, PRINT res) - | Except.error err => (ref, s!"Parsing failed: {err}") - -def printLogs (env : Env) : IO Unit := - forM (getLogsInfo ref) (fun elem => - match elem with - | Types.strVal log => IO.println log - | x => IO.println (x.toString true) - ) - -def loadMalFns (env: Env) (fndefs: List String): Env × String := - fndefs.foldl (fun (res : Env × String) fndef => + | Except.ok result => + try + let (newenv, res) ← evalTypes env result + return (newenv, PRINT res) + catch + | e => return (env, s!"Error: {e}") + | Except.error err => return (env, s!"Parsing failed: {err}") + +def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do + fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) := rep.{u} ref fndef - (newref, s!"{msg}¬{newmsg}") - ) (ref, "") + let (newref, newmsg) ← rep.{u} ref fndef + return (newref, s!"{msg}¬{newmsg}") + ) (env, "") def fnDefs: List String := [ "(def! not (fn* (a) (if a false true)))", + "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", ] def main (args : List String) : IO Unit := do - let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let astArgs := (args.map (fun arg => Types.strVal arg)) let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) if args.length > 0 then - let (ref, val) := rep.{u} env s!"(load-file \"{args[0]!}\")" - printLogs ref + let (_, val) ← rep.{u} env s!"(load-file \"{args[0]!}\")" IO.println val else @@ -362,7 +327,6 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (ref, val) := rep.{u} env value - printLogs ref + let (newenv, val) ← rep.{u} env value IO.println val - env := resetLogs ref + env := newenv From aa59b209674f5434b746a92c31724552cac51d1a Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Tue, 27 Aug 2024 17:58:24 +0200 Subject: [PATCH 34/39] use IO, refactor step 8 --- impls/lean/LeanMal/step8_macros.lean | 374 ++++++++++++--------------- 1 file changed, 165 insertions(+), 209 deletions(-) diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index 938ca3da51..ee3f46df11 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -12,8 +12,8 @@ def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do let params := match p with | Types.vecVal x => Types.listVal (toList x) | _ => p - let newfn := Fun.userDefined ref.increment params body - Except.ok (ref, Types.funcVal newfn) + let newfn := Fun.userDefined env.increment params body + return (env, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := @@ -26,53 +26,42 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do - let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" - else _ref + partial def evalTypes (env : Env) (ast : Types) : IO (Env × Types) := do + if getDebugEval env then IO.println s!"EVAL:{pr_str true ast}" match ast with - | Types.symbolVal v => match ref.get (KeyType.strKey v) with - | some (_, vi) => Except.ok (ref, vi) + | Types.symbolVal v => match env.get (KeyType.strKey v) with + | some (_, vi) => return (env, vi) | none => throw (IO.userError s!"'{v}' not found") - | Types.listVal el => (evalList ref el) - | Types.vecVal el => (evalVec ref (toList el)) - | Types.dictVal el => (evalDict ref el) - | x => Except.ok (ref, x) + | Types.listVal el => (evalList env el) + | Types.vecVal el => (evalVec env (toList el)) + | Types.dictVal el => (evalDict env el) + | x => return (env, x) partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do - match evalTypes ref head with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function: {head.toString true}: {e}") - | Except.ok (ref2, fn) => - match evalFuncVal ref2 fn args with - | Except.error e => Except.error e - | Except.ok (fref, res) => - -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope - Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) + let (env2, fn) ← evalTypes env head + let (fref, res) ← evalFuncVal env2 fn args + -- after executing a function, propagate atoms (defined in outer environments) to the parent scope + return ((forwardMutatedAtoms fref env), res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do match fn with | Types.funcVal v => match v with | Fun.builtin name => - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - evalFnNative newEnv name results args + let (newEnv, results) ← evalFuncArgs env args + evalFnNative newEnv name results args | Fun.userDefined fref params body => - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys - let normalArgs := results.take keys.length - let variadicArg := results.drop keys.length - let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 - - let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newEnv.merge fref).mergeDict argsLevel argsDict - - evalTypes merged body + let (newEnv, results) ← evalFuncArgs env args + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newEnv.merge fref).mergeDict argsLevel argsDict + evalTypes merged body | Fun.macroFn fref params body => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false @@ -81,143 +70,121 @@ mutual let normalArgs := args.take keys.length let variadicArg := args.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= ref.getLevel then fref.getLevel + 1 else ref.getLevel + 1 + let argsLevel := if fref.getLevel >= env.getLevel then fref.getLevel + 1 else env.getLevel + 1 let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (ref.merge fref).mergeDict argsLevel argsDict - - match evalTypes merged body with - | Except.error e => Except.error e - | Except.ok (_, newast) => evalTypes ref newast + let merged := (env.merge fref).mergeDict argsLevel argsDict + let (_, newast) ← evalTypes merged body + evalTypes env newast | _ => throw (IO.userError s!"`unexpected token, expected: function`") partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do - if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + if List.length lst == 0 then return (env, Types.listVal lst) else let head := lst[0]! match lst[0]! with | Types.symbolVal v => match v with - | "def!" => evalDefn ref (lst.drop 1) - | "let*" => evalLet ref (lst.drop 1) - | "do" => evalDo ref (lst.drop 1) - | "if" => evalIf ref (lst.drop 1) - | "fn*" => makeFn ref (lst.drop 1) + | "def!" => evalDefn env (lst.drop 1) + | "let*" => evalLet env (lst.drop 1) + | "do" => evalDo env (lst.drop 1) + | "if" => evalIf env (lst.drop 1) + | "fn*" => makeFn env (lst.drop 1) | "quote" => if lst.length < 2 then throw (IO.userError "quote: expected 1 argument") - else Except.ok (ref, lst[1]!) + else return (env, lst[1]!) | "quasiquote" => if lst.length < 2 then throw (IO.userError "quasiquote: expected 1 argument") - else evalTypes ref (quasiquote lst[1]!) - | "defmacro!" => evalDefMacro ref (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) + else evalTypes env (quasiquote lst[1]!) + | "defmacro!" => evalDefMacro env (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do - match evalFuncArgs ref elems with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) + let (newEnv, results) ← evalFuncArgs env elems + return (newEnv, Types.vecVal (listToVec results)) partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do - match evalDictInner ref lst with - | Except.error e => Except.error e - | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) + let (newEnv, newDict) ← evalDictInner env lst + return (newEnv, Types.dictVal newDict) - partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := do match lst with - | Dict.empty => Except.ok (ref, lst) - | Dict.insert k _ v restDict => match evalTypes ref v with - | Except.error e => Except.error e - | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with - | Except.error e => Except.error e - | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k 0 newVal updatedDict - Except.ok (updatedRef, newDict) + | Dict.empty => return (env, lst) + | Dict.insert k _ v restDict => + let (newEnv, newVal) ← evalTypes env v + let (updatedEnv, updatedDict) ← evalDictInner newEnv restDict + let newDict := Dict.insert k 0 newVal updatedDict + return (updatedEnv, newDict) partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := - match args.foldl (fun (res : IO (Env × List Types)) x => - match res with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") - | Except.ok (r, acc) => match evalTypes r x with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, acc ++ [res]) - ) (Except.ok (ref, [])) with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) + args.foldlM (fun (res : Env × List Types) (x : Types) => do + let (r, acc) := res + let (updatedenv, res) ← evalTypes r x + return (updatedenv, acc ++ [res]) + ) (env, []) partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! - match (evalTypes ref body) with - | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newEnv, value) => - match key with + let (newEnv, value) ← (evalTypes env body) + match key with | Types.symbolVal v => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value - Except.ok (refResult, value) - | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") + let refResult := newEnv.add (KeyType.strKey v) env.getLevel value + return (refResult, value) + | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalDefMacro (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! - match (evalTypes ref body) with - | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newEnv, value) => - match key with - | Types.symbolVal v => - match value with - | Types.funcVal func => - match func with - | Fun.macroFn _ _ _ => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value - Except.ok (refResult, value) - | Fun.userDefined fref params body => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) - Except.ok (refResult, value) - | _ => Except.error (newEnv, s!"defmacro!: unexpected builtin function") - | x => Except.error (newEnv, s!"unexpected token type: {x.toString true}, expected: function") - | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") + let (newEnv, value) ← evalTypes env body + match key with + | Types.symbolVal v => + match value with + | Types.funcVal func => + match func with + | Fun.macroFn _ _ _ => + let refResult := newEnv.add (KeyType.strKey v) env.getLevel value + return (refResult, value) + | Fun.userDefined fref params body => + let refResult := newEnv.add (KeyType.strKey v) env.getLevel (Types.funcVal (Fun.macroFn fref params body)) + return (refResult, value) + | _ => throw (IO.userError s!"defmacro!: unexpected builtin function") + | x => throw (IO.userError s!"unexpected token type: {x.toString true}, expected: function") + | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! - let result := match pairs with - | Types.listVal v => evalLetArgs ref.increment v - | Types.vecVal v => evalLetArgs ref.increment (toList v) + let newEnv ← match pairs with + | Types.listVal v => evalLetArgs env.increment v + | Types.vecVal v => evalLetArgs env.increment (toList v) | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") - match result with - | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") - | Except.ok newEnv => match evalTypes newEnv body with - | Except.error e => Except.error e - -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope - | Except.ok (letref, result) => - Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) + let (letref, result) ← evalTypes newEnv body + -- after executing let*, propagate atoms (defined in outer environments) to the parent scope + return ((forwardMutatedAtoms letref env), result) - partial def evalLetArgs (env: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with - | [] => Except.ok ref + | [] => return env | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with - | Types.symbolVal key => match evalTypes ref y with - | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") - | Except.ok (updatedRef, value) => - evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest + | Types.symbolVal key => + let (updatedEnv, value) ← evalTypes env y + evalLetArgs (updatedEnv.add (KeyType.strKey key) env.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - if results.length == 0 then Except.ok (newEnv, Types.Nil) - else Except.ok (newEnv, results[results.length - 1]!) + let (newEnv, results) ← evalFuncArgs env args + if results.length == 0 then return (newEnv, Types.Nil) + else return (newEnv, results[results.length - 1]!) partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") @@ -226,16 +193,14 @@ mutual let thenExpr := args[1]! let hasElse := args.length > 2 - match evalTypes ref condition with - | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") - | Except.ok (newEnv, condResp) => - let cond := match condResp with - | Types.boolVal v => v - | Types.Nil => false - | _ => true - if cond then evalTypes newEnv thenExpr - else if hasElse then evalTypes newEnv args[2]! - else Except.ok (newEnv, Types.Nil) + let (newEnv, condResp) ← evalTypes env condition + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else return (newEnv, Types.Nil) partial def swapAtom (env: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") @@ -247,22 +212,18 @@ mutual | Types.symbolVal sym => match fn with | Types.funcVal _ => - match ref.get (KeyType.strKey sym) with + match env.get (KeyType.strKey sym) with | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") - | Except.ok (_, res) => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) - Except.ok (newEnv, res) + let (_, res) ← evalFuncVal env fn ([v] ++ rest) + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + return (newEnv, res) | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) with - | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") - | Except.ok (_, res) => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newEnv, res) + let (_, res) ← evalFuncVal env fn ([v] ++ rest) + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + return (newEnv, res) | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") @@ -271,7 +232,7 @@ mutual if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! - evalTypes ref ast + evalTypes env ast partial def starts_with (lst: List Types) (symb: String) : Bool := if lst.length == 2 then @@ -306,48 +267,48 @@ mutual partial def evalFnNative (env : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with - | "+" => sum ref results - | "-" => sub ref results - | "*" => mul ref results - | "/" => div ref results - | "<" => lt ref results - | "<=" => lte ref results - | ">" => gt ref results - | ">=" => gte ref results - | "=" => eq ref results false - | "list" => Except.ok (ref, Types.listVal results) - | "count" => countFunc ref results - | "cons" => cons ref results - | "concat" => concat ref results - | "vec" => makeVec ref results - | "nth" => nthSeq ref results - | "first" => firstSeq ref results - | "rest" => restSeq ref results - | "atom" => makeAtom ref results - | "deref" => derefAtom ref results - | "reset!" => resetAtom ref results args - | "swap!" => swapAtom ref results args - | "prn" => prnFunc ref results - | "pr-str" => prStrFunc ref results - | "str" => strFunc ref results - | "println" => printlnFunc ref results - | "eval" => eval ref results - | "read-string" => match readString results ref with -- readString results Dict.empty - | Except.error e => throw (IO.userError e) - | Except.ok res => Except.ok (ref, res) + | "+" => sum env results + | "-" => sub env results + | "*" => mul env results + | "/" => div env results + | "<" => lt env results + | "<=" => lte env results + | ">" => gt env results + | ">=" => gte env results + | "=" => eq env results false + | "list" => return (env, Types.listVal results) + | "count" => countFunc env results + | "cons" => cons env results + | "concat" => concat env results + | "vec" => makeVec env results + | "nth" => nthSeq env results + | "first" => firstSeq env results + | "rest" => restSeq env results + | "atom" => makeAtom env results + | "deref" => derefAtom env results + | "reset!" => resetAtom env results args + | "swap!" => swapAtom env results args + | "prn" => prnFunc env results + | "pr-str" => prStrFunc env results + | "str" => strFunc env results + | "println" => printlnFunc env results + | "eval" => eval env results + | "read-string" => + let res ← readString results env -- readString results Dict.empty + return (env, res) | _ => match results with | [x] => match x with | Types.listVal x => match name with - | "list?" => Except.ok (ref, Types.boolVal true) - | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "list?" => return (env, Types.boolVal true) + | "empty?" => return (env, Types.boolVal (x.length == 0)) + | _ => return (env, Types.boolVal false) | Types.vecVal x => match name with - | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "empty?" => return (env, Types.boolVal ((toList x).length == 0)) + | _ => return (env, Types.boolVal false) | Types.atomVal _ => match name with - | "atom?" => Except.ok (ref, Types.boolVal true) - | _ => Except.ok (ref, Types.boolVal false) - | _ => Except.ok (ref, Types.boolVal false) + | "atom?" => return (env, Types.boolVal true) + | _ => return (env, Types.boolVal false) + | _ => return (env, Types.boolVal false) | _ => throw (IO.userError s!"'{name}' not found") end @@ -358,41 +319,37 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (env: Env) (input : String): Env × String := +def rep (env: Env) (input : String): IO (Env × String) := do match READ.{u} input with - | Except.ok result => match evalTypes ref result with - | Except.error (newref, e) => (newref, e) - | Except.ok (newref, res) => (newref, PRINT res) - | Except.error err => (ref, s!"Parsing failed: {err}") - -def printLogs (env : Env) : IO Unit := - forM (getLogsInfo ref) (fun elem => - match elem with - | Types.strVal log => IO.println log - | x => IO.println (x.toString true) - ) - -def loadMalFns (env: Env) (fndefs: List String): Env × String := - fndefs.foldl (fun (res : Env × String) fndef => + | Except.ok result => + try + let (newenv, res) ← evalTypes env result + return (newenv, PRINT res) + catch + | e => return (env, s!"Error: {e}") + | Except.error err => return (env, s!"Parsing failed: {err}") + +def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do + fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) := rep.{u} ref fndef - (newref, s!"{msg}¬{newmsg}") - ) (ref, "") + let (newref, newmsg) ← rep.{u} ref fndef + return (newref, s!"{msg}¬{newmsg}") + ) (env, "") def fnDefs: List String := [ "(def! *host-language* \"Lean\")", "(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)))))))", ] def main (args : List String) : IO Unit := do - let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let astArgs := (args.map (fun arg => Types.strVal arg)) let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) if args.length > 0 then - let (ref, val) := rep.{u} env s!"(load-file \"{args[0]!}\")" - printLogs ref + let (_, val) ← rep.{u} env s!"(load-file \"{args[0]!}\")" IO.println val else @@ -408,7 +365,6 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (ref, val) := rep.{u} env value - printLogs ref + let (newenv, val) ← rep.{u} env value IO.println val - env := resetLogs ref + env := newenv From 795c52be15c6192208e07a21ca8d57d5667d1d23 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Tue, 27 Aug 2024 18:55:39 +0200 Subject: [PATCH 35/39] use IO, refactor step 9, A --- impls/lean/LeanMal/core.lean | 42 ++- impls/lean/LeanMal/step9_try.lean | 518 ++++++++++++++--------------- impls/lean/LeanMal/stepA_mal.lean | 523 ++++++++++++++---------------- 3 files changed, 513 insertions(+), 570 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 4457ef25df..71d6eac7d7 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -523,7 +523,7 @@ def readFileContent (filePath : String) : IO String := do def slurp (env : Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 1 then - throw (IO.userError "slurp: 2 arguments required") + throw (IO.userError "slurp: 1 argument required") else match lst[0]! with | Types.strVal filename => do @@ -532,8 +532,43 @@ def slurp (env : Env) (lst: List Types) : IO (Env × Types) := do return (env, Types.strVal content) catch e => throw (IO.userError s!"slurp: failed to read file: {e.toString}") - | _ => - throw (IO.userError "slurp: filename must be a string") + | _ => throw (IO.userError "slurp: filename must be a string") + +def isEOF (stdin : IO.FS.Stream) : IO Bool := do + let input ← stdin.read 1 -- Try to read one more character + if input.isEmpty then + pure true -- EOF detected + else + pure false -- Some input available + +def prompt (msg: String) : IO (Option String) := do + IO.print msg + let stdin ← IO.getStdin + let input ← stdin.getLine + if input.isEmpty then + let eof ← isEOF stdin + if eof then + return none -- Indicates EOF (Ctrl+D) + else + return some "" + else + let value := input.trim + if value = "exit" then + return some "" + else + return some value + +def readline (env : Env) (lst: List Types) : IO (Env × Types) := do + if lst.length < 1 then + throw (IO.userError "readline: 1 arguments required") + else + match lst[0]! with + | Types.strVal msg => do + let ret := ← prompt msg + match ret with + | none => return (env, Types.Nil) + | some v => return (env, Types.strVal v) + | _ => throw (IO.userError "readline: argument must be a string") def loadFnNative (env : Env) (name: String) : Env := env.add (KeyType.strKey name) 0 (Types.funcVal (Fun.builtin name)) @@ -559,6 +594,7 @@ def coreFnSymbols: List String := [ "read-string", "slurp", "atom", "atom?", "deref", "reset!", "swap!", "eval", + "readline", "time-ms", "meta", "with-meta" ] diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index c66112891d..741b8051e2 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -12,8 +12,8 @@ def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do let params := match p with | Types.vecVal x => Types.listVal (toList x) | _ => p - let newfn := Fun.userDefined ref.increment params body - Except.ok (ref, Types.funcVal newfn) + let newfn := Fun.userDefined env.increment params body + return (env, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := @@ -26,61 +26,50 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do - let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" - else _ref + partial def evalTypes (env : Env) (ast : Types) : IO (Env × Types) := do + if getDebugEval env then IO.println s!"EVAL:{pr_str true ast}" match ast with - | Types.symbolVal v => match ref.get (KeyType.strKey v) with - | some (_, vi) => Except.ok (ref, vi) + | Types.symbolVal v => match env.get (KeyType.strKey v) with + | some (_, vi) => return (env, vi) | none => throw (IO.userError s!"'{v}' not found") - | Types.listVal el => (evalList ref el) - | Types.vecVal el => (evalVec ref (toList el)) - | Types.dictVal el => (evalDict ref el) - | x => Except.ok (ref, x) - - partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do - match evalTypes ref head with - | Except.error e => Except.error e - | Except.ok (ref2, fn) => - match evalFuncVal ref2 fn args true with - | Except.error e => Except.error e - | Except.ok (fref, res) => - -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope - Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) + | Types.listVal el => (evalList env el) + | Types.vecVal el => (evalVec env (toList el)) + | Types.dictVal el => (evalDict env el) + | x => return (env, x) + + partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do + let (env2, fn) ← evalTypes env head + let (fref, res) ← evalFuncVal env2 fn args true + -- after executing a function, propagate atoms (defined in outer environments) to the parent scope + return ((forwardMutatedAtoms fref env), res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : IO (Env × Types) := do match fn with | Types.funcVal v => match v with | Fun.builtin name => - match if !evaluateArgs then Except.ok (ref, args) else - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) - with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => evalFnNative newEnv name results args - | Fun.userDefined fref params body => - match if !evaluateArgs then Except.ok (ref, args) else - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) - with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys - let normalArgs := results.take keys.length - let variadicArg := results.drop keys.length - let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 - - let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newEnv.merge fref).mergeDict argsLevel argsDict - - evalTypes merged body - | Fun.macroFn fref params body => + let (newEnv, results) ← if !evaluateArgs then + pure (env, args) + else + evalFuncArgs env args + evalFnNative newEnv name results args + | Fun.userDefined fenv params body => + let (newEnv, results) ← if !evaluateArgs then + pure (env, args) + else + evalFuncArgs env args + + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let argsLevel := if fenv.getLevel >= newEnv.getLevel then fenv.getLevel + 1 else newEnv.getLevel + 1 + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newEnv.merge fenv).mergeDict argsLevel argsDict + evalTypes merged body + | Fun.macroFn fenv params body => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] @@ -88,144 +77,122 @@ mutual let normalArgs := args.take keys.length let variadicArg := args.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= ref.getLevel then fref.getLevel + 1 else ref.getLevel + 1 + let argsLevel := if fenv.getLevel >= env.getLevel then fenv.getLevel + 1 else env.getLevel + 1 let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (ref.merge fref).mergeDict argsLevel argsDict - - match evalTypes merged body with - | Except.error e => Except.error e - | Except.ok (_, newast) => evalTypes ref newast + let merged := (env.merge fenv).mergeDict argsLevel argsDict + let (_, newast) ← evalTypes merged body + evalTypes env newast | _ => throw (IO.userError s!"`unexpected token, expected: function`") partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do - if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + if List.length lst == 0 then return (env, Types.listVal lst) else let head := lst[0]! match head with | Types.symbolVal v => match v with - | "def!" => evalDefn ref (lst.drop 1) - | "let*" => evalLet ref (lst.drop 1) - | "do" => evalDo ref (lst.drop 1) - | "if" => evalIf ref (lst.drop 1) - | "fn*" => makeFn ref (lst.drop 1) - | "try*" => evalTry ref (lst.drop 1) + | "def!" => evalDefn env (lst.drop 1) + | "let*" => evalLet env (lst.drop 1) + | "do" => evalDo env (lst.drop 1) + | "if" => evalIf env (lst.drop 1) + | "fn*" => makeFn env (lst.drop 1) + | "try*" => evalTry env (lst.drop 1) | "quote" => if lst.length < 2 then throw (IO.userError "quote: expected 1 argument") - else Except.ok (ref, lst[1]!) + else return (env, lst[1]!) | "quasiquote" => if lst.length < 2 then throw (IO.userError "quasiquote: expected 1 argument") - else evalTypes ref (quasiquote lst[1]!) - | "defmacro!" => evalDefMacro ref (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) + else evalTypes env (quasiquote lst[1]!) + | "defmacro!" => evalDefMacro env (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do - match evalFuncArgs ref elems with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) + let (newEnv, results) ← evalFuncArgs env elems + return (newEnv, Types.vecVal (listToVec results)) partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do - match evalDictInner ref lst with - | Except.error e => Except.error e - | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) + let (newEnv, newDict) ← evalDictInner env lst + return (newEnv, Types.dictVal newDict) - partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := do match lst with - | Dict.empty => Except.ok (ref, lst) - | Dict.insert k _ v restDict => match evalTypes ref v with - | Except.error e => Except.error e - | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with - | Except.error e => Except.error e - | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k 0 newVal updatedDict - Except.ok (updatedRef, newDict) + | Dict.empty => return (env, lst) + | Dict.insert k _ v restDict => + let (newEnv, newVal) ← evalTypes env v + let (updatedEnv, updatedDict) ← evalDictInner newEnv restDict + let newDict := Dict.insert k 0 newVal updatedDict + return (updatedEnv, newDict) partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := - match args.foldl (fun (res : IO (Env × List Types)) x => - match res with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") - | Except.ok (r, acc) => match evalTypes r x with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, acc ++ [res]) - ) (Except.ok (ref, [])) with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) + args.foldlM (fun (res : Env × List Types) (x : Types) => do + let (r, acc) := res + let (updatedenv, res) ← evalTypes r x + return (updatedenv, acc ++ [res]) + ) (env, []) partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! - match (evalTypes ref body) with - | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newEnv, value) => - match key with + let (newEnv, value) ← (evalTypes env body) + match key with | Types.symbolVal v => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value - Except.ok (refResult, value) - | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") + let envResult := newEnv.add (KeyType.strKey v) env.getLevel value + return (envResult, value) + | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalDefMacro (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! - match (evalTypes ref body) with - | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newEnv, value) => - match key with - | Types.symbolVal v => - match value with - | Types.funcVal func => - match func with - | Fun.macroFn _ _ _ => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value - Except.ok (refResult, value) - | Fun.userDefined fref params body => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) - Except.ok (refResult, value) - | _ => Except.error (newEnv, s!"defmacro!: unexpected builtin function") - | x => Except.error (newEnv, s!"unexpected token type: {x.toString true}, expected: function") - | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") + let (newEnv, value) ← evalTypes env body + match key with + | Types.symbolVal v => + match value with + | Types.funcVal func => + match func with + | Fun.macroFn _ _ _ => + let envResult := newEnv.add (KeyType.strKey v) env.getLevel value + return (envResult, value) + | Fun.userDefined fenv params body => + let envResult := newEnv.add (KeyType.strKey v) env.getLevel (Types.funcVal (Fun.macroFn fenv params body)) + return (envResult, value) + | _ => throw (IO.userError s!"defmacro!: unexpected builtin function") + | x => throw (IO.userError s!"unexpected token type: {x.toString true}, expected: function") + | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! - let result := match pairs with - | Types.listVal v => evalLetArgs ref.increment v - | Types.vecVal v => evalLetArgs ref.increment (toList v) + let newEnv ← match pairs with + | Types.listVal v => evalLetArgs env.increment v + | Types.vecVal v => evalLetArgs env.increment (toList v) | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") - match result with - | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") - | Except.ok newEnv => match evalTypes newEnv body with - | Except.error e => Except.error e - -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope - | Except.ok (letref, result) => - Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) + let (letenv, result) ← evalTypes newEnv body + -- after executing let*, propagate atoms (defined in outer environments) to the parent scope + return ((forwardMutatedAtoms letenv env), result) - partial def evalLetArgs (env: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with - | [] => Except.ok ref + | [] => return env | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with - | Types.symbolVal key => match evalTypes ref y with - | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") - | Except.ok (updatedRef, value) => - evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest + | Types.symbolVal key => + let (updatedEnv, value) ← evalTypes env y + evalLetArgs (updatedEnv.add (KeyType.strKey key) env.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - if results.length == 0 then Except.ok (newEnv, Types.Nil) - else Except.ok (newEnv, results[results.length - 1]!) + let (newEnv, results) ← evalFuncArgs env args + if results.length == 0 then return (newEnv, Types.Nil) + else return (newEnv, results[results.length - 1]!) partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") @@ -234,24 +201,24 @@ mutual let thenExpr := args[1]! let hasElse := args.length > 2 - match evalTypes ref condition with - | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") - | Except.ok (newEnv, condResp) => - let cond := match condResp with - | Types.boolVal v => v - | Types.Nil => false - | _ => true - if cond then evalTypes newEnv thenExpr - else if hasElse then evalTypes newEnv args[2]! - else Except.ok (newEnv, Types.Nil) + let (newEnv, condResp) ← evalTypes env condition + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else return (newEnv, Types.Nil) partial def evalTry (env: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "try*: unexpected syntax") else - match evalTypes ref lst[0]! with - | Except.ok (newEnv, result) => Except.ok (newEnv, result) - | Except.error evalErr => - if lst.length < 2 then Except.error evalErr + try + let (newEnv, result) ← evalTypes env lst[0]! + return (newEnv, result) + catch + | evalErr => + if lst.length < 2 then throw evalErr else match lst[1]! with | Types.listVal catchBody => @@ -265,19 +232,18 @@ mutual let es := catchBody[1]! match es with | Types.symbolVal errorSymbol => - let (errRef, errStr) := evalErr - let err := Types.strVal errStr - if catchBody.length < 2 then Except.error (errRef, "try*: unexpected syntax") + let err := Types.strVal evalErr.toString + if catchBody.length < 2 then throw (IO.userError "try*: unexpected syntax") else let toeval := catchBody[2]! - let built := buildDictWithSymbols ref.getDict ref.getLevel [errorSymbol] [err] - let merged := ref.mergeDict (ref.getLevel + 1) built + let built := buildDictWithSymbols env.getDict env.getLevel [errorSymbol] [err] + let merged := env.mergeDict (env.getLevel + 1) built evalTypes merged toeval | _ => throw (IO.userError s!"unexpected return type, expected: symbol") - else Except.error evalErr - | _ => Except.error evalErr + else throw evalErr + | _ => throw evalErr -- | Types.vecVal v => -- TODO - | _ => Except.error evalErr + | _ => throw evalErr partial def swapAtom (env: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") @@ -289,22 +255,18 @@ mutual | Types.symbolVal sym => match fn with | Types.funcVal _ => - match ref.get (KeyType.strKey sym) with + match env.get (KeyType.strKey sym) with | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) false with - | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") - | Except.ok (_, res) => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) - Except.ok (newEnv, res) + let (_, res) ← evalFuncVal env fn ([v] ++ rest) false + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + return (newEnv, res) | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) false with - | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") - | Except.ok (_, res) => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newEnv, res) + let (_, res) ← evalFuncVal env fn ([v] ++ rest) false + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + return (newEnv, res) | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") @@ -313,7 +275,7 @@ mutual if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! - evalTypes ref ast + evalTypes env ast partial def starts_with (lst: List Types) (symb: String) : Bool := if lst.length == 2 then @@ -347,17 +309,14 @@ mutual | _ => ast partial def nativeMapOverList (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do - match args.foldl (fun (res : IO (Env × List Types)) x => - match res with - | Except.error e => Except.error e - | Except.ok (r, acc) => - match evalFuncVal r fn [x] false with - | Except.error e => Except.error e - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, acc ++ [res]) - ) (Except.ok (ref, [])) with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, Types.listVal results) + let finalResult ← args.foldlM (fun (res : (Env × List Types)) (x : Types) => do + let (r, acc) := res + let (updatedRef, res) ← evalFuncVal r fn [x] false + pure (updatedRef, acc ++ [res]) + ) (env, []) + + let (newEnv, results) := finalResult + pure (newEnv, Types.listVal results) partial def nativeMap (env: Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "map: unexpected syntax") @@ -367,8 +326,8 @@ mutual match fn with | Types.funcVal _ => match params with - | Types.listVal v => nativeMapOverList ref fn v - | Types.vecVal v => nativeMapOverList ref fn (toList v) + | Types.listVal v => nativeMapOverList env fn v + | Types.vecVal v => nativeMapOverList env fn (toList v) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: function") @@ -381,93 +340,93 @@ mutual let firstargs := lst.drop 1 |>.take n match vecargs with | Types.listVal v => - evalFuncVal ref fn (firstargs ++ v) false + evalFuncVal env fn (firstargs ++ v) false | Types.vecVal v => - evalFuncVal ref fn (firstargs ++ (toList v)) false + evalFuncVal env fn (firstargs ++ (toList v)) false | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") partial def evalFnNative (env : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with - | "+" => sum ref results - | "-" => sub ref results - | "*" => mul ref results - | "/" => div ref results - | "<" => lt ref results - | "<=" => lte ref results - | ">" => gt ref results - | ">=" => gte ref results - | "=" => eq ref results false - | "list" => Except.ok (ref, Types.listVal results) - | "count" => countFunc ref results - | "cons" => cons ref results - | "concat" => concat ref results - | "map" => nativeMap ref results - | "apply" => nativeApply ref results - | "vec" => makeVec ref results - | "vector" => makeVector ref results - | "nth" => nthSeq ref results - | "first" => firstSeq ref results - | "rest" => restSeq ref results - | "conj" => conj ref results - | "seq" => seq ref results - | "hash-map" => makeDict ref results - | "assoc" => assocDict ref results - | "dissoc" => dissocDict ref results - | "get" => getDict ref results - | "contains?" => containsDict ref results - | "keys" => getKeysDict ref results - | "vals" => getValuesDict ref results - | "throw" => throwFn ref results - | "symbol" => makeSymbol ref results - | "keyword" => makeKeyword ref results - | "atom" => makeAtom ref results - | "deref" => derefAtom ref results - | "reset!" => resetAtom ref results args - | "swap!" => swapAtom ref results args - | "prn" => prnFunc ref results - | "pr-str" => prStrFunc ref results - | "str" => strFunc ref results - | "println" => printlnFunc ref results - | "eval" => eval ref results - | "read-string" => match readString results ref with -- readString results Dict.empty - | Except.error e => throw (IO.userError e) - | Except.ok res => Except.ok (ref, res) + | "+" => sum env results + | "-" => sub env results + | "*" => mul env results + | "/" => div env results + | "<" => lt env results + | "<=" => lte env results + | ">" => gt env results + | ">=" => gte env results + | "=" => eq env results false + | "list" => return (env, Types.listVal results) + | "count" => countFunc env results + | "cons" => cons env results + | "concat" => concat env results + | "map" => nativeMap env results + | "apply" => nativeApply env results + | "vec" => makeVec env results + | "vector" => makeVector env results + | "nth" => nthSeq env results + | "first" => firstSeq env results + | "rest" => restSeq env results + | "conj" => conj env results + | "seq" => seq env results + | "hash-map" => makeDict env results + | "assoc" => assocDict env results + | "dissoc" => dissocDict env results + | "get" => getDict env results + | "contains?" => containsDict env results + | "keys" => getKeysDict env results + | "vals" => getValuesDict env results + | "throw" => throwFn env results + | "symbol" => makeSymbol env results + | "keyword" => makeKeyword env results + | "atom" => makeAtom env results + | "deref" => derefAtom env results + | "reset!" => resetAtom env results args + | "swap!" => swapAtom env results args + | "prn" => prnFunc env results + | "pr-str" => prStrFunc env results + | "str" => strFunc env results + | "println" => printlnFunc env results + | "eval" => eval env results + | "read-string" => + let res ← readString results env -- readString results Dict.empty + return (env, res) | _ => match results with | [x] => match x with - | Types.Nil => if name == "nil?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.intVal _ => if name == "number?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.floatVal _ => if name == "number?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.strVal _ => if name == "string?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.symbolVal _ => if name == "symbol?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.keywordVal _ => if name == "keyword?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.dictVal _ => if name == "map?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.Nil => if name == "nil?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.intVal _ => if name == "number?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.floatVal _ => if name == "number?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.strVal _ => if name == "string?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.symbolVal _ => if name == "symbol?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.keywordVal _ => if name == "keyword?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.dictVal _ => if name == "map?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) | Types.listVal x => match name with - | "list?" => Except.ok (ref, Types.boolVal true) - | "sequential?" => Except.ok (ref, Types.boolVal true) - | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "list?" => return (env, Types.boolVal true) + | "sequential?" => return (env, Types.boolVal true) + | "empty?" => return (env, Types.boolVal (x.length == 0)) + | _ => return (env, Types.boolVal false) | Types.vecVal x => match name with - | "sequential?" => Except.ok (ref, Types.boolVal true) - | "vector?" => Except.ok (ref, Types.boolVal true) - | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "sequential?" => return (env, Types.boolVal true) + | "vector?" => return (env, Types.boolVal true) + | "empty?" => return (env, Types.boolVal ((toList x).length == 0)) + | _ => return (env, Types.boolVal false) | Types.boolVal x => match name with - | "true?" => Except.ok (ref, Types.boolVal x) - | "false?" => Except.ok (ref, Types.boolVal !x) - | _ => Except.ok (ref, Types.boolVal false) + | "true?" => return (env, Types.boolVal x) + | "false?" => return (env, Types.boolVal !x) + | _ => return (env, Types.boolVal false) | Types.atomVal _ => match name with - | "atom?" => Except.ok (ref, Types.boolVal true) - | _ => Except.ok (ref, Types.boolVal false) + | "atom?" => return (env, Types.boolVal true) + | _ => return (env, Types.boolVal false) | Types.funcVal func => match name with | "fn?" => match func with - | Fun.builtin _ => Except.ok (ref, Types.boolVal true) - | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal true) - | Fun.macroFn _ _ _ => Except.ok (ref, Types.boolVal false) + | Fun.builtin _ => return (env, Types.boolVal true) + | Fun.userDefined _ _ _ => return (env, Types.boolVal true) + | Fun.macroFn _ _ _ => return (env, Types.boolVal false) | "macro?" => match func with - | Fun.builtin _ => Except.ok (ref, Types.boolVal false) - | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal false) - | Fun.macroFn _ _ _ => Except.ok (ref, Types.boolVal true) - | _ => Except.ok (ref, Types.boolVal false) + | Fun.builtin _ => return (env, Types.boolVal false) + | Fun.userDefined _ _ _ => return (env, Types.boolVal false) + | Fun.macroFn _ _ _ => return (env, Types.boolVal true) + | _ => return (env, Types.boolVal false) | _ => throw (IO.userError s!"'{name}' not found") end @@ -478,41 +437,37 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (env: Env) (input : String): Env × String := +def rep (env: Env) (input : String): IO (Env × String) := do match READ.{u} input with - | Except.ok result => match evalTypes ref result with - | Except.error (newref, e) => (newref, s!"Error: {e}") - | Except.ok (newref, res) => (newref, PRINT res) - | Except.error err => (ref, s!"Parsing failed: {err}") - -def printLogs (env : Env) : IO Unit := - forM (getLogsInfo ref) (fun elem => - match elem with - | Types.strVal log => IO.println log - | x => IO.println (x.toString true) - ) - -def loadMalFns (env: Env) (fndefs: List String): Env × String := - fndefs.foldl (fun (res : Env × String) fndef => + | Except.ok result => + try + let (newenv, res) ← evalTypes env result + return (newenv, PRINT res) + catch + | e => return (env, s!"Error: {e}") + | Except.error err => return (env, s!"Parsing failed: {err}") + +def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do + fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) := rep.{u} ref fndef - (newref, s!"{msg}¬{newmsg}") - ) (ref, "") + let (newref, newmsg) ← rep.{u} ref fndef + return (newref, s!"{msg}¬{newmsg}") + ) (env, "") def fnDefs: List String := [ "(def! *host-language* \"Lean\")", "(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)))))))", ] def main (args : List String) : IO Unit := do - let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let astArgs := (args.map (fun arg => Types.strVal arg)) let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) if args.length > 0 then - let (ref, val) := rep.{u} env s!"(load-file \"{args[0]!}\")" - printLogs ref + let (_, val) ← rep.{u} env s!"(load-file \"{args[0]!}\")" IO.println val else @@ -528,7 +483,6 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (ref, val) := rep.{u} env value - printLogs ref + let (newenv, val) ← rep.{u} env value IO.println val - env := resetLogs ref + env := newenv diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index 52a2c58cb5..00061c80c7 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -12,8 +12,8 @@ def makeFn (env: Env) (args : List Types) : IO (Env × Types) := do let params := match p with | Types.vecVal x => Types.listVal (toList x) | _ => p - let newfn := Fun.userDefined ref.increment params body - Except.ok (ref, Types.funcVal newfn) + let newfn := Fun.userDefined env.increment params body + return (env, Types.funcVal newfn) def splitOnAmpersand (input : List String) : (List String × List String) := let rec loop (acc1 : List String) (rest : List String) : (List String × List String) := @@ -26,61 +26,50 @@ def splitOnAmpersand (input : List String) : (List String × List String) := loop [] input mutual - partial def evalTypes (_ref : Env) (ast : Types) : IO (Env × Types) := do - let ref := if getDebugEval _ref then logInfo _ref s!"EVAL:{pr_str true ast}" - else _ref + partial def evalTypes (env : Env) (ast : Types) : IO (Env × Types) := do + if getDebugEval env then IO.println s!"EVAL:{pr_str true ast}" match ast with - | Types.symbolVal v => match ref.get (KeyType.strKey v) with - | some (_, vi) => Except.ok (ref, vi) + | Types.symbolVal v => match env.get (KeyType.strKey v) with + | some (_, vi) => return (env, vi) | none => throw (IO.userError s!"'{v}' not found") - | Types.listVal el => (evalList ref el) - | Types.vecVal el => (evalVec ref (toList el)) - | Types.dictVal el => (evalDict ref el) - | x => Except.ok (ref, x) - - partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do - match evalTypes ref head with - | Except.error e => Except.error e - | Except.ok (ref2, fn) => - match evalFuncVal ref2 fn args true with - | Except.error e => Except.error e - | Except.ok (fref, res) => - -- after executing a function, propagate atoms (defined in outer environments) and logs to the parent scope - Except.ok (forwardLogs fref (forwardMutatedAtoms fref ref), res) + | Types.listVal el => (evalList env el) + | Types.vecVal el => (evalVec env (toList el)) + | Types.dictVal el => (evalDict env el) + | x => return (env, x) + + partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do + let (env2, fn) ← evalTypes env head + let (fref, res) ← evalFuncVal env2 fn args true + -- after executing a function, propagate atoms (defined in outer environments) to the parent scope + return ((forwardMutatedAtoms fref env), res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : IO (Env × Types) := do match fn with | Types.funcVal v => match v with | Fun.builtin name => - match if !evaluateArgs then Except.ok (ref, args) else - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) - with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => evalFnNative newEnv name results args - | Fun.userDefined fref params body => - match if !evaluateArgs then Except.ok (ref, args) else - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) - with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - let allkeys: List String := match params with - | Types.listVal v => v.map fun x => x.toString false - | _ => [] - let (keys, variadic) := splitOnAmpersand allkeys - let normalArgs := results.take keys.length - let variadicArg := results.drop keys.length - let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= newEnv.getLevel then fref.getLevel + 1 else newEnv.getLevel + 1 - - let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (newEnv.merge fref).mergeDict argsLevel argsDict - - evalTypes merged body - | Fun.macroFn fref params body => + let (newEnv, results) ← if !evaluateArgs then + pure (env, args) + else + evalFuncArgs env args + evalFnNative newEnv name results args + | Fun.userDefined fenv params body => + let (newEnv, results) ← if !evaluateArgs then + pure (env, args) + else + evalFuncArgs env args + + let allkeys: List String := match params with + | Types.listVal v => v.map fun x => x.toString false + | _ => [] + let (keys, variadic) := splitOnAmpersand allkeys + let normalArgs := results.take keys.length + let variadicArg := results.drop keys.length + let argVals := normalArgs ++ [Types.listVal variadicArg] + let argsLevel := if fenv.getLevel >= newEnv.getLevel then fenv.getLevel + 1 else newEnv.getLevel + 1 + let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) + let merged := (newEnv.merge fenv).mergeDict argsLevel argsDict + evalTypes merged body + | Fun.macroFn fenv params body => let allkeys: List String := match params with | Types.listVal v => v.map fun x => x.toString false | _ => [] @@ -88,144 +77,122 @@ mutual let normalArgs := args.take keys.length let variadicArg := args.drop keys.length let argVals := normalArgs ++ [Types.listVal variadicArg] - let argsLevel := if fref.getLevel >= ref.getLevel then fref.getLevel + 1 else ref.getLevel + 1 + let argsLevel := if fenv.getLevel >= env.getLevel then fenv.getLevel + 1 else env.getLevel + 1 let argsDict := (buildDict argsLevel (keys ++ variadic) argVals) - let merged := (ref.merge fref).mergeDict argsLevel argsDict - - match evalTypes merged body with - | Except.error e => Except.error e - | Except.ok (_, newast) => evalTypes ref newast + let merged := (env.merge fenv).mergeDict argsLevel argsDict + let (_, newast) ← evalTypes merged body + evalTypes env newast | _ => throw (IO.userError s!"`unexpected token, expected: function`") partial def evalList (env: Env) (lst : List Types) : IO (Env × Types) := do - if List.length lst == 0 then Except.ok (ref, Types.listVal lst) + if List.length lst == 0 then return (env, Types.listVal lst) else let head := lst[0]! match head with | Types.symbolVal v => match v with - | "def!" => evalDefn ref (lst.drop 1) - | "let*" => evalLet ref (lst.drop 1) - | "do" => evalDo ref (lst.drop 1) - | "if" => evalIf ref (lst.drop 1) - | "fn*" => makeFn ref (lst.drop 1) - | "try*" => evalTry ref (lst.drop 1) + | "def!" => evalDefn env (lst.drop 1) + | "let*" => evalLet env (lst.drop 1) + | "do" => evalDo env (lst.drop 1) + | "if" => evalIf env (lst.drop 1) + | "fn*" => makeFn env (lst.drop 1) + | "try*" => evalTry env (lst.drop 1) | "quote" => if lst.length < 2 then throw (IO.userError "quote: expected 1 argument") - else Except.ok (ref, lst[1]!) + else return (env, lst[1]!) | "quasiquote" => if lst.length < 2 then throw (IO.userError "quasiquote: expected 1 argument") - else evalTypes ref (quasiquote lst[1]!) - | "defmacro!" => evalDefMacro ref (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) - | _ => evalFunc ref head (lst.drop 1) + else evalTypes env (quasiquote lst[1]!) + | "defmacro!" => evalDefMacro env (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) + | _ => evalFunc env head (lst.drop 1) partial def evalVec (env: Env) (elems : List Types) : IO (Env × Types) := do - match evalFuncArgs ref elems with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, Types.vecVal (listToVec results)) + let (newEnv, results) ← evalFuncArgs env elems + return (newEnv, Types.vecVal (listToVec results)) partial def evalDict (env: Env) (lst : Dict) : IO (Env × Types) := do - match evalDictInner ref lst with - | Except.error e => Except.error e - | Except.ok (newEnv, newDict) => Except.ok (newEnv, Types.dictVal newDict) + let (newEnv, newDict) ← evalDictInner env lst + return (newEnv, Types.dictVal newDict) - partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := + partial def evalDictInner (env: Env) (lst : Dict) : IO (Env × Dict) := do match lst with - | Dict.empty => Except.ok (ref, lst) - | Dict.insert k _ v restDict => match evalTypes ref v with - | Except.error e => Except.error e - | Except.ok (newEnv, newVal) => match evalDictInner newEnv restDict with - | Except.error e => Except.error e - | Except.ok (updatedRef, updatedDict) => - let newDict := Dict.insert k 0 newVal updatedDict - Except.ok (updatedRef, newDict) + | Dict.empty => return (env, lst) + | Dict.insert k _ v restDict => + let (newEnv, newVal) ← evalTypes env v + let (updatedEnv, updatedDict) ← evalDictInner newEnv restDict + let newDict := Dict.insert k 0 newVal updatedDict + return (updatedEnv, newDict) partial def evalFuncArgs (env: Env) (args: List Types) : IO (Env × List Types) := - match args.foldl (fun (res : IO (Env × List Types)) x => - match res with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument accumulator: {x.toString true}: {e}") - | Except.ok (r, acc) => match evalTypes r x with - | Except.error (newref, e) => Except.error (newref, s!"error evaluating function argument: {x.toString true}: {e}") - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, acc ++ [res]) - ) (Except.ok (ref, [])) with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, results) + args.foldlM (fun (res : Env × List Types) (x : Types) => do + let (r, acc) := res + let (updatedenv, res) ← evalTypes r x + return (updatedenv, acc ++ [res]) + ) (env, []) partial def evalDefn (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! - match (evalTypes ref body) with - | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newEnv, value) => - match key with + let (newEnv, value) ← (evalTypes env body) + match key with | Types.symbolVal v => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value - Except.ok (refResult, value) - | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") + let envResult := newEnv.add (KeyType.strKey v) env.getLevel value + return (envResult, value) + | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalDefMacro (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "def! unexpected syntax") else let key := args[0]! let body := args[1]! - match (evalTypes ref body) with - | Except.error (newref, e) => Except.error (newref, s!"def!: {e}") - | Except.ok (newEnv, value) => - match key with - | Types.symbolVal v => - match value with - | Types.funcVal func => - match func with - | Fun.macroFn _ _ _ => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel value - Except.ok (refResult, value) - | Fun.userDefined fref params body => - let refResult := newEnv.add (KeyType.strKey v) ref.getLevel (Types.funcVal (Fun.macroFn fref params body)) - Except.ok (refResult, value) - | _ => Except.error (newEnv, s!"defmacro!: unexpected builtin function") - | x => Except.error (newEnv, s!"unexpected token type: {x.toString true}, expected: function") - | _ => Except.error (newEnv, s!"def! unexpected token, expected: symbol") + let (newEnv, value) ← evalTypes env body + match key with + | Types.symbolVal v => + match value with + | Types.funcVal func => + match func with + | Fun.macroFn _ _ _ => + let envResult := newEnv.add (KeyType.strKey v) env.getLevel value + return (envResult, value) + | Fun.userDefined fenv params body => + let envResult := newEnv.add (KeyType.strKey v) env.getLevel (Types.funcVal (Fun.macroFn fenv params body)) + return (envResult, value) + | _ => throw (IO.userError s!"defmacro!: unexpected builtin function") + | x => throw (IO.userError s!"unexpected token type: {x.toString true}, expected: function") + | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalLet (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "let*: unexpected syntax") else let pairs := args[0]! let body := args[1]! - let result := match pairs with - | Types.listVal v => evalLetArgs ref.increment v - | Types.vecVal v => evalLetArgs ref.increment (toList v) + let newEnv ← match pairs with + | Types.listVal v => evalLetArgs env.increment v + | Types.vecVal v => evalLetArgs env.increment (toList v) | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") - match result with - | Except.error (newEnv, e) => Except.error (newEnv, s!"let*: {e}") - | Except.ok newEnv => match evalTypes newEnv body with - | Except.error e => Except.error e - -- after executing let*, propagate atoms (defined in outer environments) and logs to the parent scope - | Except.ok (letref, result) => - Except.ok (forwardLogs letref (forwardMutatedAtoms letref ref), result) + let (letenv, result) ← evalTypes newEnv body + -- after executing let*, propagate atoms (defined in outer environments) to the parent scope + return ((forwardMutatedAtoms letenv env), result) - partial def evalLetArgs (env: Env) (args : List Types) : IO Env := + partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with - | [] => Except.ok ref + | [] => return env | [_] => throw (IO.userError "let*: unexpected syntax") | x :: y :: rest => match x with - | Types.symbolVal key => match evalTypes ref y with - | Except.error (newEnv, e) => Except.error (newEnv, s!"error evaluating function argument: {key}: {e}") - | Except.ok (updatedRef, value) => - evalLetArgs (updatedRef.add (KeyType.strKey key) ref.getLevel value) rest + | Types.symbolVal key => + let (updatedEnv, value) ← evalTypes env y + evalLetArgs (updatedEnv.add (KeyType.strKey key) env.getLevel value) rest | _ => throw (IO.userError "let*: unexpected syntax") partial def evalDo (env: Env) (args : List Types) : IO (Env × Types) := do -- only return last computation result - match evalFuncArgs ref args with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => - if results.length == 0 then Except.ok (newEnv, Types.Nil) - else Except.ok (newEnv, results[results.length - 1]!) + let (newEnv, results) ← evalFuncArgs env args + if results.length == 0 then return (newEnv, Types.Nil) + else return (newEnv, results[results.length - 1]!) partial def evalIf (env: Env) (args : List Types) : IO (Env × Types) := do if args.length < 2 then throw (IO.userError "unexpected syntax") @@ -234,24 +201,24 @@ mutual let thenExpr := args[1]! let hasElse := args.length > 2 - match evalTypes ref condition with - | Except.error (newEnv, e) => Except.error (newEnv, s!"if: {e}") - | Except.ok (newEnv, condResp) => - let cond := match condResp with - | Types.boolVal v => v - | Types.Nil => false - | _ => true - if cond then evalTypes newEnv thenExpr - else if hasElse then evalTypes newEnv args[2]! - else Except.ok (newEnv, Types.Nil) + let (newEnv, condResp) ← evalTypes env condition + let cond := match condResp with + | Types.boolVal v => v + | Types.Nil => false + | _ => true + if cond then evalTypes newEnv thenExpr + else if hasElse then evalTypes newEnv args[2]! + else return (newEnv, Types.Nil) partial def evalTry (env: Env) (lst : List Types) : IO (Env × Types) := do if lst.length < 1 then throw (IO.userError "try*: unexpected syntax") else - match evalTypes ref lst[0]! with - | Except.ok (newEnv, result) => Except.ok (newEnv, result) - | Except.error evalErr => - if lst.length < 2 then Except.error evalErr + try + let (newEnv, result) ← evalTypes env lst[0]! + return (newEnv, result) + catch + | evalErr => + if lst.length < 2 then throw evalErr else match lst[1]! with | Types.listVal catchBody => @@ -265,19 +232,18 @@ mutual let es := catchBody[1]! match es with | Types.symbolVal errorSymbol => - let (errRef, errStr) := evalErr - let err := Types.strVal errStr - if catchBody.length < 2 then Except.error (errRef, "try*: unexpected syntax") + let err := Types.strVal evalErr.toString + if catchBody.length < 2 then throw (IO.userError "try*: unexpected syntax") else let toeval := catchBody[2]! - let built := buildDictWithSymbols ref.getDict ref.getLevel [errorSymbol] [err] - let merged := ref.mergeDict (ref.getLevel + 1) built + let built := buildDictWithSymbols env.getDict env.getLevel [errorSymbol] [err] + let merged := env.mergeDict (env.getLevel + 1) built evalTypes merged toeval | _ => throw (IO.userError s!"unexpected return type, expected: symbol") - else Except.error evalErr - | _ => Except.error evalErr + else throw evalErr + | _ => throw evalErr -- | Types.vecVal v => -- TODO - | _ => Except.error evalErr + | _ => throw evalErr partial def swapAtom (env: Env) (lst: List Types) (args: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "swap!: >= 2 argument required") @@ -289,22 +255,18 @@ mutual | Types.symbolVal sym => match fn with | Types.funcVal _ => - match ref.get (KeyType.strKey sym) with + match env.get (KeyType.strKey sym) with | none => throw (IO.userError s!"{sym} not found") | some (level, _) => match first with | Types.atomVal x => match x with | Atom.v v => - match evalFuncVal ref fn ([v] ++ rest) false with - | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") - | Except.ok (_, res) => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) - Except.ok (newEnv, res) + let (_, res) ← evalFuncVal env fn ([v] ++ rest) false + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.v res)) + return (newEnv, res) | Atom.withmeta v meta => - match evalFuncVal ref fn ([v] ++ rest) false with - | Except.error (newEnv, e) => Except.error (newEnv, s!"swap! evaluate function: {e}") - | Except.ok (_, res) => - let newEnv := ref.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) - Except.ok (newEnv, res) + let (_, res) ← evalFuncVal env fn ([v] ++ rest) false + let newEnv := env.add (KeyType.strKey sym) level (Types.atomVal (Atom.withmeta res meta)) + return (newEnv, res) | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: atom") | x => throw (IO.userError s!"swap!: unexpected symbol: {x.toString true}, expected: function") | x => throw (IO.userError s!"swap!: unexpected token: {x.toString true}, expected: symbol") @@ -313,7 +275,7 @@ mutual if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! - evalTypes ref ast + evalTypes env ast partial def starts_with (lst: List Types) (symb: String) : Bool := if lst.length == 2 then @@ -347,17 +309,14 @@ mutual | _ => ast partial def nativeMapOverList (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do - match args.foldl (fun (res : IO (Env × List Types)) x => - match res with - | Except.error e => Except.error e - | Except.ok (r, acc) => - match evalFuncVal r fn [x] false with - | Except.error e => Except.error e - | Except.ok (updatedRef, res) => - Except.ok (updatedRef, acc ++ [res]) - ) (Except.ok (ref, [])) with - | Except.error e => Except.error e - | Except.ok (newEnv, results) => Except.ok (newEnv, Types.listVal results) + let finalResult ← args.foldlM (fun (res : (Env × List Types)) (x : Types) => do + let (r, acc) := res + let (updatedRef, res) ← evalFuncVal r fn [x] false + pure (updatedRef, acc ++ [res]) + ) (env, []) + + let (newEnv, results) := finalResult + pure (newEnv, Types.listVal results) partial def nativeMap (env: Env) (lst: List Types) : IO (Env × Types) := do if lst.length < 2 then throw (IO.userError "map: unexpected syntax") @@ -367,8 +326,8 @@ mutual match fn with | Types.funcVal _ => match params with - | Types.listVal v => nativeMapOverList ref fn v - | Types.vecVal v => nativeMapOverList ref fn (toList v) + | Types.listVal v => nativeMapOverList env fn v + | Types.vecVal v => nativeMapOverList env fn (toList v) | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: function") @@ -381,96 +340,97 @@ mutual let firstargs := lst.drop 1 |>.take n match vecargs with | Types.listVal v => - evalFuncVal ref fn (firstargs ++ v) false + evalFuncVal env fn (firstargs ++ v) false | Types.vecVal v => - evalFuncVal ref fn (firstargs ++ (toList v)) false + evalFuncVal env fn (firstargs ++ (toList v)) false | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: list or vector") partial def evalFnNative (env : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with - | "+" => sum ref results - | "-" => sub ref results - | "*" => mul ref results - | "/" => div ref results - | "<" => lt ref results - | "<=" => lte ref results - | ">" => gt ref results - | ">=" => gte ref results - | "=" => eq ref results false - | "list" => Except.ok (ref, Types.listVal results) - | "count" => countFunc ref results - | "cons" => cons ref results - | "concat" => concat ref results - | "map" => nativeMap ref results - | "apply" => nativeApply ref results - | "vec" => makeVec ref results - | "vector" => makeVector ref results - | "nth" => nthSeq ref results - | "first" => firstSeq ref results - | "rest" => restSeq ref results - | "conj" => conj ref results - | "seq" => seq ref results - | "hash-map" => makeDict ref results - | "assoc" => assocDict ref results - | "dissoc" => dissocDict ref results - | "get" => getDict ref results - | "contains?" => containsDict ref results - | "keys" => getKeysDict ref results - | "vals" => getValuesDict ref results - | "throw" => throwFn ref results - | "symbol" => makeSymbol ref results - | "keyword" => makeKeyword ref results - | "atom" => makeAtom ref results - | "deref" => derefAtom ref results - | "reset!" => resetAtom ref results args - | "swap!" => swapAtom ref results args - | "prn" => prnFunc ref results - | "pr-str" => prStrFunc ref results - | "str" => strFunc ref results - | "println" => printlnFunc ref results - | "eval" => eval ref results - | "read-string" => match readString results ref with -- readString results Dict.empty - | Except.error e => throw (IO.userError e) - | Except.ok res => Except.ok (ref, res) + | "+" => sum env results + | "-" => sub env results + | "*" => mul env results + | "/" => div env results + | "<" => lt env results + | "<=" => lte env results + | ">" => gt env results + | ">=" => gte env results + | "=" => eq env results false + | "list" => return (env, Types.listVal results) + | "count" => countFunc env results + | "cons" => cons env results + | "concat" => concat env results + | "map" => nativeMap env results + | "apply" => nativeApply env results + | "vec" => makeVec env results + | "vector" => makeVector env results + | "nth" => nthSeq env results + | "first" => firstSeq env results + | "rest" => restSeq env results + | "conj" => conj env results + | "seq" => seq env results + | "hash-map" => makeDict env results + | "assoc" => assocDict env results + | "dissoc" => dissocDict env results + | "get" => getDict env results + | "contains?" => containsDict env results + | "keys" => getKeysDict env results + | "vals" => getValuesDict env results + | "throw" => throwFn env results + | "symbol" => makeSymbol env results + | "keyword" => makeKeyword env results + | "atom" => makeAtom env results + | "deref" => derefAtom env results + | "reset!" => resetAtom env results args + | "swap!" => swapAtom env results args + | "prn" => prnFunc env results + | "pr-str" => prStrFunc env results + | "str" => strFunc env results + | "println" => printlnFunc env results + | "eval" => eval env results + | "read-string" => + let res ← readString results env -- readString results Dict.empty + return (env, res) | "time-ms" => throw (IO.userError "Not implemented") | "meta" => throw (IO.userError "Not implemented") | "with-meta" => throw (IO.userError "Not implemented") + | "readline" => readline env results | _ => match results with | [x] => match x with - | Types.Nil => if name == "nil?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.intVal _ => if name == "number?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.floatVal _ => if name == "number?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.strVal _ => if name == "string?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.symbolVal _ => if name == "symbol?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.keywordVal _ => if name == "keyword?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) - | Types.dictVal _ => if name == "map?" then Except.ok (ref, Types.boolVal true) else Except.ok (ref, Types.boolVal false) + | Types.Nil => if name == "nil?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.intVal _ => if name == "number?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.floatVal _ => if name == "number?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.strVal _ => if name == "string?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.symbolVal _ => if name == "symbol?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.keywordVal _ => if name == "keyword?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) + | Types.dictVal _ => if name == "map?" then return (env, Types.boolVal true) else return (env, Types.boolVal false) | Types.listVal x => match name with - | "list?" => Except.ok (ref, Types.boolVal true) - | "sequential?" => Except.ok (ref, Types.boolVal true) - | "empty?" => Except.ok (ref, Types.boolVal (x.length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "list?" => return (env, Types.boolVal true) + | "sequential?" => return (env, Types.boolVal true) + | "empty?" => return (env, Types.boolVal (x.length == 0)) + | _ => return (env, Types.boolVal false) | Types.vecVal x => match name with - | "sequential?" => Except.ok (ref, Types.boolVal true) - | "vector?" => Except.ok (ref, Types.boolVal true) - | "empty?" => Except.ok (ref, Types.boolVal ((toList x).length == 0)) - | _ => Except.ok (ref, Types.boolVal false) + | "sequential?" => return (env, Types.boolVal true) + | "vector?" => return (env, Types.boolVal true) + | "empty?" => return (env, Types.boolVal ((toList x).length == 0)) + | _ => return (env, Types.boolVal false) | Types.boolVal x => match name with - | "true?" => Except.ok (ref, Types.boolVal x) - | "false?" => Except.ok (ref, Types.boolVal !x) - | _ => Except.ok (ref, Types.boolVal false) + | "true?" => return (env, Types.boolVal x) + | "false?" => return (env, Types.boolVal !x) + | _ => return (env, Types.boolVal false) | Types.atomVal _ => match name with - | "atom?" => Except.ok (ref, Types.boolVal true) - | _ => Except.ok (ref, Types.boolVal false) + | "atom?" => return (env, Types.boolVal true) + | _ => return (env, Types.boolVal false) | Types.funcVal func => match name with | "fn?" => match func with - | Fun.builtin _ => Except.ok (ref, Types.boolVal true) - | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal true) - | Fun.macroFn _ _ _ => Except.ok (ref, Types.boolVal false) + | Fun.builtin _ => return (env, Types.boolVal true) + | Fun.userDefined _ _ _ => return (env, Types.boolVal true) + | Fun.macroFn _ _ _ => return (env, Types.boolVal false) | "macro?" => match func with - | Fun.builtin _ => Except.ok (ref, Types.boolVal false) - | Fun.userDefined _ _ _ => Except.ok (ref, Types.boolVal false) - | Fun.macroFn _ _ _ => Except.ok (ref, Types.boolVal true) - | _ => Except.ok (ref, Types.boolVal false) + | Fun.builtin _ => return (env, Types.boolVal false) + | Fun.userDefined _ _ _ => return (env, Types.boolVal false) + | Fun.macroFn _ _ _ => return (env, Types.boolVal true) + | _ => return (env, Types.boolVal false) | _ => throw (IO.userError s!"'{name}' not found") end @@ -481,47 +441,41 @@ def READ (input : String): Except String Types := def PRINT (ast : Types): String := pr_str true ast -def rep (env: Env) (input : String): Env × String := +def rep (env: Env) (input : String): IO (Env × String) := do match READ.{u} input with - | Except.ok result => match evalTypes ref result with - | Except.error (newref, e) => (newref, s!"Error: {e}") - | Except.ok (newref, res) => (newref, PRINT res) - | Except.error err => (ref, s!"Parsing failed: {err}") - -def printLogs (env : Env) : IO Unit := - forM (getLogsInfo ref) (fun elem => - match elem with - | Types.strVal log => IO.println log - | x => IO.println (x.toString true) - ) - -def loadMalFns (env: Env) (fndefs: List String): Env × String := - fndefs.foldl (fun (res : Env × String) fndef => + | Except.ok result => + try + let (newenv, res) ← evalTypes env result + return (newenv, PRINT res) + catch + | e => return (env, s!"Error: {e}") + | Except.error err => return (env, s!"Parsing failed: {err}") + +def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do + fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) := rep.{u} ref fndef - (newref, s!"{msg}¬{newmsg}") - ) (ref, "") + let (newref, newmsg) ← rep.{u} ref fndef + return (newref, s!"{msg}¬{newmsg}") + ) (env, "") def fnDefs: List String := [ "(def! *host-language* \"Lean\")", "(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)))))))", ] def main (args : List String) : IO Unit := do - let (env0, _) := loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let astArgs := (args.map (fun arg => Types.strVal arg)) let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) if args.length > 0 then - let (ref, val) := rep.{u} env s!"(load-file \"{args[0]!}\")" - printLogs ref + let (_, val) ← rep.{u} env s!"(load-file \"{args[0]!}\")" IO.println val - return else - let (ref, val) := rep.{u} env s!"(println (str \"Mal [\" *host-language* \"]\"))" - printLogs ref + let (_, val) ← rep.{u} env s!"(println (str \"Mal [\" *host-language* \"]\"))" IO.println val let mut donext := true @@ -536,7 +490,6 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (ref, val) := rep.{u} env value - printLogs ref + let (newenv, val) ← rep.{u} env value IO.println val - env := resetLogs ref + env := newenv From dbc9aa28d9b92bde373e74b0493bbb642f1afab6 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Wed, 28 Aug 2024 21:25:14 +0200 Subject: [PATCH 36/39] add Dockerfile, update IMPLS - also remove Mathlib, as it is not used --- .gitignore | 1 + IMPLS.yml | 1 + impls/lean/Dockerfile | 33 ++++++++++++++++++++++++++ impls/lean/LeanMal/core.lean | 1 - impls/lean/LeanMal/reader.lean | 1 - impls/lean/LeanMal/step4_if_fn_do.lean | 1 - impls/lean/lakefile.lean | 2 -- 7 files changed, 35 insertions(+), 5 deletions(-) create mode 100644 impls/lean/Dockerfile diff --git a/.gitignore b/.gitignore index 7ecfa581fb..e83a23ac8c 100644 --- a/.gitignore +++ b/.gitignore @@ -12,6 +12,7 @@ .sbt .npm .node-gyp +.elan */experiments node_modules */notes diff --git a/IMPLS.yml b/IMPLS.yml index 02a8056ce8..e6efd15918 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -49,6 +49,7 @@ IMPL: - {IMPL: julia} - {IMPL: kotlin} - {IMPL: latex3, NO_PERF: 1, NO_SELF_HOST: 1, SLOW: 1} + - {IMPL: lean, SLOW: 1} - {IMPL: livescript} - {IMPL: logo} - {IMPL: lua} diff --git a/impls/lean/Dockerfile b/impls/lean/Dockerfile new file mode 100644 index 0000000000..f88a586b0f --- /dev/null +++ b/impls/lean/Dockerfile @@ -0,0 +1,33 @@ +FROM ubuntu:24.04 +LABEL org.opencontainers.image.source=https://github.com/kanaka/mal +LABEL org.opencontainers.image.description="mal test container: lean" + +########################################################## +# General requirements for testing or common across many +# implementations +########################################################## + +RUN apt-get -y update + +# Required for running tests +RUN apt-get -y install make python3 +RUN ln -fs /usr/bin/python3 /usr/local/bin/python + +RUN mkdir -p /mal + +WORKDIR /mal + +########################################################## +# Specific implementation requirements +########################################################## + +RUN apt-get -y install curl git-core + +# install lean toolchain manager +RUN curl https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh -sSf | sh -s -- -y -v + +# non-root users must have access +RUN mv /root/.elan/bin/lake /usr/local/bin/ + +# lake needs to create $HOME/.elan +ENV HOME=/mal diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 71d6eac7d7..2fd261e73f 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -1,5 +1,4 @@ import Lean -import Mathlib import LeanMal.types import LeanMal.reader diff --git a/impls/lean/LeanMal/reader.lean b/impls/lean/LeanMal/reader.lean index 26a323d570..f20a0724da 100644 --- a/impls/lean/LeanMal/reader.lean +++ b/impls/lean/LeanMal/reader.lean @@ -1,5 +1,4 @@ import Lean -import Mathlib import LeanMal.types open Lean Lean.Parsec diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index 4c9147a426..1c5a8c7384 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -39,7 +39,6 @@ mutual partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do let (env2, fn) ← evalTypes env head - -- only propagate logs after executing a function let (_, res) ← evalFuncVal env2 fn args return (env, res) diff --git a/impls/lean/lakefile.lean b/impls/lean/lakefile.lean index 124e81549e..319790024a 100644 --- a/impls/lean/lakefile.lean +++ b/impls/lean/lakefile.lean @@ -8,8 +8,6 @@ package "mal" where ] -- add any additional package configuration options here -require "leanprover-community" / "mathlib" - require Parser from git "https://github.com/fgdorais/lean4-parser" @ "main" @[default_target] From f73610190d80349f50510d0b4c204303873b3454 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Thu, 29 Aug 2024 12:43:28 +0200 Subject: [PATCH 37/39] lean: eval fix, comment support --- impls/lean/LeanMal/core.lean | 17 ++++++++++------- impls/lean/LeanMal/reader.lean | 22 ++++++++++++++++++++-- impls/lean/LeanMal/step3_env.lean | 10 +++++++--- impls/lean/LeanMal/step4_if_fn_do.lean | 10 +++++++--- impls/lean/LeanMal/step5_tco.lean | 10 +++++++--- impls/lean/LeanMal/step6_file.lean | 23 +++++++++++++---------- impls/lean/LeanMal/step7_quote.lean | 22 +++++++++++++--------- impls/lean/LeanMal/step8_macros.lean | 22 +++++++++++++--------- impls/lean/LeanMal/step9_try.lean | 22 +++++++++++++--------- impls/lean/LeanMal/stepA_mal.lean | 22 +++++++++++++--------- impls/lean/LeanMal/types.lean | 6 +++--- 11 files changed, 119 insertions(+), 67 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 2fd261e73f..8c76aaf712 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -605,14 +605,17 @@ def loadFnNativeAll (env : Env) : Env := def setSymbol (env : Env) (name: String) (value: Types): Env := env.add (KeyType.strKey name) 0 value --- forward mutated atoms defined in the outer environments --- outer environments always have a lower level index -def forwardMutatedAtoms (envSource: Env) (envOuter: Env): Env := +-- forwards mutated variables defined in outer scopes +-- outer scopes always have a lower level index +-- used to forward mutated atoms and variables defined by `eval` in the root scope +def forwardOuterScopeDefs (envSource: Env) (envOuter: Env): Env := envSource.getDict.fold envOuter (fun key l v acc => if l > acc.getLevel then acc + else if l < acc.getLevel then acc.add key l v else - match acc.get key with - | none => acc - | some (lOuter, _) => - if l != lOuter then acc else acc.add key l v + match acc.get key with + | none => acc.add key l v + | some (lOuter, _) => + if l != lOuter then acc + else acc.add key l v ) diff --git a/impls/lean/LeanMal/reader.lean b/impls/lean/LeanMal/reader.lean index f20a0724da..3d5c8a1569 100644 --- a/impls/lean/LeanMal/reader.lean +++ b/impls/lean/LeanMal/reader.lean @@ -149,6 +149,19 @@ def read_operator_or_number : Parsec Types := do else return Types.symbolVal (String.singleton sign) | none => return Types.symbolVal (String.singleton sign) +-- Define a parser for inline comments starting with ";" or ";;" +def read_comment : Parsec Unit := do + skipString ";" + + let nextCh ← peek? + match nextCh with + | none => pure () + | some _ => + let _ ← optional (many (satisfy (λ c => c ≠ '\n' && c ≠ '\r'))) + _ ← optional (satisfy (λ c => c = '\n' || c = '\r')) + let _ ← optional wspace + pure () + mutual partial def read_list (envir: Dict := Dict.empty) : Parsec Types := do -- ws @@ -235,8 +248,13 @@ mutual partial def read_atom (_: Dict := Dict.empty) : Parsec Types := read_operator_or_number <|> read_float_or_int <|> read_str_val <|> read_keyword <|> read_nil_val <|> read_bool_val <|> read_symbol_val - partial def read_types (envir: Dict := Dict.empty) : Parsec Types := - read_list envir <|> read_vector envir <|> read_hash_map envir <|> read_symbol "'" "quote" envir <|> read_symbol "`" "quasiquote" envir <|> read_symbol "~@" "splice-unquote" envir <|> read_symbol "~" "unquote" envir <|> read_symbol "@" "deref" envir <|> read_with_meta envir <|> read_atom envir + partial def read_types (envir: Dict := Dict.empty) : Parsec Types := do + let _ ← optional wspace + let _ ← optional (many read_comment) + match ← peek? with + | none => fail "endofinput" + | some _ => + read_list envir <|> read_vector envir <|> read_hash_map envir <|> read_symbol "'" "quote" envir <|> read_symbol "`" "quasiquote" envir <|> read_symbol "~@" "splice-unquote" envir <|> read_symbol "~" "unquote" envir <|> read_symbol "@" "deref" envir <|> read_with_meta envir <|> read_atom envir end def read_types_with_env (input : String) (envir: Dict := Dict.empty) : Except String Types := diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index 868b63bcf3..bb8e5f2397 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -182,6 +182,11 @@ def rep (env: Env) (input : String): IO (Env × String) := do | e => return (env, s!"Error: {e}") | Except.error err => return (env, s!"Parsing failed: {err}") +def repAndPrint (env: Env) (output : String): IO Env := do + if output.endsWith "endofinput" then IO.print "" + else IO.println output + return env + def main : IO Unit := do let mut env := loadFnNativeAll (Env.data 0 Dict.empty) let mut donext := true @@ -196,6 +201,5 @@ def main : IO Unit := do if value.isEmpty then donext := false else - let (newenv, val) ← rep.{u} env value - IO.println val - env := newenv + let (newenv, value) ← rep.{u} env value + env ← repAndPrint newenv value diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index 1c5a8c7384..8c90a4b92c 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -220,6 +220,11 @@ def fnDefs: List String := [ "(def! not (fn* (a) (if a false true)))", ] +def repAndPrint (env: Env) (output : String): IO Env := do + if output.endsWith "endofinput" then IO.print "" + else IO.println output + return env + def main : IO Unit := do let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let mut env := env0 @@ -235,6 +240,5 @@ def main : IO Unit := do if value.isEmpty then donext := false else - let (newenv, val) ← rep.{u} env value - IO.println val - env := newenv + let (newenv, value) ← rep.{u} env value + env ← repAndPrint newenv value diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index e8d7a1c15d..9a5cc2c2be 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -219,6 +219,11 @@ def fnDefs: List String := [ "(def! not (fn* (a) (if a false true)))", ] +def repAndPrint (env: Env) (output : String): IO Env := do + if output.endsWith "endofinput" then IO.print "" + else IO.println output + return env + def main : IO Unit := do let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let mut env := env0 @@ -234,6 +239,5 @@ def main : IO Unit := do if value.isEmpty then donext := false else - let (newenv, val) ← rep.{u} env value - IO.println val - env := newenv + let (newenv, value) ← rep.{u} env value + env ← repAndPrint newenv value diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 88ea0703cf..5823391499 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -40,8 +40,7 @@ mutual partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do let (env2, fn) ← evalTypes env head let (fref, res) ← evalFuncVal env2 fn args - -- after executing a function, propagate atoms (defined in outer environments) to the parent scope - return ((forwardMutatedAtoms fref env), res) + return ((forwardOuterScopeDefs fref env), res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation @@ -127,8 +126,7 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") let (letref, result) ← evalTypes newEnv body - -- after executing let*, propagate atoms (defined in outer environments) to the parent scope - return ((forwardMutatedAtoms letref env), result) + return ((forwardOuterScopeDefs letref env), result) partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with @@ -193,7 +191,9 @@ mutual if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! - evalTypes env ast + -- any new variables are defined on level 0 + let env0 := Env.data 0 env.getDict + evalTypes env0 ast partial def evalFnNative (env : Env) (name: String) (results: List Types) (args: List Types): IO (Env × Types) := do match name with @@ -265,11 +265,15 @@ def fnDefs: List String := [ "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", ] +def repAndPrint (env: Env) (output : String): IO Env := do + if output.endsWith "endofinput" then IO.print "" + else IO.println output + return env + def main (args : List String) : IO Unit := do let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let astArgs := (args.map (fun arg => Types.strVal arg)) + let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) - if args.length > 0 then let (_, val) ← rep.{u} env s!"(load-file \"{args[0]!}\")" IO.println val @@ -287,6 +291,5 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (newenv, val) ← rep.{u} env value - IO.println val - env := newenv + let (newenv, value) ← rep.{u} env value + env ← repAndPrint newenv value diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index d50cecbd78..26eb84b7a7 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -40,8 +40,7 @@ mutual partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do let (env2, fn) ← evalTypes env head let (fref, res) ← evalFuncVal env2 fn args - -- after executing a function, propagate atoms (defined in outer environments) to the parent scope - return ((forwardMutatedAtoms fref env), res) + return ((forwardOuterScopeDefs fref env), res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do -- first execute each function argument - reduce computation @@ -133,8 +132,7 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") let (letref, result) ← evalTypes newEnv body - -- after executing let*, propagate atoms (defined in outer environments) to the parent scope - return ((forwardMutatedAtoms letref env), result) + return ((forwardOuterScopeDefs letref env), result) partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with @@ -199,7 +197,9 @@ mutual if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! - evalTypes env ast + -- any new variables are defined on level 0 + let env0 := Env.data 0 env.getDict + evalTypes env0 ast partial def starts_with (lst: List Types) (symb: String) : Bool := if lst.length == 2 then @@ -305,9 +305,14 @@ def fnDefs: List String := [ "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))", ] +def repAndPrint (env: Env) (output : String): IO Env := do + if output.endsWith "endofinput" then IO.print "" + else IO.println output + return env + def main (args : List String) : IO Unit := do let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let astArgs := (args.map (fun arg => Types.strVal arg)) + let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) if args.length > 0 then @@ -327,6 +332,5 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (newenv, val) ← rep.{u} env value - IO.println val - env := newenv + let (newenv, value) ← rep.{u} env value + env ← repAndPrint newenv value diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index ee3f46df11..2976be8ff1 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -40,8 +40,7 @@ mutual partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do let (env2, fn) ← evalTypes env head let (fref, res) ← evalFuncVal env2 fn args - -- after executing a function, propagate atoms (defined in outer environments) to the parent scope - return ((forwardMutatedAtoms fref env), res) + return ((forwardOuterScopeDefs fref env), res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) : IO (Env × Types) := do match fn with @@ -166,8 +165,7 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") let (letref, result) ← evalTypes newEnv body - -- after executing let*, propagate atoms (defined in outer environments) to the parent scope - return ((forwardMutatedAtoms letref env), result) + return ((forwardOuterScopeDefs letref env), result) partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with @@ -232,7 +230,9 @@ mutual if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! - evalTypes env ast + -- any new variables are defined on level 0 + let env0 := Env.data 0 env.getDict + evalTypes env0 ast partial def starts_with (lst: List Types) (symb: String) : Bool := if lst.length == 2 then @@ -343,9 +343,14 @@ def fnDefs: List String := [ "(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)))))))", ] +def repAndPrint (env: Env) (output : String): IO Env := do + if output.endsWith "endofinput" then IO.print "" + else IO.println output + return env + def main (args : List String) : IO Unit := do let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let astArgs := (args.map (fun arg => Types.strVal arg)) + let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) if args.length > 0 then @@ -365,6 +370,5 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (newenv, val) ← rep.{u} env value - IO.println val - env := newenv + let (newenv, value) ← rep.{u} env value + env ← repAndPrint newenv value diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index 741b8051e2..8aca29a22d 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -40,8 +40,7 @@ mutual partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do let (env2, fn) ← evalTypes env head let (fref, res) ← evalFuncVal env2 fn args true - -- after executing a function, propagate atoms (defined in outer environments) to the parent scope - return ((forwardMutatedAtoms fref env), res) + return ((forwardOuterScopeDefs fref env), res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : IO (Env × Types) := do match fn with @@ -174,8 +173,7 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") let (letenv, result) ← evalTypes newEnv body - -- after executing let*, propagate atoms (defined in outer environments) to the parent scope - return ((forwardMutatedAtoms letenv env), result) + return ((forwardOuterScopeDefs letenv env), result) partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with @@ -275,7 +273,9 @@ mutual if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! - evalTypes env ast + -- any new variables are defined on level 0 + let env0 := Env.data 0 env.getDict + evalTypes env0 ast partial def starts_with (lst: List Types) (symb: String) : Bool := if lst.length == 2 then @@ -461,9 +461,14 @@ def fnDefs: List String := [ "(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)))))))", ] +def repAndPrint (env: Env) (output : String): IO Env := do + if output.endsWith "endofinput" then IO.print "" + else IO.println output + return env + def main (args : List String) : IO Unit := do let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let astArgs := (args.map (fun arg => Types.strVal arg)) + let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) if args.length > 0 then @@ -483,6 +488,5 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (newenv, val) ← rep.{u} env value - IO.println val - env := newenv + let (newenv, value) ← rep.{u} env value + env ← repAndPrint newenv value diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index 00061c80c7..213f41e6c9 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -40,8 +40,7 @@ mutual partial def evalFunc (env: Env) (head : Types) (args : List Types) : IO (Env × Types) := do let (env2, fn) ← evalTypes env head let (fref, res) ← evalFuncVal env2 fn args true - -- after executing a function, propagate atoms (defined in outer environments) to the parent scope - return ((forwardMutatedAtoms fref env), res) + return ((forwardOuterScopeDefs fref env), res) partial def evalFuncVal (env: Env) (fn: Types) (args: List Types) (evaluateArgs: Bool) : IO (Env × Types) := do match fn with @@ -174,8 +173,7 @@ mutual | _ => throw (IO.userError s!"unexpected token type: ${pairs.toString true}, expected: list or vector") let (letenv, result) ← evalTypes newEnv body - -- after executing let*, propagate atoms (defined in outer environments) to the parent scope - return ((forwardMutatedAtoms letenv env), result) + return ((forwardOuterScopeDefs letenv env), result) partial def evalLetArgs (env: Env) (args : List Types) : IO Env := do match args with @@ -275,7 +273,9 @@ mutual if lst.length < 1 then throw (IO.userError "eval: unexpected syntax") else let ast := lst[0]! - evalTypes env ast + -- any new variables are defined on level 0 + let env0 := Env.data 0 env.getDict + evalTypes env0 ast partial def starts_with (lst: List Types) (symb: String) : Bool := if lst.length == 2 then @@ -465,9 +465,14 @@ def fnDefs: List String := [ "(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)))))))", ] +def repAndPrint (env: Env) (output : String): IO Env := do + if output.endsWith "endofinput" then IO.print "" + else IO.println output + return env + def main (args : List String) : IO Unit := do let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let astArgs := (args.map (fun arg => Types.strVal arg)) + let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) if args.length > 0 then @@ -490,6 +495,5 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (newenv, val) ← rep.{u} env value - IO.println val - env := newenv + let (newenv, value) ← rep.{u} env value + env ← repAndPrint newenv value diff --git a/impls/lean/LeanMal/types.lean b/impls/lean/LeanMal/types.lean index 8932a257d4..aff8a74ed8 100644 --- a/impls/lean/LeanMal/types.lean +++ b/impls/lean/LeanMal/types.lean @@ -129,9 +129,9 @@ partial def Dict.fold (d : Dict) (init : α) (f : KeyType → Nat → Types → | Dict.empty => init | Dict.insert k l v d' => d'.fold (f k l v init) f --- Function to merge two Dicts -def Dict.merge (baseDict newDict : Dict) : Dict := - let merged := newDict.fold baseDict (fun key l v acc => +-- Function to merge two Dicts. +def Dict.merge (baseDict overwriteDict : Dict) : Dict := + let merged := overwriteDict.fold baseDict (fun key l v acc => match acc.get key with | some (lBase, _) => if l > lBase then acc.add key l v else acc From 25bb6e972900f86120791123d1a3d527c3af0ecc Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Fri, 30 Aug 2024 23:11:08 +0200 Subject: [PATCH 38/39] remove slow tag, ensure lean4 stable --- IMPLS.yml | 2 +- impls/lean/Dockerfile | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/IMPLS.yml b/IMPLS.yml index e6efd15918..c6c8c3382b 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -49,7 +49,7 @@ IMPL: - {IMPL: julia} - {IMPL: kotlin} - {IMPL: latex3, NO_PERF: 1, NO_SELF_HOST: 1, SLOW: 1} - - {IMPL: lean, SLOW: 1} + - {IMPL: lean} - {IMPL: livescript} - {IMPL: logo} - {IMPL: lua} diff --git a/impls/lean/Dockerfile b/impls/lean/Dockerfile index f88a586b0f..ff368bcbb6 100644 --- a/impls/lean/Dockerfile +++ b/impls/lean/Dockerfile @@ -26,6 +26,8 @@ RUN apt-get -y install curl git-core # install lean toolchain manager RUN curl https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh -sSf | sh -s -- -y -v +RUN /root/.elan/bin/elan default leanprover/lean4:stable + # non-root users must have access RUN mv /root/.elan/bin/lake /usr/local/bin/ From 94425f8b20fc714cc1168339f00dd0e8cf1ed615 Mon Sep 17 00:00:00 2001 From: Loredana Cirstea Date: Fri, 30 Aug 2024 18:29:50 +0200 Subject: [PATCH 39/39] lean: simplify main fix running with cli args fix step8 macro --- impls/lean/LeanMal/core.lean | 4 +- impls/lean/LeanMal/reader.lean | 30 +++++++------- impls/lean/LeanMal/step1_read_print.lean | 6 +-- impls/lean/LeanMal/step2_eval.lean | 6 +-- impls/lean/LeanMal/step3_env.lean | 6 +-- impls/lean/LeanMal/step4_if_fn_do.lean | 10 ++--- impls/lean/LeanMal/step5_tco.lean | 10 ++--- impls/lean/LeanMal/step6_file.lean | 33 ++++++++------- impls/lean/LeanMal/step7_quote.lean | 34 +++++++++------- impls/lean/LeanMal/step8_macros.lean | 52 ++++++++++++++++-------- impls/lean/LeanMal/step9_try.lean | 34 +++++++++------- impls/lean/LeanMal/stepA_mal.lean | 37 +++++++++-------- 12 files changed, 147 insertions(+), 115 deletions(-) diff --git a/impls/lean/LeanMal/core.lean b/impls/lean/LeanMal/core.lean index 8c76aaf712..8c6c4b23f4 100644 --- a/impls/lean/LeanMal/core.lean +++ b/impls/lean/LeanMal/core.lean @@ -236,12 +236,12 @@ def countFunc(env : Env) (lst: List Types) : IO (Env × Types) := do | Types.Nil => return (env, Types.intVal 0) | _ => throw (IO.userError "count called on non-sequence") -def readString (lst: List Types) (envir: Env) : IO Types := do +def readString (lst: List Types) (_: Env) : IO Types := do if lst.length < 1 then throw (IO.userError "read-string: 1 arguments required") else let first := lst[0]! match first with - | Types.strVal v => match read_types_with_env v envir.getDict with -- Dict.empty + | Types.strVal v => match read_types_with_env v with -- Dict.empty | Except.error e => throw (IO.userError e) | Except.ok res => return res | x => throw (IO.userError s!"unexpected symbol: {x.toString true}, expected: string") diff --git a/impls/lean/LeanMal/reader.lean b/impls/lean/LeanMal/reader.lean index 3d5c8a1569..54146d890a 100644 --- a/impls/lean/LeanMal/reader.lean +++ b/impls/lean/LeanMal/reader.lean @@ -163,13 +163,13 @@ def read_comment : Parsec Unit := do pure () mutual - partial def read_list (envir: Dict := Dict.empty) : Parsec Types := do + partial def read_list : Parsec Types := do -- ws let _ ← optional wspace_or_comma_strict let _ ← pstring "(" let _ ← optional wspace_or_comma_strict let els ← many (do - let e ← read_types envir + let e ← read_types let _ ← optional wspace_or_comma_strict -- let _ ← optional (pchar ',') return e) @@ -179,12 +179,12 @@ mutual let _ ← optional wspace_or_comma_strict return Types.listVal (els.toList) - partial def read_vector (envir: Dict := Dict.empty) : Parsec Types := do + partial def read_vector : Parsec Types := do let _ ← optional wspace_or_comma_strict let _ ← pchar '[' let _ ← optional wspace_or_comma_strict let els ← many (do - let e ← read_types envir + let e ← read_types let _ ← optional wspace_or_comma_strict -- let _ ← optional (pchar ',') return e) @@ -195,7 +195,7 @@ mutual let vec := listToVec vecLst return Types.vecVal vec - partial def read_hash_map (_: Dict := Dict.empty) : Parsec Types := do + partial def read_hash_map : Parsec Types := do let _ ← optional wspace_or_comma_strict let _ ← pchar '{' let _ ← optional wspace_or_comma_strict @@ -222,21 +222,21 @@ mutual | Types.strVal v => return (KeyType.strKey v, value) | _ => default - partial def read_symbol (chars: String) (name: String) (envir: Dict := Dict.empty) : Parsec Types := do + partial def read_symbol (chars: String) (name: String) : Parsec Types := do let _ ← optional wspace_or_comma_strict let _ ← pstring chars - let elem ← read_types envir + let elem ← read_types let _ ← optional wspace_or_comma_strict let vecLst := [(Types.symbolVal name), elem] return Types.listVal vecLst - partial def read_with_meta (envir: Dict := Dict.empty) : Parsec Types := do + partial def read_with_meta : Parsec Types := do ws let _ ← pstring "^" let els ← many (do - let e ← read_types envir + let e ← read_types ws let _ ← optional (pchar ',') return e) @@ -245,22 +245,22 @@ mutual let vecLst := (Types.symbolVal "with-meta") :: elsVec return Types.listVal (List.append vecLst elsVec) - partial def read_atom (_: Dict := Dict.empty) : Parsec Types := + partial def read_atom : Parsec Types := read_operator_or_number <|> read_float_or_int <|> read_str_val <|> read_keyword <|> read_nil_val <|> read_bool_val <|> read_symbol_val - partial def read_types (envir: Dict := Dict.empty) : Parsec Types := do + partial def read_types : Parsec Types := do let _ ← optional wspace let _ ← optional (many read_comment) match ← peek? with | none => fail "endofinput" | some _ => - read_list envir <|> read_vector envir <|> read_hash_map envir <|> read_symbol "'" "quote" envir <|> read_symbol "`" "quasiquote" envir <|> read_symbol "~@" "splice-unquote" envir <|> read_symbol "~" "unquote" envir <|> read_symbol "@" "deref" envir <|> read_with_meta envir <|> read_atom envir + read_list <|> read_vector <|> read_hash_map <|> read_symbol "'" "quote" <|> read_symbol "`" "quasiquote" <|> read_symbol "~@" "splice-unquote" <|> read_symbol "~" "unquote" <|> read_symbol "@" "deref" <|> read_with_meta <|> read_atom end -def read_types_with_env (input : String) (envir: Dict := Dict.empty) : Except String Types := - match read_types envir input.trim.iter with +def read_types_with_env (input : String) : Except String Types := + match read_types input.trim.iter with | Lean.Parsec.ParseResult.success _ res => Except.ok res | Lean.Parsec.ParseResult.error _ err => Except.error err def read_str (input : String) : Except String Types := - read_types_with_env input (Dict.empty : Dict.{u}) + read_types_with_env input diff --git a/impls/lean/LeanMal/step1_read_print.lean b/impls/lean/LeanMal/step1_read_print.lean index 7c3f4f5b75..7e11624950 100644 --- a/impls/lean/LeanMal/step1_read_print.lean +++ b/impls/lean/LeanMal/step1_read_print.lean @@ -4,7 +4,7 @@ import LeanMal.printer universe u def READ (input : String) := - read_str.{u} input + read_str input def EVAL (ast : Types) (_: String) := ast @@ -12,7 +12,7 @@ def PRINT (ast : Types): String := pr_str true ast def rep (input : String): String := - match READ.{u} input with + match READ input with | Except.ok result => PRINT (EVAL result "") | Except.error err => @@ -31,4 +31,4 @@ def main : IO Unit := do if value.isEmpty then donext := false else - IO.println (rep.{u} value) + IO.println (rep value) diff --git a/impls/lean/LeanMal/step2_eval.lean b/impls/lean/LeanMal/step2_eval.lean index d85b214edd..a50d72b16c 100644 --- a/impls/lean/LeanMal/step2_eval.lean +++ b/impls/lean/LeanMal/step2_eval.lean @@ -4,7 +4,7 @@ import LeanMal.printer universe u def READ (input : String): Except String Types := - read_str.{u} input + read_str input def sum (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with @@ -121,7 +121,7 @@ def PRINT (ast : Types): String := pr_str true ast def rep (input : String): IO String := do - match READ.{u} input with + match READ input with | Except.ok result => try let (_, res) ← evalTypes (Env.data 0 Dict.empty) result @@ -144,5 +144,5 @@ def main : IO Unit := do if value.isEmpty then donext := false else - let output ← rep.{u} value + let output ← rep value IO.println output diff --git a/impls/lean/LeanMal/step3_env.lean b/impls/lean/LeanMal/step3_env.lean index bb8e5f2397..61942217d0 100644 --- a/impls/lean/LeanMal/step3_env.lean +++ b/impls/lean/LeanMal/step3_env.lean @@ -5,7 +5,7 @@ import LeanMal.types universe u def READ (input : String): Except String Types := - read_str.{u} input + read_str input def sum (env : Env) (lst: List Types) : IO (Env × Types) := do match lst with @@ -173,7 +173,7 @@ def PRINT (ast : Types): String := pr_str true ast def rep (env: Env) (input : String): IO (Env × String) := do - match READ.{u} input with + match READ input with | Except.ok result => try let (newenv, res) ← evalTypes env result @@ -201,5 +201,5 @@ def main : IO Unit := do if value.isEmpty then donext := false else - let (newenv, value) ← rep.{u} env value + let (newenv, value) ← rep env value env ← repAndPrint newenv value diff --git a/impls/lean/LeanMal/step4_if_fn_do.lean b/impls/lean/LeanMal/step4_if_fn_do.lean index 8c90a4b92c..7fa2090c42 100644 --- a/impls/lean/LeanMal/step4_if_fn_do.lean +++ b/impls/lean/LeanMal/step4_if_fn_do.lean @@ -194,13 +194,13 @@ mutual end def READ (input : String): Except String Types := - read_str.{u} input + read_str input def PRINT (ast : Types): String := pr_str true ast def rep (env: Env) (input : String): IO (Env × String) := do - match READ.{u} input with + match READ input with | Except.ok result => try let (newenv, res) ← evalTypes env result @@ -212,7 +212,7 @@ def rep (env: Env) (input : String): IO (Env × String) := do def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) ← rep.{u} ref fndef + let (newref, newmsg) ← rep ref fndef return (newref, s!"{msg}¬{newmsg}") ) (env, "") @@ -226,7 +226,7 @@ def repAndPrint (env: Env) (output : String): IO Env := do return env def main : IO Unit := do - let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let (env0, _) ← loadMalFns (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let mut env := env0 let mut donext := true while donext do @@ -240,5 +240,5 @@ def main : IO Unit := do if value.isEmpty then donext := false else - let (newenv, value) ← rep.{u} env value + let (newenv, value) ← rep env value env ← repAndPrint newenv value diff --git a/impls/lean/LeanMal/step5_tco.lean b/impls/lean/LeanMal/step5_tco.lean index 9a5cc2c2be..4e7cc22e59 100644 --- a/impls/lean/LeanMal/step5_tco.lean +++ b/impls/lean/LeanMal/step5_tco.lean @@ -193,13 +193,13 @@ mutual end def READ (input : String): Except String Types := - read_str.{u} input + read_str input def PRINT (ast : Types): String := pr_str true ast def rep (env: Env) (input : String): IO (Env × String) := do - match READ.{u} input with + match READ input with | Except.ok result => try let (newenv, res) ← evalTypes env result @@ -211,7 +211,7 @@ def rep (env: Env) (input : String): IO (Env × String) := do def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) ← rep.{u} ref fndef + let (newref, newmsg) ← rep ref fndef return (newref, s!"{msg}¬{newmsg}") ) (env, "") @@ -225,7 +225,7 @@ def repAndPrint (env: Env) (output : String): IO Env := do return env def main : IO Unit := do - let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let (env0, _) ← loadMalFns (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs let mut env := env0 let mut donext := true while donext do @@ -239,5 +239,5 @@ def main : IO Unit := do if value.isEmpty then donext := false else - let (newenv, value) ← rep.{u} env value + let (newenv, value) ← rep env value env ← repAndPrint newenv value diff --git a/impls/lean/LeanMal/step6_file.lean b/impls/lean/LeanMal/step6_file.lean index 5823391499..d59c6fd055 100644 --- a/impls/lean/LeanMal/step6_file.lean +++ b/impls/lean/LeanMal/step6_file.lean @@ -238,13 +238,13 @@ mutual end def READ (input : String): Except String Types := - read_str.{u} input + read_str input def PRINT (ast : Types): String := pr_str true ast def rep (env: Env) (input : String): IO (Env × String) := do - match READ.{u} input with + match READ input with | Except.ok result => try let (newenv, res) ← evalTypes env result @@ -256,7 +256,7 @@ def rep (env: Env) (input : String): IO (Env × String) := do def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) ← rep.{u} ref fndef + let (newref, newmsg) ← rep ref fndef return (newref, s!"{msg}¬{newmsg}") ) (env, "") @@ -270,16 +270,10 @@ def repAndPrint (env: Env) (output : String): IO Env := do else IO.println output return env -def main (args : List String) : IO Unit := do - let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) - let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) - if args.length > 0 then - let (_, val) ← rep.{u} env s!"(load-file \"{args[0]!}\")" - IO.println val - else - - let mut donext := true +def reploop (inienv: Env) : IO Unit := do + let mut donext := false + let mut env := inienv + donext := true while donext do IO.print "user> " let stdin ← IO.getStdin @@ -291,5 +285,16 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (newenv, value) ← rep.{u} env value + let (newenv, value) ← rep env value env ← repAndPrint newenv value + +def main (args : List String) : IO Unit := do + let (env0, _) ← loadMalFns (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let env := setSymbol env0 "*ARGV*" (Types.listVal []) + + if args.length > 0 then do + let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) + let newenv := setSymbol env0 "*ARGV*" (Types.listVal astArgs) + let (_, _) ← rep newenv s!"(load-file \"{args[0]!}\")" + IO.Process.exit 0 + else reploop env diff --git a/impls/lean/LeanMal/step7_quote.lean b/impls/lean/LeanMal/step7_quote.lean index 26eb84b7a7..ed48a6d179 100644 --- a/impls/lean/LeanMal/step7_quote.lean +++ b/impls/lean/LeanMal/step7_quote.lean @@ -278,13 +278,13 @@ mutual end def READ (input : String): Except String Types := - read_str.{u} input + read_str input def PRINT (ast : Types): String := pr_str true ast def rep (env: Env) (input : String): IO (Env × String) := do - match READ.{u} input with + match READ input with | Except.ok result => try let (newenv, res) ← evalTypes env result @@ -296,7 +296,7 @@ def rep (env: Env) (input : String): IO (Env × String) := do def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) ← rep.{u} ref fndef + let (newref, newmsg) ← rep ref fndef return (newref, s!"{msg}¬{newmsg}") ) (env, "") @@ -310,17 +310,10 @@ def repAndPrint (env: Env) (output : String): IO Env := do else IO.println output return env -def main (args : List String) : IO Unit := do - let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) - let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) - - if args.length > 0 then - let (_, val) ← rep.{u} env s!"(load-file \"{args[0]!}\")" - IO.println val - else - - let mut donext := true +def reploop (inienv: Env) : IO Unit := do + let mut donext := false + let mut env := inienv + donext := true while donext do IO.print "user> " let stdin ← IO.getStdin @@ -332,5 +325,16 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (newenv, value) ← rep.{u} env value + let (newenv, value) ← rep env value env ← repAndPrint newenv value + +def main (args : List String) : IO Unit := do + let (env0, _) ← loadMalFns (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let env := setSymbol env0 "*ARGV*" (Types.listVal []) + + if args.length > 0 then do + let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) + let newenv := setSymbol env0 "*ARGV*" (Types.listVal astArgs) + let (_, _) ← rep newenv s!"(load-file \"{args[0]!}\")" + IO.Process.exit 0 + else reploop env diff --git a/impls/lean/LeanMal/step8_macros.lean b/impls/lean/LeanMal/step8_macros.lean index 2976be8ff1..e09c56c139 100644 --- a/impls/lean/LeanMal/step8_macros.lean +++ b/impls/lean/LeanMal/step8_macros.lean @@ -134,7 +134,7 @@ mutual | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") partial def evalDefMacro (env: Env) (args : List Types) : IO (Env × Types) := do - if args.length < 2 then throw (IO.userError "def! unexpected syntax") + if args.length < 2 then throw (IO.userError "defmacro! unexpected syntax") else let key := args[0]! let body := args[1]! @@ -148,8 +148,9 @@ mutual let refResult := newEnv.add (KeyType.strKey v) env.getLevel value return (refResult, value) | Fun.userDefined fref params body => - let refResult := newEnv.add (KeyType.strKey v) env.getLevel (Types.funcVal (Fun.macroFn fref params body)) - return (refResult, value) + let res := (Types.funcVal (Fun.macroFn fref params body)) + let refResult := newEnv.add (KeyType.strKey v) env.getLevel res + return (refResult, res) | _ => throw (IO.userError s!"defmacro!: unexpected builtin function") | x => throw (IO.userError s!"unexpected token type: {x.toString true}, expected: function") | _ => throw (IO.userError s!"def! unexpected token, expected: symbol") @@ -308,19 +309,30 @@ mutual | Types.atomVal _ => match name with | "atom?" => return (env, Types.boolVal true) | _ => return (env, Types.boolVal false) + | Types.funcVal func => + match name with + | "fn?" => match func with + | Fun.builtin _ => return (env, Types.boolVal true) + | Fun.userDefined _ _ _ => return (env, Types.boolVal true) + | Fun.macroFn _ _ _ => return (env, Types.boolVal false) + | "macro?" => match func with + | Fun.builtin _ => return (env, Types.boolVal false) + | Fun.userDefined _ _ _ => return (env, Types.boolVal false) + | Fun.macroFn _ _ _ => return (env, Types.boolVal true) + | _ => return (env, Types.boolVal false) | _ => return (env, Types.boolVal false) | _ => throw (IO.userError s!"'{name}' not found") end def READ (input : String): Except String Types := - read_str.{u} input + read_str input def PRINT (ast : Types): String := pr_str true ast def rep (env: Env) (input : String): IO (Env × String) := do - match READ.{u} input with + match READ input with | Except.ok result => try let (newenv, res) ← evalTypes env result @@ -332,7 +344,7 @@ def rep (env: Env) (input : String): IO (Env × String) := do def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) ← rep.{u} ref fndef + let (newref, newmsg) ← rep ref fndef return (newref, s!"{msg}¬{newmsg}") ) (env, "") @@ -348,17 +360,10 @@ def repAndPrint (env: Env) (output : String): IO Env := do else IO.println output return env -def main (args : List String) : IO Unit := do - let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) - let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) - - if args.length > 0 then - let (_, val) ← rep.{u} env s!"(load-file \"{args[0]!}\")" - IO.println val - else - - let mut donext := true +def reploop (inienv: Env) : IO Unit := do + let mut donext := false + let mut env := inienv + donext := true while donext do IO.print "user> " let stdin ← IO.getStdin @@ -370,5 +375,16 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (newenv, value) ← rep.{u} env value + let (newenv, value) ← rep env value env ← repAndPrint newenv value + +def main (args : List String) : IO Unit := do + let (env0, _) ← loadMalFns (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let env := setSymbol env0 "*ARGV*" (Types.listVal []) + + if args.length > 0 then do + let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) + let newenv := setSymbol env0 "*ARGV*" (Types.listVal astArgs) + let (_, _) ← rep newenv s!"(load-file \"{args[0]!}\")" + IO.Process.exit 0 + else reploop env diff --git a/impls/lean/LeanMal/step9_try.lean b/impls/lean/LeanMal/step9_try.lean index 8aca29a22d..86c5093f48 100644 --- a/impls/lean/LeanMal/step9_try.lean +++ b/impls/lean/LeanMal/step9_try.lean @@ -432,13 +432,13 @@ mutual end def READ (input : String): Except String Types := - read_str.{u} input + read_str input def PRINT (ast : Types): String := pr_str true ast def rep (env: Env) (input : String): IO (Env × String) := do - match READ.{u} input with + match READ input with | Except.ok result => try let (newenv, res) ← evalTypes env result @@ -450,7 +450,7 @@ def rep (env: Env) (input : String): IO (Env × String) := do def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) ← rep.{u} ref fndef + let (newref, newmsg) ← rep ref fndef return (newref, s!"{msg}¬{newmsg}") ) (env, "") @@ -466,17 +466,10 @@ def repAndPrint (env: Env) (output : String): IO Env := do else IO.println output return env -def main (args : List String) : IO Unit := do - let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) - let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) - - if args.length > 0 then - let (_, val) ← rep.{u} env s!"(load-file \"{args[0]!}\")" - IO.println val - else - - let mut donext := true +def reploop (inienv: Env) : IO Unit := do + let mut donext := false + let mut env := inienv + donext := true while donext do IO.print "user> " let stdin ← IO.getStdin @@ -488,5 +481,16 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (newenv, value) ← rep.{u} env value + let (newenv, value) ← rep env value env ← repAndPrint newenv value + +def main (args : List String) : IO Unit := do + let (env0, _) ← loadMalFns (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let env := setSymbol env0 "*ARGV*" (Types.listVal []) + + if args.length > 0 then do + let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) + let newenv := setSymbol env0 "*ARGV*" (Types.listVal astArgs) + let (_, _) ← rep newenv s!"(load-file \"{args[0]!}\")" + IO.Process.exit 0 + else reploop env diff --git a/impls/lean/LeanMal/stepA_mal.lean b/impls/lean/LeanMal/stepA_mal.lean index 213f41e6c9..d7206709fc 100644 --- a/impls/lean/LeanMal/stepA_mal.lean +++ b/impls/lean/LeanMal/stepA_mal.lean @@ -436,13 +436,13 @@ mutual end def READ (input : String): Except String Types := - read_str.{u} input + read_str input def PRINT (ast : Types): String := pr_str true ast def rep (env: Env) (input : String): IO (Env × String) := do - match READ.{u} input with + match READ input with | Except.ok result => try let (newenv, res) ← evalTypes env result @@ -454,7 +454,7 @@ def rep (env: Env) (input : String): IO (Env × String) := do def loadMalFns (env: Env) (fndefs: List String): IO (Env × String) := do fndefs.foldlM (fun (res : Env × String) fndef => do let (ref, msg) := res - let (newref, newmsg) ← rep.{u} ref fndef + let (newref, newmsg) ← rep ref fndef return (newref, s!"{msg}¬{newmsg}") ) (env, "") @@ -470,20 +470,12 @@ def repAndPrint (env: Env) (output : String): IO Env := do else IO.println output return env -def main (args : List String) : IO Unit := do - let (env0, _) ← loadMalFns.{u} (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs - let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) - let mut env := setSymbol env0 "*ARGV*" (Types.listVal astArgs) - - if args.length > 0 then - let (_, val) ← rep.{u} env s!"(load-file \"{args[0]!}\")" - IO.println val - else +def reploop (inienv: Env) : IO Unit := do + let (_, _) ← rep inienv s!"(println (str \"Mal [\" *host-language* \"]\"))" - let (_, val) ← rep.{u} env s!"(println (str \"Mal [\" *host-language* \"]\"))" - IO.println val - - let mut donext := true + let mut donext := false + let mut env := inienv + donext := true while donext do IO.print "user> " let stdin ← IO.getStdin @@ -495,5 +487,16 @@ def main (args : List String) : IO Unit := do if value.isEmpty then donext := false else - let (newenv, value) ← rep.{u} env value + let (newenv, value) ← rep env value env ← repAndPrint newenv value + +def main (args : List String) : IO Unit := do + let (env0, _) ← loadMalFns (loadFnNativeAll (Env.data 0 Dict.empty)) fnDefs + let env := setSymbol env0 "*ARGV*" (Types.listVal []) + + if args.length > 0 then do + let astArgs := ((args.drop 1).map (fun arg => Types.strVal arg)) + let newenv := setSymbol env0 "*ARGV*" (Types.listVal astArgs) + let (_, _) ← rep newenv s!"(load-file \"{args[0]!}\")" + IO.Process.exit 0 + else reploop env