diff options
| author | Eduardo Julian | 2015-05-10 15:04:36 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2015-05-10 15:04:36 -0400 |
| commit | 8dc736e2a383fe964d63dda6b885d41cabc6261c (patch) | |
| tree | 8e4d9ddf503bbcd53023073dd8cfa4e824b85ab2 /source/lux.lux | |
| parent | ab7b946a980475cad1e58186ac8c929c7659f529 (diff) | |
- Switched to the new prefix convention for both lux's special forms and the host's.
- Made a few optimizations to speed-up the now slowed-down compiler.
Diffstat (limited to '')
| -rw-r--r-- | source/lux.lux | 2317 |
1 files changed, 1164 insertions, 1153 deletions
diff --git a/source/lux.lux b/source/lux.lux index 26425e7b8..f2a6f70da 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -7,53 +7,53 @@ ## You must not remove this notice, or any other, from this software. ## First things first, must define functions -(jvm-interface Function - (:' (-> [java.lang.Object] java.lang.Object) +(_jvm_interface Function + (: (-> [java.lang.Object] java.lang.Object) apply)) ## Basic types -(def' Bool (#DataT "java.lang.Boolean")) -(export' Bool) +(_lux_def Bool (#DataT "java.lang.Boolean")) +(_lux_export Bool) -(def' Int (#DataT "java.lang.Long")) -(export' Int) +(_lux_def Int (#DataT "java.lang.Long")) +(_lux_export Int) -(def' Real (#DataT "java.lang.Double")) -(export' Real) +(_lux_def Real (#DataT "java.lang.Double")) +(_lux_export Real) -(def' Char (#DataT "java.lang.Character")) -(export' Char) +(_lux_def Char (#DataT "java.lang.Character")) +(_lux_export Char) -(def' Text (#DataT "java.lang.String")) -(export' Text) +(_lux_def Text (#DataT "java.lang.String")) +(_lux_export Text) -(def' Void (#VariantT #Nil)) -(export' Void) +(_lux_def Void (#VariantT #Nil)) +(_lux_export Void) -(def' Ident (#TupleT (#Cons [Text (#Cons [Text #Nil])]))) -(export' Ident) +(_lux_def Ident (#TupleT (#Cons [Text (#Cons [Text #Nil])]))) +(_lux_export Ident) ## (deftype (List a) ## (| #Nil ## (#Cons (, a (List a))))) -(def' List - (#AllT [#None "List" "a" - (#VariantT (#Cons [["lux;Nil" (#TupleT #Nil)] - (#Cons [["lux;Cons" (#TupleT (#Cons [(#BoundT "a") - (#Cons [(#AppT [(#BoundT "List") (#BoundT "a")]) - #Nil])]))] - #Nil])]))])) -(export' List) +(_lux_def List + (#AllT [#None "List" "a" + (#VariantT (#Cons [["lux;Nil" (#TupleT #Nil)] + (#Cons [["lux;Cons" (#TupleT (#Cons [(#BoundT "a") + (#Cons [(#AppT [(#BoundT "List") (#BoundT "a")]) + #Nil])]))] + #Nil])]))])) +(_lux_export List) ## (deftype (Maybe a) ## (| #None ## (#Some a))) -(def' Maybe - (#AllT [#None "Maybe" "a" - (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] - (#Cons [["lux;Some" (#BoundT "a")] - #Nil])]))])) -(export' Maybe) +(_lux_def Maybe + (#AllT [#None "Maybe" "a" + (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] + (#Cons [["lux;Some" (#BoundT "a")] + #Nil])]))])) +(_lux_export Maybe) ## (deftype #rec Type ## (| (#DataT Text) @@ -65,70 +65,70 @@ ## (#VarT Int) ## (#AllT (, (Maybe (List (, Text Type))) Text Text Type)) ## (#AppT (, Type Type)))) -(def' Type - (case' (#AppT [(#BoundT "Type") (#BoundT "_")]) - Type - (case' (#AppT [List (#TupleT (#Cons [Text (#Cons [Type #Nil])]))]) - TypeEnv - (#AppT [(#AllT [#None "Type" "_" - (#VariantT (#Cons [["lux;DataT" Text] - (#Cons [["lux;TupleT" (#AppT [List Type])] - (#Cons [["lux;VariantT" TypeEnv] - (#Cons [["lux;RecordT" TypeEnv] - (#Cons [["lux;LambdaT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))] - (#Cons [["lux;BoundT" Text] - (#Cons [["lux;VarT" Int] - (#Cons [["lux;AllT" (#TupleT (#Cons [(#AppT [Maybe TypeEnv]) (#Cons [Text (#Cons [Text (#Cons [Type #Nil])])])]))] - (#Cons [["lux;AppT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))] - (#Cons [["lux;ExT" Int] - #Nil])])])])])])])])])]))]) - Void])))) -(export' Type) +(_lux_def Type + (_lux_case (#AppT [(#BoundT "Type") (#BoundT "_")]) + Type + (_lux_case (#AppT [List (#TupleT (#Cons [Text (#Cons [Type #Nil])]))]) + TypeEnv + (#AppT [(#AllT [#None "Type" "_" + (#VariantT (#Cons [["lux;DataT" Text] + (#Cons [["lux;TupleT" (#AppT [List Type])] + (#Cons [["lux;VariantT" TypeEnv] + (#Cons [["lux;RecordT" TypeEnv] + (#Cons [["lux;LambdaT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))] + (#Cons [["lux;BoundT" Text] + (#Cons [["lux;VarT" Int] + (#Cons [["lux;AllT" (#TupleT (#Cons [(#AppT [Maybe TypeEnv]) (#Cons [Text (#Cons [Text (#Cons [Type #Nil])])])]))] + (#Cons [["lux;AppT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))] + (#Cons [["lux;ExT" Int] + #Nil])])])])])])])])])]))]) + Void])))) +(_lux_export Type) ## (deftype (Bindings k v) ## (& #counter Int ## #mappings (List (, k v)))) -(def' Bindings - (#AllT [#None "Bindings" "k" - (#AllT [#None "" "v" - (#RecordT (#Cons [["lux;counter" Int] - (#Cons [["lux;mappings" (#AppT [List - (#TupleT (#Cons [(#BoundT "k") - (#Cons [(#BoundT "v") - #Nil])]))])] - #Nil])]))])])) +(_lux_def Bindings + (#AllT [#None "Bindings" "k" + (#AllT [#None "" "v" + (#RecordT (#Cons [["lux;counter" Int] + (#Cons [["lux;mappings" (#AppT [List + (#TupleT (#Cons [(#BoundT "k") + (#Cons [(#BoundT "v") + #Nil])]))])] + #Nil])]))])])) ## (deftype (Env k v) ## (& #name Text ## #inner-closures Int ## #locals (Bindings k v) ## #closure (Bindings k v))) -(def' Env - (#AllT [#None "Env" "k" - (#AllT [#None "" "v" - (#RecordT (#Cons [["lux;name" Text] - (#Cons [["lux;inner-closures" Int] - (#Cons [["lux;locals" (#AppT [(#AppT [Bindings (#BoundT "k")]) - (#BoundT "v")])] - (#Cons [["lux;closure" (#AppT [(#AppT [Bindings (#BoundT "k")]) - (#BoundT "v")])] - #Nil])])])]))])])) +(_lux_def Env + (#AllT [#None "Env" "k" + (#AllT [#None "" "v" + (#RecordT (#Cons [["lux;name" Text] + (#Cons [["lux;inner-closures" Int] + (#Cons [["lux;locals" (#AppT [(#AppT [Bindings (#BoundT "k")]) + (#BoundT "v")])] + (#Cons [["lux;closure" (#AppT [(#AppT [Bindings (#BoundT "k")]) + (#BoundT "v")])] + #Nil])])])]))])])) ## (deftype Cursor ## (, Text Int Int)) -(def' Cursor - (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))) +(_lux_def Cursor + (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))) ## (deftype (Meta m v) ## (| (#Meta (, m v)))) -(def' Meta - (#AllT [#None "Meta" "m" - (#AllT [#None "" "v" - (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") - (#Cons [(#BoundT "v") - #Nil])]))] - #Nil]))])])) -(export' Meta) +(_lux_def Meta + (#AllT [#None "Meta" "m" + (#AllT [#None "" "v" + (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") + (#Cons [(#BoundT "v") + #Nil])]))] + #Nil]))])])) +(_lux_export Meta) ## (deftype (Syntax' w) ## (| (#Bool Bool) @@ -141,98 +141,98 @@ ## (#Form (List (w (Syntax' w)))) ## (#Tuple (List (w (Syntax' w)))) ## (#Record (List (, (w (Syntax' w)) (w (Syntax' w))))))) -(def' Syntax' - (case' (#AppT [(#BoundT "w") - (#AppT [(#BoundT "Syntax'") - (#BoundT "w")])]) - Syntax - (case' (#AppT [List Syntax]) - SyntaxList - (#AllT [#None "Syntax'" "w" - (#VariantT (#Cons [["lux;Bool" Bool] - (#Cons [["lux;Int" Int] - (#Cons [["lux;Real" Real] - (#Cons [["lux;Char" Char] - (#Cons [["lux;Text" Text] - (#Cons [["lux;Symbol" Ident] - (#Cons [["lux;Tag" Ident] - (#Cons [["lux;Form" SyntaxList] - (#Cons [["lux;Tuple" SyntaxList] - (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])] - #Nil]) - ])])])])])])])])]) - )])))) -(export' Syntax') +(_lux_def Syntax' + (_lux_case (#AppT [(#BoundT "w") + (#AppT [(#BoundT "Syntax'") + (#BoundT "w")])]) + Syntax + (_lux_case (#AppT [List Syntax]) + SyntaxList + (#AllT [#None "Syntax'" "w" + (#VariantT (#Cons [["lux;Bool" Bool] + (#Cons [["lux;Int" Int] + (#Cons [["lux;Real" Real] + (#Cons [["lux;Char" Char] + (#Cons [["lux;Text" Text] + (#Cons [["lux;Symbol" Ident] + (#Cons [["lux;Tag" Ident] + (#Cons [["lux;Form" SyntaxList] + (#Cons [["lux;Tuple" SyntaxList] + (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])] + #Nil]) + ])])])])])])])])]) + )])))) +(_lux_export Syntax') ## (deftype Syntax ## (Meta Cursor (Syntax' (Meta Cursor)))) -(def' Syntax - (case' (#AppT [Meta Cursor]) - w - (#AppT [w (#AppT [Syntax' w])]))) -(export' Syntax) +(_lux_def Syntax + (_lux_case (#AppT [Meta Cursor]) + w + (#AppT [w (#AppT [Syntax' w])]))) +(_lux_export Syntax) -(def' SyntaxList (#AppT [List Syntax])) +(_lux_def SyntaxList (#AppT [List Syntax])) ## (deftype (Either l r) ## (| (#Left l) ## (#Right r))) -(def' Either - (#AllT [#None "_" "l" - (#AllT [#None "" "r" - (#VariantT (#Cons [["lux;Left" (#BoundT "l")] - (#Cons [["lux;Right" (#BoundT "r")] - #Nil])]))])])) -(export' Either) +(_lux_def Either + (#AllT [#None "_" "l" + (#AllT [#None "" "r" + (#VariantT (#Cons [["lux;Left" (#BoundT "l")] + (#Cons [["lux;Right" (#BoundT "r")] + #Nil])]))])])) +(_lux_export Either) ## (deftype (StateE s a) ## (-> s (Either Text (, s a)))) -(def' StateE - (#AllT [#None "StateE" "s" - (#AllT [#None "" "a" - (#LambdaT [(#BoundT "s") - (#AppT [(#AppT [Either Text]) - (#TupleT (#Cons [(#BoundT "s") - (#Cons [(#BoundT "a") - #Nil])]))])])])])) - -## (def' Reader +(_lux_def StateE + (#AllT [#None "StateE" "s" + (#AllT [#None "" "a" + (#LambdaT [(#BoundT "s") + (#AppT [(#AppT [Either Text]) + (#TupleT (#Cons [(#BoundT "s") + (#Cons [(#BoundT "a") + #Nil])]))])])])])) + +## (deftype Reader ## (List (Meta Cursor Text))) -(def' Reader - (#AppT [List - (#AppT [(#AppT [Meta Cursor]) - Text])])) -(export' Reader) +(_lux_def Reader + (#AppT [List + (#AppT [(#AppT [Meta Cursor]) + Text])])) +(_lux_export Reader) ## (deftype HostState ## (& #writer (^ org.objectweb.asm.ClassWriter) ## #loader (^ java.net.URLClassLoader))) -(def' HostState - (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")] - (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] - #Nil])]))) +(_lux_def HostState + (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")] + (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] + #Nil])]))) ## (deftype (DefData' m) ## (| #TypeD ## (#ValueD Type) ## (#MacroD m) ## (#AliasD Ident))) -(def' DefData' - (#AllT [#None "DefData'" "" - (#VariantT (#Cons [["lux;TypeD" (#TupleT #Nil)] - (#Cons [["lux;ValueD" Type] - (#Cons [["lux;MacroD" (#BoundT "")] - (#Cons [["lux;AliasD" Ident] - #Nil])])])]))])) +(_lux_def DefData' + (#AllT [#None "DefData'" "" + (#VariantT (#Cons [["lux;TypeD" (#TupleT #Nil)] + (#Cons [["lux;ValueD" Type] + (#Cons [["lux;MacroD" (#BoundT "")] + (#Cons [["lux;AliasD" Ident] + #Nil])])])]))])) ## (deftype LuxVar ## (| (#Local Int) ## (#Global Ident))) -(def' LuxVar - (#VariantT (#Cons [["lux;Local" Int] - (#Cons [["lux;Global" Ident] - #Nil])]))) -(export' LuxVar) +(_lux_def LuxVar + (#VariantT (#Cons [["lux;Local" Int] + (#Cons [["lux;Global" Ident] + #Nil])]))) +(_lux_export LuxVar) ## (deftype #rec CompilerState ## (& #source Reader @@ -241,324 +241,324 @@ ## #envs (List (Env Text (, LuxVar Type))) ## #types (Bindings Int Type) ## #host HostState)) -(def' CompilerState - (#AppT [(#AllT [#None "CompilerState" "" - (#RecordT (#Cons [["lux;source" Reader] - (#Cons [["lux;modules" (#AppT [List (#TupleT (#Cons [Text - (#Cons [(#AppT [List (#TupleT (#Cons [Text - (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList - (#AppT [(#AppT [StateE (#AppT [(#BoundT "CompilerState") - (#BoundT "")])]) - SyntaxList])])]) - #Nil])])) - #Nil])]))]) - #Nil])]))])] - (#Cons [["lux;module-aliases" (#AppT [List Void])] - (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) - (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])] - (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] - (#Cons [["lux;host" HostState] - (#Cons [["lux;seed" Int] - #Nil])])])])])])]))]) - Void])) -(export' CompilerState) +(_lux_def CompilerState + (#AppT [(#AllT [#None "CompilerState" "" + (#RecordT (#Cons [["lux;source" Reader] + (#Cons [["lux;modules" (#AppT [List (#TupleT (#Cons [Text + (#Cons [(#AppT [List (#TupleT (#Cons [Text + (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList + (#AppT [(#AppT [StateE (#AppT [(#BoundT "CompilerState") + (#BoundT "")])]) + SyntaxList])])]) + #Nil])])) + #Nil])]))]) + #Nil])]))])] + (#Cons [["lux;module-aliases" (#AppT [List Void])] + (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) + (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])] + (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] + (#Cons [["lux;host" HostState] + (#Cons [["lux;seed" Int] + #Nil])])])])])])]))]) + Void])) +(_lux_export CompilerState) ## (deftype Macro ## (-> (List Syntax) (StateE CompilerState (List Syntax)))) -(def' Macro - (#LambdaT [SyntaxList - (#AppT [(#AppT [StateE CompilerState]) - SyntaxList])])) -(export' Macro) +(_lux_def Macro + (#LambdaT [SyntaxList + (#AppT [(#AppT [StateE CompilerState]) + SyntaxList])])) +(_lux_export Macro) ## Base functions & macros ## (def (_meta data) ## (-> (Syntax' (Meta Cursor)) Syntax) ## (#Meta [["" -1 -1] data])) -(def' _meta - (:' (#LambdaT [(#AppT [Syntax' - (#AppT [Meta Cursor])]) - Syntax]) - (lambda' _ data - (#Meta [["" -1 -1] data])))) +(_lux_def _meta + (_lux_: (#LambdaT [(#AppT [Syntax' + (#AppT [Meta Cursor])]) + Syntax]) + (_lux_lambda _ data + (#Meta [["" -1 -1] data])))) ## (def (return x) ## (All [a] ## (-> a CompilerState ## (Either Text (, CompilerState a)))) ## ...) -(def' return - (:' (#AllT [#None "" "a" - (#LambdaT [(#BoundT "a") - (#LambdaT [CompilerState - (#AppT [(#AppT [Either Text]) - (#TupleT (#Cons [CompilerState - (#Cons [(#BoundT "a") - #Nil])]))])])])]) - (lambda' _ val - (lambda' _ state - (#Right [state val]))))) +(_lux_def return + (_lux_: (#AllT [#None "" "a" + (#LambdaT [(#BoundT "a") + (#LambdaT [CompilerState + (#AppT [(#AppT [Either Text]) + (#TupleT (#Cons [CompilerState + (#Cons [(#BoundT "a") + #Nil])]))])])])]) + (_lux_lambda _ val + (_lux_lambda _ state + (#Right [state val]))))) ## (def (fail msg) ## (All [a] ## (-> Text CompilerState ## (Either Text (, CompilerState a)))) ## ...) -(def' fail - (:' (#AllT [#None "" "a" - (#LambdaT [Text - (#LambdaT [CompilerState - (#AppT [(#AppT [Either Text]) - (#TupleT (#Cons [CompilerState - (#Cons [(#BoundT "a") - #Nil])]))])])])]) - (lambda' _ msg - (lambda' _ state - (#Left msg))))) - -(def' $text - (:' (#LambdaT [Text Syntax]) - (lambda' _ text - (_meta (#Text text))))) - -(def' $symbol - (:' (#LambdaT [Ident Syntax]) - (lambda' _ ident - (_meta (#Symbol ident))))) - -(def' $tag - (:' (#LambdaT [Ident Syntax]) - (lambda' _ ident - (_meta (#Tag ident))))) - -(def' $form - (:' (#LambdaT [(#AppT [List Syntax]) Syntax]) - (lambda' _ tokens - (_meta (#Form tokens))))) - -(def' $tuple - (:' (#LambdaT [(#AppT [List Syntax]) Syntax]) - (lambda' _ tokens - (_meta (#Tuple tokens))))) - -(def' $record - (:' (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax]) - (lambda' _ tokens - (_meta (#Record tokens))))) - -(def' let' - (:' Macro - (lambda' _ tokens - (case' tokens - (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) - (return (#Cons [($form (#Cons [($symbol ["" "case'"]) - (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) - #Nil])) - - _ - (fail "Wrong syntax for let'"))))) -(declare-macro' let') - -(def' lambda_ - (:' Macro - (lambda' _ tokens - (case' tokens - (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])]) - (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"])) - (#Cons [(_meta (#Symbol ["" ""])) - (#Cons [arg - (#Cons [(case' args' - #Nil - body - - _ - (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) - (#Cons [(_meta (#Tuple args')) - (#Cons [body #Nil])])])))) - #Nil])])])]))) - #Nil])) - - (#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])]) - (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"])) - (#Cons [(_meta (#Symbol self)) - (#Cons [arg - (#Cons [(case' args' - #Nil - body - - _ - (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) - (#Cons [(_meta (#Tuple args')) - (#Cons [body #Nil])])])))) - #Nil])])])]))) - #Nil])) - - _ - (fail "Wrong syntax for lambda"))))) -(declare-macro' lambda_) - -(def' def_ - (:' Macro - (lambda_ [tokens] - (case' tokens - (#Cons [(#Meta [_ (#Tag ["" "export"])]) - (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) - (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) - (#Cons [name - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) - (#Cons [type - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) - (#Cons [name - (#Cons [(_meta (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - #Nil])])]))) - (#Cons [(_meta (#Form (#Cons [($symbol ["" "export'"]) (#Cons [name #Nil])]))) - #Nil])])) - - (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) - (#Cons [name - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - #Nil])])]))) - (#Cons [(_meta (#Form (#Cons [($symbol ["" "export'"]) (#Cons [name #Nil])]))) - #Nil])])) - - (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) - (#Cons [type (#Cons [body #Nil])])]) - (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) - (#Cons [name - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) - (#Cons [type - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) - (#Cons [name - (#Cons [(_meta (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - #Nil])])]))) - #Nil])) - - (#Cons [name (#Cons [type (#Cons [body #Nil])])]) - (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) - (#Cons [name - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - #Nil])])]))) - #Nil])) - - _ - (fail "Wrong syntax for def") - )))) -(declare-macro' def_) +(_lux_def fail + (_lux_: (#AllT [#None "" "a" + (#LambdaT [Text + (#LambdaT [CompilerState + (#AppT [(#AppT [Either Text]) + (#TupleT (#Cons [CompilerState + (#Cons [(#BoundT "a") + #Nil])]))])])])]) + (_lux_lambda _ msg + (_lux_lambda _ state + (#Left msg))))) + +(_lux_def $text + (_lux_: (#LambdaT [Text Syntax]) + (_lux_lambda _ text + (_meta (#Text text))))) + +(_lux_def $symbol + (_lux_: (#LambdaT [Ident Syntax]) + (_lux_lambda _ ident + (_meta (#Symbol ident))))) + +(_lux_def $tag + (_lux_: (#LambdaT [Ident Syntax]) + (_lux_lambda _ ident + (_meta (#Tag ident))))) + +(_lux_def $form + (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax]) + (_lux_lambda _ tokens + (_meta (#Form tokens))))) + +(_lux_def $tuple + (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax]) + (_lux_lambda _ tokens + (_meta (#Tuple tokens))))) + +(_lux_def $record + (_lux_: (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax]) + (_lux_lambda _ tokens + (_meta (#Record tokens))))) + +(_lux_def let' + (_lux_: Macro + (_lux_lambda _ tokens + (_lux_case tokens + (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) + (return (#Cons [($form (#Cons [($symbol ["" "_lux_case"]) + (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) + #Nil])) + + _ + (fail "Wrong syntax for let'"))))) +(_lux_declare-macro let') + +(_lux_def lambda_ + (_lux_: Macro + (_lux_lambda _ tokens + (_lux_case tokens + (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_lambda"])) + (#Cons [(_meta (#Symbol ["" ""])) + (#Cons [arg + (#Cons [(_lux_case args' + #Nil + body + + _ + (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) + (#Cons [(_meta (#Tuple args')) + (#Cons [body #Nil])])])))) + #Nil])])])]))) + #Nil])) + + (#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_lambda"])) + (#Cons [(_meta (#Symbol self)) + (#Cons [arg + (#Cons [(_lux_case args' + #Nil + body + + _ + (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) + (#Cons [(_meta (#Tuple args')) + (#Cons [body #Nil])])])))) + #Nil])])])]))) + #Nil])) + + _ + (fail "Wrong syntax for lambda"))))) +(_lux_declare-macro lambda_) + +(_lux_def def_ + (_lux_: Macro + (lambda_ [tokens] + (_lux_case tokens + (#Cons [(#Meta [_ (#Tag ["" "export"])]) + (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) + (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_:"])) + (#Cons [type + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) + (#Cons [name + (#Cons [(_meta (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])])]))) + (#Cons [(_meta (#Form (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])]))) + #Nil])])) + + (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_:"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + #Nil])])]))) + (#Cons [(_meta (#Form (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])]))) + #Nil])])) + + (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) + (#Cons [type (#Cons [body #Nil])])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_:"])) + (#Cons [type + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"])) + (#Cons [name + (#Cons [(_meta (#Tuple args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])])]))) + #Nil])) + + (#Cons [name (#Cons [type (#Cons [body #Nil])])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "_lux_:"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + #Nil])])]))) + #Nil])) + + _ + (fail "Wrong syntax for def") + )))) +(_lux_declare-macro def_) (def_ #export (defmacro tokens) Macro - (case' tokens - (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])]) - (return (#Cons [($form (#Cons [($symbol ["lux" "def_"]) - (#Cons [($form (#Cons [name args])) - (#Cons [($symbol ["lux" "Macro"]) - (#Cons [body - #Nil])]) - ])])) - (#Cons [($form (#Cons [($symbol ["" "declare-macro'"]) (#Cons [name #Nil])])) - #Nil])])) - - (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])])]) - (return (#Cons [($form (#Cons [($symbol ["lux" "def_"]) - (#Cons [($tag ["" "export"]) - (#Cons [($form (#Cons [name args])) - (#Cons [($symbol ["lux" "Macro"]) - (#Cons [body - #Nil])]) - ])])])) - (#Cons [($form (#Cons [($symbol ["" "declare-macro'"]) (#Cons [name #Nil])])) - #Nil])])) - - _ - (fail "Wrong syntax for defmacro"))) -(declare-macro' defmacro) + (_lux_case tokens + (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])]) + (return (#Cons [($form (#Cons [($symbol ["lux" "def_"]) + (#Cons [($form (#Cons [name args])) + (#Cons [($symbol ["lux" "Macro"]) + (#Cons [body + #Nil])]) + ])])) + (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])])) + #Nil])])) + + (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])])]) + (return (#Cons [($form (#Cons [($symbol ["lux" "def_"]) + (#Cons [($tag ["" "export"]) + (#Cons [($form (#Cons [name args])) + (#Cons [($symbol ["lux" "Macro"]) + (#Cons [body + #Nil])]) + ])])])) + (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])])) + #Nil])])) + + _ + (fail "Wrong syntax for defmacro"))) +(_lux_declare-macro defmacro) (defmacro #export (comment tokens) (return #Nil)) (defmacro (->' tokens) - (case' tokens - (#Cons [input (#Cons [output #Nil])]) - (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) - (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])]))) - #Nil])]))) - #Nil])) - - (#Cons [input (#Cons [output others])]) - (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) - (#Cons [(_meta (#Tuple (#Cons [input - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "->'"])) - (#Cons [output others])]))) - #Nil])]))) - #Nil])]))) - #Nil])) - - _ - (fail "Wrong syntax for ->'"))) + (_lux_case tokens + (#Cons [input (#Cons [output #Nil])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) + (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])]))) + #Nil])]))) + #Nil])) + + (#Cons [input (#Cons [output others])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"])) + (#Cons [(_meta (#Tuple (#Cons [input + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "->'"])) + (#Cons [output others])]))) + #Nil])]))) + #Nil])]))) + #Nil])) + + _ + (fail "Wrong syntax for ->'"))) (defmacro (All' tokens) - (case' tokens - (#Cons [(#Meta [_ (#Tuple #Nil)]) - (#Cons [body #Nil])]) - (return (#Cons [body - #Nil])) - - (#Cons [(#Meta [_ (#Tuple (#Cons [(#Meta [_ (#Symbol ["" arg-name])]) other-args]))]) - (#Cons [body #Nil])]) - (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AllT"])) - (#Cons [(_meta (#Tuple (#Cons [(_meta (#Tag ["lux" "None"])) - (#Cons [(_meta (#Text "")) - (#Cons [(_meta (#Text arg-name)) - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "All'"])) - (#Cons [(_meta (#Tuple other-args)) - (#Cons [body - #Nil])])]))) - #Nil])])])]))) - #Nil])]))) - #Nil])) - - _ - (fail "Wrong syntax for All'"))) + (_lux_case tokens + (#Cons [(#Meta [_ (#Tuple #Nil)]) + (#Cons [body #Nil])]) + (return (#Cons [body + #Nil])) + + (#Cons [(#Meta [_ (#Tuple (#Cons [(#Meta [_ (#Symbol ["" arg-name])]) other-args]))]) + (#Cons [body #Nil])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AllT"])) + (#Cons [(_meta (#Tuple (#Cons [(_meta (#Tag ["lux" "None"])) + (#Cons [(_meta (#Text "")) + (#Cons [(_meta (#Text arg-name)) + (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "All'"])) + (#Cons [(_meta (#Tuple other-args)) + (#Cons [body + #Nil])])]))) + #Nil])])])]))) + #Nil])]))) + #Nil])) + + _ + (fail "Wrong syntax for All'"))) (defmacro (B' tokens) - (case' tokens - (#Cons [(#Meta [_ (#Symbol ["" bound-name])]) - #Nil]) - (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"])) - (#Cons [(_meta (#Text bound-name)) - #Nil])]))) - #Nil])) + (_lux_case tokens + (#Cons [(#Meta [_ (#Symbol ["" bound-name])]) + #Nil]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"])) + (#Cons [(_meta (#Text bound-name)) + #Nil])]))) + #Nil])) - _ - (fail "Wrong syntax for B'"))) + _ + (fail "Wrong syntax for B'"))) (defmacro ($' tokens) - (case' tokens - (#Cons [x #Nil]) - (return tokens) + (_lux_case tokens + (#Cons [x #Nil]) + (return tokens) - (#Cons [x (#Cons [y xs])]) - (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "$'"])) - (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AppT"])) - (#Cons [(_meta (#Tuple (#Cons [x (#Cons [y #Nil])]))) - #Nil])]))) - xs])]))) - #Nil])) + (#Cons [x (#Cons [y xs])]) + (return (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "$'"])) + (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AppT"])) + (#Cons [(_meta (#Tuple (#Cons [x (#Cons [y #Nil])]))) + #Nil])]))) + xs])]))) + #Nil])) - _ - (fail "Wrong syntax for $'"))) + _ + (fail "Wrong syntax for $'"))) (def_ #export (fold f init xs) (All' [a b] @@ -566,12 +566,12 @@ (B' a) ($' List (B' b)) (B' a))) - (case' xs - #Nil - init + (_lux_case xs + #Nil + init - (#Cons [x xs']) - (fold f (f init x) xs'))) + (#Cons [x xs']) + (fold f (f init x) xs'))) (def_ #export (reverse list) (All' [a] @@ -590,149 +590,146 @@ #Nil]))) (defmacro #export (list& xs) - (case' (reverse xs) - (#Cons [last init]) - (return (list (fold (lambda_ [tail head] - (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) - (_meta (#Tuple (list head tail))))))) - last - init))) + (_lux_case (reverse xs) + (#Cons [last init]) + (return (list (fold (lambda_ [tail head] + (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) + (_meta (#Tuple (list head tail))))))) + last + init))) - _ - (fail "Wrong syntax for list&"))) + _ + (fail "Wrong syntax for list&"))) (defmacro #export (lambda tokens) - (let' [name tokens'] (:' (#TupleT (list Ident ($' List Syntax))) - (case' tokens - (#Cons [(#Meta [_ (#Symbol name)]) tokens']) - [name tokens'] - - _ - [["" ""] tokens])) - (case' tokens' - (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) - (case' args - #Nil - (fail "lambda requires a non-empty arguments tuple.") - - (#Cons [harg targs]) - (return (list ($form (list ($symbol ["" "lambda'"]) - ($symbol name) - harg - (fold (lambda_ [body' arg] - ($form (list ($symbol ["" "lambda'"]) - ($symbol ["" ""]) - arg - body'))) - body - (reverse targs))))))) + (let' [name tokens'] (_lux_: (#TupleT (list Ident ($' List Syntax))) + (_lux_case tokens + (#Cons [(#Meta [_ (#Symbol name)]) tokens']) + [name tokens'] - _ - (fail "Wrong syntax for lambda")))) + _ + [["" ""] tokens])) + (_lux_case tokens' + (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) + (_lux_case args + #Nil + (fail "lambda requires a non-empty arguments tuple.") + + (#Cons [harg targs]) + (return (list ($form (list ($symbol ["" "_lux_lambda"]) + ($symbol name) + harg + (fold (lambda_ [body' arg] + ($form (list ($symbol ["" "_lux_lambda"]) + ($symbol ["" ""]) + arg + body'))) + body + (reverse targs))))))) + + _ + (fail "Wrong syntax for lambda")))) (defmacro (def__ tokens) - (case' tokens - (#Cons [(#Meta [_ (#Tag ["" "export"])]) - (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) - (#Cons [type (#Cons [body #Nil])])])]) - (return (list ($form (list ($symbol ["" "def'"]) - name - ($form (list ($symbol ["" ":'"]) - type - ($form (list ($symbol ["lux" "lambda"]) - name - ($tuple args) - body)))))) - ($form (list ($symbol ["" "export'"]) name)))) - - (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) - (return (list ($form (list ($symbol ["" "def'"]) - name - ($form (list ($symbol ["" ":'"]) - type - body)))) - ($form (list ($symbol ["" "export'"]) name)))) - - (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) - (#Cons [type (#Cons [body #Nil])])]) - (return (list ($form (list ($symbol ["" "def'"]) - name - ($form (list ($symbol ["" ":'"]) - type - ($form (list ($symbol ["lux" "lambda"]) - name - ($tuple args) - body)))))))) - - (#Cons [name (#Cons [type (#Cons [body #Nil])])]) - (return (list ($form (list ($symbol ["" "def'"]) - name - ($form (list ($symbol ["" ":'"]) type body)))))) - - _ - (fail "Wrong syntax for def") - )) + (_lux_case tokens + (#Cons [(#Meta [_ (#Tag ["" "export"])]) + (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) + (#Cons [type (#Cons [body #Nil])])])]) + (return (list ($form (list ($symbol ["" "_lux_def"]) + name + ($form (list ($symbol ["" "_lux_:"]) + type + ($form (list ($symbol ["lux" "lambda"]) + name + ($tuple args) + body)))))) + ($form (list ($symbol ["" "_lux_export"]) name)))) + + (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) + (return (list ($form (list ($symbol ["" "_lux_def"]) + name + ($form (list ($symbol ["" "_lux_:"]) + type + body)))) + ($form (list ($symbol ["" "_lux_export"]) name)))) + + (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) + (#Cons [type (#Cons [body #Nil])])]) + (return (list ($form (list ($symbol ["" "_lux_def"]) + name + ($form (list ($symbol ["" "_lux_:"]) + type + ($form (list ($symbol ["lux" "lambda"]) + name + ($tuple args) + body)))))))) + + (#Cons [name (#Cons [type (#Cons [body #Nil])])]) + (return (list ($form (list ($symbol ["" "_lux_def"]) + name + ($form (list ($symbol ["" "_lux_:"]) type body)))))) + + _ + (fail "Wrong syntax for def") + )) (def__ (as-pairs xs) (All' [a] (->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a)))))) - (case' xs - (#Cons [x (#Cons [y xs'])]) - (#Cons [[x y] (as-pairs xs')]) + (_lux_case xs + (#Cons [x (#Cons [y xs'])]) + (#Cons [[x y] (as-pairs xs')]) - _ - #Nil)) + _ + #Nil)) (defmacro #export (let tokens) - (case' tokens - (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])]) - (return (list (fold (:' (->' Syntax (#TupleT (list Syntax Syntax)) - Syntax) - (lambda [body binding] - (case' binding - [label value] - (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body)))))) - body - (fold (:' (->' ($' List (#TupleT (list Syntax Syntax))) (#TupleT (list Syntax Syntax)) - ($' List (#TupleT (list Syntax Syntax)))) - (lambda [tail head] - (#Cons [head tail]))) - #Nil - (as-pairs bindings))))) + (_lux_case tokens + (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])]) + (return (list (fold (_lux_: (->' Syntax (#TupleT (list Syntax Syntax)) + Syntax) + (lambda [body binding] + (_lux_case binding + [label value] + (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body)))))) + body + (fold (lambda [tail head] (#Cons [head tail])) + #Nil + (as-pairs bindings))))) - _ - (fail "Wrong syntax for let"))) + _ + (fail "Wrong syntax for let"))) (def__ #export (map f xs) (All' [a b] (->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b)))) - (case' xs - #Nil - #Nil + (_lux_case xs + #Nil + #Nil - (#Cons [x xs']) - (#Cons [(f x) (map f xs')]))) + (#Cons [x xs']) + (#Cons [(f x) (map f xs')]))) (def__ #export (any? p xs) (All' [a] (->' (->' (B' a) Bool) ($' List (B' a)) Bool)) - (case' xs - #Nil - false + (_lux_case xs + #Nil + false - (#Cons [x xs']) - (case' (p x) - true true - false (any? p xs')))) + (#Cons [x xs']) + (_lux_case (p x) + true true + false (any? p xs')))) (def__ (spliced? token) (->' Syntax Bool) - (case' token - (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [_ #Nil])]))]) - true + (_lux_case token + (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [_ #Nil])]))]) + true - _ - false)) + _ + false)) (def__ (wrap-meta content) (->' Syntax Syntax) @@ -742,143 +739,142 @@ (def__ (untemplate-list tokens) (->' ($' List Syntax) Syntax) - (case' tokens - #Nil - (_meta (#Tag ["lux" "Nil"])) + (_lux_case tokens + #Nil + (_meta (#Tag ["lux" "Nil"])) - (#Cons [token tokens']) - (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) - (_meta (#Tuple (list token (untemplate-list tokens'))))))))) + (#Cons [token tokens']) + (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) + (_meta (#Tuple (list token (untemplate-list tokens'))))))))) (def__ (list:++ xs ys) (All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a)))) - (case' xs - (#Cons [x xs']) - (#Cons [x (list:++ xs' ys)]) + (_lux_case xs + (#Cons [x xs']) + (#Cons [x (list:++ xs' ys)]) - #Nil - ys)) + #Nil + ys)) (defmacro #export ($ tokens) - (case' tokens - (#Cons [op (#Cons [init args])]) - (return (list (fold (lambda [a1 a2] ($form (list op a1 a2))) - init - args))) - - _ - (fail "Wrong syntax for $"))) + (_lux_case tokens + (#Cons [op (#Cons [init args])]) + (return (list (fold (lambda [a1 a2] ($form (list op a1 a2))) + init + args))) + + _ + (fail "Wrong syntax for $"))) (def__ (splice untemplate tag elems) (->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax) - (case' (any? spliced? elems) - true - (let [elems' (map (:' (->' Syntax Syntax) - (lambda [elem] - (case' elem - (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [spliced #Nil])]))]) - spliced + (_lux_case (any? spliced? elems) + true + (let [elems' (map (lambda [elem] + (_lux_case elem + (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [spliced #Nil])]))]) + spliced - _ - ($form (list ($symbol ["" ":'"]) - ($symbol ["lux" "SyntaxList"]) - ($form (list ($symbol ["lux" "list"]) (untemplate elem)))))))) - elems)] - (wrap-meta ($form (list tag - ($form (list& ($symbol ["lux" "$"]) - ($symbol ["lux" "list:++"]) - elems')))))) - - false - (wrap-meta ($form (list tag (untemplate-list (map untemplate elems))))))) + _ + ($form (list ($symbol ["" "_lux_:"]) + ($symbol ["lux" "SyntaxList"]) + ($form (list ($symbol ["lux" "list"]) (untemplate elem))))))) + elems)] + (wrap-meta ($form (list tag + ($form (list& ($symbol ["lux" "$"]) + ($symbol ["lux" "list:++"]) + elems')))))) + + false + (wrap-meta ($form (list tag (untemplate-list (map untemplate elems))))))) (def__ (untemplate subst token) (->' Text Syntax Syntax) - (case' token - (#Meta [_ (#Bool value)]) - (wrap-meta ($form (list ($tag ["lux" "Bool"]) (_meta (#Bool value))))) + (_lux_case token + (#Meta [_ (#Bool value)]) + (wrap-meta ($form (list ($tag ["lux" "Bool"]) (_meta (#Bool value))))) - (#Meta [_ (#Int value)]) - (wrap-meta ($form (list ($tag ["lux" "Int"]) (_meta (#Int value))))) + (#Meta [_ (#Int value)]) + (wrap-meta ($form (list ($tag ["lux" "Int"]) (_meta (#Int value))))) - (#Meta [_ (#Real value)]) - (wrap-meta ($form (list ($tag ["lux" "Real"]) (_meta (#Real value))))) + (#Meta [_ (#Real value)]) + (wrap-meta ($form (list ($tag ["lux" "Real"]) (_meta (#Real value))))) - (#Meta [_ (#Char value)]) - (wrap-meta ($form (list ($tag ["lux" "Char"]) (_meta (#Char value))))) + (#Meta [_ (#Char value)]) + (wrap-meta ($form (list ($tag ["lux" "Char"]) (_meta (#Char value))))) - (#Meta [_ (#Text value)]) - (wrap-meta ($form (list ($tag ["lux" "Text"]) (_meta (#Text value))))) + (#Meta [_ (#Text value)]) + (wrap-meta ($form (list ($tag ["lux" "Text"]) (_meta (#Text value))))) - (#Meta [_ (#Tag [module name])]) - (let [module' (case' module - "" - subst + (#Meta [_ (#Tag [module name])]) + (let [module' (_lux_case module + "" + subst - _ - module)] - (wrap-meta ($form (list ($tag ["lux" "Tag"]) ($tuple (list ($text module') ($text name))))))) + _ + module)] + (wrap-meta ($form (list ($tag ["lux" "Tag"]) ($tuple (list ($text module') ($text name))))))) - (#Meta [_ (#Symbol [module name])]) - (let [module' (case' module - "" - subst + (#Meta [_ (#Symbol [module name])]) + (let [module' (_lux_case module + "" + subst - _ - module)] - (wrap-meta ($form (list ($tag ["lux" "Symbol"]) ($tuple (list ($text module') ($text name))))))) + _ + module)] + (wrap-meta ($form (list ($tag ["lux" "Symbol"]) ($tuple (list ($text module') ($text name))))))) - (#Meta [_ (#Tuple elems)]) - (splice (untemplate subst) ($tag ["lux" "Tuple"]) elems) + (#Meta [_ (#Tuple elems)]) + (splice (untemplate subst) ($tag ["lux" "Tuple"]) elems) - (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~"])]) (#Cons [unquoted #Nil])]))]) - unquoted + (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~"])]) (#Cons [unquoted #Nil])]))]) + unquoted - (#Meta [_ (#Form elems)]) - (splice (untemplate subst) ($tag ["lux" "Form"]) elems) + (#Meta [_ (#Form elems)]) + (splice (untemplate subst) ($tag ["lux" "Form"]) elems) - (#Meta [_ (#Record fields)]) - (wrap-meta ($form (list ($tag ["lux" "Record"]) - (untemplate-list (map (:' (->' (#TupleT (list Syntax Syntax)) Syntax) - (lambda [kv] - (let [[k v] kv] - ($tuple (list (untemplate subst k) (untemplate subst v)))))) - fields))))) - )) + (#Meta [_ (#Record fields)]) + (wrap-meta ($form (list ($tag ["lux" "Record"]) + (untemplate-list (map (_lux_: (->' (#TupleT (list Syntax Syntax)) Syntax) + (lambda [kv] + (let [[k v] kv] + ($tuple (list (untemplate subst k) (untemplate subst v)))))) + fields))))) + )) (defmacro (`' tokens) - (case' tokens - (#Cons [template #Nil]) - (return (list (untemplate "" template))) + (_lux_case tokens + (#Cons [template #Nil]) + (return (list (untemplate "" template))) - _ - (fail "Wrong syntax for `'"))) + _ + (fail "Wrong syntax for `'"))) (defmacro #export (|> tokens) - (case' tokens - (#Cons [init apps]) - (return (list (fold (lambda [acc app] - (case' app - (#Meta [_ (#Form parts)]) - ($form (list:++ parts (list acc))) + (_lux_case tokens + (#Cons [init apps]) + (return (list (fold (lambda [acc app] + (_lux_case app + (#Meta [_ (#Form parts)]) + ($form (list:++ parts (list acc))) - _ - (`' ((~ app) (~ acc))))) - init - apps))) + _ + (`' ((~ app) (~ acc))))) + init + apps))) - _ - (fail "Wrong syntax for |>"))) + _ + (fail "Wrong syntax for |>"))) (defmacro #export (if tokens) - (case' tokens - (#Cons [test (#Cons [then (#Cons [else #Nil])])]) - (return (list (`' (case' (~ test) - true (~ then) - false (~ else))))) + (_lux_case tokens + (#Cons [test (#Cons [then (#Cons [else #Nil])])]) + (return (list (`' (_lux_case (~ test) + true (~ then) + false (~ else))))) - _ - (fail "Wrong syntax for if"))) + _ + (fail "Wrong syntax for if"))) ## (deftype (Lux a) ## (-> CompilerState (Either Text (, CompilerState a)))) @@ -908,71 +904,71 @@ #lux;bind (lambda [f ma] - (case' ma - #None #None - (#Some a) (f a)))}) + (_lux_case ma + #None #None + (#Some a) (f a)))}) (def__ Lux:Monad ($' Monad Lux) {#lux;return - (lambda return [x] - (lambda [state] - (#Right [state x]))) + (lambda [x] + (lambda [state] + (#Right [state x]))) #lux;bind (lambda [f ma] (lambda [state] - (case' (ma state) - (#Left msg) - (#Left msg) + (_lux_case (ma state) + (#Left msg) + (#Left msg) - (#Right [state' a]) - (f a state'))))}) + (#Right [state' a]) + (f a state'))))}) (defmacro #export (^ tokens) - (case' tokens - (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil]) - (return (list (`' (#;DataT (~ (_meta (#Text class-name))))))) + (_lux_case tokens + (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil]) + (return (list (`' (#;DataT (~ (_meta (#Text class-name))))))) - _ - (fail "Wrong syntax for ^"))) + _ + (fail "Wrong syntax for ^"))) (defmacro #export (-> tokens) - (case' (reverse tokens) - (#Cons [output inputs]) - (return (list (fold (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)]))) - output - inputs))) - - _ - (fail "Wrong syntax for ->"))) + (_lux_case (reverse tokens) + (#Cons [output inputs]) + (return (list (fold (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)]))) + output + inputs))) + + _ + (fail "Wrong syntax for ->"))) (defmacro #export (, tokens) (return (list (`' (#;TupleT (;list (~@ tokens))))))) (defmacro (do tokens) - (case' tokens - (#Cons [monad (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])]) - (let [body' (fold (:' (-> Syntax (, Syntax Syntax) Syntax) - (lambda [body' binding] - (let [[var value] binding] - (case' var - (#Meta [_ (#Tag ["" "let"])]) - (`' (;let (~ value) (~ body'))) - - _ - (`' (;bind (lambda' (~ ($symbol ["" ""])) - (~ var) - (~ body')) - (~ value))))))) - body - (reverse (as-pairs bindings)))] - (return (list (`' (case' (~ monad) - {#;return ;return #;bind ;bind} - (~ body')))))) - - _ - (fail "Wrong syntax for do"))) + (_lux_case tokens + (#Cons [monad (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])]) + (let [body' (fold (_lux_: (-> Syntax (, Syntax Syntax) Syntax) + (lambda [body' binding] + (let [[var value] binding] + (_lux_case var + (#Meta [_ (#Tag ["" "let"])]) + (`' (;let (~ value) (~ body'))) + + _ + (`' (;bind (_lux_lambda (~ ($symbol ["" ""])) + (~ var) + (~ body')) + (~ value))))))) + body + (reverse (as-pairs bindings)))] + (return (list (`' (_lux_case (~ monad) + {#;return ;return #;bind ;bind} + (~ body')))))) + + _ + (fail "Wrong syntax for do"))) (def__ (map% m f xs) ## (All [m a b] @@ -983,16 +979,16 @@ ($' List (B' a)) ($' (B' m) ($' List (B' b))))) (let [{#;return ;return #;bind _} m] - (case' xs - #Nil - (;return #Nil) - - (#Cons [x xs']) - (do m - [y (f x) - ys (map% m f xs')] - (;return (#Cons [y ys]))) - ))) + (_lux_case xs + #Nil + (;return #Nil) + + (#Cons [x xs']) + (do m + [y (f x) + ys (map% m f xs')] + (;return (#Cons [y ys]))) + ))) (def__ #export (. f g) (All' [a b c] @@ -1002,21 +998,21 @@ (def__ (get-ident x) (-> Syntax ($' Maybe Text)) - (case' x - (#Meta [_ (#Symbol ["" sname])]) - (#Some sname) + (_lux_case x + (#Meta [_ (#Symbol ["" sname])]) + (#Some sname) - _ - #None)) + _ + #None)) (def__ (tuple->list tuple) (-> Syntax ($' Maybe ($' List Syntax))) - (case' tuple - (#Meta [_ (#Tuple members)]) - (#Some members) + (_lux_case tuple + (#Meta [_ (#Tuple members)]) + (#Some members) - _ - #None)) + _ + #None)) (def__ RepEnv Type @@ -1024,97 +1020,97 @@ (def__ (make-env xs ys) (-> ($' List Text) ($' List Syntax) RepEnv) - (case' (:' (, ($' List Text) ($' List Syntax)) - [xs ys]) - [(#Cons [x xs']) (#Cons [y ys'])] - (#Cons [[x y] (make-env xs' ys')]) + (_lux_case (_lux_: (, ($' List Text) ($' List Syntax)) + [xs ys]) + [(#Cons [x xs']) (#Cons [y ys'])] + (#Cons [[x y] (make-env xs' ys')]) - _ - #Nil)) + _ + #Nil)) (def__ (text:= x y) (-> Text Text Bool) - (jvm-invokevirtual java.lang.Object equals [java.lang.Object] - x [y])) + (_jvm_invokevirtual java.lang.Object equals [java.lang.Object] + x [y])) (def__ (get-rep key env) (-> Text RepEnv ($' Maybe Syntax)) - (case' env - #Nil - #None + (_lux_case env + #Nil + #None - (#Cons [[k v] env']) - (if (text:= k key) - (#Some v) - (get-rep key env')))) + (#Cons [[k v] env']) + (if (text:= k key) + (#Some v) + (get-rep key env')))) (def__ (apply-template env template) (-> RepEnv Syntax Syntax) - (case' template - (#Meta [_ (#Symbol ["" sname])]) - (case' (get-rep sname env) - (#Some subst) - subst + (_lux_case template + (#Meta [_ (#Symbol ["" sname])]) + (_lux_case (get-rep sname env) + (#Some subst) + subst - _ - template) + _ + template) - (#Meta [_ (#Tuple elems)]) - ($tuple (map (apply-template env) elems)) + (#Meta [_ (#Tuple elems)]) + ($tuple (map (apply-template env) elems)) - (#Meta [_ (#Form elems)]) - ($form (map (apply-template env) elems)) + (#Meta [_ (#Form elems)]) + ($form (map (apply-template env) elems)) - (#Meta [_ (#Record members)]) - ($record (map (:' (-> (, Syntax Syntax) (, Syntax Syntax)) - (lambda [kv] - (let [[slot value] kv] - [(apply-template env slot) (apply-template env value)]))) - members)) + (#Meta [_ (#Record members)]) + ($record (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax)) + (lambda [kv] + (let [[slot value] kv] + [(apply-template env slot) (apply-template env value)]))) + members)) - _ - template)) + _ + template)) (def__ (join-map f xs) (All' [a b] (-> (-> (B' a) ($' List (B' b))) ($' List (B' a)) ($' List (B' b)))) - (case' xs - #Nil - #Nil - - (#Cons [x xs']) - (list:++ (f x) (join-map f xs')))) - -(defmacro (do-template tokens) - (case' tokens - (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [(#Meta [_ (#Tuple templates)]) data])]) - (case' (:' (, ($' Maybe ($' List Text)) ($' Maybe ($' List ($' List Syntax)))) - [(map% Maybe:Monad get-ident bindings) - (map% Maybe:Monad tuple->list data)]) - [(#Some bindings') (#Some data')] - (let [apply (:' (-> RepEnv ($' List Syntax)) - (lambda [env] (map (apply-template env) templates)))] - (|> data' - (join-map (. apply (make-env bindings'))) - return)) + (_lux_case xs + #Nil + #Nil + + (#Cons [x xs']) + (list:++ (f x) (join-map f xs')))) + +(defmacro #export (do-template tokens) + (_lux_case tokens + (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [(#Meta [_ (#Tuple templates)]) data])]) + (_lux_case (_lux_: (, ($' Maybe ($' List Text)) ($' Maybe ($' List ($' List Syntax)))) + [(map% Maybe:Monad get-ident bindings) + (map% Maybe:Monad tuple->list data)]) + [(#Some bindings') (#Some data')] + (let [apply (_lux_: (-> RepEnv ($' List Syntax)) + (lambda [env] (map (apply-template env) templates)))] + (|> data' + (join-map (. apply (make-env bindings'))) + return)) - _ - (fail "All the do-template bindigns must be symbols.")) + _ + (fail "All the do-template bindigns must be symbols.")) - _ - (fail "Wrong syntax for do-template"))) + _ + (fail "Wrong syntax for do-template"))) (do-template [<name> <cmp> <type>] [(def__ #export (<name> x y) (-> <type> <type> Bool) (<cmp> x y))] - [int:= jvm-leq Int] - [int:> jvm-lgt Int] - [int:< jvm-llt Int] - [real:= jvm-deq Real] - [real:> jvm-dgt Real] - [real:< jvm-dlt Real] + [int:= _jvm_leq Int] + [int:> _jvm_lgt Int] + [int:< _jvm_llt Int] + [real:= _jvm_deq Real] + [real:> _jvm_dgt Real] + [real:< _jvm_dlt Real] ) (do-template [<name> <cmp> <type>] @@ -1122,16 +1118,16 @@ (-> <type> <type> <type>) (<cmp> x y))] - [int:+ jvm-ladd Int] - [int:- jvm-lsub Int] - [int:* jvm-lmul Int] - [int:/ jvm-ldiv Int] - [int:% jvm-lrem Int] - [real:+ jvm-dadd Real] - [real:- jvm-dsub Real] - [real:* jvm-dmul Real] - [real:/ jvm-ddiv Real] - [real:% jvm-drem Real] + [int:+ _jvm_ladd Int] + [int:- _jvm_lsub Int] + [int:* _jvm_lmul Int] + [int:/ _jvm_ldiv Int] + [int:% _jvm_lrem Int] + [real:+ _jvm_dadd Real] + [real:- _jvm_dsub Real] + [real:* _jvm_dmul Real] + [real:/ _jvm_ddiv Real] + [real:% _jvm_drem Real] ) (def__ (multiple? div n) @@ -1148,8 +1144,8 @@ (def__ #export (text:++ x y) (-> Text Text Text) - (jvm-invokevirtual java.lang.String concat [java.lang.String] - x [y])) + (_jvm_invokevirtual java.lang.String concat [java.lang.String] + x [y])) (def__ (ident->text ident) (-> Ident Text) @@ -1158,88 +1154,88 @@ (def__ (replace-syntax reps syntax) (-> RepEnv Syntax Syntax) - (case' syntax - (#Meta [_ (#Symbol ["" name])]) - (case' (get-rep name reps) - (#Some replacement) - replacement - - #None - syntax) - - (#Meta [_ (#Form parts)]) - (#Meta [_ (#Form (map (replace-syntax reps) parts))]) - - (#Meta [_ (#Tuple members)]) - (#Meta [_ (#Tuple (map (replace-syntax reps) members))]) - - (#Meta [_ (#Record slots)]) - (#Meta [_ (#Record (map (:' (-> (, Syntax Syntax) (, Syntax Syntax)) - (lambda [slot] - (let [[k v] slot] - [(replace-syntax reps k) (replace-syntax reps v)]))) - slots))]) - - _ - syntax) + (_lux_case syntax + (#Meta [_ (#Symbol ["" name])]) + (_lux_case (get-rep name reps) + (#Some replacement) + replacement + + #None + syntax) + + (#Meta [_ (#Form parts)]) + (#Meta [_ (#Form (map (replace-syntax reps) parts))]) + + (#Meta [_ (#Tuple members)]) + (#Meta [_ (#Tuple (map (replace-syntax reps) members))]) + + (#Meta [_ (#Record slots)]) + (#Meta [_ (#Record (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax)) + (lambda [slot] + (let [[k v] slot] + [(replace-syntax reps k) (replace-syntax reps v)]))) + slots))]) + + _ + syntax) ) (defmacro #export (All tokens) - (let [[self-ident tokens'] (:' (, Text SyntaxList) - (case' tokens - (#Cons [(#Meta [_ (#Symbol ["" self-ident])]) tokens']) - [self-ident tokens'] - - _ - ["" tokens]))] - (case' tokens' - (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) - (case' (map% Maybe:Monad get-ident args) - (#Some idents) - (case' idents - #Nil - (return (list body)) - - (#Cons [harg targs]) - (let [replacements (map (:' (-> Text (, Text Syntax)) - (lambda [ident] [ident (`' (#;BoundT (~ ($text ident))))])) - (list& self-ident idents)) - body' (fold (lambda [body' arg'] (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')]))) - (replace-syntax replacements body) - (reverse targs))] - (return (list (`' (#;AllT [#;None (~ ($text self-ident)) (~ ($text harg)) (~ body')])))))) - - #None - (fail "'All' arguments must be symbols.")) - - _ - (fail "Wrong syntax for All")) + (let [[self-ident tokens'] (_lux_: (, Text SyntaxList) + (_lux_case tokens + (#Cons [(#Meta [_ (#Symbol ["" self-ident])]) tokens']) + [self-ident tokens'] + + _ + ["" tokens]))] + (_lux_case tokens' + (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) + (_lux_case (map% Maybe:Monad get-ident args) + (#Some idents) + (_lux_case idents + #Nil + (return (list body)) + + (#Cons [harg targs]) + (let [replacements (map (_lux_: (-> Text (, Text Syntax)) + (lambda [ident] [ident (`' (#;BoundT (~ ($text ident))))])) + (list& self-ident idents)) + body' (fold (lambda [body' arg'] (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')]))) + (replace-syntax replacements body) + (reverse targs))] + (return (list (`' (#;AllT [#;None (~ ($text self-ident)) (~ ($text harg)) (~ body')])))))) + + #None + (fail "'All' arguments must be symbols.")) + + _ + (fail "Wrong syntax for All")) )) (def__ (get k plist) (All [a] (-> Text ($' List (, Text a)) ($' Maybe a))) - (case' plist - (#Cons [[k' v] plist']) - (if (text:= k k') - (#Some v) - (get k plist')) + (_lux_case plist + (#Cons [[k' v] plist']) + (if (text:= k k') + (#Some v) + (get k plist')) - #Nil - #None)) + #Nil + #None)) (def__ #export (get-module-name state) ($' Lux Text) - (case' state - {#source source #modules modules #module-aliases module-aliases - #envs envs #types types #host host - #seed seed} - (case' (reverse envs) - #Nil - (#Left "Can't get the module name without a module!") + (_lux_case state + {#source source #modules modules #module-aliases module-aliases + #envs envs #types types #host host + #seed seed} + (_lux_case (reverse envs) + #Nil + (#Left "Can't get the module name without a module!") - (#Cons [{#name module-name #inner-closures _ #locals _ #closure _} _]) - (#Right [state module-name])))) + (#Cons [{#name module-name #inner-closures _ #locals _ #closure _} _]) + (#Right [state module-name])))) (def__ (find-macro' modules current-module module name) (-> ($' List (, Text ($' List (, Text (, Bool ($' DefData' (-> ($' List Syntax) ($' StateE CompilerState ($' List Syntax))))))))) @@ -1248,19 +1244,19 @@ (do Maybe:Monad [bindings (get module modules) gdef (get name bindings)] - (case' (:' (, Bool ($' DefData' Macro)) gdef) - [exported? (#MacroD macro')] - (if exported? - (#Some macro') - (if (text:= module current-module) - (#Some macro') - #None)) - - [_ (#AliasD [r-module r-name])] - (find-macro' modules current-module r-module r-name) - - _ - #None))) + (_lux_case (_lux_: (, Bool ($' DefData' Macro)) gdef) + [exported? (#MacroD macro')] + (if exported? + (#Some macro') + (if (text:= module current-module) + (#Some macro') + #None)) + + [_ (#AliasD [r-module r-name])] + (find-macro' modules current-module r-module r-name) + + _ + #None))) (def__ #export (find-macro ident) (-> Ident ($' Lux ($' Maybe Macro))) @@ -1268,53 +1264,63 @@ [current-module get-module-name] (let [[module name] ident] (lambda [state] - (case' state - {#source source #modules modules #module-aliases module-aliases - #envs envs #types types #host host - #seed seed} - (#Right [state (find-macro' modules current-module module name)])))))) + (_lux_case state + {#source source #modules modules #module-aliases module-aliases + #envs envs #types types #host host + #seed seed} + (#Right [state (find-macro' modules current-module module name)])))))) (def__ (list:join xs) (All [a] (-> ($' List ($' List a)) ($' List a))) (fold list:++ #Nil xs)) +## (def__ #export (normalize ident) +## (-> Ident ($' Lux Ident)) +## (_lux_case ident +## ["" name] +## (do Lux:Monad +## [module-name get-module-name] +## (;return (: Ident [module-name name]))) + +## _ +## (return ident))) (def__ #export (normalize ident state) (-> Ident ($' Lux Ident)) - (case' ident - ["" name] - (case' state - {#source source #modules modules #module-aliases module-aliases - #envs envs #types types #host host - #seed seed} - (case' (reverse envs) - #Nil - (#Left "Can't normalize Ident without a global environment.") + (_lux_case ident + ["" name] + (_lux_case state + {#source source #modules modules #module-aliases module-aliases + #envs envs #types types #host host + #seed seed} + (_lux_case (reverse envs) + #Nil + (#Left "Can't normalize Ident without a global environment.") - (#Cons [{#name prefix #inner-closures _ #locals _ #closure _} _]) - (#Right [state [prefix name]]))) - - _ - (#Right [state ident]))) + (#Cons [{#name prefix #inner-closures _ #locals _ #closure _} _]) + (#Right [state [prefix name]]))) + + _ + (#Right [state ident]))) (defmacro #export (| tokens) (do Lux:Monad [pairs (map% Lux:Monad - (:' (-> Syntax ($' Lux Syntax)) - (lambda [token] - (case' token - (#Meta [_ (#Tag ident)]) - (do Lux:Monad - [ident (normalize ident)] - (;return (`' [(~ ($text (ident->text ident))) (;,)]))) - - (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))]) - (do Lux:Monad - [ident (normalize ident)] - (;return (`' [(~ ($text (ident->text ident))) (~ value)]))) - - _ - (fail "Wrong syntax for |")))) + (_lux_: (-> Syntax ($' Lux Syntax)) + (lambda [token] + (_lux_case token + (#Meta [_ (#Tag ident)]) + (do Lux:Monad + [ident (normalize ident)] + (;return (`' [(~ ($text (ident->text ident))) (;,)]))) + + (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))]) + (do Lux:Monad + [ident (normalize ident)] + (;return (`' [(~ ($text (ident->text ident))) (~ value)]))) + + _ + (fail "Wrong syntax for |")))) tokens)] (;return (list (`' (#;VariantT (;list (~@ pairs)))))))) @@ -1323,264 +1329,267 @@ (fail "& expects an even number of arguments.") (do Lux:Monad [pairs (map% Lux:Monad - (:' (-> (, Syntax Syntax) ($' Lux Syntax)) - (lambda [pair] - (case' pair - [(#Meta [_ (#Tag ident)]) value] - (do Lux:Monad - [ident (normalize ident)] - (;return (`' [(~ ($text (ident->text ident))) (~ value)]))) - - _ - (fail "Wrong syntax for &")))) + (_lux_: (-> (, Syntax Syntax) ($' Lux Syntax)) + (lambda [pair] + (_lux_case pair + [(#Meta [_ (#Tag ident)]) value] + (do Lux:Monad + [ident (normalize ident)] + (;return (`' [(~ ($text (ident->text ident))) (~ value)]))) + + _ + (fail "Wrong syntax for &")))) (as-pairs tokens))] (;return (list (`' (#;RecordT (;list (~@ pairs))))))))) (def__ #export (->text x) (-> (^ java.lang.Object) Text) - (jvm-invokevirtual java.lang.Object toString [] x [])) + (_jvm_invokevirtual java.lang.Object toString [] x [])) (def__ #export (interpose sep xs) (All [a] (-> a ($' List a) ($' List a))) - (case' xs - #Nil - xs + (_lux_case xs + #Nil + xs - (#Cons [x #Nil]) - xs + (#Cons [x #Nil]) + xs - (#Cons [x xs']) - (list& x sep (interpose sep xs')))) + (#Cons [x xs']) + (list& x sep (interpose sep xs')))) (def__ #export (syntax:show syntax) (-> Syntax Text) - (case' syntax - (#Meta [_ (#Bool value)]) - (->text value) + (_lux_case syntax + (#Meta [_ (#Bool value)]) + (->text value) - (#Meta [_ (#Int value)]) - (->text value) + (#Meta [_ (#Int value)]) + (->text value) - (#Meta [_ (#Real value)]) - (->text value) + (#Meta [_ (#Real value)]) + (->text value) - (#Meta [_ (#Char value)]) - ($ text:++ "#\"" (->text value) "\"") + (#Meta [_ (#Char value)]) + ($ text:++ "#\"" (->text value) "\"") - (#Meta [_ (#Text value)]) - value + (#Meta [_ (#Text value)]) + value - (#Meta [_ (#Symbol ident)]) - (ident->text ident) + (#Meta [_ (#Symbol ident)]) + (ident->text ident) - (#Meta [_ (#Tag ident)]) - (text:++ "#" (ident->text ident)) + (#Meta [_ (#Tag ident)]) + (text:++ "#" (ident->text ident)) - (#Meta [_ (#Tuple members)]) - ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]") + (#Meta [_ (#Tuple members)]) + ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]") - (#Meta [_ (#Form members)]) - ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")") + (#Meta [_ (#Form members)]) + ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")") - (#Meta [_ (#Record slots)]) - ($ text:++ "{" (|> slots - (map (:' (-> (, Syntax Syntax) Text) - (lambda [slot] - (let [[k v] slot] - ($ text:++ (syntax:show k) " " (syntax:show v)))))) - (interpose " ") (fold text:++ "")) "}") - )) + (#Meta [_ (#Record slots)]) + ($ text:++ "{" + (|> slots + (map (_lux_: (-> (, Syntax Syntax) Text) + (lambda [slot] + (let [[k v] slot] + ($ text:++ (syntax:show k) " " (syntax:show v)))))) + (interpose " ") + (fold text:++ "")) + "}") + )) (def__ #export (macro-expand syntax) (-> Syntax ($' Lux ($' List Syntax))) - (case' syntax - (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))]) - (do Lux:Monad - [macro-name' (normalize macro-name) - ?macro (find-macro macro-name')] - (case' ?macro - (#Some macro) - (do Lux:Monad - [expansion (macro args) - expansion' (map% Lux:Monad macro-expand expansion)] - (;return (list:join expansion'))) - - #None - (do Lux:Monad - [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))] - (;return (list ($form (list:join parts'))))))) - - (#Meta [_ (#Form (#Cons [harg targs]))]) - (do Lux:Monad - [harg+ (macro-expand harg) - targs+ (map% Lux:Monad macro-expand targs)] - (;return (list ($form (list:++ harg+ (list:join targs+)))))) - - (#Meta [_ (#Tuple members)]) - (do Lux:Monad - [members' (map% Lux:Monad macro-expand members)] - (;return (list ($tuple (list:join members'))))) - - _ - (return (list syntax)))) + (_lux_case syntax + (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))]) + (do Lux:Monad + [macro-name' (normalize macro-name) + ?macro (find-macro macro-name')] + (_lux_case ?macro + (#Some macro) + (do Lux:Monad + [expansion (macro args) + expansion' (map% Lux:Monad macro-expand expansion)] + (;return (list:join expansion'))) + + #None + (do Lux:Monad + [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))] + (;return (list ($form (list:join parts'))))))) + + (#Meta [_ (#Form (#Cons [harg targs]))]) + (do Lux:Monad + [harg+ (macro-expand harg) + targs+ (map% Lux:Monad macro-expand targs)] + (;return (list ($form (list:++ harg+ (list:join targs+)))))) + + (#Meta [_ (#Tuple members)]) + (do Lux:Monad + [members' (map% Lux:Monad macro-expand members)] + (;return (list ($tuple (list:join members'))))) + + _ + (return (list syntax)))) (def__ (walk-type type) (-> Syntax Syntax) - (case' type - (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) parts]))]) - ($form (#Cons [($tag tag) (map walk-type parts)])) + (_lux_case type + (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) parts]))]) + ($form (#Cons [($tag tag) (map walk-type parts)])) - (#Meta [_ (#Tuple members)]) - ($tuple (map walk-type members)) + (#Meta [_ (#Tuple members)]) + ($tuple (map walk-type members)) - (#Meta [_ (#Form (#Cons [type-fn args]))]) - (fold (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)]))) - (walk-type type-fn) - (map walk-type args)) - - _ - type)) + (#Meta [_ (#Form (#Cons [type-fn args]))]) + (fold (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)]))) + (walk-type type-fn) + (map walk-type args)) + + _ + type)) (defmacro #export (type` tokens) - (case' tokens - (#Cons [type #Nil]) - (do Lux:Monad - [type+ (macro-expand type)] - (case' type+ - (#Cons [type' #Nil]) - (;return (list (walk-type type'))) - - _ - (fail "type`: The expansion of the type-syntax had to yield a single element."))) - - _ - (fail "Wrong syntax for type`"))) + (_lux_case tokens + (#Cons [type #Nil]) + (do Lux:Monad + [type+ (macro-expand type)] + (_lux_case type+ + (#Cons [type' #Nil]) + (;return (list (walk-type type'))) + + _ + (fail "type`: The expansion of the type-syntax had to yield a single element."))) + + _ + (fail "Wrong syntax for type`"))) (defmacro #export (: tokens) - (case' tokens - (#Cons [type (#Cons [value #Nil])]) - (return (list (`' (:' (;type` (~ type)) (~ value))))) + (_lux_case tokens + (#Cons [type (#Cons [value #Nil])]) + (return (list (`' (_lux_: (;type` (~ type)) (~ value))))) - _ - (fail "Wrong syntax for :"))) + _ + (fail "Wrong syntax for :"))) (defmacro #export (:! tokens) - (case' tokens - (#Cons [type (#Cons [value #Nil])]) - (return (list (`' (:!' (;type` (~ type)) (~ value))))) + (_lux_case tokens + (#Cons [type (#Cons [value #Nil])]) + (return (list (`' (_lux_:! (;type` (~ type)) (~ value))))) - _ - (fail "Wrong syntax for :!"))) + _ + (fail "Wrong syntax for :!"))) (defmacro #export (deftype tokens) (let [[export? tokens'] (: (, Bool (List Syntax)) - (case' tokens - (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens']) - [true tokens'] + (_lux_case tokens + (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens']) + [true tokens'] - _ - [false tokens])) + _ + [false tokens])) parts (: (Maybe (, Syntax (List Syntax) Syntax)) - (case' tokens' - (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])]) - (#Some [($symbol name) #Nil type]) - - (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])]) - (#Some [($symbol name) args type]) - - _ - #None))] - (case' parts - (#Some [name args type]) - (let [with-export (: (List Syntax) - (if export? - (list (`' (export' (~ name)))) - #Nil)) - type' (: Syntax - (case' args - #Nil - type - - _ - (`' (;All (~ name) [(~@ args)] (~ type)))))] - (return (list& (`' (def' (~ name) (;type` (~ type')))) - with-export))) - - #None - (fail "Wrong syntax for deftype")) + (_lux_case tokens' + (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])]) + (#Some [($symbol name) #Nil type]) + + (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])]) + (#Some [($symbol name) args type]) + + _ + #None))] + (_lux_case parts + (#Some [name args type]) + (let [with-export (: (List Syntax) + (if export? + (list (`' (_lux_export (~ name)))) + #Nil)) + type' (: Syntax + (_lux_case args + #Nil + type + + _ + (`' (;All (~ name) [(~@ args)] (~ type)))))] + (return (list& (`' (_lux_def (~ name) (;type` (~ type')))) + with-export))) + + #None + (fail "Wrong syntax for deftype")) )) (deftype #export (IO a) (-> (,) a)) (defmacro #export (io tokens) - (case' tokens - (#Cons [value #Nil]) - (let [blank ($symbol ["" ""])] - (return (list (`' (lambda' (~ blank) (~ blank) (~ value)))))) + (_lux_case tokens + (#Cons [value #Nil]) + (let [blank ($symbol ["" ""])] + (return (list (`' (_lux_lambda (~ blank) (~ blank) (~ value)))))) - _ - (fail "Wrong syntax for io"))) + _ + (fail "Wrong syntax for io"))) (defmacro #export (exec tokens) - (case' (reverse tokens) - (#Cons [value actions]) - (let [dummy ($symbol ["" ""])] - (return (list (fold (lambda [post pre] (`' (case' (~ pre) (~ dummy) (~ post)))) - value - actions)))) + (_lux_case (reverse tokens) + (#Cons [value actions]) + (let [dummy ($symbol ["" ""])] + (return (list (fold (lambda [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post)))) + value + actions)))) - _ - (fail "Wrong syntax for exec"))) + _ + (fail "Wrong syntax for exec"))) (defmacro #export (def tokens) (let [[export? tokens'] (: (, Bool (List Syntax)) - (case' tokens - (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens']) - [true tokens'] + (_lux_case tokens + (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens']) + [true tokens'] - _ - [false tokens])) + _ + [false tokens])) parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax)) - (case' tokens' - (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])]) - (#Some [name args (#Some type) body]) - - (#Cons [name (#Cons [type (#Cons [body #Nil])])]) - (#Some [name #Nil (#Some type) body]) - - (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])]) - (#Some [name args #None body]) - - (#Cons [name (#Cons [body #Nil])]) - (#Some [name #Nil #None body]) - - _ - #None))] - (case' parts - (#Some [name args ?type body]) - (let [body' (: Syntax - (case' args - #Nil - body - - _ - (`' (;lambda (~ name) [(~@ args)] (~ body))))) - body'' (: Syntax - (case' ?type - (#Some type) - (`' (: (~ type) (~ body'))) - - #None - body'))] - (return (list& (`' (def' (~ name) (~ body''))) - (if export? - (list (`' (export' (~ name)))) - #Nil)))) - - #None - (fail "Wrong syntax for def")))) + (_lux_case tokens' + (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])]) + (#Some [name args (#Some type) body]) + + (#Cons [name (#Cons [type (#Cons [body #Nil])])]) + (#Some [name #Nil (#Some type) body]) + + (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])]) + (#Some [name args #None body]) + + (#Cons [name (#Cons [body #Nil])]) + (#Some [name #Nil #None body]) + + _ + #None))] + (_lux_case parts + (#Some [name args ?type body]) + (let [body' (: Syntax + (_lux_case args + #Nil + body + + _ + (`' (;lambda (~ name) [(~@ args)] (~ body))))) + body'' (: Syntax + (_lux_case ?type + (#Some type) + (`' (: (~ type) (~ body'))) + + #None + body'))] + (return (list& (`' (_lux_def (~ name) (~ body''))) + (if export? + (list (`' (_lux_export (~ name)))) + #Nil)))) + + #None + (fail "Wrong syntax for def")))) (def (rejoin-pair pair) (-> (, Syntax Syntax) (List Syntax)) @@ -1588,28 +1597,28 @@ (list left right))) (defmacro #export (case tokens) - (case' tokens - (#Cons [value branches]) - (do Lux:Monad - [expansions (map% Lux:Monad - (: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax)))) - (lambda expander [branch] - (let [[pattern body] branch] - (case' pattern - (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) macro-args]))]) - (do Lux:Monad - [expansion (macro-expand ($form (list& ($symbol macro-name) body macro-args))) - expansions (map% Lux:Monad expander (as-pairs expansion))] - (;return (list:join expansions))) - - _ - (;return (list branch)))))) - (as-pairs branches))] - (;return (list (`' (case' (~ value) - (~@ (|> expansions list:join (map rejoin-pair) list:join))))))) - - _ - (fail "Wrong syntax for case"))) + (_lux_case tokens + (#Cons [value branches]) + (do Lux:Monad + [expansions (map% Lux:Monad + (: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax)))) + (lambda expander [branch] + (let [[pattern body] branch] + (_lux_case pattern + (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) macro-args]))]) + (do Lux:Monad + [expansion (macro-expand ($form (list& ($symbol macro-name) body macro-args))) + expansions (map% Lux:Monad expander (as-pairs expansion))] + (;return (list:join expansions))) + + _ + (;return (list branch)))))) + (as-pairs branches))] + (;return (list (`' (_lux_case (~ value) + (~@ (|> expansions list:join (map rejoin-pair) list:join))))))) + + _ + (fail "Wrong syntax for case"))) (defmacro #export (\ tokens) (case tokens @@ -1650,8 +1659,8 @@ (def (int:show int) (-> Int Text) - (jvm-invokevirtual java.lang.Object toString [] - int [])) + (_jvm_invokevirtual java.lang.Object toString [] + int [])) (defmacro #export (` tokens) (do Lux:Monad @@ -1692,7 +1701,7 @@ (: (-> Syntax (Lux (, Ident Syntax))) (lambda [token] (case token - (\ (#Meta [_ (#Form (list (#Meta [_ (#Symbol ["" ":'"])]) type (#Meta [_ (#Symbol name)])))])) + (\ (#Meta [_ (#Form (list (#Meta [_ (#Symbol ["" "_lux_:"])]) type (#Meta [_ (#Symbol name)])))])) (do Lux:Monad [name' (normalize name)] (;return (: (, Ident Syntax) [name' type]))) @@ -1734,9 +1743,9 @@ _ (`' (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))] - (return (list& (`' (def' (~ name) (~ sigs'))) + (return (list& (`' (_lux_def (~ name) (~ sigs'))) (if export? - (list (`' (export' (~ name)))) + (list (`' (_lux_export (~ name)))) #Nil)))) #None @@ -1749,7 +1758,7 @@ (: (-> Syntax (Lux (, Syntax Syntax))) (lambda [token] (case token - (\ (#Meta [_ (#Form (list (#Meta [_ (#Symbol ["" "def'"])]) (#Meta [_ (#Symbol name)]) value))])) + (\ (#Meta [_ (#Form (list (#Meta [_ (#Symbol ["" "_lux_def"])]) (#Meta [_ (#Symbol name)]) value))])) (do Lux:Monad [name' (normalize name)] (;return (: (, Syntax Syntax) [($tag name') value]))) @@ -1788,7 +1797,7 @@ (`' (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))] (return (list& (`' (def (~ name) (~ type) (~ defs'))) (if export? - (list (`' (export' (~ name)))) + (list (`' (_lux_export (~ name)))) #Nil)))) #None @@ -1803,8 +1812,8 @@ (def (= x y) (<test> x y)))] - [Int:Eq Int jvm-leq] - [Real:Eq Real jvm-deq]) + [Int:Eq Int _jvm_leq] + [Real:Eq Real _jvm_deq]) (def #export (id x) (All [a] (-> a a)) @@ -1852,17 +1861,20 @@ [(defstruct #export <name> (Ord <type>) (def (< x y) (<lt> x y)) + (def (<= x y) (or (<lt> x y) (<eq> x y))) + (def (> x y) (<gt> x y)) + (def (>= x y) (or (<gt> x y) (<eq> x y))))] - [Int:Ord Int jvm-llt jvm-lgt jvm-leq] - [Real:Ord Real jvm-dlt jvm-dgt jvm-deq]) + [Int:Ord Int _jvm_llt _jvm_lgt _jvm_leq] + [Real:Ord Real _jvm_dlt _jvm_dgt _jvm_deq]) (defmacro #export (alias-lux tokens state) (case state @@ -1880,8 +1892,7 @@ (list))))) lux)] (#Right [state (map (lambda [name] - (` ((~ ($symbol ["" "def'"])) (~ ($symbol ["" name])) - (~ ($symbol ["lux" name]))))) + (` ((~ ($symbol ["" "_lux_def"])) (~ ($symbol ["" name])) (~ ($symbol ["lux" name]))))) (list:join to-alias))])) #None @@ -1890,8 +1901,8 @@ (def #export (print x) (-> Text (,)) - (jvm-invokevirtual java.io.PrintStream print [java.lang.Object] - (jvm-getstatic java.lang.System out) [x])) + (_jvm_invokevirtual java.io.PrintStream print [java.lang.Object] + (_jvm_getstatic java.lang.System out) [x])) (def #export (println x) (-> Text (,)) @@ -1915,18 +1926,18 @@ (def (index-of part text) (-> Text Text Int) - (jvm-i2l (jvm-invokevirtual java.lang.String indexOf [java.lang.String] - text [part]))) + (_jvm_i2l (_jvm_invokevirtual java.lang.String indexOf [java.lang.String] + text [part]))) (def (substring1 idx text) (-> Int Text Text) - (jvm-invokevirtual java.lang.String substring [int] - text [(jvm-l2i idx)])) + (_jvm_invokevirtual java.lang.String substring [int] + text [(_jvm_l2i idx)])) (def (substring2 idx1 idx2 text) (-> Int Int Text Text) - (jvm-invokevirtual java.lang.String substring [int int] - text [(jvm-l2i idx1) (jvm-l2i idx2)])) + (_jvm_invokevirtual java.lang.String substring [int int] + text [(_jvm_l2i idx1) (_jvm_l2i idx2)])) (def (split-slot slot) (-> Text (, Text Text)) @@ -1986,22 +1997,22 @@ [($tag [module name]) ($symbol ["" name])]))) slots)) _ (println (text:++ "Using pattern: " (syntax:show pattern)))] - (#Right [state (list (` (case' (~ struct) (~ pattern) (~ body))))])) + (#Right [state (list (` (_lux_case (~ struct) (~ pattern) (~ body))))])) _ (#Left "Can only \"use\" records.")))))) _ (let [dummy ($symbol ["" ""])] - (#Right [state (list (` (case' (~ struct) - (~ dummy) - (using (~ dummy) (~ body)))))]))) + (#Right [state (list (` (_lux_case (~ struct) + (~ dummy) + (using (~ dummy) (~ body)))))]))) _ (#Left "Wrong syntax for defsig"))) ## (defmacro (loop tokens) -## (case' tokens +## (_lux_case tokens ## (#Cons [bindings (#Cons [body #Nil])]) ## (let [pairs (as-pairs bindings)] ## (return (list (#Form (#Cons [(` (lambda (~ (#Symbol ["" "recur"])) (~ (#Tuple (map first pairs))) @@ -2009,7 +2020,7 @@ ## (map second pairs)]))))))) ## (defmacro (get@ tokens) -## (let [output (case' tokens +## (let [output (_lux_case tokens ## (#Cons [tag (#Cons [record #Nil])]) ## (` (get@' (~ tag) (~ record))) @@ -2018,7 +2029,7 @@ ## (return (list output)))) ## (defmacro (set@ tokens) -## (let [output (case' tokens +## (let [output (_lux_case tokens ## (#Cons [tag (#Cons [value (#Cons [record #Nil])])]) ## (` (set@' (~ tag) (~ value) (~ record))) @@ -2030,7 +2041,7 @@ ## (return (list output)))) ## (defmacro (update@ tokens) -## (let [output (case' tokens +## (let [output (_lux_case tokens ## (#Cons [tag (#Cons [func (#Cons [record #Nil])])]) ## (` (let [_record_ (~ record)] ## (set@' (~ tag) ((~ func) (get@' (~ tag) _record_)) _record_))) |