## First things first, must define functions (jvm-interface Function (: apply (-> [java.lang.Object] java.lang.Object))) ## (jvm-interface Function ## [apply ([java.lang.Object] java.lang.Object)]) ## (jvm-class Function ## (modifiers public abstract) ## (fields) ## (abstract-methods ## [apply1 ([java.lang.Object] java.lang.Object)]) ## (virtual-methods ## [apply2 ((this [arg1 java.lang.Object] [arg2 java.lang.Object]) ## java.lang.Object ## (jvm-invokevirtual lux.Function "apply1" [java.lang.Object] ## (jvm-invokevirtual lux.Function "apply1" [java.lang.Object] ## this [arg1]) [arg2]))] ## [apply3 ((this [arg1 java.lang.Object] [arg2 java.lang.Object] [arg3 java.lang.Object]) ## java.lang.Object ## (jvm-invokevirtual lux.Function "apply1" [java.lang.Object] ## (jvm-invokevirtual lux.Function "apply2" [java.lang.Object java.lang.Object] ## this [arg1 arg2]) [arg3]))])) ## Basic types (def' Any #AnyT) (def' Bool (#DataT "java.lang.Boolean")) (def' Int (#DataT "java.lang.Long")) (def' Real (#DataT "java.lang.Double")) (def' Char (#DataT "java.lang.Character")) (def' Text (#DataT "java.lang.String")) ## (deftype (List a) ## (| #Nil ## (#Cons (, a (List a))))) (def' List (#AllT [#Nil "List" "a" (#VariantT (#Cons [["lux;Nil" (#TupleT #Nil)] (#Cons [["lux;Cons" (#TupleT (#Cons [(#BoundT "a") (#Cons [(#AppT [(#BoundT "List") (#BoundT "a")]) #Nil])]))] #Nil])]))])) ## (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)))) (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])))) ## (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 ## (#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])))) ## ## ## (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 ## ## ## (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 [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 [ ] ## ## ## ## ## ## (def ( p xs) ## ## ## ## ## ## (case xs ## ## ## ## ## ## #Nil true ## ## ## ## ## ## (#Cons [x xs']) ( (p x) ( 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 [ ] ## ## ## ## ## ## (def (int+ )) ## ## ## ## ## ## [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 [ ] ## ## ## [(def ( x y) ## ## ## (-> Int Int Int) ## ## ## (if ( x y) ## ## ## x ## ## ## y))] ## ## ## [max int>] ## ## ## [min int<]) ## ## ## (do-templates [ ] ## ## ## [(def ( n) ## ## ## (-> Int Bool) ## ## ## ( 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 [ ] ## ## ## [(def ( n xs) ## ## ## (All [a] ## ## ## (-> Int (List a) (List a))) ## ## ## (if (int> n 0) ## ## ## (case' xs ## ## ## #Nil #Nil ## ## ## (#Cons [x xs']) ) ## ## ## ))] ## ## ## [take #Nil (list+ x (take (dec n) xs'))] ## ## ## [drop xs (drop (dec n) xs')]) ## ## ## (do-templates [ ] ## ## ## [(def ( f xs) ## ## ## (All [a] ## ## ## (-> (-> a Bool) (List a) (List a))) ## ## ## (case' xs ## ## ## #Nil #Nil ## ## ## (#Cons [x xs']) (if (f x) #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 [ ] ## ## ## ## (def ( pair) ## ## ## ## (case' pair ## ## ## ## [f s] ## ## ## ## )) ## ## ## ## [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])