diff options
| author | Eduardo Julian | 2015-04-16 22:41:15 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2015-04-16 22:41:15 -0400 |
| commit | 61f70deb6d4e8ad2f9e06122c3591a075c5b1bbc (patch) | |
| tree | 2a412a10ca838878918edcf1015b8918890b69f1 /source | |
| parent | 12aed842461ecc596c07227dcefce36d440e2c85 (diff) | |
- |do bindings are now based on pattern matching (that way, tuple destructuring can be done at do).
- Patterns are no longer put inside a MatchAC structure, but are instead just moved around as lists.
- Code outside of &type can no longer create/delete type-vars directly, but must now rely on with-var & with-vars to manage the life-cycle of type-vars.
- Simplified pattern-matching analysis at lux/analyser/case.
- The LEFT_APP optimization in check* has been replicated on the other side as RIGHT_APP, to attempt to improve performance of pattern-matching.
Diffstat (limited to 'source')
| -rw-r--r-- | source/lux.lux | 2458 |
1 files changed, 1239 insertions, 1219 deletions
diff --git a/source/lux.lux b/source/lux.lux index ca6a1925c..84eaab689 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -74,1232 +74,1252 @@ #Nil])])])])])])])])])])]))]) #NothingT])))) -## (deftype (Maybe a) -## (| #None -## (#Some a))) -(def' Maybe - (#AllT [#Nil "Maybe" "a" - (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] - (#Cons [["lux;Some" (#BoundT "a")] - #Nil])]))])) - -## (deftype (Bindings k v) -## (& #counter Int -## #mappings (List (, k v)))) -(def' Bindings - (#AllT [#Nil "Bindings" "k" - (#AllT [#Nil "" "v" - (#RecordT (#Cons [["lux;counter" Int] - (#Cons [["lux;mappings" (#AppT [List - (#TupleT (#Cons [(#BoundT "k") - (#Cons [(#BoundT "v") - #Nil])]))])] - #Nil])]))])])) - -## (deftype (Env k v) -## (& #name Text -## #inner-closures Int -## #locals (Bindings k v) -## #closure (Bindings k v))) -(def' Env - (#AllT [#Nil "Env" "k" - (#AllT [#Nil "" "v" - (#RecordT (#Cons [["lux;name" Text] - (#Cons [["lux;inner-closures" Int] - (#Cons [["lux;locals" (#AppT [(#AppT [Bindings (#BoundT "k")]) - (#BoundT "v")])] - (#Cons [["lux;closure" (#AppT [(#AppT [Bindings (#BoundT "k")]) - (#BoundT "v")])] - #Nil])])])]))])])) - -## (deftype Cursor -## (, Text Int Int)) -(def' Cursor - (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))) - -## (deftype (Meta m v) -## (| (#Meta (, m v)))) -(def' Meta - (#AllT [#Nil "Meta" "m" - (#AllT [#Nil "" "v" - (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") - (#Cons [(#BoundT "v") - #Nil])]))] - #Nil]))])])) - +## (def' Type +## (case' (#AppT [(#BoundT "Type") (#BoundT "")]) +## Type +## (case' (#AppT [List (#TupleT (#Cons [Text (#Cons [Type #Nil])]))]) +## TypeEnv +## (#AppT [(#AllT [#Nil "Type" "" +## (#VariantT (#Cons [["lux;AnyT" (#TupleT #Nil)] +## (#Cons [["lux;NothingT" (#TupleT #Nil)] +## (#Cons [["lux;DataT" Text] +## (#Cons [["lux;TupleT" (#AppT [List (#AppT [(#BoundT "Type") (#BoundT "")])])] +## (#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 [TypeEnv (#Cons [Text (#Cons [Text (#Cons [Type #Nil])])])]))] +## (#Cons [["lux;AppT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))] +## #Nil])])])])])])])])])])]))]) +## #NothingT])))) + +## ## (deftype (Maybe a) +## ## (| #None +## ## (#Some a))) +## (def' Maybe +## (#AllT [#Nil "Maybe" "a" +## (#VariantT (#Cons [["lux;None" (#TupleT #Nil)] +## (#Cons [["lux;Some" (#BoundT "a")] +## #Nil])]))])) + +## ## (deftype (Bindings k v) +## ## (& #counter Int +## ## #mappings (List (, k v)))) +## (def' Bindings +## (#AllT [#Nil "Bindings" "k" +## (#AllT [#Nil "" "v" +## (#RecordT (#Cons [["lux;counter" Int] +## (#Cons [["lux;mappings" (#AppT [List +## (#TupleT (#Cons [(#BoundT "k") +## (#Cons [(#BoundT "v") +## #Nil])]))])] +## #Nil])]))])])) + +## ## (deftype (Env k v) +## ## (& #name Text +## ## #inner-closures Int +## ## #locals (Bindings k v) +## ## #closure (Bindings k v))) +## (def' Env +## (#AllT [#Nil "Env" "k" +## (#AllT [#Nil "" "v" +## (#RecordT (#Cons [["lux;name" Text] +## (#Cons [["lux;inner-closures" Int] +## (#Cons [["lux;locals" (#AppT [(#AppT [Bindings (#BoundT "k")]) +## (#BoundT "v")])] +## (#Cons [["lux;closure" (#AppT [(#AppT [Bindings (#BoundT "k")]) +## (#BoundT "v")])] +## #Nil])])])]))])])) + +## ## (deftype Cursor +## ## (, Text Int Int)) +## (def' Cursor +## (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])]))) + +## ## (deftype (Meta m v) +## ## (| (#Meta (, m v)))) +## (def' Meta +## (#AllT [#Nil "Meta" "m" +## (#AllT [#Nil "" "v" +## (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m") +## (#Cons [(#BoundT "v") +## #Nil])]))] +## #Nil]))])])) + +## ## (def' Reader +## ## (List (Meta Cursor Text))) ## (def' Reader -## (List (Meta Cursor Text))) -(def' Reader - (#AppT [List - (#AppT [(#AppT [Meta Cursor]) - Text])])) - -## (deftype Compiler_State -## (& #source (Maybe Reader) -## #modules (List Any) -## #module-aliases (List Any) -## #global-env (Maybe (Env Text Any)) -## #local-envs (List (Env Text Any)) -## #types (Bindings Int Type) -## #writer (^ org.objectweb.asm.ClassWriter) -## #loader (^ java.net.URLClassLoader) -## #eval-ctor Int)) -(def' Compiler_State - (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])] - (#Cons [["lux;modules" (#AppT [List Any])] - (#Cons [["lux;module-aliases" (#AppT [List Any])] - (#Cons [["lux;global-env" (#AppT [Maybe (#AppT [(#AppT [Env Text]) Any])])] - (#Cons [["lux;local-envs" (#AppT [List (#AppT [(#AppT [Env Text]) Any])])] - (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] - (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")] - (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] - (#Cons [["lux;eval-ctor" Int] - #Nil])])])])])])])])]))) - -## (deftype #rec Syntax -## (Meta Cursor (| (#Bool Bool) -## (#Int Int) -## (#Real Real) -## (#Char Char) -## (#Text Text) -## (#Form (List Syntax)) -## (#Tuple (List Syntax)) -## (#Record (List (, Text Syntax)))))) -(def' Syntax - (case' (#AppT [(#BoundT "Syntax") (#BoundT "")]) - Syntax - (case' (#AppT [List Syntax]) - SyntaxList - (#AppT [(#AllT [#Nil "Syntax" "" - (#AppT [(#AppT [Meta Cursor]) - (#VariantT (#Cons [["lux;Bool" Bool] - (#Cons [["lux;Int" Int] - (#Cons [["lux;Real" Real] - (#Cons [["lux;Char" Char] - (#Cons [["lux;Text" Text] - (#Cons [["lux;Form" SyntaxList] - (#Cons [["lux;Tuple" SyntaxList] - (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Text (#Cons [Syntax #Nil])]))])] - #Nil])])])])])])])]))])]) - #NothingT])))) +## (#AppT [List +## (#AppT [(#AppT [Meta Cursor]) +## Text])])) + +## ## (deftype Compiler_State +## ## (& #source (Maybe Reader) +## ## #modules (List Any) +## ## #module-aliases (List Any) +## ## #global-env (Maybe (Env Text Any)) +## ## #local-envs (List (Env Text Any)) +## ## #types (Bindings Int Type) +## ## #writer (^ org.objectweb.asm.ClassWriter) +## ## #loader (^ java.net.URLClassLoader) +## ## #eval-ctor Int)) +## (def' Compiler_State +## (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])] +## (#Cons [["lux;modules" (#AppT [List Any])] +## (#Cons [["lux;module-aliases" (#AppT [List Any])] +## (#Cons [["lux;global-env" (#AppT [Maybe (#AppT [(#AppT [Env Text]) Any])])] +## (#Cons [["lux;local-envs" (#AppT [List (#AppT [(#AppT [Env Text]) Any])])] +## (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] +## (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")] +## (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")] +## (#Cons [["lux;eval-ctor" Int] +## #Nil])])])])])])])])]))) -## (deftype (Either l r) -## (| (#Left l) -## (#Right r))) -(def' Either - (#AllT [#Nil "_" "l" - (#AllT [#Nil "" "r" - (#VariantT (#Cons [["lux;Left" (#BoundT "l")] - (#Cons [["lux;Right" (#BoundT "r")] - #Nil])]))])])) - -## (deftype Macro -## (-> (List Syntax) Compiler_State -## (Either Text [Compiler_State (List Syntax)]))) -(def' Macro - (case' (#AppT [List Syntax]) - SyntaxList - (#LambdaT [SyntaxList - (#LambdaT [Compiler_State - (#AppT [(#AppT [Either Text]) - (#TupleT (#Cons [Compiler_State - (#Cons [SyntaxList #Nil])]))])])]))) - -## Base functions & macros -## (def (_meta data) -## (All [a] (-> a (Meta Cursor a))) -## (#Meta [["" -1 -1] data])) -(def' _meta - (check' (#AllT [#Nil "_" "a" - (#LambdaT [(#BoundT "a") - (#AppT [(#AppT [Meta Cursor]) - (#BoundT "a")])])]) - (lambda' _ data - (#Meta [["" -1 -1] data])))) - -(def' let' - (check' Macro - (lambda' _ tokens - (lambda' _ state - (case' tokens - (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) - (#Right [state - (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) - (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) - #Nil])]) - - _ - (#Left "Wrong syntax for let'")) - )))) - -## (def' let' -## (check' Macro -## (lambda' _ tokens -## (lambda' _ state -## (#Left "Wrong syntax for let'") -## )))) - -## (def' let' -## (lambda' _ tokens -## (lambda' _ state -## (case' tokens -## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) -## (#Right [state -## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) -## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) -## #Nil])]) - -## _ -## (#Left "Wrong syntax for let'")) -## ))) -## (declare-macro' let') - -## ## ## (All 21268 -## ## ## (-> 21268 -## ## ## (All 21267 -## ## ## (-> 21267 -## ## ## (| (#lux;Right (, 21267 -## ## ## (| (#lux;Cons (, (((All Meta m (All v (| (#lux;Meta (, m v))))) -## ## ## (, (^ java.lang.String []) (^ java.lang.Long []) (^ java.lang.Long []))) -## ## ## ⌈17⌋) -## ## ## (| (#lux;Nil (, ))))))))))))) - -## ## (def' lambda +## ## (deftype #rec Syntax +## ## (Meta Cursor (| (#Bool Bool) +## ## (#Int Int) +## ## (#Real Real) +## ## (#Char Char) +## ## (#Text Text) +## ## (#Form (List Syntax)) +## ## (#Tuple (List Syntax)) +## ## (#Record (List (, Text Syntax)))))) +## (def' Syntax +## (case' (#AppT [(#BoundT "Syntax") (#BoundT "")]) +## Syntax +## (case' (#AppT [List Syntax]) +## SyntaxList +## (#AppT [(#AllT [#Nil "Syntax" "" +## (#AppT [(#AppT [Meta Cursor]) +## (#VariantT (#Cons [["lux;Bool" Bool] +## (#Cons [["lux;Int" Int] +## (#Cons [["lux;Real" Real] +## (#Cons [["lux;Char" Char] +## (#Cons [["lux;Text" Text] +## (#Cons [["lux;Form" SyntaxList] +## (#Cons [["lux;Tuple" SyntaxList] +## (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Text (#Cons [Syntax #Nil])]))])] +## #Nil])])])])])])])]))])]) +## #NothingT])))) + +## ## ## (deftype (Either l r) +## ## ## (| (#Left l) +## ## ## (#Right r))) +## ## (def' Either +## ## (#AllT [#Nil "_" "l" +## ## (#AllT [#Nil "" "r" +## ## (#VariantT (#Cons [["lux;Left" (#BoundT "l")] +## ## (#Cons [["lux;Right" (#BoundT "r")] +## ## #Nil])]))])])) + +## ## ## (deftype Macro +## ## ## (-> (List Syntax) Compiler_State +## ## ## (Either Text [Compiler_State (List Syntax)]))) +## ## (def' Macro +## ## (case' (#AppT [List Syntax]) +## ## SyntaxList +## ## (#LambdaT [SyntaxList +## ## (#LambdaT [Compiler_State +## ## (#AppT [(#AppT [Either Text]) +## ## (#TupleT (#Cons [Compiler_State +## ## (#Cons [SyntaxList #Nil])]))])])]))) + +## ## ## Base functions & macros +## ## ## (def (_meta data) +## ## ## (All [a] (-> a (Meta Cursor a))) +## ## ## (#Meta [["" -1 -1] data])) +## ## (def' _meta +## ## (check' (#AllT [#Nil "_" "a" +## ## (#LambdaT [(#BoundT "a") +## ## (#AppT [(#AppT [Meta Cursor]) +## ## (#BoundT "a")])])]) +## ## (lambda' _ data +## ## (#Meta [["" -1 -1] data])))) + +## ## (def' let' +## ## (check' Macro +## ## (lambda' _ tokens +## ## (lambda' _ state +## ## (case' tokens +## ## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) +## ## (#Right [state +## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) +## ## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) +## ## #Nil])]) + +## ## _ +## ## (#Left "Wrong syntax for let'")) +## ## )))) + +## ## (def' let' ## ## (check' Macro ## ## (lambda' _ tokens ## ## (lambda' _ state -## ## (let' output (case' tokens -## ## (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])]) -## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"])) -## ## (#Cons [(_meta (#Symbol ["" ""])) -## ## (#Cons [arg -## ## (#Cons [(case' args' -## ## #Nil -## ## body - -## ## _ -## ## (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) -## ## (#Cons [(_meta (#Tuple args')) -## ## (#Cons [body #Nil])])])))) -## ## #Nil])])])]))) - -## ## (#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])]) -## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"])) -## ## (#Cons [(_meta (#Symbol self)) -## ## (#Cons [arg -## ## (#Cons [(case' args' -## ## #Nil -## ## body - -## ## _ -## ## (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) -## ## (#Cons [(_meta (#Tuple args')) -## ## (#Cons [body #Nil])])])))) -## ## #Nil])])])])))) -## ## (#Right [state (#Cons [output #Nil])])) +## ## (#Left "Wrong syntax for let'") ## ## )))) -## ## (declare-macro lambda) -## ## (def' def -## ## (check' Macro -## ## (lambda [tokens state] -## ## (let' output (case' tokens -## ## (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [body #Nil])]) -## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) tokens]))) - -## ## (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) -## ## (#Cons [body #Nil])]) -## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) -## ## (#Cons [(_meta (#Symbol name)) -## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) -## ## (#Cons [(_meta (#Symbol name)) -## ## (#Cons [(_meta (#Tuple args)) -## ## (#Cons [body #Nil])])])]))) -## ## #Nil])])]))) - -## ## (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type (#Cons [body #Nil])])]) -## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) -## ## (#Cons [(_meta (#Symbol name)) -## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "check'"])) -## ## (#Cons [type -## ## (#Cons [body -## ## #Nil])])]))) -## ## #Nil])])]))) - -## ## (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) -## ## (#Cons [type (#Cons [body #Nil])])]) -## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) -## ## (#Cons [(_meta (#Symbol name)) -## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "check'"])) -## ## (#Cons [type -## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) -## ## (#Cons [(_meta (#Symbol name)) -## ## (#Cons [(_meta (#Tuple args)) -## ## (#Cons [body #Nil])])])]))) -## ## #Nil])])]))) -## ## #Nil])])])))) -## ## (#Right [state (#Cons [output #Nil])]))))) -## ## (declare-macro def) - -## ## (def (defmacro tokens state) -## ## (let' [fn-name fn-def] (case' tokens -## ## (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol fn-name)]) args]))]) -## ## (#Cons [body #Nil])]) -## ## [fn-name -## ## (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "def"])) -## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol fn-name)) args]))) -## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "check'"])) -## ## (#Cons [(_meta (#Symbol ["lux;" "Macro"])) -## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) -## ## (#Cons [(_meta (#Symbol name)) -## ## (#Cons [(_meta (#Tuple args)) -## ## (#Cons [body #Nil])])])]))) -## ## #Nil])])]))) -## ## #Nil])])])))]) -## ## (let' declaration (_meta (#Form (#Cons [(_meta (#Symbol ["" "declare-macro"])) (#Cons [(_meta (#Symbol fn-name)) #Nil])]))) -## ## (#Right [state (#Cons [fn-def (#Cons [declaration #Nil])])])))) -## ## (declare-macro defmacro) - -## ## (defmacro (comment tokens state) -## ## (#Right [state #Nil])) - -## ## (def (int+ x y) -## ## (-> Int Int Int) -## ## (jvm-ladd x y)) - -## ## (def (id x) -## ## (All [a] (-> a a)) -## ## x) - -## ## (def (print x) -## ## (-> (^ java.lang.Object) []) -## ## (jvm-invokevirtual java.io.PrintStream "print" [java.lang.Object] -## ## (jvm-getstatic java.lang.System "out") [x])) - -## ## (def (println x) -## ## (-> (^ java.lang.Object) []) -## ## (jvm-invokevirtual java.io.PrintStream "println" [java.lang.Object] -## ## (jvm-getstatic java.lang.System "out") [x])) - -## ## (deftype (IO a) -## ## (-> (,) a)) - -## ## (defmacro (io tokens) -## ## (case' tokens -## ## (#Cons [value #Nil]) -## ## (return (list (` (lambda [_] (~ value))))))) - -## ## (def (fold f init xs) -## ## (All [a b] -## ## (-> (-> a b a) a (List b) a)) -## ## (case' xs -## ## #Nil -## ## init - -## ## (#Cons [x xs']) -## ## (fold f (f init x) xs'))) - -## ## (def (reverse list) -## ## (All [a] -## ## (-> (List a) (List a))) -## ## (fold (lambda [tail head] -## ## (#Cons [head tail])) -## ## #Nil -## ## list)) - -## ## (defmacro (list xs state) -## ## (let' xs' (reverse xs) -## ## (let' output (fold (lambda [tail head] -## ## (_meta (#Form (#Cons [(_meta (#Tag ["lux" "Cons"])) -## ## (#Cons [(_meta (#Tuple (#Cons [head (#Cons [tail #Nil])]))) -## ## #Nil])])))) -## ## (_meta (#Tag ["lux" "Nil"])) -## ## xs') -## ## (#Right [state (#Cons [output #Nil])])))) - -## ## (defmacro (list+ xs state) -## ## (case' (reverse xs) -## ## #Nil -## ## [#Nil state] - -## ## (#Cons [last init']) -## ## (let' output (fold (lambda [tail head] -## ## (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) (_meta (#Tuple (list head tail))))))) -## ## last -## ## init') -## ## (#Right [state (#Cons [output #Nil])])))) - -## ## (def (as-pairs xs) -## ## (All [a] -## ## (-> (List a) (List [a a]))) -## ## (case' xs -## ## (#Cons [x (#Cons [y xs'])]) -## ## (#Cons [[x y] (as-pairs xs')]) - -## ## _ -## ## #Nil)) - -## ## (defmacro (let tokens state) -## ## (case' tokens -## ## (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])]) -## ## (let' output (fold (lambda [body binding] -## ## (case' binding -## ## [label value] -## ## (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body))))) -## ## body -## ## (reverse (as-pairs bindings))) -## ## (#Right [state (list output)])))) - -## ## (def (. f g) -## ## (All [a b c] -## ## (-> (-> b c) (-> a b) (-> a c))) -## ## (lambda [x] (f (g x)))) - -## ## (def (++ xs ys) -## ## (All [a] -## ## (-> (List a) (List a) (List a))) -## ## (case' xs -## ## #Nil -## ## ys - -## ## (#Cons [x xs']) -## ## (#Cons [x (++ xs' ys)]))) - -## ## (def concat -## ## (All [a] -## ## (-> (List (List a)) (List a))) -## ## (fold ++ #Nil)) - -## ## (def (map f xs) -## ## (All [a b] -## ## (-> (-> a b) (List a) (List b))) -## ## (case' xs -## ## #Nil -## ## #Nil - -## ## (#Cons [x xs']) -## ## (#Cons [(f x) (map f xs')]))) - -## ## (def flat-map -## ## (All [a b] -## ## (-> (-> a (List b)) (List a) (List b))) -## ## (. concat map)) - -## ## (def (wrap-meta content) -## ## ... -## ## (_meta (#Form (list (_meta (#Tag ["lux" "Meta"])) -## ## (_meta (#Tuple (list (_meta (#Tuple (list (_meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text ""))))) -## ## (_meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int -1))))) -## ## (_meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int -1)))))))) -## ## (_meta content)))))))) - -## ## (def (untemplate-list tokens) -## ## (-> (List Syntax) Syntax) -## ## (case' tokens -## ## #Nil -## ## (_meta (#Tag ["lux" "Nil"])) - -## ## (#Cons [token tokens']) -## ## (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) -## ## (_meta (#Tuple (list token (untemplate-list tokens'))))))))) - -## ## (def (untemplate token) -## ## ... -## ## (case' token -## ## (#Meta [_ (#Bool value)]) -## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Bool"])) (_meta (#Bool value))))) - -## ## (#Meta [_ (#Int value)]) -## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int value))))) - -## ## (#Meta [_ (#Real value)]) -## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Real"])) (_meta (#Real value))))) - -## ## (#Meta [_ (#Char value)]) -## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Char"])) (_meta (#Char value))))) - -## ## (#Meta [_ (#Text value)]) -## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text value))))) - -## ## (#Meta [_ (#Tag [module name])]) -## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tag"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name)))))))) - -## ## (#Meta [_ (#Symbol [module name])]) -## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Symbol"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name)))))))) - -## ## (#Meta [_ (#Tuple elems)]) -## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tuple"])) (untemplate-list (map untemplate elems))))) - -## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol [_ "~"])]) (#Cons [(#Meta [_ unquoted]) #Nil])]))]) -## ## (_meta unquoted) - -## ## (#Meta [_ (#Form elems)]) -## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Form"])) (untemplate-list (map untemplate elems))))) -## ## )) - -## ## (defmacro (` tokens state) -## ## (case' tokens -## ## (#Cons [template #Nil]) -## ## (#Right [state (list (untemplate template))]))) - -## ## (defmacro (if tokens state) -## ## (case' tokens -## ## (#Cons [test (#Cons [then (#Cons [else #Nil])])]) -## ## (#Right [state -## ## (list (` (case' (~ test) -## ## true (~ then) -## ## false (~ else))))]))) - -## ## (def (filter p xs) -## ## (All [a] -## ## (-> (-> a Bool) (List a) (List a))) -## ## (case' xs -## ## #Nil -## ## #Nil - -## ## (#Cons [x xs']) -## ## (if (p x) -## ## (#Cons [x (filter p xs')]) -## ## (filter p xs')))) - -## ## (deftype (LuxStateM a) -## ## (-> CompilerState (Either Text [CompilerState a]))) - -## ## (def (return val) -## ## (All [a] -## ## (-> a (LuxStateM a))) -## ## (lambda [state] -## ## (#Right [state val]))) - -## ## (def (fail msg) -## ## (-> Text (LuxStateM Nothing)) -## ## (lambda [_] -## ## (#Left msg))) - -## ## (def (bind f v) -## ## (All [m a b] (-> (-> a (m b)) (m a) (m b))) -## ## (lambda [state] -## ## (case' (v state) -## ## (#Right [state' x]) -## ## (f x state') - -## ## (#Left msg) -## ## (#Left msg)))) - -## ## (def (first pair) -## ## (All [a b] (-> (, a b) a)) -## ## (case' pair -## ## [f s] -## ## f)) - -## ## (def (second pair) -## ## (All [a b] (-> (, a b) b)) -## ## (case' pair -## ## [f s] -## ## s)) - -## ## (defmacro (loop tokens) -## ## (case' tokens -## ## (#Cons [bindings (#Cons [body #Nil])]) -## ## (let [pairs (as-pairs bindings)] -## ## (return (list (#Form (#Cons [(` (lambda (~ (#Symbol ["lux" "recur"])) (~ (#Tuple (map first pairs))) -## ## (~ body))) -## ## (map second pairs)]))))))) - -## ## (defmacro (export tokens) -## ## (return (map (lambda [t] (` (export' (~ t)))) -## ## tokens))) - -## ## (defmacro (and tokens) -## ## (let [as-if (case' tokens -## ## #Nil -## ## (` true) - -## ## (#Cons [init tests]) -## ## (fold (lambda [prev next] -## ## (` (if (~ prev) (~ next) false))) -## ## init -## ## tokens) -## ## )] -## ## (return (list as-if)))) - -## ## (defmacro (or tokens) -## ## (let [as-if (case' tokens -## ## #Nil -## ## (` false) - -## ## (#Cons [init tests]) -## ## (fold (lambda [prev next] -## ## (` (if (~ prev) true (~ next)))) -## ## init -## ## tokens) -## ## )] -## ## (return (list as-if)))) - -## ## (def (not x) -## ## (-> Bool Bool) -## ## (case' x -## ## true false -## ## false true)) - -## ## (defmacro (|> tokens) -## ## (case' tokens -## ## (#Cons [init apps]) -## ## (return (list (fold (lambda [acc app] -## ## (case' app -## ## (#Form parts) -## ## (#Form (++ parts (list acc))) - -## ## _ -## ## (` ((~ app) (~ acc))))) -## ## init -## ## apps))))) - -## ## (defmacro ($ tokens) -## ## (case' tokens -## ## (#Cons [op (#Cons [init args])]) -## ## (return (list (fold (lambda [acc elem] -## ## (` ((~ op) (~ acc) (~ elem)))) -## ## init -## ## args))))) - -## ## (def (const x) -## ## (All [a] -## ## (-> a (-> Any a))) -## ## (lambda [_] -## ## x)) - -## ## (def (int> x y) -## ## (-> Int Int Bool) -## ## (jvm-lgt x y)) - -## ## (def (int< x y) -## ## (-> Int Int Bool) -## ## (jvm-llt x y)) - -## ## (def inc -## ## (-> Int Int) -## ## (int+ 1)) - -## ## (def dec -## ## (-> Int Int) -## ## (int+ -1)) - -## ## (def (repeat n x) -## ## (All [a] (-> Int a (List a))) -## ## (if (int> n 0) -## ## (#Cons [x (repeat (dec n) x)]) -## ## #Nil)) - -## ## (def size -## ## (All [a] -## ## (-> (List a) Int)) -## ## (fold (lambda [acc _] (inc acc)) 0)) - -## ## (def (last xs) -## ## (All [a] -## ## (-> (List a) (Maybe a))) -## ## (case' xs -## ## #Nil #None -## ## (#Cons [x #Nil]) (#Some x) -## ## (#Cons [_ xs']) (last xs'))) - -## ## (def (init xs) -## ## (All [a] -## ## (-> (List a) (Maybe (List a)))) -## ## (case' xs -## ## #Nil #None -## ## (#Cons [_ #Nil]) (#Some #Nil) -## ## (#Cons [x xs']) (case' (init xs') -## ## (#Some xs'') -## ## (#Some (#Cons [x xs''])) - -## ## _ -## ## (#Some (#Cons [x #Nil]))))) - -## ## (defmacro (cond tokens) -## ## (case' (reverse tokens) -## ## (#Cons [else branches']) -## ## (return (list (fold (lambda [else branch] -## ## (case' branch -## ## [test then] -## ## (` (if (~ test) (~ then) (~ else))))) -## ## else -## ## (|> branches' reverse as-pairs)))))) - -## ## (def (interleave xs ys) -## ## (All [a] -## ## (-> (List a) (List a) (List a))) -## ## (case' [xs ys] -## ## [(#Cons [x xs']) (#Cons [y ys'])] -## ## (list+ x y (interleave xs' ys')) - -## ## _ -## ## #Nil)) - -## ## (def (interpose sep xs) -## ## (All [a] -## ## (-> a (List a) (List a))) -## ## (case' xs -## ## #Nil -## ## xs - -## ## (#Cons [x #Nil]) -## ## xs - -## ## (#Cons [x xs']) -## ## (list+ x sep (interpose sep xs')))) - -## ## (def (empty? xs) -## ## (All [a] -## ## (-> (List a) Bool)) -## ## (case' xs -## ## #Nil true -## ## _ false)) - -## ## ## ## ## (do-template [<name> <op>] -## ## ## ## ## (def (<name> p xs) -## ## ## ## ## (case xs -## ## ## ## ## #Nil true -## ## ## ## ## (#Cons [x xs']) (<op> (p x) (<name> p xs')))) - -## ## ## ## ## [every? and] -## ## ## ## ## [any? or]) - -## ## (def (range from to) -## ## (-> Int Int (List Int)) -## ## (if (int< from to) -## ## (#Cons [from (range (inc from) to)]) -## ## #Nil)) - -## ## (def (tuple->list tuple) -## ## (-> Syntax (List Syntax)) -## ## (case' tuple -## ## (#Meta [_ (#Tuple list)]) -## ## list)) - -## ## (def (zip2 xs ys) -## ## (All [a b] -## ## (-> (List a) (List b) (List (, a b)))) -## ## (case' [xs ys] -## ## [(#Cons [x xs']) (#Cons [y ys'])] -## ## (#Cons [[x y] (zip2 xs' ys')]) - -## ## _ -## ## #Nil)) - -## ## (def (get key map) -## ## (All [a b] -## ## (-> a (List (, a b)) (Maybe b))) -## ## (case' map -## ## #Nil -## ## #None - -## ## (#Cons [[k v] map']) -## ## (if (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] -## ## k [key]) -## ## (#Some v) -## ## (get key map')))) - -## ## (def (get-ident x) -## ## (-> Syntax Text) -## ## (case' x -## ## (#Meta [_ (#Symbol [_ ident])]) -## ## ident)) - -## ## (def (text-++ x y) -## ## (-> Text Text Text) -## ## (jvm-invokevirtual java.lang.String "concat" [java.lang.String] -## ## x [y])) - -## ## (def (show-env env) -## ## ... -## ## (|> env (map first) (interpose ", ") (fold text-++ ""))) - -## ## (def (apply-template env template) -## ## (case' template -## ## (#Meta [_ (#Symbol [_ ident])]) -## ## (case' (get ident env) -## ## (#Some subst) -## ## subst - -## ## _ -## ## template) - -## ## (#Meta [_ (#Tuple elems)]) -## ## (_meta (#Tuple (map (apply-template env) elems))) - -## ## (#Meta [_ (#Form elems)]) -## ## (_meta (#Form (map (apply-template env) elems))) - -## ## (#Meta [_ (#Record members)]) -## ## (_meta (#Record (map (lambda [kv] -## ## (case' kv -## ## [slot value] -## ## [(apply-template env slot) (apply-template env value)])) -## ## members))) - -## ## _ -## ## template)) - -## ## (defmacro (do-templates tokens) -## ## (case' tokens -## ## (#Cons [bindings (#Cons [(#Meta [_ (#Tuple templates)]) data])]) -## ## (let [bindings-list (map get-ident (tuple->list bindings)) -## ## data-lists (map tuple->list data) -## ## apply (lambda [env] (map (apply-template env) templates))] -## ## (|> data-lists -## ## (map (. apply (zip2 bindings-list))) -## ## return)))) - -## ## ## ## ## (do-template [<name> <offset>] -## ## ## ## ## (def <name> (int+ <offset>)) - -## ## ## ## ## [inc 1] -## ## ## ## ## [dec -1]) - -## ## (def (int= x y) -## ## (-> Int Int Bool) -## ## (jvm-leq x y)) - -## ## (def (int% x y) -## ## (-> Int Int Int) -## ## (jvm-lrem x y)) - -## ## (def (int>= x y) -## ## (-> Int Int Bool) -## ## (or (int= x y) -## ## (int> x y))) - -## ## (do-templates [<name> <cmp>] -## ## [(def (<name> x y) -## ## (-> Int Int Int) -## ## (if (<cmp> x y) -## ## x -## ## y))] - -## ## [max int>] -## ## [min int<]) - -## ## (do-templates [<name> <cmp>] -## ## [(def (<name> n) -## ## (-> Int Bool) -## ## (<cmp> n 0))] - -## ## [neg? int<] -## ## [pos? int>=]) - -## ## (def (even? n) -## ## (-> Int Bool) -## ## (int= 0 (int% n 0))) - -## ## (def (odd? n) -## ## (-> Int Bool) -## ## (not (even? n))) - -## ## (do-templates [<name> <done> <step>] -## ## [(def (<name> n xs) -## ## (All [a] -## ## (-> Int (List a) (List a))) -## ## (if (int> n 0) -## ## (case' xs -## ## #Nil #Nil -## ## (#Cons [x xs']) <step>) -## ## <done>))] - -## ## [take #Nil (list+ x (take (dec n) xs'))] -## ## [drop xs (drop (dec n) xs')]) - -## ## (do-templates [<name> <done> <step>] -## ## [(def (<name> f xs) -## ## (All [a] -## ## (-> (-> a Bool) (List a) (List a))) -## ## (case' xs -## ## #Nil #Nil -## ## (#Cons [x xs']) (if (f x) <step> #Nil)))] - -## ## [take-while #Nil (list+ x (take-while f xs'))] -## ## [drop-while xs (drop-while f xs')]) - -## ## ## (defmacro (get@ tokens) -## ## ## (let [output (case' tokens -## ## ## (#Cons [tag (#Cons [record #Nil])]) -## ## ## (` (get@' (~ tag) (~ record))) - -## ## ## (#Cons [tag #Nil]) -## ## ## (` (lambda [record] (get@' (~ tag) record))))] -## ## ## (return (list output)))) - -## ## ## (defmacro (set@ tokens) -## ## ## (let [output (case' tokens -## ## ## (#Cons [tag (#Cons [value (#Cons [record #Nil])])]) -## ## ## (` (set@' (~ tag) (~ value) (~ record))) - -## ## ## (#Cons [tag (#Cons [value #Nil])]) -## ## ## (` (lambda [record] (set@' (~ tag) (~ value) record))) - -## ## ## (#Cons [tag #Nil]) -## ## ## (` (lambda [value record] (set@' (~ tag) value record))))] -## ## ## (return (list output)))) - -## ## ## (defmacro (update@ tokens) -## ## ## (let [output (case' tokens -## ## ## (#Cons [tag (#Cons [func (#Cons [record #Nil])])]) -## ## ## (` (let [_record_ (~ record)] -## ## ## (set@' (~ tag) ((~ func) (get@' (~ tag) _record_)) _record_))) - -## ## ## (#Cons [tag (#Cons [func #Nil])]) -## ## ## (` (lambda [record] -## ## ## (` (set@' (~ tag) ((~ func) (get@' (~ tag) record)) record)))) - -## ## ## (#Cons [tag #Nil]) -## ## ## (` (lambda [func record] -## ## ## (set@' (~ tag) (func (get@' (~ tag) record)) record))))] -## ## ## (return (list output)))) - -## ## (def (show-int int) -## ## (-> Int Text) -## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## int [])) - -## ## (def gensym -## ## (LuxStateM Syntax) -## ## (lambda [state] -## ## [(update@ [#gen-seed] inc state) -## ## (_meta (#Symbol ($ text-++ "__" (show-int (get@ [#gen-seed] state)) "__")))])) - -## ## ## (do-template [<name> <member>] -## ## ## (def (<name> pair) -## ## ## (case' pair -## ## ## [f s] -## ## ## <member>)) - -## ## ## [first f] -## ## ## [second s]) - -## ## (def (show-syntax syntax) -## ## (-> Syntax Text) -## ## (case' syntax -## ## (#Meta [_ (#Bool value)]) -## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## value []) - -## ## (#Meta [_ (#Int value)]) -## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## value []) - -## ## (#Meta [_ (#Real value)]) -## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## value []) - -## ## (#Meta [_ (#Char value)]) -## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## value []) - -## ## (#Meta [_ (#Text value)]) -## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## value []) - -## ## (#Meta [_ (#Symbol [module name])]) -## ## ($ text-++ module ";" name) - -## ## (#Meta [_ (#Tag [module name])]) -## ## ($ text-++ "#" module ";" name) - -## ## (#Meta [_ (#Tuple members)]) -## ## ($ text-++ "[" (fold text-++ "" (interpose " " (map show-syntax members))) "]") - -## ## (#Meta [_ (#Form members)]) -## ## ($ text-++ "(" (fold text-++ "" (interpose " " (map show-syntax members))) ")") -## ## )) - -## ## (defmacro (do tokens) -## ## (case' tokens -## ## (#Cons [(#Meta [_ monad]) (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])]) -## ## (let [output (fold (lambda [body binding] -## ## (case' binding -## ## [lhs rhs] -## ## (` (lux;bind (lambda [(~ lhs)] (~ body)) -## ## (~ rhs))))) -## ## body -## ## (reverse (as-pairs bindings)))] -## ## (return (list (` (using (~ monad) (~ output)))))))) - -## ## (def (map% f xs) -## ## (All [m a b] -## ## (-> (-> a (m b)) (List a) (m (List b)))) -## ## (case' xs -## ## #Nil -## ## (return xs) - -## ## (#Cons [x xs']) -## ## (do [y (f x) -## ## ys (map% f xs')] -## ## (return (#Cons [y ys]))))) - -## ## ## (defmacro ($keys tokens) +## ## (def' let' +## ## (lambda' _ tokens +## ## (lambda' _ state +## ## (case' tokens +## ## (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) +## ## (#Right [state +## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"])) +## ## (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))) +## ## #Nil])]) + +## ## _ +## ## (#Left "Wrong syntax for let'")) +## ## ))) +## ## (declare-macro' let') + +## ## ## ## (All 21268 +## ## ## ## (-> 21268 +## ## ## ## (All 21267 +## ## ## ## (-> 21267 +## ## ## ## (| (#lux;Right (, 21267 +## ## ## ## (| (#lux;Cons (, (((All Meta m (All v (| (#lux;Meta (, m v))))) +## ## ## ## (, (^ java.lang.String []) (^ java.lang.Long []) (^ java.lang.Long []))) +## ## ## ## ⌈17⌋) +## ## ## ## (| (#lux;Nil (, ))))))))))))) + +## ## ## (def' lambda +## ## ## (check' Macro +## ## ## (lambda' _ tokens +## ## ## (lambda' _ state +## ## ## (let' output (case' tokens +## ## ## (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])]) +## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"])) +## ## ## (#Cons [(_meta (#Symbol ["" ""])) +## ## ## (#Cons [arg +## ## ## (#Cons [(case' args' +## ## ## #Nil +## ## ## body + +## ## ## _ +## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) +## ## ## (#Cons [(_meta (#Tuple args')) +## ## ## (#Cons [body #Nil])])])))) +## ## ## #Nil])])])]))) + +## ## ## (#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])]) +## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "lambda'"])) +## ## ## (#Cons [(_meta (#Symbol self)) +## ## ## (#Cons [arg +## ## ## (#Cons [(case' args' +## ## ## #Nil +## ## ## body + +## ## ## _ +## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) +## ## ## (#Cons [(_meta (#Tuple args')) +## ## ## (#Cons [body #Nil])])])))) +## ## ## #Nil])])])])))) +## ## ## (#Right [state (#Cons [output #Nil])])) +## ## ## )))) +## ## ## (declare-macro lambda) + +## ## ## (def' def +## ## ## (check' Macro +## ## ## (lambda [tokens state] +## ## ## (let' output (case' tokens +## ## ## (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [body #Nil])]) +## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) tokens]))) + +## ## ## (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) +## ## ## (#Cons [body #Nil])]) +## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) +## ## ## (#Cons [(_meta (#Symbol name)) +## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) +## ## ## (#Cons [(_meta (#Symbol name)) +## ## ## (#Cons [(_meta (#Tuple args)) +## ## ## (#Cons [body #Nil])])])]))) +## ## ## #Nil])])]))) + +## ## ## (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type (#Cons [body #Nil])])]) +## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) +## ## ## (#Cons [(_meta (#Symbol name)) +## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "check'"])) +## ## ## (#Cons [type +## ## ## (#Cons [body +## ## ## #Nil])])]))) +## ## ## #Nil])])]))) + +## ## ## (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) +## ## ## (#Cons [type (#Cons [body #Nil])])]) +## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"])) +## ## ## (#Cons [(_meta (#Symbol name)) +## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "check'"])) +## ## ## (#Cons [type +## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) +## ## ## (#Cons [(_meta (#Symbol name)) +## ## ## (#Cons [(_meta (#Tuple args)) +## ## ## (#Cons [body #Nil])])])]))) +## ## ## #Nil])])]))) +## ## ## #Nil])])])))) +## ## ## (#Right [state (#Cons [output #Nil])]))))) +## ## ## (declare-macro def) + +## ## ## (def (defmacro tokens state) +## ## ## (let' [fn-name fn-def] (case' tokens +## ## ## (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol fn-name)]) args]))]) +## ## ## (#Cons [body #Nil])]) +## ## ## [fn-name +## ## ## (_meta (#Form (#Cons [(_meta (#Symbol ["lux" "def"])) +## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol fn-name)) args]))) +## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "check'"])) +## ## ## (#Cons [(_meta (#Symbol ["lux;" "Macro"])) +## ## ## (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda"])) +## ## ## (#Cons [(_meta (#Symbol name)) +## ## ## (#Cons [(_meta (#Tuple args)) +## ## ## (#Cons [body #Nil])])])]))) +## ## ## #Nil])])]))) +## ## ## #Nil])])])))]) +## ## ## (let' declaration (_meta (#Form (#Cons [(_meta (#Symbol ["" "declare-macro"])) (#Cons [(_meta (#Symbol fn-name)) #Nil])]))) +## ## ## (#Right [state (#Cons [fn-def (#Cons [declaration #Nil])])])))) +## ## ## (declare-macro defmacro) + +## ## ## (defmacro (comment tokens state) +## ## ## (#Right [state #Nil])) + +## ## ## (def (int+ x y) +## ## ## (-> Int Int Int) +## ## ## (jvm-ladd x y)) + +## ## ## (def (id x) +## ## ## (All [a] (-> a a)) +## ## ## x) + +## ## ## (def (print x) +## ## ## (-> (^ java.lang.Object) []) +## ## ## (jvm-invokevirtual java.io.PrintStream "print" [java.lang.Object] +## ## ## (jvm-getstatic java.lang.System "out") [x])) + +## ## ## (def (println x) +## ## ## (-> (^ java.lang.Object) []) +## ## ## (jvm-invokevirtual java.io.PrintStream "println" [java.lang.Object] +## ## ## (jvm-getstatic java.lang.System "out") [x])) + +## ## ## (deftype (IO a) +## ## ## (-> (,) a)) + +## ## ## (defmacro (io tokens) ## ## ## (case' tokens -## ## ## (#Cons [(#Meta [_ (#Tuple fields)]) #Nil]) -## ## ## (return (list (_meta (#Record (map (lambda [slot] -## ## ## (case' slot -## ## ## (#Meta [_ (#Tag [module name])]) -## ## ## [($ text-++ module ";" name) (_meta (#Symbol [module name]))])) -## ## ## fields))))))) - -## ## ## (defmacro ($or tokens) +## ## ## (#Cons [value #Nil]) +## ## ## (return (list (` (lambda [_] (~ value))))))) + +## ## ## (def (fold f init xs) +## ## ## (All [a b] +## ## ## (-> (-> a b a) a (List b) a)) +## ## ## (case' xs +## ## ## #Nil +## ## ## init + +## ## ## (#Cons [x xs']) +## ## ## (fold f (f init x) xs'))) + +## ## ## (def (reverse list) +## ## ## (All [a] +## ## ## (-> (List a) (List a))) +## ## ## (fold (lambda [tail head] +## ## ## (#Cons [head tail])) +## ## ## #Nil +## ## ## list)) + +## ## ## (defmacro (list xs state) +## ## ## (let' xs' (reverse xs) +## ## ## (let' output (fold (lambda [tail head] +## ## ## (_meta (#Form (#Cons [(_meta (#Tag ["lux" "Cons"])) +## ## ## (#Cons [(_meta (#Tuple (#Cons [head (#Cons [tail #Nil])]))) +## ## ## #Nil])])))) +## ## ## (_meta (#Tag ["lux" "Nil"])) +## ## ## xs') +## ## ## (#Right [state (#Cons [output #Nil])])))) + +## ## ## (defmacro (list+ xs state) +## ## ## (case' (reverse xs) +## ## ## #Nil +## ## ## [#Nil state] + +## ## ## (#Cons [last init']) +## ## ## (let' output (fold (lambda [tail head] +## ## ## (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) (_meta (#Tuple (list head tail))))))) +## ## ## last +## ## ## init') +## ## ## (#Right [state (#Cons [output #Nil])])))) + +## ## ## (def (as-pairs xs) +## ## ## (All [a] +## ## ## (-> (List a) (List [a a]))) +## ## ## (case' xs +## ## ## (#Cons [x (#Cons [y xs'])]) +## ## ## (#Cons [[x y] (as-pairs xs')]) + +## ## ## _ +## ## ## #Nil)) + +## ## ## (defmacro (let tokens state) ## ## ## (case' tokens -## ## ## (#Cons [(#Meta [_ (#Tuple patterns)]) (#Cons [body #Nil])]) -## ## ## (return (flat-map (lambda [pattern] (list pattern body)) -## ## ## patterns)))) - -## ## ## (def null jvm-null) - -## ## (defmacro (^ tokens) -## ## (case' tokens -## ## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) #Nil]) -## ## (return (list (` (#DataT (~ (_meta (#Text class-name))))))) -## ## )) - -## ## (defmacro (, members) -## ## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "TupleT"])) (untemplate-list members))))))) - -## ## (defmacro (| members) -## ## (let [members' (map (lambda [m] -## ## (case' m -## ## (#Meta [_ (#Tag [module name])]) -## ## [($ text-++ module ";" name) (` (#Tuple (list)))] - -## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) -## ## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) -## ## members)] -## ## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "VariantT"])) (untemplate-list members)))))))) - -## ## (defmacro (& members) -## ## (let [members' (map (lambda [m] -## ## (case' m -## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) -## ## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) -## ## members)] -## ## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "RecordT"])) (untemplate-list members)))))))) - -## ## (defmacro (-> tokens) -## ## (case' (reverse tokens) -## ## (#Cons [f-return f-args]) -## ## (fold (lambda [f-return f-arg] -## ## (` (#LambdaT [(~ f-arg) (~ f-return)]))) -## ## f-return -## ## f-args))) - -## ## (def (text= x y) -## ## (-> Text Text Bool) -## ## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] -## ## x [y])) - -## ## (def (replace-ident ident value syntax) -## ## (-> (, Text Text) Syntax Syntax Syntax) -## ## (let [[module name] ident] -## ## (case' syntax -## ## (#Meta [_ (#Symbol [?module ?name])]) -## ## (if (and (text= module ?module) -## ## (text= name ?name)) -## ## value -## ## syntax) - -## ## (#Meta [_ (#Form members)]) -## ## (_meta (#Form (map (replace-ident ident value) members))) - -## ## (#Meta [_ (#Tuple members)]) -## ## (_meta (#Tuple (map (replace-ident ident value) members))) - -## ## (#Meta [_ (#Record members)]) -## ## (_meta (#Record (map (lambda [kv] -## ## (case' kv -## ## [k v] -## ## [k (replace-ident ident value v)])) -## ## members))) - -## ## _ -## ## syntax))) - -## ## (defmacro (All tokens) -## ## (let [[name args body] (case' tokens -## ## (#Cons [(#Meta [_ (#Symbol [_ name])]) (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])]) -## ## [name args body] - -## ## (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) -## ## ["" args body]) -## ## rolled (fold (lambda [body arg] -## ## (case' arg -## ## (#Meta [_ (#Symbol [arg-module arg-name])]) -## ## (` (#AllT (list) "" (~ (_meta (#Text arg-name))) (~ (replace-ident [arg-module arg-name] -## ## (` (#BoundT (~ (#Text arg-name)))) -## ## body)))))) -## ## body -## ## args)] -## ## (case' rolled -## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ["lux" "AllT"])]) (#Cons [env (#Cons [(#Meta [_ (#Text "")]) (#Cons [(#Meta [_ (#Text arg-name)]) (#Cons [body #Nil])])])])]))]) -## ## (return (list (` (#AllT (~ env) (~ (#Text name)) (~ (#Text arg-name)) -## ## (~ (replace-ident arg-name (` (#BoundT (~ (#Text name)))) -## ## body))))))))) - -## ## (defmacro (Exists tokens) -## ## (case' tokens -## ## (#Cons [args (#Cons [body #Nil])]) -## ## (return (list (` (All (~ args) (~ body))))))) - -## ## (def Any #AnyT) -## ## (def Nothing #NothingT) -## ## (def Bool (^ java.lang.Boolean)) -## ## (def Int (^ java.lang.Long)) -## ## (def Real (^ java.lang.Double)) -## ## (def Char (^ java.lang.Character)) -## ## (def Text (^ java.lang.String)) - -## ## (deftype (List a) -## ## (| #Nil -## ## (#Cons (, a (List a))))) - -## ## (deftype #rec Type -## ## (| #AnyT -## ## #NothingT -## ## (#DataT Text) -## ## (#TupleT (List Type)) -## ## (#VariantT (List (, Text Type))) -## ## (#RecordT (List (, Text Type))) -## ## (#LambdaT (, Type Type)) -## ## (#BoundT Text) -## ## (#VarT Int) -## ## (#AllT (, (List (, Text Type)) Text Text Type)) -## ## (#AppT (, Type Type)))) - -## ## (deftype (Either l r) -## ## (| (#Left l) -## ## (#Right r))) +## ## ## (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])]) +## ## ## (let' output (fold (lambda [body binding] +## ## ## (case' binding +## ## ## [label value] +## ## ## (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body))))) +## ## ## body +## ## ## (reverse (as-pairs bindings))) +## ## ## (#Right [state (list output)])))) + +## ## ## (def (. f g) +## ## ## (All [a b c] +## ## ## (-> (-> b c) (-> a b) (-> a c))) +## ## ## (lambda [x] (f (g x)))) + +## ## ## (def (++ xs ys) +## ## ## (All [a] +## ## ## (-> (List a) (List a) (List a))) +## ## ## (case' xs +## ## ## #Nil +## ## ## ys + +## ## ## (#Cons [x xs']) +## ## ## (#Cons [x (++ xs' ys)]))) + +## ## ## (def concat +## ## ## (All [a] +## ## ## (-> (List (List a)) (List a))) +## ## ## (fold ++ #Nil)) + +## ## ## (def (map f xs) +## ## ## (All [a b] +## ## ## (-> (-> a b) (List a) (List b))) +## ## ## (case' xs +## ## ## #Nil +## ## ## #Nil + +## ## ## (#Cons [x xs']) +## ## ## (#Cons [(f x) (map f xs')]))) + +## ## ## (def flat-map +## ## ## (All [a b] +## ## ## (-> (-> a (List b)) (List a) (List b))) +## ## ## (. concat map)) + +## ## ## (def (wrap-meta content) +## ## ## ... +## ## ## (_meta (#Form (list (_meta (#Tag ["lux" "Meta"])) +## ## ## (_meta (#Tuple (list (_meta (#Tuple (list (_meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text ""))))) +## ## ## (_meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int -1))))) +## ## ## (_meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int -1)))))))) +## ## ## (_meta content)))))))) + +## ## ## (def (untemplate-list tokens) +## ## ## (-> (List Syntax) Syntax) +## ## ## (case' tokens +## ## ## #Nil +## ## ## (_meta (#Tag ["lux" "Nil"])) -## ## (deftype #rec Syntax -## ## (| (#Bool Bool) -## ## (#Int Int) -## ## (#Real Real) -## ## (#Char Char) -## ## (#Text Text) -## ## (#Form (List Syntax)) -## ## (#Tuple (List Syntax)) -## ## (#Record (List (, Text Syntax))))) - -## ## (deftype Macro -## ## (-> (List Syntax) CompilerState -## ## (Either Text (, CompilerState (List Syntax))))) - -## ## (def (macro-expand syntax) -## ## (-> Syntax (LuxStateM (List Syntax))) -## ## (case' syntax -## ## (#Form (#Cons [(#Symbol macro-name) args])) -## ## (do [macro (get-macro macro-name)] -## ## ((coerce macro Macro) args)))) - -## ## (defmacro (case tokens) -## ## (case' tokens -## ## (#Cons value branches) -## ## (loop [kind #Pattern -## ## pieces branches -## ## new-pieces (list)] -## ## (case' pieces -## ## #Nil -## ## (return (list (' (case' (~ value) (~@ new-pieces))))) - -## ## (#Cons piece pieces') -## ## (let [[kind' expanded more-pieces] (case' kind -## ## #Body -## ## [#Pattern (list piece) #Nil] - -## ## #Pattern -## ## (do [expansion (macro-expand piece)] -## ## (case' expansion -## ## #Nil -## ## [#Pattern #Nil #Nil] - -## ## (#Cons exp #Nil) -## ## [#Body (list exp) #Nil] - -## ## (#Cons exp exps) -## ## [#Body (list exp) exps])) -## ## )] -## ## (recur kind' (++ expanded new-pieces) (++ more-pieces pieces)))) -## ## ))) - -## ## (def (defsyntax tokens) -## ## ...) - -## ## (deftype (State s a) -## ## (-> s (, s a))) - -## ## (deftype (Parser a) -## ## (State (List Syntax) a)) - -## ## (def (parse-ctor tokens) -## ## (Parser (, Syntax (List Syntax))) -## ## (case tokens -## ## (list+ (#Symbol name) tokens') -## ## [tokens' [(#Symbol name) (list)]] - -## ## (list+ (#Form (list+ (#Symbol name) args)) tokens') -## ## [tokens' [(#Symbol name) args]])) - -## ## (defsyntax (defsig -## ## [[name args] parse-ctor] -## ## [anns ($+ $1)]) -## ## (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) -## ## (` (#Record (~ (untemplate-list ...)))) -## ## args)] -## ## (return (list (` (def (~ name) (~ def-body))))))) - -## ## (defsyntax (defstruct -## ## [[name args] parse-ctor] -## ## signature -## ## [defs ($+ $1)]) -## ## (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) -## ## (` (#Record (~ (untemplate-list ...)))) -## ## args)] -## ## (return (list (` (def (~ name) -## ## (: (~ def-body) (~ signature)))))))) - -## ## (defsig (Monad m) -## ## (: return (All [a] (-> a (m a)))) -## ## (: bind (All [a b] (-> (-> a (m b)) (m a) (m b))))) - -## ## (defstruct ListMonad (Monad List) -## ## (def (return x) -## ## (list x)) - -## ## (def bind (. concat map))) - -## ## (defsig (Eq a) -## ## (: = (-> a a Bool))) - -## ## (defstruct (List_Eq A_Eq) -## ## (All [a] (-> (Eq a) (Eq (List a)))) - -## ## (def (= xs ys) -## ## (and (= (length xs) (length ys)) -## ## (map (lambda [[x y]] -## ## (with A_Eq -## ## (= x y))) -## ## (zip2 xs ys))))) - -## ## ## ## (def (with tokens) -## ## ## ## ...) - -## ## ## ## TODO: Full pattern-matching -## ## ## ## TODO: Type-related macros -## ## ## ## TODO: (Im|Ex)ports-related macros -## ## ## ## TODO: Macro-related macros - -## ## ## ## (import "lux") -## ## ## ## (module-alias "lux" "l") -## ## ## ## (def-alias "lux;map" "map") - -## ## ## ## (def (require tokens) -## ## ## ## (case tokens -## ## ## ## ...)) - -## ## ## ## (require lux #as l #refer [map]) +## ## ## (#Cons [token tokens']) +## ## ## (_meta (#Form (list (_meta (#Tag ["lux" "Cons"])) +## ## ## (_meta (#Tuple (list token (untemplate-list tokens'))))))))) + +## ## ## (def (untemplate token) +## ## ## ... +## ## ## (case' token +## ## ## (#Meta [_ (#Bool value)]) +## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Bool"])) (_meta (#Bool value))))) + +## ## ## (#Meta [_ (#Int value)]) +## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int value))))) + +## ## ## (#Meta [_ (#Real value)]) +## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Real"])) (_meta (#Real value))))) + +## ## ## (#Meta [_ (#Char value)]) +## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Char"])) (_meta (#Char value))))) + +## ## ## (#Meta [_ (#Text value)]) +## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text value))))) + +## ## ## (#Meta [_ (#Tag [module name])]) +## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tag"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name)))))))) + +## ## ## (#Meta [_ (#Symbol [module name])]) +## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Symbol"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name)))))))) + +## ## ## (#Meta [_ (#Tuple elems)]) +## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tuple"])) (untemplate-list (map untemplate elems))))) + +## ## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol [_ "~"])]) (#Cons [(#Meta [_ unquoted]) #Nil])]))]) +## ## ## (_meta unquoted) + +## ## ## (#Meta [_ (#Form elems)]) +## ## ## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Form"])) (untemplate-list (map untemplate elems))))) +## ## ## )) + +## ## ## (defmacro (` tokens state) +## ## ## (case' tokens +## ## ## (#Cons [template #Nil]) +## ## ## (#Right [state (list (untemplate template))]))) + +## ## ## (defmacro (if tokens state) +## ## ## (case' tokens +## ## ## (#Cons [test (#Cons [then (#Cons [else #Nil])])]) +## ## ## (#Right [state +## ## ## (list (` (case' (~ test) +## ## ## true (~ then) +## ## ## false (~ else))))]))) + +## ## ## (def (filter p xs) +## ## ## (All [a] +## ## ## (-> (-> a Bool) (List a) (List a))) +## ## ## (case' xs +## ## ## #Nil +## ## ## #Nil + +## ## ## (#Cons [x xs']) +## ## ## (if (p x) +## ## ## (#Cons [x (filter p xs')]) +## ## ## (filter p xs')))) + +## ## ## (deftype (LuxStateM a) +## ## ## (-> CompilerState (Either Text [CompilerState a]))) + +## ## ## (def (return val) +## ## ## (All [a] +## ## ## (-> a (LuxStateM a))) +## ## ## (lambda [state] +## ## ## (#Right [state val]))) + +## ## ## (def (fail msg) +## ## ## (-> Text (LuxStateM Nothing)) +## ## ## (lambda [_] +## ## ## (#Left msg))) + +## ## ## (def (bind f v) +## ## ## (All [m a b] (-> (-> a (m b)) (m a) (m b))) +## ## ## (lambda [state] +## ## ## (case' (v state) +## ## ## (#Right [state' x]) +## ## ## (f x state') + +## ## ## (#Left msg) +## ## ## (#Left msg)))) + +## ## ## (def (first pair) +## ## ## (All [a b] (-> (, a b) a)) +## ## ## (case' pair +## ## ## [f s] +## ## ## f)) + +## ## ## (def (second pair) +## ## ## (All [a b] (-> (, a b) b)) +## ## ## (case' pair +## ## ## [f s] +## ## ## s)) + +## ## ## (defmacro (loop tokens) +## ## ## (case' tokens +## ## ## (#Cons [bindings (#Cons [body #Nil])]) +## ## ## (let [pairs (as-pairs bindings)] +## ## ## (return (list (#Form (#Cons [(` (lambda (~ (#Symbol ["lux" "recur"])) (~ (#Tuple (map first pairs))) +## ## ## (~ body))) +## ## ## (map second pairs)]))))))) + +## ## ## (defmacro (export tokens) +## ## ## (return (map (lambda [t] (` (export' (~ t)))) +## ## ## tokens))) + +## ## ## (defmacro (and tokens) +## ## ## (let [as-if (case' tokens +## ## ## #Nil +## ## ## (` true) + +## ## ## (#Cons [init tests]) +## ## ## (fold (lambda [prev next] +## ## ## (` (if (~ prev) (~ next) false))) +## ## ## init +## ## ## tokens) +## ## ## )] +## ## ## (return (list as-if)))) + +## ## ## (defmacro (or tokens) +## ## ## (let [as-if (case' tokens +## ## ## #Nil +## ## ## (` false) + +## ## ## (#Cons [init tests]) +## ## ## (fold (lambda [prev next] +## ## ## (` (if (~ prev) true (~ next)))) +## ## ## init +## ## ## tokens) +## ## ## )] +## ## ## (return (list as-if)))) + +## ## ## (def (not x) +## ## ## (-> Bool Bool) +## ## ## (case' x +## ## ## true false +## ## ## false true)) + +## ## ## (defmacro (|> tokens) +## ## ## (case' tokens +## ## ## (#Cons [init apps]) +## ## ## (return (list (fold (lambda [acc app] +## ## ## (case' app +## ## ## (#Form parts) +## ## ## (#Form (++ parts (list acc))) + +## ## ## _ +## ## ## (` ((~ app) (~ acc))))) +## ## ## init +## ## ## apps))))) + +## ## ## (defmacro ($ tokens) +## ## ## (case' tokens +## ## ## (#Cons [op (#Cons [init args])]) +## ## ## (return (list (fold (lambda [acc elem] +## ## ## (` ((~ op) (~ acc) (~ elem)))) +## ## ## init +## ## ## args))))) + +## ## ## (def (const x) +## ## ## (All [a] +## ## ## (-> a (-> Any a))) +## ## ## (lambda [_] +## ## ## x)) + +## ## ## (def (int> x y) +## ## ## (-> Int Int Bool) +## ## ## (jvm-lgt x y)) + +## ## ## (def (int< x y) +## ## ## (-> Int Int Bool) +## ## ## (jvm-llt x y)) + +## ## ## (def inc +## ## ## (-> Int Int) +## ## ## (int+ 1)) + +## ## ## (def dec +## ## ## (-> Int Int) +## ## ## (int+ -1)) + +## ## ## (def (repeat n x) +## ## ## (All [a] (-> Int a (List a))) +## ## ## (if (int> n 0) +## ## ## (#Cons [x (repeat (dec n) x)]) +## ## ## #Nil)) + +## ## ## (def size +## ## ## (All [a] +## ## ## (-> (List a) Int)) +## ## ## (fold (lambda [acc _] (inc acc)) 0)) + +## ## ## (def (last xs) +## ## ## (All [a] +## ## ## (-> (List a) (Maybe a))) +## ## ## (case' xs +## ## ## #Nil #None +## ## ## (#Cons [x #Nil]) (#Some x) +## ## ## (#Cons [_ xs']) (last xs'))) + +## ## ## (def (init xs) +## ## ## (All [a] +## ## ## (-> (List a) (Maybe (List a)))) +## ## ## (case' xs +## ## ## #Nil #None +## ## ## (#Cons [_ #Nil]) (#Some #Nil) +## ## ## (#Cons [x xs']) (case' (init xs') +## ## ## (#Some xs'') +## ## ## (#Some (#Cons [x xs''])) + +## ## ## _ +## ## ## (#Some (#Cons [x #Nil]))))) + +## ## ## (defmacro (cond tokens) +## ## ## (case' (reverse tokens) +## ## ## (#Cons [else branches']) +## ## ## (return (list (fold (lambda [else branch] +## ## ## (case' branch +## ## ## [test then] +## ## ## (` (if (~ test) (~ then) (~ else))))) +## ## ## else +## ## ## (|> branches' reverse as-pairs)))))) + +## ## ## (def (interleave xs ys) +## ## ## (All [a] +## ## ## (-> (List a) (List a) (List a))) +## ## ## (case' [xs ys] +## ## ## [(#Cons [x xs']) (#Cons [y ys'])] +## ## ## (list+ x y (interleave xs' ys')) + +## ## ## _ +## ## ## #Nil)) + +## ## ## (def (interpose sep xs) +## ## ## (All [a] +## ## ## (-> a (List a) (List a))) +## ## ## (case' xs +## ## ## #Nil +## ## ## xs + +## ## ## (#Cons [x #Nil]) +## ## ## xs + +## ## ## (#Cons [x xs']) +## ## ## (list+ x sep (interpose sep xs')))) + +## ## ## (def (empty? xs) +## ## ## (All [a] +## ## ## (-> (List a) Bool)) +## ## ## (case' xs +## ## ## #Nil true +## ## ## _ false)) + +## ## ## ## ## ## (do-template [<name> <op>] +## ## ## ## ## ## (def (<name> p xs) +## ## ## ## ## ## (case xs +## ## ## ## ## ## #Nil true +## ## ## ## ## ## (#Cons [x xs']) (<op> (p x) (<name> p xs')))) + +## ## ## ## ## ## [every? and] +## ## ## ## ## ## [any? or]) + +## ## ## (def (range from to) +## ## ## (-> Int Int (List Int)) +## ## ## (if (int< from to) +## ## ## (#Cons [from (range (inc from) to)]) +## ## ## #Nil)) + +## ## ## (def (tuple->list tuple) +## ## ## (-> Syntax (List Syntax)) +## ## ## (case' tuple +## ## ## (#Meta [_ (#Tuple list)]) +## ## ## list)) + +## ## ## (def (zip2 xs ys) +## ## ## (All [a b] +## ## ## (-> (List a) (List b) (List (, a b)))) +## ## ## (case' [xs ys] +## ## ## [(#Cons [x xs']) (#Cons [y ys'])] +## ## ## (#Cons [[x y] (zip2 xs' ys')]) + +## ## ## _ +## ## ## #Nil)) + +## ## ## (def (get key map) +## ## ## (All [a b] +## ## ## (-> a (List (, a b)) (Maybe b))) +## ## ## (case' map +## ## ## #Nil +## ## ## #None + +## ## ## (#Cons [[k v] map']) +## ## ## (if (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] +## ## ## k [key]) +## ## ## (#Some v) +## ## ## (get key map')))) + +## ## ## (def (get-ident x) +## ## ## (-> Syntax Text) +## ## ## (case' x +## ## ## (#Meta [_ (#Symbol [_ ident])]) +## ## ## ident)) + +## ## ## (def (text-++ x y) +## ## ## (-> Text Text Text) +## ## ## (jvm-invokevirtual java.lang.String "concat" [java.lang.String] +## ## ## x [y])) + +## ## ## (def (show-env env) +## ## ## ... +## ## ## (|> env (map first) (interpose ", ") (fold text-++ ""))) + +## ## ## (def (apply-template env template) +## ## ## (case' template +## ## ## (#Meta [_ (#Symbol [_ ident])]) +## ## ## (case' (get ident env) +## ## ## (#Some subst) +## ## ## subst + +## ## ## _ +## ## ## template) + +## ## ## (#Meta [_ (#Tuple elems)]) +## ## ## (_meta (#Tuple (map (apply-template env) elems))) + +## ## ## (#Meta [_ (#Form elems)]) +## ## ## (_meta (#Form (map (apply-template env) elems))) + +## ## ## (#Meta [_ (#Record members)]) +## ## ## (_meta (#Record (map (lambda [kv] +## ## ## (case' kv +## ## ## [slot value] +## ## ## [(apply-template env slot) (apply-template env value)])) +## ## ## members))) + +## ## ## _ +## ## ## template)) + +## ## ## (defmacro (do-templates tokens) +## ## ## (case' tokens +## ## ## (#Cons [bindings (#Cons [(#Meta [_ (#Tuple templates)]) data])]) +## ## ## (let [bindings-list (map get-ident (tuple->list bindings)) +## ## ## data-lists (map tuple->list data) +## ## ## apply (lambda [env] (map (apply-template env) templates))] +## ## ## (|> data-lists +## ## ## (map (. apply (zip2 bindings-list))) +## ## ## return)))) + +## ## ## ## ## ## (do-template [<name> <offset>] +## ## ## ## ## ## (def <name> (int+ <offset>)) + +## ## ## ## ## ## [inc 1] +## ## ## ## ## ## [dec -1]) + +## ## ## (def (int= x y) +## ## ## (-> Int Int Bool) +## ## ## (jvm-leq x y)) + +## ## ## (def (int% x y) +## ## ## (-> Int Int Int) +## ## ## (jvm-lrem x y)) + +## ## ## (def (int>= x y) +## ## ## (-> Int Int Bool) +## ## ## (or (int= x y) +## ## ## (int> x y))) + +## ## ## (do-templates [<name> <cmp>] +## ## ## [(def (<name> x y) +## ## ## (-> Int Int Int) +## ## ## (if (<cmp> x y) +## ## ## x +## ## ## y))] + +## ## ## [max int>] +## ## ## [min int<]) + +## ## ## (do-templates [<name> <cmp>] +## ## ## [(def (<name> n) +## ## ## (-> Int Bool) +## ## ## (<cmp> n 0))] + +## ## ## [neg? int<] +## ## ## [pos? int>=]) + +## ## ## (def (even? n) +## ## ## (-> Int Bool) +## ## ## (int= 0 (int% n 0))) + +## ## ## (def (odd? n) +## ## ## (-> Int Bool) +## ## ## (not (even? n))) + +## ## ## (do-templates [<name> <done> <step>] +## ## ## [(def (<name> n xs) +## ## ## (All [a] +## ## ## (-> Int (List a) (List a))) +## ## ## (if (int> n 0) +## ## ## (case' xs +## ## ## #Nil #Nil +## ## ## (#Cons [x xs']) <step>) +## ## ## <done>))] + +## ## ## [take #Nil (list+ x (take (dec n) xs'))] +## ## ## [drop xs (drop (dec n) xs')]) + +## ## ## (do-templates [<name> <done> <step>] +## ## ## [(def (<name> f xs) +## ## ## (All [a] +## ## ## (-> (-> a Bool) (List a) (List a))) +## ## ## (case' xs +## ## ## #Nil #Nil +## ## ## (#Cons [x xs']) (if (f x) <step> #Nil)))] + +## ## ## [take-while #Nil (list+ x (take-while f xs'))] +## ## ## [drop-while xs (drop-while f xs')]) + +## ## ## ## (defmacro (get@ tokens) +## ## ## ## (let [output (case' tokens +## ## ## ## (#Cons [tag (#Cons [record #Nil])]) +## ## ## ## (` (get@' (~ tag) (~ record))) + +## ## ## ## (#Cons [tag #Nil]) +## ## ## ## (` (lambda [record] (get@' (~ tag) record))))] +## ## ## ## (return (list output)))) + +## ## ## ## (defmacro (set@ tokens) +## ## ## ## (let [output (case' tokens +## ## ## ## (#Cons [tag (#Cons [value (#Cons [record #Nil])])]) +## ## ## ## (` (set@' (~ tag) (~ value) (~ record))) + +## ## ## ## (#Cons [tag (#Cons [value #Nil])]) +## ## ## ## (` (lambda [record] (set@' (~ tag) (~ value) record))) + +## ## ## ## (#Cons [tag #Nil]) +## ## ## ## (` (lambda [value record] (set@' (~ tag) value record))))] +## ## ## ## (return (list output)))) + +## ## ## ## (defmacro (update@ tokens) +## ## ## ## (let [output (case' tokens +## ## ## ## (#Cons [tag (#Cons [func (#Cons [record #Nil])])]) +## ## ## ## (` (let [_record_ (~ record)] +## ## ## ## (set@' (~ tag) ((~ func) (get@' (~ tag) _record_)) _record_))) + +## ## ## ## (#Cons [tag (#Cons [func #Nil])]) +## ## ## ## (` (lambda [record] +## ## ## ## (` (set@' (~ tag) ((~ func) (get@' (~ tag) record)) record)))) + +## ## ## ## (#Cons [tag #Nil]) +## ## ## ## (` (lambda [func record] +## ## ## ## (set@' (~ tag) (func (get@' (~ tag) record)) record))))] +## ## ## ## (return (list output)))) + +## ## ## (def (show-int int) +## ## ## (-> Int Text) +## ## ## (jvm-invokevirtual java.lang.Object "toString" [] +## ## ## int [])) + +## ## ## (def gensym +## ## ## (LuxStateM Syntax) +## ## ## (lambda [state] +## ## ## [(update@ [#gen-seed] inc state) +## ## ## (_meta (#Symbol ($ text-++ "__" (show-int (get@ [#gen-seed] state)) "__")))])) + +## ## ## ## (do-template [<name> <member>] +## ## ## ## (def (<name> pair) +## ## ## ## (case' pair +## ## ## ## [f s] +## ## ## ## <member>)) + +## ## ## ## [first f] +## ## ## ## [second s]) + +## ## ## (def (show-syntax syntax) +## ## ## (-> Syntax Text) +## ## ## (case' syntax +## ## ## (#Meta [_ (#Bool value)]) +## ## ## (jvm-invokevirtual java.lang.Object "toString" [] +## ## ## value []) + +## ## ## (#Meta [_ (#Int value)]) +## ## ## (jvm-invokevirtual java.lang.Object "toString" [] +## ## ## value []) + +## ## ## (#Meta [_ (#Real value)]) +## ## ## (jvm-invokevirtual java.lang.Object "toString" [] +## ## ## value []) + +## ## ## (#Meta [_ (#Char value)]) +## ## ## (jvm-invokevirtual java.lang.Object "toString" [] +## ## ## value []) + +## ## ## (#Meta [_ (#Text value)]) +## ## ## (jvm-invokevirtual java.lang.Object "toString" [] +## ## ## value []) + +## ## ## (#Meta [_ (#Symbol [module name])]) +## ## ## ($ text-++ module ";" name) + +## ## ## (#Meta [_ (#Tag [module name])]) +## ## ## ($ text-++ "#" module ";" name) + +## ## ## (#Meta [_ (#Tuple members)]) +## ## ## ($ text-++ "[" (fold text-++ "" (interpose " " (map show-syntax members))) "]") + +## ## ## (#Meta [_ (#Form members)]) +## ## ## ($ text-++ "(" (fold text-++ "" (interpose " " (map show-syntax members))) ")") +## ## ## )) + +## ## ## (defmacro (do tokens) +## ## ## (case' tokens +## ## ## (#Cons [(#Meta [_ monad]) (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])]) +## ## ## (let [output (fold (lambda [body binding] +## ## ## (case' binding +## ## ## [lhs rhs] +## ## ## (` (lux;bind (lambda [(~ lhs)] (~ body)) +## ## ## (~ rhs))))) +## ## ## body +## ## ## (reverse (as-pairs bindings)))] +## ## ## (return (list (` (using (~ monad) (~ output)))))))) + +## ## ## (def (map% f xs) +## ## ## (All [m a b] +## ## ## (-> (-> a (m b)) (List a) (m (List b)))) +## ## ## (case' xs +## ## ## #Nil +## ## ## (return xs) + +## ## ## (#Cons [x xs']) +## ## ## (do [y (f x) +## ## ## ys (map% f xs')] +## ## ## (return (#Cons [y ys]))))) + +## ## ## ## (defmacro ($keys tokens) +## ## ## ## (case' tokens +## ## ## ## (#Cons [(#Meta [_ (#Tuple fields)]) #Nil]) +## ## ## ## (return (list (_meta (#Record (map (lambda [slot] +## ## ## ## (case' slot +## ## ## ## (#Meta [_ (#Tag [module name])]) +## ## ## ## [($ text-++ module ";" name) (_meta (#Symbol [module name]))])) +## ## ## ## fields))))))) + +## ## ## ## (defmacro ($or tokens) +## ## ## ## (case' tokens +## ## ## ## (#Cons [(#Meta [_ (#Tuple patterns)]) (#Cons [body #Nil])]) +## ## ## ## (return (flat-map (lambda [pattern] (list pattern body)) +## ## ## ## patterns)))) + +## ## ## ## (def null jvm-null) + +## ## ## (defmacro (^ tokens) +## ## ## (case' tokens +## ## ## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) #Nil]) +## ## ## (return (list (` (#DataT (~ (_meta (#Text class-name))))))) +## ## ## )) + +## ## ## (defmacro (, members) +## ## ## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "TupleT"])) (untemplate-list members))))))) + +## ## ## (defmacro (| members) +## ## ## (let [members' (map (lambda [m] +## ## ## (case' m +## ## ## (#Meta [_ (#Tag [module name])]) +## ## ## [($ text-++ module ";" name) (` (#Tuple (list)))] + +## ## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) +## ## ## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) +## ## ## members)] +## ## ## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "VariantT"])) (untemplate-list members)))))))) + +## ## ## (defmacro (& members) +## ## ## (let [members' (map (lambda [m] +## ## ## (case' m +## ## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag [module name])]) (#Cons [value #Nil])]))]) +## ## ## [($ text-++ module ";" name) (` (#Tuple (~ value)))])) +## ## ## members)] +## ## ## (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "RecordT"])) (untemplate-list members)))))))) + +## ## ## (defmacro (-> tokens) +## ## ## (case' (reverse tokens) +## ## ## (#Cons [f-return f-args]) +## ## ## (fold (lambda [f-return f-arg] +## ## ## (` (#LambdaT [(~ f-arg) (~ f-return)]))) +## ## ## f-return +## ## ## f-args))) + +## ## ## (def (text= x y) +## ## ## (-> Text Text Bool) +## ## ## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object] +## ## ## x [y])) + +## ## ## (def (replace-ident ident value syntax) +## ## ## (-> (, Text Text) Syntax Syntax Syntax) +## ## ## (let [[module name] ident] +## ## ## (case' syntax +## ## ## (#Meta [_ (#Symbol [?module ?name])]) +## ## ## (if (and (text= module ?module) +## ## ## (text= name ?name)) +## ## ## value +## ## ## syntax) + +## ## ## (#Meta [_ (#Form members)]) +## ## ## (_meta (#Form (map (replace-ident ident value) members))) + +## ## ## (#Meta [_ (#Tuple members)]) +## ## ## (_meta (#Tuple (map (replace-ident ident value) members))) + +## ## ## (#Meta [_ (#Record members)]) +## ## ## (_meta (#Record (map (lambda [kv] +## ## ## (case' kv +## ## ## [k v] +## ## ## [k (replace-ident ident value v)])) +## ## ## members))) + +## ## ## _ +## ## ## syntax))) + +## ## ## (defmacro (All tokens) +## ## ## (let [[name args body] (case' tokens +## ## ## (#Cons [(#Meta [_ (#Symbol [_ name])]) (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])]) +## ## ## [name args body] + +## ## ## (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])]) +## ## ## ["" args body]) +## ## ## rolled (fold (lambda [body arg] +## ## ## (case' arg +## ## ## (#Meta [_ (#Symbol [arg-module arg-name])]) +## ## ## (` (#AllT (list) "" (~ (_meta (#Text arg-name))) (~ (replace-ident [arg-module arg-name] +## ## ## (` (#BoundT (~ (#Text arg-name)))) +## ## ## body)))))) +## ## ## body +## ## ## args)] +## ## ## (case' rolled +## ## ## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ["lux" "AllT"])]) (#Cons [env (#Cons [(#Meta [_ (#Text "")]) (#Cons [(#Meta [_ (#Text arg-name)]) (#Cons [body #Nil])])])])]))]) +## ## ## (return (list (` (#AllT (~ env) (~ (#Text name)) (~ (#Text arg-name)) +## ## ## (~ (replace-ident arg-name (` (#BoundT (~ (#Text name)))) +## ## ## body))))))))) + +## ## ## (defmacro (Exists tokens) +## ## ## (case' tokens +## ## ## (#Cons [args (#Cons [body #Nil])]) +## ## ## (return (list (` (All (~ args) (~ body))))))) + +## ## ## (def Any #AnyT) +## ## ## (def Nothing #NothingT) +## ## ## (def Bool (^ java.lang.Boolean)) +## ## ## (def Int (^ java.lang.Long)) +## ## ## (def Real (^ java.lang.Double)) +## ## ## (def Char (^ java.lang.Character)) +## ## ## (def Text (^ java.lang.String)) + +## ## ## (deftype (List a) +## ## ## (| #Nil +## ## ## (#Cons (, a (List a))))) + +## ## ## (deftype #rec Type +## ## ## (| #AnyT +## ## ## #NothingT +## ## ## (#DataT Text) +## ## ## (#TupleT (List Type)) +## ## ## (#VariantT (List (, Text Type))) +## ## ## (#RecordT (List (, Text Type))) +## ## ## (#LambdaT (, Type Type)) +## ## ## (#BoundT Text) +## ## ## (#VarT Int) +## ## ## (#AllT (, (List (, Text Type)) Text Text Type)) +## ## ## (#AppT (, Type Type)))) + +## ## ## (deftype (Either l r) +## ## ## (| (#Left l) +## ## ## (#Right r))) + +## ## ## (deftype #rec Syntax +## ## ## (| (#Bool Bool) +## ## ## (#Int Int) +## ## ## (#Real Real) +## ## ## (#Char Char) +## ## ## (#Text Text) +## ## ## (#Form (List Syntax)) +## ## ## (#Tuple (List Syntax)) +## ## ## (#Record (List (, Text Syntax))))) + +## ## ## (deftype Macro +## ## ## (-> (List Syntax) CompilerState +## ## ## (Either Text (, CompilerState (List Syntax))))) + +## ## ## (def (macro-expand syntax) +## ## ## (-> Syntax (LuxStateM (List Syntax))) +## ## ## (case' syntax +## ## ## (#Form (#Cons [(#Symbol macro-name) args])) +## ## ## (do [macro (get-macro macro-name)] +## ## ## ((coerce macro Macro) args)))) + +## ## ## (defmacro (case tokens) +## ## ## (case' tokens +## ## ## (#Cons value branches) +## ## ## (loop [kind #Pattern +## ## ## pieces branches +## ## ## new-pieces (list)] +## ## ## (case' pieces +## ## ## #Nil +## ## ## (return (list (' (case' (~ value) (~@ new-pieces))))) + +## ## ## (#Cons piece pieces') +## ## ## (let [[kind' expanded more-pieces] (case' kind +## ## ## #Body +## ## ## [#Pattern (list piece) #Nil] + +## ## ## #Pattern +## ## ## (do [expansion (macro-expand piece)] +## ## ## (case' expansion +## ## ## #Nil +## ## ## [#Pattern #Nil #Nil] + +## ## ## (#Cons exp #Nil) +## ## ## [#Body (list exp) #Nil] + +## ## ## (#Cons exp exps) +## ## ## [#Body (list exp) exps])) +## ## ## )] +## ## ## (recur kind' (++ expanded new-pieces) (++ more-pieces pieces)))) +## ## ## ))) + +## ## ## (def (defsyntax tokens) +## ## ## ...) + +## ## ## (deftype (State s a) +## ## ## (-> s (, s a))) + +## ## ## (deftype (Parser a) +## ## ## (State (List Syntax) a)) + +## ## ## (def (parse-ctor tokens) +## ## ## (Parser (, Syntax (List Syntax))) +## ## ## (case tokens +## ## ## (list+ (#Symbol name) tokens') +## ## ## [tokens' [(#Symbol name) (list)]] + +## ## ## (list+ (#Form (list+ (#Symbol name) args)) tokens') +## ## ## [tokens' [(#Symbol name) args]])) + +## ## ## (defsyntax (defsig +## ## ## [[name args] parse-ctor] +## ## ## [anns ($+ $1)]) +## ## ## (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) +## ## ## (` (#Record (~ (untemplate-list ...)))) +## ## ## args)] +## ## ## (return (list (` (def (~ name) (~ def-body))))))) + +## ## ## (defsyntax (defstruct +## ## ## [[name args] parse-ctor] +## ## ## signature +## ## ## [defs ($+ $1)]) +## ## ## (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body)))) +## ## ## (` (#Record (~ (untemplate-list ...)))) +## ## ## args)] +## ## ## (return (list (` (def (~ name) +## ## ## (: (~ def-body) (~ signature)))))))) + +## ## ## (defsig (Monad m) +## ## ## (: return (All [a] (-> a (m a)))) +## ## ## (: bind (All [a b] (-> (-> a (m b)) (m a) (m b))))) + +## ## ## (defstruct ListMonad (Monad List) +## ## ## (def (return x) +## ## ## (list x)) + +## ## ## (def bind (. concat map))) + +## ## ## (defsig (Eq a) +## ## ## (: = (-> a a Bool))) + +## ## ## (defstruct (List_Eq A_Eq) +## ## ## (All [a] (-> (Eq a) (Eq (List a)))) + +## ## ## (def (= xs ys) +## ## ## (and (= (length xs) (length ys)) +## ## ## (map (lambda [[x y]] +## ## ## (with A_Eq +## ## ## (= x y))) +## ## ## (zip2 xs ys))))) + +## ## ## ## ## (def (with tokens) +## ## ## ## ## ...) + +## ## ## ## ## TODO: Full pattern-matching +## ## ## ## ## TODO: Type-related macros +## ## ## ## ## TODO: (Im|Ex)ports-related macros +## ## ## ## ## TODO: Macro-related macros + +## ## ## ## ## (import "lux") +## ## ## ## ## (module-alias "lux" "l") +## ## ## ## ## (def-alias "lux;map" "map") + +## ## ## ## ## (def (require tokens) +## ## ## ## ## (case tokens +## ## ## ## ## ...)) + +## ## ## ## ## (require lux #as l #refer [map]) |