diff options
author | Eduardo Julian | 2015-05-22 20:07:08 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-05-22 20:07:08 -0400 |
commit | f52eb6df2e57f67e7cf30d85c6340ce00f923d6f (patch) | |
tree | ca519afee2afd631446ff6cce18161ee1558a212 | |
parent | c4ac3e692ae96d6898d8efb42faf4dfadd43f4ae (diff) |
- Corrected the indentation issues in the lux files.
- Temporarily reverted back to forward apply-analysis.
- Fixed an error in lux.base/show-ast.
- Reader now only returns a tuple instead of a full-blown #Meta variant.
- Reader now doesn't cut the strings that it reads. Instead, the "cursor" just moves around, indicating where to read.
- Inlined some calculations that previously relied on try-all%.
-rw-r--r-- | source/lux.lux | 2069 | ||||
-rw-r--r-- | source/program.lux | 8 | ||||
-rw-r--r-- | src/lux.clj | 5 | ||||
-rw-r--r-- | src/lux/analyser.clj | 1 | ||||
-rw-r--r-- | src/lux/analyser/lux.clj | 86 | ||||
-rw-r--r-- | src/lux/base.clj | 20 | ||||
-rw-r--r-- | src/lux/compiler.clj | 4 | ||||
-rw-r--r-- | src/lux/compiler/lux.clj | 9 | ||||
-rw-r--r-- | src/lux/lexer.clj | 56 | ||||
-rw-r--r-- | src/lux/reader.clj | 75 | ||||
-rw-r--r-- | src/lux/type.clj | 128 |
11 files changed, 1301 insertions, 1160 deletions
diff --git a/source/lux.lux b/source/lux.lux index 1385cf8a5..e3f3ba243 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -37,22 +37,22 @@ ## (| #Nil ## (#Cons (, a (List a))))) (_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])]))])) + (#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))) (_lux_def Maybe - (#AllT [#None "Maybe" "a" - (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] - (#Cons [["lux;Some" (#BoundT "a")] - #Nil])]))])) + (#AllT [#None "Maybe" "a" + (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] + (#Cons [["lux;Some" (#BoundT "a")] + #Nil])]))])) (_lux_export Maybe) ## (deftype #rec Type @@ -66,37 +66,37 @@ ## (#AllT (, (Maybe (List (, Text Type))) Text Text Type)) ## (#AppT (, Type 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_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)))) (_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])]))])])) + (#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 @@ -104,30 +104,30 @@ ## #locals (Bindings k v) ## #closure (Bindings k v))) (_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])])])]))])])) + (#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)) (_lux_def Cursor - (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))) + (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))) ## (deftype (Meta m v) ## (| (#Meta (, m v)))) (_lux_def Meta - (#AllT [#None "Meta" "m" - (#AllT [#None "" "v" - (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") - (#Cons [(#BoundT "v") - #Nil])]))] - #Nil]))])])) + (#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) @@ -142,34 +142,34 @@ ## (#TupleS (List (w (Syntax' w)))) ## (#RecordS (List (, (w (Syntax' w)) (w (Syntax' w))))))) (_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;BoolS" Bool] - (#Cons [["lux;IntS" Int] - (#Cons [["lux;RealS" Real] - (#Cons [["lux;CharS" Char] - (#Cons [["lux;TextS" Text] - (#Cons [["lux;SymbolS" Ident] - (#Cons [["lux;TagS" Ident] - (#Cons [["lux;FormS" SyntaxList] - (#Cons [["lux;TupleS" SyntaxList] - (#Cons [["lux;RecordS" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])] - #Nil]) - ])])])])])])])])]) - )])))) + (_lux_case (#AppT [(#BoundT "w") + (#AppT [(#BoundT "Syntax'") + (#BoundT "w")])]) + Syntax + (_lux_case (#AppT [List Syntax]) + SyntaxList + (#AllT [#None "Syntax'" "w" + (#VariantT (#Cons [["lux;BoolS" Bool] + (#Cons [["lux;IntS" Int] + (#Cons [["lux;RealS" Real] + (#Cons [["lux;CharS" Char] + (#Cons [["lux;TextS" Text] + (#Cons [["lux;SymbolS" Ident] + (#Cons [["lux;TagS" Ident] + (#Cons [["lux;FormS" SyntaxList] + (#Cons [["lux;TupleS" SyntaxList] + (#Cons [["lux;RecordS" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])] + #Nil]) + ])])])])])])])])]) + )])))) (_lux_export Syntax') ## (deftype Syntax ## (Meta Cursor (Syntax' (Meta Cursor)))) (_lux_def Syntax - (_lux_case (#AppT [Meta Cursor]) - w - (#AppT [w (#AppT [Syntax' w])]))) + (_lux_case (#AppT [Meta Cursor]) + w + (#AppT [w (#AppT [Syntax' w])]))) (_lux_export Syntax) (_lux_def SyntaxList (#AppT [List Syntax])) @@ -178,39 +178,39 @@ ## (| (#Left l) ## (#Right r))) (_lux_def Either - (#AllT [#None "_" "l" - (#AllT [#None "" "r" - (#VariantT (#Cons [["lux;Left" (#BoundT "l")] - (#Cons [["lux;Right" (#BoundT "r")] - #Nil])]))])])) + (#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)))) (_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])]))])])])])) + (#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))) (_lux_def Reader - (#AppT [List - (#AppT [(#AppT [Meta Cursor]) - Text])])) + (#AppT [List + (#AppT [(#AppT [Meta Cursor]) + Text])])) (_lux_export Reader) ## (deftype HostState ## (& #writer (^ org.objectweb.asm.ClassWriter) ## #loader (^ java.net.URLClassLoader))) (_lux_def HostState - (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")] - (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] - #Nil])]))) + (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")] + (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] + #Nil])]))) ## (deftype (DefData' m) ## (| #TypeD @@ -218,20 +218,20 @@ ## (#MacroD m) ## (#AliasD Ident))) (_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])])])]))])) + (#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))) (_lux_def LuxVar - (#VariantT (#Cons [["lux;Local" Int] - (#Cons [["lux;Global" Ident] - #Nil])]))) + (#VariantT (#Cons [["lux;Local" Int] + (#Cons [["lux;Global" Ident] + #Nil])]))) (_lux_export LuxVar) ## (deftype #rec CompilerState @@ -242,33 +242,33 @@ ## #types (Bindings Int Type) ## #host HostState)) (_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])) + (#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)))) (_lux_def Macro - (#LambdaT [SyntaxList - (#AppT [(#AppT [StateE CompilerState]) - SyntaxList])])) + (#LambdaT [SyntaxList + (#AppT [(#AppT [StateE CompilerState]) + SyntaxList])])) (_lux_export Macro) ## Base functions & macros @@ -276,11 +276,11 @@ ## (-> (Syntax' (Meta Cursor)) Syntax) ## (#Meta [["" -1 -1] data])) (_lux_def _meta - (_lux_: (#LambdaT [(#AppT [Syntax' - (#AppT [Meta Cursor])]) - Syntax]) - (_lux_lambda _ data - (#Meta [["" -1 -1] data])))) + (_lux_: (#LambdaT [(#AppT [Syntax' + (#AppT [Meta Cursor])]) + Syntax]) + (_lux_lambda _ data + (#Meta [["" -1 -1] data])))) ## (def (return x) ## (All [a] @@ -288,16 +288,16 @@ ## (Either Text (, CompilerState a)))) ## ...) (_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]))))) + (_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] @@ -305,260 +305,275 @@ ## (Either Text (, CompilerState a)))) ## ...) (_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_: (#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 (#TextS text))))) + (_lux_: (#LambdaT [Text Syntax]) + (_lux_lambda _ text + (_meta (#TextS text))))) (_lux_def $symbol - (_lux_: (#LambdaT [Ident Syntax]) - (_lux_lambda _ ident - (_meta (#SymbolS ident))))) + (_lux_: (#LambdaT [Ident Syntax]) + (_lux_lambda _ ident + (_meta (#SymbolS ident))))) (_lux_def $tag - (_lux_: (#LambdaT [Ident Syntax]) - (_lux_lambda _ ident - (_meta (#TagS ident))))) + (_lux_: (#LambdaT [Ident Syntax]) + (_lux_lambda _ ident + (_meta (#TagS ident))))) (_lux_def $form - (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax]) - (_lux_lambda _ tokens - (_meta (#FormS tokens))))) + (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax]) + (_lux_lambda _ tokens + (_meta (#FormS tokens))))) (_lux_def $tuple - (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax]) - (_lux_lambda _ tokens - (_meta (#TupleS tokens))))) + (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax]) + (_lux_lambda _ tokens + (_meta (#TupleS tokens))))) (_lux_def $record - (_lux_: (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax]) - (_lux_lambda _ tokens - (_meta (#RecordS tokens))))) + (_lux_: (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax]) + (_lux_lambda _ tokens + (_meta (#RecordS 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_: Macro + (_lux_lambda _ tokens + (_lux_case tokens + (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) + (return (_lux_: SyntaxList + (#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 [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"])) - (#Cons [(_meta (#SymbolS ["" ""])) - (#Cons [arg - (#Cons [(_lux_case args' - #Nil - body - - _ - (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) - (#Cons [(_meta (#TupleS args')) - (#Cons [body #Nil])])])))) - #Nil])])])]))) - #Nil])) - - (#Cons [(#Meta [_ (#SymbolS self)]) (#Cons [(#Meta [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"])) - (#Cons [(_meta (#SymbolS self)) - (#Cons [arg - (#Cons [(_lux_case args' - #Nil - body - - _ - (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) - (#Cons [(_meta (#TupleS args')) - (#Cons [body #Nil])])])))) - #Nil])])])]))) - #Nil])) - - _ - (fail "Wrong syntax for lambda"))))) + (_lux_: Macro + (_lux_lambda _ tokens + (_lux_case tokens + (#Cons [(#Meta [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])]) + (return (_lux_: SyntaxList + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"])) + (#Cons [(_meta (#SymbolS ["" ""])) + (#Cons [arg + (#Cons [(_lux_case args' + #Nil + body + + _ + (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) + (#Cons [(_meta (#TupleS args')) + (#Cons [body #Nil])])])))) + #Nil])])])]))) + #Nil]))) + + (#Cons [(#Meta [_ (#SymbolS self)]) (#Cons [(#Meta [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])])]) + (return (_lux_: SyntaxList + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"])) + (#Cons [(_meta (#SymbolS self)) + (#Cons [arg + (#Cons [(_lux_case args' + #Nil + body + + _ + (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) + (#Cons [(_meta (#TupleS 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 [_ (#TagS ["" "export"])]) - (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) - (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) - (#Cons [name - (#Cons [(_meta (#TupleS args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - #Nil])])]))) - (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])]))) - #Nil])])) - - (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - #Nil])])]))) - (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])]))) - #Nil])])) - - (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) - (#Cons [type (#Cons [body #Nil])])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) - (#Cons [name - (#Cons [(_meta (#TupleS args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - #Nil])])]))) - #Nil])) - - (#Cons [name (#Cons [type (#Cons [body #Nil])])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) - (#Cons [name - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) - (#Cons [type - (#Cons [body - #Nil])])]))) - #Nil])])]))) - #Nil])) - - _ - (fail "Wrong syntax for def") - )))) + (_lux_: Macro + (lambda_ [tokens] + (_lux_case tokens + (#Cons [(#Meta [_ (#TagS ["" "export"])]) + (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) + (#Cons [type (#Cons [body #Nil])])])]) + (return (_lux_: SyntaxList + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) + (#Cons [name + (#Cons [(_meta (#TupleS args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])])]))) + (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])]))) + #Nil])]))) + + (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) + (return (_lux_: SyntaxList + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + #Nil])])]))) + (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])]))) + #Nil])]))) + + (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) + (#Cons [type (#Cons [body #Nil])])]) + (return (_lux_: SyntaxList + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda_"])) + (#Cons [name + (#Cons [(_meta (#TupleS args)) + (#Cons [body #Nil])])])]))) + #Nil])])]))) + #Nil])])]))) + #Nil]))) + + (#Cons [name (#Cons [type (#Cons [body #Nil])])]) + (return (_lux_: SyntaxList + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"])) + (#Cons [name + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"])) + (#Cons [type + (#Cons [body + #Nil])])]))) + #Nil])])]))) + #Nil]))) + + _ + (fail "Wrong syntax for def") + )))) (_lux_declare-macro def_) (def_ #export (defmacro tokens) Macro (_lux_case tokens - (#Cons [(#Meta [_ (#FormS (#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 [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#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"))) + (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])]) + (return (_lux_: SyntaxList + (#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 [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])]) + (return (_lux_: SyntaxList + (#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)) + (return (_lux_: SyntaxList #Nil))) (defmacro (->' tokens) (_lux_case tokens - (#Cons [input (#Cons [output #Nil])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"])) - (#Cons [(_meta (#TupleS (#Cons [input (#Cons [output #Nil])]))) - #Nil])]))) - #Nil])) - - (#Cons [input (#Cons [output others])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"])) - (#Cons [(_meta (#TupleS (#Cons [input - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "->'"])) - (#Cons [output others])]))) - #Nil])]))) - #Nil])]))) - #Nil])) - - _ - (fail "Wrong syntax for ->'"))) + (#Cons [input (#Cons [output #Nil])]) + (return (_lux_: SyntaxList + (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"])) + (#Cons [(_meta (#TupleS (#Cons [input (#Cons [output #Nil])]))) + #Nil])]))) + #Nil]))) + + (#Cons [input (#Cons [output others])]) + (return (_lux_: SyntaxList + (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"])) + (#Cons [(_meta (#TupleS (#Cons [input + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "->'"])) + (#Cons [output others])]))) + #Nil])]))) + #Nil])]))) + #Nil]))) + + _ + (fail "Wrong syntax for ->'"))) (defmacro (All' tokens) (_lux_case tokens - (#Cons [(#Meta [_ (#TupleS #Nil)]) - (#Cons [body #Nil])]) - (return (#Cons [body - #Nil])) - - (#Cons [(#Meta [_ (#TupleS (#Cons [(#Meta [_ (#SymbolS ["" arg-name])]) other-args]))]) - (#Cons [body #Nil])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AllT"])) - (#Cons [(_meta (#TupleS (#Cons [(_meta (#TagS ["lux" "None"])) - (#Cons [(_meta (#TextS "")) - (#Cons [(_meta (#TextS arg-name)) - (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "All'"])) - (#Cons [(_meta (#TupleS other-args)) - (#Cons [body - #Nil])])]))) - #Nil])])])]))) - #Nil])]))) - #Nil])) - - _ - (fail "Wrong syntax for All'"))) + (#Cons [(#Meta [_ (#TupleS #Nil)]) + (#Cons [body #Nil])]) + (return (_lux_: SyntaxList + (#Cons [body + #Nil]))) + + (#Cons [(#Meta [_ (#TupleS (#Cons [(#Meta [_ (#SymbolS ["" arg-name])]) other-args]))]) + (#Cons [body #Nil])]) + (return (_lux_: SyntaxList + (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AllT"])) + (#Cons [(_meta (#TupleS (#Cons [(_meta (#TagS ["lux" "None"])) + (#Cons [(_meta (#TextS "")) + (#Cons [(_meta (#TextS arg-name)) + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "All'"])) + (#Cons [(_meta (#TupleS other-args)) + (#Cons [body + #Nil])])]))) + #Nil])])])]))) + #Nil])]))) + #Nil]))) + + _ + (fail "Wrong syntax for All'"))) (defmacro (B' tokens) (_lux_case tokens - (#Cons [(#Meta [_ (#SymbolS ["" bound-name])]) - #Nil]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "BoundT"])) - (#Cons [(_meta (#TextS bound-name)) - #Nil])]))) - #Nil])) + (#Cons [(#Meta [_ (#SymbolS ["" bound-name])]) + #Nil]) + (return (_lux_: SyntaxList + (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "BoundT"])) + (#Cons [(_meta (#TextS bound-name)) + #Nil])]))) + #Nil]))) - _ - (fail "Wrong syntax for B'"))) + _ + (fail "Wrong syntax for B'"))) (defmacro ($' tokens) (_lux_case tokens - (#Cons [x #Nil]) - (return tokens) + (#Cons [x #Nil]) + (return tokens) + + (#Cons [x (#Cons [y xs])]) + (return (_lux_: SyntaxList + (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "$'"])) + (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AppT"])) + (#Cons [(_meta (#TupleS (#Cons [x (#Cons [y #Nil])]))) + #Nil])]))) + xs])]))) + #Nil]))) - (#Cons [x (#Cons [y xs])]) - (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "$'"])) - (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AppT"])) - (#Cons [(_meta (#TupleS (#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] @@ -567,169 +582,182 @@ ($' List (B' b)) (B' a))) (_lux_case xs - #Nil - init + #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] (->' ($' List (B' a)) ($' List (B' a)))) - (fold (lambda_ [tail head] (#Cons [head tail])) + (fold (_lux_: (All' [a] + (->' ($' List (B' a)) (B' a) ($' List (B' a)))) + (lambda_ [tail head] + (#Cons [head tail]))) #Nil list)) (defmacro #export (list xs) - (return (#Cons [(fold (lambda_ [tail head] - (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"])) - (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])]))) - #Nil])])))) - (_meta (#TagS ["lux" "Nil"])) - (reverse xs)) - #Nil]))) + (return (_lux_: SyntaxList + (#Cons [(fold (lambda_ [tail head] + (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"])) + (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])]))) + #Nil])])))) + (_meta (#TagS ["lux" "Nil"])) + (reverse xs)) + #Nil])))) (defmacro #export (list& xs) (_lux_case (reverse xs) - (#Cons [last init]) - (return (list (fold (lambda_ [tail head] - (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) - (_meta (#TupleS (list head tail))))))) - last - init))) + (#Cons [last init]) + (return (_lux_: SyntaxList + (list (fold (lambda_ [tail head] + (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) + (_meta (#TupleS (list head tail))))))) + last + init)))) - _ - (fail "Wrong syntax for list&"))) + _ + (fail "Wrong syntax for list&"))) (defmacro #export (lambda tokens) (let' [name tokens'] (_lux_: (#TupleT (list Ident ($' List Syntax))) (_lux_case tokens - (#Cons [(#Meta [_ (#SymbolS name)]) tokens']) - [name tokens'] + (#Cons [(#Meta [_ (#SymbolS name)]) tokens']) + [name tokens'] - _ - [["" ""] tokens])) + _ + [["" ""] tokens])) (_lux_case tokens' - (#Cons [(#Meta [_ (#TupleS 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")))) + (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])]) + (_lux_case args + #Nil + (fail "lambda requires a non-empty arguments tuple.") + + (#Cons [harg targs]) + (return (_lux_: SyntaxList + (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) (_lux_case tokens - (#Cons [(#Meta [_ (#TagS ["" "export"])]) - (#Cons [(#Meta [_ (#FormS (#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 [_ (#TagS ["" "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 [_ (#FormS (#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") - )) + (#Cons [(#Meta [_ (#TagS ["" "export"])]) + (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) + (#Cons [type (#Cons [body #Nil])])])]) + (return (_lux_: SyntaxList + (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 [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])]) + (return (_lux_: SyntaxList + (list ($form (list ($symbol ["" "_lux_def"]) + name + ($form (list ($symbol ["" "_lux_:"]) + type + body)))) + ($form (list ($symbol ["" "_lux_export"]) name))))) + + (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) + (#Cons [type (#Cons [body #Nil])])]) + (return (_lux_: SyntaxList + (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 (_lux_: SyntaxList + (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)))))) (_lux_case xs - (#Cons [x (#Cons [y xs'])]) - (#Cons [[x y] (as-pairs xs')]) + (#Cons [x (#Cons [y xs'])]) + (#Cons [[x y] (as-pairs xs')]) - _ - #Nil)) + _ + #Nil)) (defmacro #export (let tokens) (_lux_case tokens - (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])]) - (return (list (fold (_lux_: (->' Syntax (#TupleT (list Syntax Syntax)) - Syntax) - (lambda [body binding] - (_lux_case binding - [label value] - (_meta (#FormS (list (_meta (#SymbolS ["lux" "let'"])) label value body)))))) - body - (fold (lambda [tail head] (#Cons [head tail])) - #Nil - (as-pairs bindings))))) - - _ - (fail "Wrong syntax for let"))) + (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])]) + (return (_lux_: SyntaxList + (list (fold (_lux_: (->' Syntax (#TupleT (list Syntax Syntax)) + Syntax) + (lambda [body binding] + (_lux_case binding + [label value] + (_meta (#FormS (list (_meta (#SymbolS ["lux" "let'"])) label value body)))))) + body + (fold (_lux_: (All' [a] + (->' ($' List (B' a)) (B' a) ($' List (B' a)))) + (lambda [tail head] (#Cons [head tail]))) + #Nil + (as-pairs bindings)))))) + + _ + (fail "Wrong syntax for let"))) (def__ #export (map f xs) (All' [a b] (->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b)))) (_lux_case xs - #Nil - #Nil + #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)) (_lux_case xs - #Nil - false + #Nil + false - (#Cons [x xs']) - (_lux_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) (_lux_case token - (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [_ #Nil])]))]) - true + (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [_ #Nil])]))]) + true - _ - false)) + _ + false)) (def__ (wrap-meta content) (->' Syntax Syntax) @@ -740,141 +768,147 @@ (def__ (untemplate-list tokens) (->' ($' List Syntax) Syntax) (_lux_case tokens - #Nil - (_meta (#TagS ["lux" "Nil"])) + #Nil + (_meta (#TagS ["lux" "Nil"])) - (#Cons [token tokens']) - (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) - (_meta (#TupleS (list token (untemplate-list tokens'))))))))) + (#Cons [token tokens']) + (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) + (_meta (#TupleS (list token (untemplate-list tokens'))))))))) (def__ (list:++ xs ys) (All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a)))) (_lux_case xs - (#Cons [x xs']) - (#Cons [x (list:++ xs' ys)]) + (#Cons [x xs']) + (#Cons [x (list:++ xs' ys)]) - #Nil - ys)) + #Nil + ys)) (defmacro #export ($ tokens) (_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 $"))) + (#Cons [op (#Cons [init args])]) + (return (_lux_: SyntaxList + (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) (_lux_case (any? spliced? elems) - true - (let [elems' (map (lambda [elem] - (_lux_case elem - (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))]) - spliced - - _ - ($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))))))) + true + (let [elems' (map (_lux_: (->' Syntax Syntax) + (lambda [elem] + (_lux_case elem + (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))]) + spliced + + _ + ($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) (_lux_case token - (#Meta [_ (#BoolS value)]) - (wrap-meta ($form (list ($tag ["lux" "BoolS"]) (_meta (#BoolS value))))) + (#Meta [_ (#BoolS value)]) + (wrap-meta ($form (list ($tag ["lux" "BoolS"]) (_meta (#BoolS value))))) - (#Meta [_ (#IntS value)]) - (wrap-meta ($form (list ($tag ["lux" "IntS"]) (_meta (#IntS value))))) + (#Meta [_ (#IntS value)]) + (wrap-meta ($form (list ($tag ["lux" "IntS"]) (_meta (#IntS value))))) - (#Meta [_ (#RealS value)]) - (wrap-meta ($form (list ($tag ["lux" "RealS"]) (_meta (#RealS value))))) + (#Meta [_ (#RealS value)]) + (wrap-meta ($form (list ($tag ["lux" "RealS"]) (_meta (#RealS value))))) - (#Meta [_ (#CharS value)]) - (wrap-meta ($form (list ($tag ["lux" "CharS"]) (_meta (#CharS value))))) + (#Meta [_ (#CharS value)]) + (wrap-meta ($form (list ($tag ["lux" "CharS"]) (_meta (#CharS value))))) - (#Meta [_ (#TextS value)]) - (wrap-meta ($form (list ($tag ["lux" "TextS"]) (_meta (#TextS value))))) + (#Meta [_ (#TextS value)]) + (wrap-meta ($form (list ($tag ["lux" "TextS"]) (_meta (#TextS value))))) - (#Meta [_ (#TagS [module name])]) - (let [module' (_lux_case module - "" - subst + (#Meta [_ (#TagS [module name])]) + (let [module' (_lux_case module + "" + subst - _ - module)] - (wrap-meta ($form (list ($tag ["lux" "TagS"]) ($tuple (list ($text module') ($text name))))))) + _ + module)] + (wrap-meta ($form (list ($tag ["lux" "TagS"]) ($tuple (list ($text module') ($text name))))))) - (#Meta [_ (#SymbolS [module name])]) - (let [module' (_lux_case module - "" - subst + (#Meta [_ (#SymbolS [module name])]) + (let [module' (_lux_case module + "" + subst - _ - module)] - (wrap-meta ($form (list ($tag ["lux" "SymbolS"]) ($tuple (list ($text module') ($text name))))))) + _ + module)] + (wrap-meta ($form (list ($tag ["lux" "SymbolS"]) ($tuple (list ($text module') ($text name))))))) - (#Meta [_ (#TupleS elems)]) - (splice (untemplate subst) ($tag ["lux" "TupleS"]) elems) + (#Meta [_ (#TupleS elems)]) + (splice (untemplate subst) ($tag ["lux" "TupleS"]) elems) - (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))]) - unquoted + (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))]) + unquoted - (#Meta [_ (#FormS elems)]) - (splice (untemplate subst) ($tag ["lux" "FormS"]) elems) + (#Meta [_ (#FormS elems)]) + (splice (untemplate subst) ($tag ["lux" "FormS"]) elems) - (#Meta [_ (#RecordS fields)]) - (wrap-meta ($form (list ($tag ["lux" "RecordS"]) - (untemplate-list (map (_lux_: (->' (#TupleT (list Syntax Syntax)) Syntax) - (lambda [kv] - (let [[k v] kv] - ($tuple (list (untemplate subst k) (untemplate subst v)))))) - fields))))) - )) + (#Meta [_ (#RecordS fields)]) + (wrap-meta ($form (list ($tag ["lux" "RecordS"]) + (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) (_lux_case tokens - (#Cons [template #Nil]) - (return (list (untemplate "" template))) + (#Cons [template #Nil]) + (return (_lux_: SyntaxList + (list (untemplate "" template)))) - _ - (fail "Wrong syntax for `'"))) + _ + (fail "Wrong syntax for `'"))) (defmacro #export (|> tokens) (_lux_case tokens - (#Cons [init apps]) - (return (list (fold (lambda [acc app] - (_lux_case app - (#Meta [_ (#FormS parts)]) - ($form (list:++ parts (list acc))) + (#Cons [init apps]) + (return (_lux_: SyntaxList + (list (fold (_lux_: (->' Syntax Syntax Syntax) + (lambda [acc app] + (_lux_case app + (#Meta [_ (#FormS 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) (_lux_case tokens - (#Cons [test (#Cons [then (#Cons [else #Nil])])]) - (return (list (`' (_lux_case (~ test) - true (~ then) - false (~ else))))) + (#Cons [test (#Cons [then (#Cons [else #Nil])])]) + (return (_lux_: SyntaxList + (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)))) @@ -905,8 +939,8 @@ #lux;bind (lambda [f ma] (_lux_case ma - #None #None - (#Some a) (f a)))}) + #None #None + (#Some a) (f a)))}) (def__ Lux:Monad ($' Monad Lux) @@ -919,56 +953,61 @@ (lambda [f ma] (lambda [state] (_lux_case (ma state) - (#Left msg) - (#Left msg) + (#Left msg) + (#Left msg) - (#Right [state' a]) - (f a state'))))}) + (#Right [state' a]) + (f a state'))))}) (defmacro #export (^ tokens) (_lux_case tokens - (#Cons [(#Meta [_ (#SymbolS ["" class-name])]) #Nil]) - (return (list (`' (#;DataT (~ (_meta (#TextS class-name))))))) + (#Cons [(#Meta [_ (#SymbolS ["" class-name])]) #Nil]) + (return (_lux_: SyntaxList + (list (`' (#;DataT (~ (_meta (#TextS class-name)))))))) - _ - (fail "Wrong syntax for ^"))) + _ + (fail "Wrong syntax for ^"))) (defmacro #export (-> tokens) (_lux_case (reverse tokens) - (#Cons [output inputs]) - (return (list (fold (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)]))) - output - inputs))) - - _ - (fail "Wrong syntax for ->"))) + (#Cons [output inputs]) + (return (_lux_: SyntaxList + (list (fold (_lux_: (->' Syntax Syntax Syntax) + (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)])))) + output + inputs)))) + + _ + (fail "Wrong syntax for ->"))) (defmacro #export (, tokens) - (return (list (`' (#;TupleT (;list (~@ tokens))))))) + (return (_lux_: SyntaxList + (list (`' (#;TupleT (;list (~@ tokens)))))))) (defmacro (do tokens) (_lux_case tokens - (#Cons [monad (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])]) - (let [body' (fold (_lux_: (-> Syntax (, Syntax Syntax) Syntax) - (lambda [body' binding] - (let [[var value] binding] - (_lux_case var - (#Meta [_ (#TagS ["" "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"))) + (#Cons [monad (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])]) + (let [body' (fold (_lux_: (-> Syntax (, Syntax Syntax) Syntax) + (lambda [body' binding] + (let [[var value] binding] + (_lux_case var + (#Meta [_ (#TagS ["" "let"])]) + (`' (;let (~ value) (~ body'))) + + _ + (`' (;bind (_lux_lambda (~ ($symbol ["" ""])) + (~ var) + (~ body')) + (~ value))))))) + body + (reverse (as-pairs bindings)))] + (return (_lux_: SyntaxList + (list (`' (_lux_case (~ monad) + {#;return ;return #;bind ;bind} + (~ body'))))))) + + _ + (fail "Wrong syntax for do"))) (def__ (map% m f xs) ## (All [m a b] @@ -980,15 +1019,15 @@ ($' (B' m) ($' List (B' b))))) (let [{#;return ;return #;bind _} m] (_lux_case xs - #Nil - (;return #Nil) - - (#Cons [x xs']) - (do m - [y (f x) - ys (map% m f xs')] - (;return (#Cons [y ys]))) - ))) + #Nil + (;return (_lux_: List #Nil)) + + (#Cons [x xs']) + (do m + [y (f x) + ys (map% m f xs')] + (;return (_lux_: List (#Cons [y ys])))) + ))) (def__ #export (. f g) (All' [a b c] @@ -999,20 +1038,20 @@ (def__ (get-ident x) (-> Syntax ($' Maybe Text)) (_lux_case x - (#Meta [_ (#SymbolS ["" sname])]) - (#Some sname) + (#Meta [_ (#SymbolS ["" sname])]) + (#Some sname) - _ - #None)) + _ + #None)) (def__ (tuple->list tuple) (-> Syntax ($' Maybe ($' List Syntax))) (_lux_case tuple - (#Meta [_ (#TupleS members)]) - (#Some members) + (#Meta [_ (#TupleS members)]) + (#Some members) - _ - #None)) + _ + #None)) (def__ RepEnv Type @@ -1022,11 +1061,11 @@ (-> ($' List Text) ($' List Syntax) RepEnv) (_lux_case (_lux_: (, ($' List Text) ($' List Syntax)) [xs ys]) - [(#Cons [x xs']) (#Cons [y ys'])] - (#Cons [[x y] (make-env xs' ys')]) + [(#Cons [x xs']) (#Cons [y ys'])] + (#Cons [[x y] (make-env xs' ys')]) - _ - #Nil)) + _ + #Nil)) (def__ (text:= x y) (-> Text Text Bool) @@ -1036,69 +1075,69 @@ (def__ (get-rep key env) (-> Text RepEnv ($' Maybe Syntax)) (_lux_case env - #Nil - #None + #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) (_lux_case template - (#Meta [_ (#SymbolS ["" sname])]) - (_lux_case (get-rep sname env) - (#Some subst) - subst + (#Meta [_ (#SymbolS ["" sname])]) + (_lux_case (get-rep sname env) + (#Some subst) + subst - _ - template) + _ + template) - (#Meta [_ (#TupleS elems)]) - ($tuple (map (apply-template env) elems)) + (#Meta [_ (#TupleS elems)]) + ($tuple (map (apply-template env) elems)) - (#Meta [_ (#FormS elems)]) - ($form (map (apply-template env) elems)) + (#Meta [_ (#FormS elems)]) + ($form (map (apply-template env) elems)) - (#Meta [_ (#RecordS members)]) - ($record (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax)) - (lambda [kv] - (let [[slot value] kv] - [(apply-template env slot) (apply-template env value)]))) - members)) + (#Meta [_ (#RecordS 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)))) (_lux_case xs - #Nil - #Nil + #Nil + #Nil - (#Cons [x xs']) - (list:++ (f x) (join-map f xs')))) + (#Cons [x xs']) + (list:++ (f x) (join-map f xs')))) (defmacro #export (do-template tokens) (_lux_case tokens - (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [(#Meta [_ (#TupleS 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 "Wrong syntax for do-template"))) + (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [(#Meta [_ (#TupleS 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 "Wrong syntax for do-template"))) (do-template [<name> <cmp> <type>] [(def__ #export (<name> x y) @@ -1155,87 +1194,91 @@ (def__ (replace-syntax reps syntax) (-> RepEnv Syntax Syntax) (_lux_case syntax - (#Meta [_ (#SymbolS ["" name])]) - (_lux_case (get-rep name reps) - (#Some replacement) - replacement + (#Meta [_ (#SymbolS ["" name])]) + (_lux_case (get-rep name reps) + (#Some replacement) + replacement - #None - syntax) - - (#Meta [_ (#FormS parts)]) - (#Meta [_ (#FormS (map (replace-syntax reps) parts))]) - - (#Meta [_ (#TupleS members)]) - (#Meta [_ (#TupleS (map (replace-syntax reps) members))]) - - (#Meta [_ (#RecordS slots)]) - (#Meta [_ (#RecordS (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax)) - (lambda [slot] - (let [[k v] slot] - [(replace-syntax reps k) (replace-syntax reps v)]))) - slots))]) - - _ - syntax) + #None + syntax) + + (#Meta [_ (#FormS parts)]) + (#Meta [_ (#FormS (map (replace-syntax reps) parts))]) + + (#Meta [_ (#TupleS members)]) + (#Meta [_ (#TupleS (map (replace-syntax reps) members))]) + + (#Meta [_ (#RecordS slots)]) + (#Meta [_ (#RecordS (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'] (_lux_: (, Text SyntaxList) (_lux_case tokens - (#Cons [(#Meta [_ (#SymbolS ["" self-ident])]) tokens']) - [self-ident tokens'] + (#Cons [(#Meta [_ (#SymbolS ["" self-ident])]) tokens']) + [self-ident tokens'] - _ - ["" tokens]))] + _ + ["" tokens]))] (_lux_case tokens' - (#Cons [(#Meta [_ (#TupleS 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")) + (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])]) + (_lux_case (map% Maybe:Monad get-ident args) + (#Some idents) + (_lux_case idents + #Nil + (return (_lux_: SyntaxList + (list body))) + + (#Cons [harg targs]) + (let [replacements (map (_lux_: (-> Text (, Text Syntax)) + (lambda [ident] [ident (`' (#;BoundT (~ ($text ident))))])) + (list& self-ident idents)) + body' (fold (_lux_: (-> Syntax Text Syntax) + (lambda [body' arg'] + (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')])))) + (replace-syntax replacements body) + (reverse targs))] + (return (_lux_: SyntaxList + (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))) (_lux_case plist - (#Cons [[k' v] plist']) - (if (text:= k k') - (#Some v) - (get k 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) (_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!") + {#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))))))))) @@ -1245,18 +1288,18 @@ [bindings (get module modules) gdef (get name bindings)] (_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))) + [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))) @@ -1265,10 +1308,10 @@ (let [[module name] ident] (lambda [state] (_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)])))))) + {#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] @@ -1288,20 +1331,20 @@ (def__ #export (normalize ident state) (-> Ident ($' Lux Ident)) (_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]))) + ["" 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]))) (defmacro #export (| tokens) (do Lux:Monad @@ -1309,20 +1352,21 @@ (_lux_: (-> Syntax ($' Lux Syntax)) (lambda [token] (_lux_case token - (#Meta [_ (#TagS ident)]) - (do Lux:Monad - [ident (normalize ident)] - (;return (`' [(~ ($text (ident->text ident))) (;,)]))) - - (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) (#Cons [value #Nil])]))]) - (do Lux:Monad - [ident (normalize ident)] - (;return (`' [(~ ($text (ident->text ident))) (~ value)]))) - - _ - (fail "Wrong syntax for |")))) + (#Meta [_ (#TagS ident)]) + (do Lux:Monad + [ident (normalize ident)] + (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (;,)])))) + + (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) (#Cons [value #Nil])]))]) + (do Lux:Monad + [ident (normalize ident)] + (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (~ value)])))) + + _ + (fail "Wrong syntax for |")))) tokens)] - (;return (list (`' (#;VariantT (;list (~@ pairs)))))))) + (;return (_lux_: SyntaxList + (list (`' (#;VariantT (;list (~@ pairs))))))))) (defmacro #export (& tokens) (if (not (multiple? 2 (length tokens))) @@ -1332,15 +1376,16 @@ (_lux_: (-> (, Syntax Syntax) ($' Lux Syntax)) (lambda [pair] (_lux_case pair - [(#Meta [_ (#TagS ident)]) value] - (do Lux:Monad - [ident (normalize ident)] - (;return (`' [(~ ($text (ident->text ident))) (~ value)]))) - - _ - (fail "Wrong syntax for &")))) + [(#Meta [_ (#TagS ident)]) value] + (do Lux:Monad + [ident (normalize ident)] + (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (~ value)])))) + + _ + (fail "Wrong syntax for &")))) (as-pairs tokens))] - (;return (list (`' (#;RecordT (;list (~@ pairs))))))))) + (;return (_lux_: SyntaxList + (list (`' (#;RecordT (;list (~@ pairs)))))))))) (def__ #export (->text x) (-> (^ java.lang.Object) Text) @@ -1350,174 +1395,179 @@ (All [a] (-> a ($' List a) ($' List a))) (_lux_case xs - #Nil - 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) (_lux_case syntax - (#Meta [_ (#BoolS value)]) - (->text value) + (#Meta [_ (#BoolS value)]) + (->text value) - (#Meta [_ (#IntS value)]) - (->text value) + (#Meta [_ (#IntS value)]) + (->text value) - (#Meta [_ (#RealS value)]) - (->text value) + (#Meta [_ (#RealS value)]) + (->text value) - (#Meta [_ (#CharS value)]) - ($ text:++ "#\"" (->text value) "\"") + (#Meta [_ (#CharS value)]) + ($ text:++ "#\"" (->text value) "\"") - (#Meta [_ (#TextS value)]) - value + (#Meta [_ (#TextS value)]) + value - (#Meta [_ (#SymbolS ident)]) - (ident->text ident) + (#Meta [_ (#SymbolS ident)]) + (ident->text ident) - (#Meta [_ (#TagS ident)]) - (text:++ "#" (ident->text ident)) + (#Meta [_ (#TagS ident)]) + (text:++ "#" (ident->text ident)) - (#Meta [_ (#TupleS members)]) - ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]") + (#Meta [_ (#TupleS members)]) + ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]") - (#Meta [_ (#FormS members)]) - ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")") + (#Meta [_ (#FormS members)]) + ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")") - (#Meta [_ (#RecordS slots)]) - ($ text:++ "{" - (|> slots - (map (_lux_: (-> (, Syntax Syntax) Text) - (lambda [slot] - (let [[k v] slot] - ($ text:++ (syntax:show k) " " (syntax:show v)))))) - (interpose " ") - (fold text:++ "")) - "}") - )) + (#Meta [_ (#RecordS 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))) (_lux_case syntax - (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS 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 [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))]) + (do Lux:Monad + [macro-name' (normalize macro-name) + ?macro (find-macro (_lux_: Ident macro-name'))] + (_lux_case (_lux_: ($' Maybe Macro) ?macro) + (#Some macro) + (do Lux:Monad + [expansion (macro args) + expansion' (map% Lux:Monad macro-expand (_lux_: SyntaxList expansion))] + (;return (_lux_: SyntaxList (list:join (_lux_: ($' List SyntaxList) expansion'))))) + + #None + (do Lux:Monad + [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))] + (;return (_lux_: SyntaxList (list ($form (list:join (_lux_: ($' List SyntaxList) parts'))))))))) - (#Meta [_ (#FormS (#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 [_ (#FormS (#Cons [harg targs]))]) + (do Lux:Monad + [harg+ (macro-expand harg) + targs+ (map% Lux:Monad macro-expand (_lux_: SyntaxList targs))] + (;return (_lux_: SyntaxList (list ($form (list:++ harg+ (list:join (_lux_: ($' List SyntaxList) targs+)))))))) - (#Meta [_ (#TupleS members)]) - (do Lux:Monad - [members' (map% Lux:Monad macro-expand members)] - (;return (list ($tuple (list:join members'))))) + (#Meta [_ (#TupleS members)]) + (do Lux:Monad + [members' (map% Lux:Monad macro-expand members)] + (;return (_lux_: SyntaxList (list ($tuple (list:join (_lux_: ($' List SyntaxList) members'))))))) - _ - (return (list syntax)))) + _ + (return (_lux_: SyntaxList (list syntax))))) (def__ (walk-type type) (-> Syntax Syntax) (_lux_case type - (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS tag)]) parts]))]) - ($form (#Cons [($tag tag) (map walk-type parts)])) + (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS tag)]) parts]))]) + ($form (#Cons [($tag tag) (map walk-type parts)])) - (#Meta [_ (#TupleS members)]) - ($tuple (map walk-type members)) + (#Meta [_ (#TupleS members)]) + ($tuple (map walk-type members)) - (#Meta [_ (#FormS (#Cons [type-fn args]))]) - (fold (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)]))) - (walk-type type-fn) - (map walk-type args)) - - _ - type)) + (#Meta [_ (#FormS (#Cons [type-fn args]))]) + (fold (_lux_: (-> Syntax Syntax Syntax) + (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)])))) + (walk-type type-fn) + (map walk-type args)) + + _ + type)) (defmacro #export (type` tokens) (_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."))) + (#Cons [type #Nil]) + (do Lux:Monad + [type+ (macro-expand type)] + (_lux_case (_lux_: SyntaxList type+) + (#Cons [type' #Nil]) + (;return (_lux_: SyntaxList + (list (walk-type type')))) + + _ + (fail "type`: The expansion of the type-syntax had to yield a single element."))) - _ - (fail "Wrong syntax for type`"))) + _ + (fail "Wrong syntax for type`"))) (defmacro #export (: tokens) (_lux_case tokens - (#Cons [type (#Cons [value #Nil])]) - (return (list (`' (_lux_: (;type` (~ type)) (~ value))))) + (#Cons [type (#Cons [value #Nil])]) + (return (_lux_: SyntaxList + (list (`' (_lux_: (;type` (~ type)) (~ value)))))) - _ - (fail "Wrong syntax for :"))) + _ + (fail "Wrong syntax for :"))) (defmacro #export (:! tokens) (_lux_case tokens - (#Cons [type (#Cons [value #Nil])]) - (return (list (`' (_lux_:! (;type` (~ type)) (~ value))))) + (#Cons [type (#Cons [value #Nil])]) + (return (_lux_: SyntaxList + (list (`' (_lux_:! (;type` (~ type)) (~ value)))))) - _ - (fail "Wrong syntax for :!"))) + _ + (fail "Wrong syntax for :!"))) (defmacro #export (deftype tokens) (let [[export? tokens'] (: (, Bool (List Syntax)) (_lux_case tokens - (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens']) - [true tokens'] + (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens']) + [true tokens'] - _ - [false tokens])) + _ + [false tokens])) parts (: (Maybe (, Syntax (List Syntax) Syntax)) (_lux_case tokens' - (#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])]) - (#Some [($symbol name) #Nil type]) + (#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])]) + (#Some [($symbol name) #Nil type]) - (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS name)]) args]))]) (#Cons [type #Nil])]) - (#Some [($symbol name) args type]) + (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS name)]) args]))]) (#Cons [type #Nil])]) + (#Some [($symbol name) args type]) - _ - #None))] + _ + #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")) + (#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 (_lux_: SyntaxList + (list& (`' (_lux_def (~ name) (;type` (~ type')))) + with-export)))) + + #None + (fail "Wrong syntax for deftype")) )) (deftype #export (IO a) @@ -1525,71 +1575,75 @@ (defmacro #export (io tokens) (_lux_case tokens - (#Cons [value #Nil]) - (let [blank ($symbol ["" ""])] - (return (list (`' (_lux_lambda (~ blank) (~ blank) (~ value)))))) + (#Cons [value #Nil]) + (let [blank ($symbol ["" ""])] + (return (_lux_: SyntaxList + (list (`' (_lux_lambda (~ blank) (~ blank) (~ value))))))) - _ - (fail "Wrong syntax for io"))) + _ + (fail "Wrong syntax for io"))) (defmacro #export (exec tokens) (_lux_case (reverse tokens) - (#Cons [value actions]) - (let [dummy ($symbol ["" ""])] - (return (list (fold (lambda [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post)))) - value - actions)))) + (#Cons [value actions]) + (let [dummy ($symbol ["" ""])] + (return (_lux_: SyntaxList + (list (fold (: (-> Syntax Syntax Syntax) + (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)) (_lux_case tokens - (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens']) - [true tokens'] + (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens']) + [true tokens'] - _ - [false tokens])) + _ + [false tokens])) parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax)) (_lux_case tokens' - (#Cons [(#Meta [_ (#FormS (#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 [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])]) - (#Some [name args #None body]) - - (#Cons [name (#Cons [body #Nil])]) - (#Some [name #Nil #None body]) - - _ - #None))] + (#Cons [(#Meta [_ (#FormS (#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 [_ (#FormS (#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")))) + (#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 (_lux_: SyntaxList + (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)) @@ -1598,36 +1652,39 @@ (defmacro #export (case tokens) (_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 [_ (#FormS (#Cons [(#Meta [_ (#SymbolS 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"))) + (#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 [_ (#FormS (#Cons [(#Meta [_ (#SymbolS 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 (: (List Syntax) expansion)))] + (;return (: (List (, Syntax Syntax)) (list:join (: (List (List (, Syntax Syntax))) expansions))))) + + _ + (;return (: (List (, Syntax Syntax)) (list branch))))))) + (as-pairs branches))] + (;return (_lux_: SyntaxList + (list (`' (_lux_case (~ value) + (~@ (|> (: (List (List (, Syntax Syntax))) expansions) + list:join (map rejoin-pair) list:join)))))))) + + _ + (fail "Wrong syntax for case"))) (defmacro #export (\ tokens) (case tokens (#Cons [body (#Cons [pattern #Nil])]) (do Lux:Monad [pattern+ (macro-expand pattern)] - (case pattern+ + (case (: (List Syntax) pattern+) (#Cons [pattern' #Nil]) - (;return (list pattern' body)) + (;return (: (List Syntax) + (list pattern' body))) _ (fail "\\ can only expand to 1 pattern."))) @@ -1645,8 +1702,10 @@ _ (do Lux:Monad [patterns' (map% Lux:Monad macro-expand patterns)] - (;return (list:join (map (lambda [pattern] (list pattern body)) - (list:join patterns')))))) + (;return (_lux_: SyntaxList + (list:join (map (: (-> Syntax (List Syntax)) + (lambda [pattern] (list pattern body))) + (list:join patterns'))))))) _ (fail "Wrong syntax for \\or"))) @@ -1667,7 +1726,8 @@ [module-name get-module-name] (case tokens (\ (list template)) - (;return (list (untemplate module-name template))) + (;return (_lux_: SyntaxList + (list (untemplate module-name template)))) _ (fail "Wrong syntax for `")))) @@ -1687,7 +1747,7 @@ (-> Syntax (Lux Syntax)) (do Lux:Monad [token+ (macro-expand token)] - (case token+ + (case (: (List Syntax) token+) (\ (list token')) (;return token') @@ -1709,12 +1769,13 @@ _ (fail "Signatures require typed members!")))) tokens')] - (;return (list (`' (#;RecordT (list (~@ (map (: (-> (, Ident Syntax) Syntax) - (lambda [pair] - (let [[name type] pair] - (`' [(~ (|> name ident->text $text)) - (~ type)])))) - members))))))))) + (;return (: (List Syntax) + (list (`' (#;RecordT (list (~@ (map (: (-> (, Ident Syntax) Syntax) + (lambda [pair] + (let [[name type] pair] + (`' [(~ (|> name ident->text $text)) + (~ type)])))) + members)))))))))) (defmacro #export (defsig tokens) (let [[export? tokens'] (: (, Bool (List Syntax)) @@ -1743,10 +1804,11 @@ _ (`' (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))] - (return (list& (`' (_lux_def (~ name) (~ sigs'))) - (if export? - (list (`' (_lux_export (~ name)))) - #Nil)))) + (return (_lux_: SyntaxList + (list& (`' (_lux_def (~ name) (~ sigs'))) + (if export? + (list (`' (_lux_export (~ name)))) + #Nil))))) #None (fail "Wrong syntax for defsig")))) @@ -1766,7 +1828,8 @@ _ (fail "Structures require defined members!")))) tokens')] - (;return (list ($record members))))) + (;return (_lux_: SyntaxList + (list ($record members)))))) (defmacro #export (defstruct tokens) (let [[export? tokens'] (: (, Bool (List Syntax)) @@ -1795,10 +1858,11 @@ _ (`' (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))] - (return (list& (`' (def (~ name) (~ type) (~ defs'))) - (if export? - (list (`' (_lux_export (~ name)))) - #Nil)))) + (return (_lux_: SyntaxList + (list& (`' (def (~ name) (~ type) (~ defs'))) + (if export? + (list (`' (_lux_export (~ name)))) + #Nil))))) #None (fail "Wrong syntax for defsig")))) @@ -1847,9 +1911,11 @@ [(defmacro #export (<name> tokens) (case (reverse tokens) (\ (list& last init)) - (return (list (fold (lambda [post pre] (` <form>)) - last - init))) + (return (: (List Syntax) + (list (fold (: (-> Syntax Syntax Syntax) + (lambda [post pre] (` <form>))) + last + init)))) _ (fail <message>)))] @@ -1891,9 +1957,11 @@ (list name) (list))))) lux)] - (#Right [state (map (lambda [name] - (` ((~ ($symbol ["" "_lux_def"])) (~ ($symbol ["" name])) (~ ($symbol ["lux" name]))))) - (list:join to-alias))])) + (#Right [state (_lux_: SyntaxList + (map (: (-> Text Syntax) + (lambda [name] + (` ((~ ($symbol ["" "_lux_def"])) (~ ($symbol ["" name])) (~ ($symbol ["lux" name])))))) + (list:join to-alias)))])) #None (#Left "Uh, oh... The universe is not working properly...")) @@ -1997,16 +2065,18 @@ [($tag [module name]) ($symbol ["" name])]))) slots)) _ (println (text:++ "Using pattern: " (syntax:show pattern)))] - (#Right [state (list (` (_lux_case (~ struct) (~ pattern) (~ body))))])) + (#Right [state (_lux_: SyntaxList + (list (` (_lux_case (~ struct) (~ pattern) (~ body)))))])) _ (#Left "Can only \"use\" records.")))))) _ (let [dummy ($symbol ["" ""])] - (#Right [state (list (` (_lux_case (~ struct) - (~ dummy) - (using (~ dummy) (~ body)))))]))) + (#Right [state (_lux_: SyntaxList + (list (` (_lux_case (~ struct) + (~ dummy) + (using (~ dummy) (~ body))))))]))) _ (#Left "Wrong syntax for defsig"))) @@ -2014,9 +2084,10 @@ (defmacro #export (when tokens) (case tokens (\ (list test body)) - (return (list (` (if (~ test) - (#Some (~ body)) - #None)))) + (return (_lux_: SyntaxList + (list (` (if (~ test) + (#Some (~ body)) + #None))))) _ (fail "Wrong syntax for when"))) diff --git a/source/program.lux b/source/program.lux index a9451580f..cefec07d4 100644 --- a/source/program.lux +++ b/source/program.lux @@ -12,7 +12,7 @@ (filter p xs')))) (_jvm_program _ - (exec (println "Hello, world!") - (|> (int:+ 2 2) ->text ($ text:++ "2 + 2 = ") println) - (println (->text (using Int:Ord - (< 5 10)))))) + (exec (println "Hello, world!") + (|> (int:+ 2 2) ->text ($ text:++ "2 + 2 = ") println) + (println (->text (using Int:Ord + (< 5 10)))))) diff --git a/src/lux.clj b/src/lux.clj index 5b32955a3..eb025f55e 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -2,10 +2,13 @@ (:gen-class) (:require [lux.base :as &] [lux.compiler :as &compiler] + [lux.type :as &type] :reload-all)) (defn -main [& _] - (time (&compiler/compile-all (&/|list "program"))) + (do (time (&compiler/compile-all (&/|list "program"))) + ;; (prn @&type/counter) + ) (System/exit 0)) (comment diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index c37c1acde..3c5c5c956 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -454,6 +454,7 @@ (fail ""))) (defn ^:private analyse-basic-ast [analyse eval! exo-type token] + ;; (prn 'analyse-basic-ast (&/show-ast token)) (fn [state] (matchv ::M/objects [((aba1 analyse eval! exo-type token) state)] [["lux;Right" [state* output]]] diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 1b0c70f77..7600f34ff 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -151,7 +151,7 @@ [_] (fail* "[Analyser Error] Can't have anything other than a global def in the global environment.")) - (fail* "")) + (fail* "_{_ analyse-symbol _}_")) [["lux;Cons" [top-outer _]]] (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) @@ -172,39 +172,42 @@ ))) )) -(defn ^:private analyse-apply* [analyse exo-type fun-type args] - (matchv ::M/objects [args] - [["lux;Nil" _]] - (|do [_ (&type/check exo-type fun-type)] - (return (&/T (&/|list) fun-type))) - - [["lux;Cons" [?arg ?args*]]] - (|do [?fun-type* (&type/actual-type fun-type)] - (matchv ::M/objects [?fun-type*] - [["lux;AllT" _]] - (&type/with-var - (fn [$var] - (|do [type* (&type/apply-type ?fun-type* $var) - [?args** ?type**] (analyse-apply* analyse exo-type type* args)] - (matchv ::M/objects [$var] - [["lux;VarT" ?id]] - (|do [? (&type/bound? ?id) - _ (if ? - (return nil) - (|do [ex &type/existential] - (&type/set-var ?id ex))) - type*** (&type/clean $var ?type**)] - (return (&/T ?args** type***))) - )))) - - [["lux;LambdaT" [?input-t ?output-t]]] - (|do [[=args ?output-t*] (analyse-apply* analyse exo-type ?output-t ?args*) - =arg (&&/analyse-1 analyse ?input-t ?arg)] - (return (&/T (&/|cons =arg =args) ?output-t*))) +(defn ^:private analyse-apply* [analyse exo-type =fn ?args] + (matchv ::M/objects [=fn] + [[?fun-expr ?fun-type]] + (matchv ::M/objects [?args] + [["lux;Nil" _]] + (|do [_ (&type/check exo-type ?fun-type)] + (return =fn)) + + [["lux;Cons" [?arg ?args*]]] + (|do [?fun-type* (&type/actual-type ?fun-type)] + (matchv ::M/objects [?fun-type*] + [["lux;AllT" _]] + (&type/with-var + (fn [$var] + (|do [type* (&type/apply-type ?fun-type* $var) + output (analyse-apply* analyse exo-type (&/T ?fun-expr type*) ?args)] + (matchv ::M/objects [output $var] + [[?expr* ?type*] ["lux;VarT" ?id]] + (|do [? (&type/bound? ?id) + _ (if ? + (return nil) + (|do [ex &type/existential] + (&type/set-var ?id ex))) + type** (&type/clean $var ?type*)] + (return (&/T ?expr* type**))) + )))) + + [["lux;LambdaT" [?input-t ?output-t]]] + (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)] + (analyse-apply* analyse exo-type (&/T (&/V "apply" (&/T =fn =arg)) + ?output-t) + ?args*)) - [_] - (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) - )) + [_] + (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*))))) + ))) (defn analyse-apply [analyse exo-type =fn ?args] (|do [loader &/loader] @@ -219,14 +222,12 @@ (&/flat-map% (partial analyse exo-type) macro-expansion)) [_] - (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)] - (return (&/|list (&/T (&/V "apply" (&/T =fn =args)) - =app-type)))))) + (|do [output (analyse-apply* analyse exo-type =fn ?args)] + (return (&/|list output))))) [_] - (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)] - (return (&/|list (&/T (&/V "apply" (&/T =fn =args)) - =app-type))))) + (|do [output (analyse-apply* analyse exo-type =fn ?args)] + (return (&/|list output)))) ))) (defn analyse-case [analyse exo-type ?value ?branches] @@ -263,7 +264,12 @@ (|do [? (&type/bound? ?id)] (if ? (|do [dtype (&type/deref ?id)] - (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype)))) + (matchv ::M/objects [dtype] + [["lux;ExT" _]] + (return (&/T _expr exo-type)) + + [_] + (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))) (return (&/T _expr exo-type)))))))) [_] diff --git a/src/lux/base.clj b/src/lux/base.clj index 9ea255132..edf6781ea 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -551,40 +551,40 @@ (defn show-ast [ast] (matchv ::M/objects [ast] - [["lux;Meta" [_ ["lux;Bool" ?value]]]] + [["lux;Meta" [_ ["lux;BoolS" ?value]]]] (pr-str ?value) - [["lux;Meta" [_ ["lux;Int" ?value]]]] + [["lux;Meta" [_ ["lux;IntS" ?value]]]] (pr-str ?value) - [["lux;Meta" [_ ["lux;Real" ?value]]]] + [["lux;Meta" [_ ["lux;RealS" ?value]]]] (pr-str ?value) - [["lux;Meta" [_ ["lux;Char" ?value]]]] + [["lux;Meta" [_ ["lux;CharS" ?value]]]] (pr-str ?value) - [["lux;Meta" [_ ["lux;Text" ?value]]]] + [["lux;Meta" [_ ["lux;TextS" ?value]]]] (str "\"" ?value "\"") - [["lux;Meta" [_ ["lux;Tag" [?module ?tag]]]]] + [["lux;Meta" [_ ["lux;TagS" [?module ?tag]]]]] (str "#" ?module ";" ?tag) - [["lux;Meta" [_ ["lux;Symbol" [?module ?ident]]]]] + [["lux;Meta" [_ ["lux;SymbolS" [?module ?ident]]]]] (if (= "" ?module) ?ident (str ?module ";" ?ident)) - [["lux;Meta" [_ ["lux;Tuple" ?elems]]]] + [["lux;Meta" [_ ["lux;TupleS" ?elems]]]] (str "[" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) "]") - [["lux;Meta" [_ ["lux;Record" ?elems]]]] + [["lux;Meta" [_ ["lux;RecordS" ?elems]]]] (str "{" (->> ?elems (|map (fn [elem] (|let [[k v] elem] (str (show-ast k) " " (show-ast v))))) (|interpose " ") (fold str "")) "}") - [["lux;Meta" [_ ["lux;Form" ?elems]]]] + [["lux;Meta" [_ ["lux;FormS" ?elems]]]] (str "(" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) ")") )) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 26b75bec3..6fb9e2c6d 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -60,8 +60,8 @@ [["lux;Global" [?owner-class ?name]]] (&&lux/compile-global compile-expression ?type ?owner-class ?name) - [["apply" [?fn ?args]]] - (&&lux/compile-apply compile-expression ?type ?fn ?args) + [["apply" [?fn ?arg]]] + (&&lux/compile-apply compile-expression ?type ?fn ?arg) [["variant" [?tag ?members]]] (&&lux/compile-variant compile-expression ?type ?tag ?members) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 2c5073a4d..cf4a65f04 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -117,14 +117,11 @@ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]] (return nil))) -(defn compile-apply [compile *type* ?fn ?args] +(defn compile-apply [compile *type* ?fn ?arg] (|do [^MethodVisitor *writer* &/get-writer _ (compile ?fn) - _ (&/map% (fn [?arg] - (|do [_ (compile ?arg) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] - (return nil))) - ?args)] + _ (compile ?arg) + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] (return nil))) (defn compile-def [compile ?name ?body ?def-data] diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index 2ee8088d3..d2ab4a5d7 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -18,11 +18,11 @@ (fail (str "[Lexer Error] Unknown escape character: " escaped)))) (defn ^:private lex-text-body [_] - (&/try-all% (&/|list (|do [[_ [_ [prefix escaped]]] (&reader/read-regex2 #"(?s)^([^\"\\]*)(\\.)") + (&/try-all% (&/|list (|do [[_ [prefix escaped]] (&reader/read-regex2 #"(?s)^([^\"\\]*)(\\.)") unescaped (escape-char escaped) postfix (lex-text-body nil)] (return (str prefix unescaped postfix))) - (|do [[_ [_ body]] (&reader/read-regex #"(?s)^([^\"\\]*)")] + (|do [[_ body] (&reader/read-regex #"(?s)^([^\"\\]*)")] (return body))))) (def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]*)" @@ -31,26 +31,26 @@ ;; [Lexers] (def ^:private lex-white-space - (|do [[_ [meta white-space]] (&reader/read-regex #"^(\s+)")] + (|do [[meta white-space] (&reader/read-regex #"^(\s+)")] (return (&/V "lux;Meta" (&/T meta (&/V "White_Space" white-space)))))) (def ^:private lex-single-line-comment (|do [_ (&reader/read-text "##") - [_ [meta comment]] (&reader/read-regex #"^(.*)$")] + [meta comment] (&reader/read-regex #"^(.*)$")] (return (&/V "lux;Meta" (&/T meta (&/V "Comment" comment)))))) (defn ^:private lex-multi-line-comment [_] (|do [_ (&reader/read-text "#(") - [meta comment] (&/try-all% (&/|list (|do [[_ [meta comment]] (&reader/read-regex #"(?is)^(?!#\()(.*?(?=\)#))") + [meta comment] (&/try-all% (&/|list (|do [[meta comment] (&reader/read-regex #"(?is)^(?!#\()(.*?(?=\)#))") ;; :let [_ (prn 'immediate comment)] _ (&reader/read-text ")#")] (return (&/T meta comment))) (|do [;; :let [_ (prn 'pre/_0)] - [_ [meta pre]] (&reader/read-regex+ #"(?is)^(.*?)(#\(|$)") + [meta pre] (&reader/read-regex+ #"(?is)^(.*?)(#\(|$)") ;; :let [_ (prn 'pre pre)] - [_ [_ [_ inner]]] (lex-multi-line-comment nil) + [_ inner] (lex-multi-line-comment nil) ;; :let [_ (prn 'inner inner)] - [_ [_ post]] (&reader/read-regex #"(?is)^(.+?(?=\)#))") + [_ post] (&reader/read-regex #"(?is)^(.+?(?=\)#))") ;; :let [_ (prn 'post post (str pre "#(" inner ")#" post))] ] (return (&/T meta (str pre "#(" inner ")#" post)))))) @@ -64,7 +64,7 @@ (do-template [<name> <tag> <regex>] (def <name> - (|do [[_ [meta token]] (&reader/read-regex <regex>)] + (|do [[meta token] (&reader/read-regex <regex>)] (return (&/V "lux;Meta" (&/T meta (&/V <tag> token)))))) ^:private lex-bool "Bool" #"^(true|false)" @@ -73,54 +73,54 @@ ) (def ^:private lex-char - (|do [[_ [meta _]] (&reader/read-text "#\"") - token (&/try-all% (&/|list (|do [[_ [_ escaped]] (&reader/read-regex #"^(\\.)")] + (|do [[meta _] (&reader/read-text "#\"") + token (&/try-all% (&/|list (|do [[_ escaped] (&reader/read-regex #"^(\\.)")] (escape-char escaped)) - (|do [[_ [_ char]] (&reader/read-regex #"^(.)")] + (|do [[_ char] (&reader/read-regex #"^(.)")] (return char)))) _ (&reader/read-text "\"")] (return (&/V "lux;Meta" (&/T meta (&/V "Char" token)))))) (def ^:private lex-text - (|do [[_ [meta _]] (&reader/read-text "\"") + (|do [[meta _] (&reader/read-text "\"") token (lex-text-body nil) _ (&reader/read-text "\"")] (return (&/V "lux;Meta" (&/T meta (&/V "Text" token)))))) (def ^:private lex-ident - (&/try-all% (&/|list (|do [[_ [meta token]] (&reader/read-regex +ident-re+)] + (&/try-all% (&/|list (|do [[meta token] (&reader/read-regex +ident-re+)] (&/try-all% (&/|list (|do [_ (&reader/read-text ";") - [_ [_ local-token]] (&reader/read-regex +ident-re+)] + [_ local-token] (&reader/read-regex +ident-re+)] (&/try-all% (&/|list (|do [unaliased (&module/dealias token)] - (return (&/V "lux;Meta" (&/T meta (&/T unaliased local-token))))) + (return (&/T meta (&/T unaliased local-token)))) (|do [? (&module/exists? token)] (if ? - (return (&/V "lux;Meta" (&/T meta (&/T token local-token)))) + (return (&/T meta (&/T token local-token))) (fail (str "[Lexer Error] Unknown module: " token)))) ))) - (return (&/V "lux;Meta" (&/T meta (&/T "" token)))) + (return (&/T meta (&/T "" token))) ))) - (|do [[_ [meta _]] (&reader/read-text ";;") - [_ [_ token]] (&reader/read-regex +ident-re+) + (|do [[meta _] (&reader/read-text ";;") + [_ token] (&reader/read-regex +ident-re+) module-name &/get-module-name] - (return (&/V "lux;Meta" (&/T meta (&/T module-name token))))) - (|do [[_ [meta _]] (&reader/read-text ";") - [_ [_ token]] (&reader/read-regex +ident-re+)] - (return (&/V "lux;Meta" (&/T meta (&/T "lux" token))))) + (return (&/T meta (&/T module-name token)))) + (|do [[meta _] (&reader/read-text ";") + [_ token] (&reader/read-regex +ident-re+)] + (return (&/T meta (&/T "lux" token)))) ))) (def ^:private lex-symbol - (|do [[_ [meta ident]] lex-ident] + (|do [[meta ident] lex-ident] (return (&/V "lux;Meta" (&/T meta (&/V "Symbol" ident)))))) (def ^:private lex-tag - (|do [[_ [meta _]] (&reader/read-text "#") - [_ [_ ident]] lex-ident] + (|do [[meta _] (&reader/read-text "#") + [_ ident] lex-ident] (return (&/V "lux;Meta" (&/T meta (&/V "Tag" ident)))))) (do-template [<name> <text> <tag>] (def <name> - (|do [[_ [meta _]] (&reader/read-text <text>)] + (|do [[meta _] (&reader/read-text <text>)] (return (&/V "lux;Meta" (&/T meta (&/V <tag> nil)))))) ^:private lex-open-paren "(" "Open_Paren" diff --git a/src/lux/reader.clj b/src/lux/reader.clj index c25870168..b1fcc4740 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -11,7 +11,7 @@ [["lux;Nil" _]] (fail* "[Reader Error] EOF") - [["lux;Cons" [["lux;Meta" [[file-name line-num column-num] line]] + [["lux;Cons" [[[file-name line-num column-num] line] more]]] (matchv ::M/objects [(body file-name line-num column-num line)] [["No" msg]] @@ -38,18 +38,24 @@ ))) ;; [Exports] -(defn ^:private re-find! [^java.util.regex.Pattern regex line] - (let [matcher (.matcher regex line)] +(defn ^:private re-find! [^java.util.regex.Pattern regex column ^String line] + (let [matcher (doto (.matcher regex line) + (.region column (.length line)) + (.useAnchoringBounds true))] (when (.find matcher) (.group matcher 0)))) -(defn ^:private re-find1! [^java.util.regex.Pattern regex line] - (let [matcher (.matcher regex line)] +(defn ^:private re-find1! [^java.util.regex.Pattern regex column ^String line] + (let [matcher (doto (.matcher regex line) + (.region column (.length line)) + (.useAnchoringBounds true))] (when (.find matcher) (.group matcher 1)))) -(defn ^:private re-find3! [^java.util.regex.Pattern regex line] - (let [matcher (.matcher regex line)] +(defn ^:private re-find3! [^java.util.regex.Pattern regex column ^String line] + (let [matcher (doto (.matcher regex line) + (.region column (.length line)) + (.useAnchoringBounds true))] (when (.find matcher) (list (.group matcher 0) (.group matcher 1) @@ -58,27 +64,29 @@ (defn read-regex [regex] (with-line (fn [file-name line-num column-num ^String line] + ;; (prn 'read-regex [file-name line-num column-num regex line]) (if-let [^String match (do ;; (prn '[regex line] [regex line]) - (re-find! regex line))] + (re-find! regex column-num line))] (let [;; _ (prn 'match match) match-length (.length match) - line* (.substring line match-length)] - (if (.isEmpty line*) - (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match))) - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match)) - (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) + column-num* (+ column-num match-length)] + (if (= column-num* (.length line)) + (&/V "Done" (&/T (&/T file-name line-num column-num) match)) + (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) match) + (&/T (&/T file-name line-num column-num*) line))))) (&/V "No" (str "[Reader Error] Pattern failed: " regex)))))) (defn read-regex2 [regex] (with-line (fn [file-name line-num column-num ^String line] - (if-let [[^String match tok1 tok2] (re-find3! regex line)] + ;; (prn 'read-regex2 [file-name line-num column-num regex line]) + (if-let [[^String match tok1 tok2] (re-find3! regex column-num line)] (let [match-length (.length match) - line* (.substring line match-length)] - (if (.isEmpty line*) - (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))) - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))) - (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) + column-num* (+ column-num match-length)] + (if (= column-num* (.length line)) + (&/V "Done" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))) + (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)) + (&/T (&/T file-name line-num column-num*) line))))) (&/V "No" (str "[Reader Error] Pattern failed: " regex)))))) (defn read-regex+ [regex] @@ -90,37 +98,38 @@ [["lux;Nil" _]] (&/V "lux;Left" "[Reader Error] EOF") - [["lux;Cons" [[_ [[file-name line-num column-num] ^String line]] + [["lux;Cons" [[[file-name line-num column-num] ^String line] reader**]]] (if-let [^String match (do ;; (prn 'read-regex+ regex line) - (re-find1! regex line))] + (re-find1! regex column-num line))] (let [match-length (.length match) - line* (.substring line match-length)] - (if (.isEmpty line*) + column-num* (+ column-num match-length)] + (if (= column-num* (.length line)) (recur (str prefix match "\n") reader**) - (&/V "lux;Right" (&/T (&/|cons (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)) + (&/V "lux;Right" (&/T (&/|cons (&/T (&/T file-name line-num column-num*) line) reader**) - (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (str prefix match))))))) + (&/T (&/T file-name line-num column-num) (str prefix match)))))) (&/V "lux;Left" (str "[Reader Error] Pattern failed: " regex)))))))) (defn read-text [^String text] (with-line (fn [file-name line-num column-num ^String line] - (if (.startsWith line text) + ;; (prn 'read-text [file-name line-num column-num text line]) + (if (.startsWith line text column-num) (let [match-length (.length text) - line* (.substring line match-length)] - (if (empty? line*) - (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text))) - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text)) - (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) + column-num* (+ column-num match-length)] + (if (= column-num* (.length line)) + (&/V "Done" (&/T (&/T file-name line-num column-num) text)) + (&/V "Yes" (&/T (&/T (&/T file-name line-num column-num) text) + (&/T (&/T file-name line-num column-num*) line))))) (&/V "No" (str "[Reader Error] Text failed: " text)))))) (defn from [file-name] (let [lines (&/->list (string/split-lines (slurp file-name)))] (&/|map (fn [line+line-num] (|let [[line-num line] line+line-num] - (&/V "lux;Meta" (&/T (&/T file-name line-num 0) - line)))) + (&/T (&/T file-name line-num 0) + line))) (&/|filter (fn [line+line-num] (|let [[line-num line] line+line-num] (not= "" line))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 97b7c1bde..105528b8a 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -547,17 +547,28 @@ (def init-fixpoints (&/|list)) +(def counter (atom {})) (defn ^:private check* [fixpoints expected actual] + ;; (swap! counter update-in [[(aget expected 0) (aget actual 0)]] + ;; #(inc (or % 0))) (matchv ::M/objects [expected actual] [["lux;VarT" ?eid] ["lux;VarT" ?aid]] (if (= ?eid ?aid) (return (&/T fixpoints nil)) - (|do [ebound (&/try-all% (&/|list (|do [ebound (deref ?eid)] - (return (&/V "lux;Some" ebound))) - (return (&/V "lux;None" nil)))) - abound (&/try-all% (&/|list (|do [abound (deref ?aid)] - (return (&/V "lux;Some" abound))) - (return (&/V "lux;None" nil))))] + (|do [ebound (fn [state] + (matchv ::M/objects [((deref ?eid) state)] + [["lux;Right" [state* ebound]]] + (return* state* (&/V "lux;Some" ebound)) + + [["lux;Left" _]] + (return* state (&/V "lux;None" nil)))) + abound (fn [state] + (matchv ::M/objects [((deref ?aid) state)] + [["lux;Right" [state* abound]]] + (return* state* (&/V "lux;Some" abound)) + + [["lux;Left" _]] + (return* state (&/V "lux;None" nil))))] (matchv ::M/objects [ebound abound] [["lux;None" _] ["lux;None" _]] (|do [_ (set-var ?eid actual)] @@ -573,39 +584,75 @@ (check* fixpoints etype atype)))) [["lux;VarT" ?id] _] - (&/try-all% (&/|list (|do [_ (set-var ?id actual)] - (return (&/T fixpoints nil))) - (|do [bound (deref ?id)] - (check* fixpoints bound actual)))) + (fn [state] + (matchv ::M/objects [((set-var ?id actual) state)] + [["lux;Right" [state* _]]] + (return* state* (&/T fixpoints nil)) + + [["lux;Left" _]] + ((|do [bound (deref ?id)] + (check* fixpoints bound actual)) + state))) [_ ["lux;VarT" ?id]] - (&/try-all% (&/|list (|do [_ (set-var ?id expected)] - (return (&/T fixpoints nil))) - (|do [bound (deref ?id)] - (check* fixpoints expected bound)))) + (fn [state] + (matchv ::M/objects [((set-var ?id expected) state)] + [["lux;Right" [state* _]]] + (return* state* (&/T fixpoints nil)) + + [["lux;Left" _]] + ((|do [bound (deref ?id)] + (check* fixpoints expected bound)) + state))) [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]] - (&/try-all% (&/|list (|do [F1 (deref ?eid)] - (&/try-all% (&/|list (|do [F2 (deref ?aid)] - (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2)))) - (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)))) - (|do [F2 (deref ?aid)] - (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) - (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) - [fixpoints** _] (check* fixpoints* A1 A2)] - (return (&/T fixpoints** nil))))) + (fn [state] + (matchv ::M/objects [((|do [F1 (deref ?eid)] + (fn [state] + (matchv ::M/objects [((|do [F2 (deref ?aid)] + (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) (&/V "lux;AppT" (&/T F2 A2)))) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + ((check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual) + state)))) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + (matchv ::M/objects [((|do [F2 (deref ?aid)] + (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) + [fixpoints** _] (check* fixpoints* A1 A2)] + (return (&/T fixpoints** nil))) + state)))) ;; (|do [_ (check* fixpoints (&/V "lux;VarT" ?eid) (&/V "lux;VarT" ?aid)) ;; _ (check* fixpoints A1 A2)] ;; (return (&/T fixpoints nil))) [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] - (&/try-all% (&/|list (|do [F1 (deref ?id)] - (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)) - (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) - e* (apply-type F2 A1) - a* (apply-type F2 A2) - [fixpoints** _] (check* fixpoints* e* a*)] - (return (&/T fixpoints** nil))))) + (fn [state] + (matchv ::M/objects [((|do [F1 (deref ?id)] + (check* fixpoints (&/V "lux;AppT" (&/T F1 A1)) actual)) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + ((|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) + e* (apply-type F2 A1) + a* (apply-type F2 A2) + [fixpoints** _] (check* fixpoints* e* a*)] + (return (&/T fixpoints** nil))) + state))) ;; [["lux;AppT" [["lux;VarT" ?id] A1]] ["lux;AppT" [F2 A2]]] ;; (|do [[fixpoints* _] (check* fixpoints (&/V "lux;VarT" ?id) F2) ;; e* (apply-type F2 A1) @@ -614,13 +661,20 @@ ;; (return (&/T fixpoints** nil))) [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] - (&/try-all% (&/|list (|do [F2 (deref ?id)] - (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) - (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) - e* (apply-type F1 A1) - a* (apply-type F1 A2) - [fixpoints** _] (check* fixpoints* e* a*)] - (return (&/T fixpoints** nil))))) + (fn [state] + (matchv ::M/objects [((|do [F2 (deref ?id)] + (check* fixpoints expected (&/V "lux;AppT" (&/T F2 A2)))) + state)] + [["lux;Right" [state* output]]] + (return* state* output) + + [["lux;Left" _]] + ((|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) + e* (apply-type F1 A1) + a* (apply-type F1 A2) + [fixpoints** _] (check* fixpoints* e* a*)] + (return (&/T fixpoints** nil))) + state))) ;; [["lux;AppT" [F1 A1]] ["lux;AppT" [["lux;VarT" ?id] A2]]] ;; (|do [[fixpoints* _] (check* fixpoints F1 (&/V "lux;VarT" ?id)) ;; e* (apply-type F1 A1) |