aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux1999
-rw-r--r--src/lux/analyser.clj110
-rw-r--r--src/lux/analyser/base.clj4
-rw-r--r--src/lux/analyser/lux.clj150
-rw-r--r--src/lux/base.clj5
-rw-r--r--src/lux/lexer.clj10
-rw-r--r--src/lux/type.clj87
7 files changed, 1268 insertions, 1097 deletions
diff --git a/source/lux.lux b/source/lux.lux
index db579f2d8..faec7869a 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -74,921 +74,1079 @@
#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]))])]))
-
+## ## (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 CompilerState
-## (& #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' CompilerState
- (#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" #Nil])]
- (#Cons [["lux;loader" (#DataT ["java.lang.ClassLoader" #Nil])]
- (#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" ""
- (#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 CompilerState
+## ## (& #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' CompilerState
+## (#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" #Nil])]
+## (#Cons [["lux;loader" (#DataT ["java.lang.ClassLoader" #Nil])]
+## (#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" ""
+## (#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 Macro
-## (-> (List Syntax) CompilerState
-## [CompilerState (List Syntax)]))
-(def' Macro
- (case' (#AppT [List Syntax])
- SyntaxList
- (#LambdaT [SyntaxList
- (#LambdaT [CompilerState
- (#TupleT (#Cons [CompilerState (#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]))))
+## ## (deftype (Either l r)
+## ## (| (#Left l)
+## ## (#Right r)))
+## (def' Either
+## (#AllT [#Nil "Either" "l"
+## (#AllT [#Nil "" "r"
+## (#VariantT (#Cons [["lux;Left" (#BoundT "l")]
+## (#Cons [["lux;Right" (#BoundT "r")]
+## #Nil])]))])]))
+## ## (deftype Macro
+## ## (-> (List Syntax) CompilerState
+## ## (Either Text [CompilerState (List Syntax)])))
+## (def' Macro
+## (case' (#AppT [List Syntax])
+## SyntaxList
+## (#LambdaT [SyntaxList
+## (#LambdaT [CompilerState
+## (#AppT [(#AppT [Either Text])
+## (#TupleT (#Cons [CompilerState
+## (#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
-## (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])]))
-## ))))
-## (declare-macro let')
-
-## (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])])]))))
-## (#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 [body
-## #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)
-## (jvm-ladd x y))
-
-## (def (id x)
-## x)
-
-## (def (print x)
-## (jvm-invokevirtual java.io.PrintStream "print" [java.lang.Object]
-## (jvm-getstatic java.lang.System "out") [x]))
-
-## (def (println x)
-## (jvm-invokevirtual java.io.PrintStream "println" [java.lang.Object]
-## (jvm-getstatic java.lang.System "out") [x]))
-
-## (def (fold f init xs)
-## (case' xs
-## #Nil
-## init
-
-## (#Cons [x xs'])
-## (fold f (f init x) xs')))
-
-## (def (reverse list)
-## (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)
-## (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)
-## (lambda [x] (f (g x))))
-
-## (def (++ xs ys)
-## (case' xs
-## #Nil
-## ys
-
-## (#Cons [x xs'])
-## (#Cons [x (++ xs' ys)])))
-
-## (def concat
-## (fold ++ #Nil))
-
-## (def (map f xs)
-## (case' xs
-## #Nil
-## #Nil
-
-## (#Cons [x xs'])
-## (#Cons [(f x) (map f xs')])))
-
-## (def flat-map (. 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)
-## (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)
-## (case' xs
-## #Nil
-## #Nil
-
-## (#Cons [x xs'])
-## (if (p x)
-## (#Cons [x (filter p xs')])
-## (filter p xs'))))
-
-## (def (return val)
-## (lambda [state]
-## (#Right [state val])))
-
-## (def (fail msg)
-## (lambda [_]
-## (#Left msg)))
-
-## (def (bind f v)
-## (lambda [state]
-## (case' (v state)
-## (#Right [state' x])
-## (f x state')
-
-## (#Left msg)
-## (#Left msg))))
-
-## (def (first pair)
-## (case' pair
-## [f s]
-## f))
-
-## (def (second pair)
-## (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)
-## (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)
-## (lambda [_] x))
-
-## (def (int> x y)
-## (jvm-lgt x y))
-
-## (def (int< x y)
-## (jvm-llt x y))
-
-## (def inc (int+ 1))
-## (def dec (int+ -1))
-
-## (def (repeat n x)
-## (if (int> n 0)
-## (#Cons [x (repeat (dec n) x)])
-## #Nil))
-
-## (def size
-## (fold (lambda [acc _] (inc acc)) 0))
-
-## (def (last xs)
-## (case' xs
-## #Nil #None
-## (#Cons [x #Nil]) (#Some x)
-## (#Cons [_ xs']) (last xs')))
-
-## (def (init xs)
-## (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)
-## (case' [xs ys]
-## [(#Cons [x xs']) (#Cons [y ys'])]
-## (list+ x y (interleave xs' ys'))
-
-## _
-## #Nil))
-
-## (def (interpose sep xs)
-## (case' xs
-## #Nil
-## xs
-
-## (#Cons [x #Nil])
-## xs
-
-## (#Cons [x xs'])
-## (list+ x sep (interpose sep xs'))))
-
-## (def (empty? xs)
-## (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)
-## (if (int< from to)
-## (#Cons [from (range (inc from) to)])
-## #Nil))
-
-## (def (tuple->list tuple)
-## (case' tuple
-## (#Meta [_ (#Tuple list)])
-## list))
-
-## (def (zip2 xs ys)
-## (case' [xs ys]
-## [(#Cons [x xs']) (#Cons [y ys'])]
-## (#Cons [[x y] (zip2 xs' ys')])
-
-## _
-## #Nil))
-
-## (def (get key map)
-## (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)
-## (case' x
-## (#Meta [_ (#Symbol [_ ident])])
-## ident))
-
-## (def (text-++ x y)
-## (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-template tokens)
-## (case' tokens
-## (#Cons [bindings (#Cons [template data])])
-## (let [bindings-list (map get-ident (tuple->list bindings))
-## data-lists (map tuple->list data)
-## apply (lambda [env] (apply-template env template))]
-## (|> data-lists
-## (map (. apply (zip2 bindings-list)))
-## return))))
-
-## ## ## ## (do-template [<name> <offset>]
-## ## ## ## (def <name> (int+ <offset>))
-
-## ## ## ## [inc 1]
-## ## ## ## [dec -1])
-
-## (def (int= x y)
-## (jvm-leq x y))
-
-## (def (int% x y)
-## (jvm-lrem x y))
-
-## (def (int>= x y)
-## (or (int= x y)
-## (int> x y)))
-
-## (do-template [<name> <cmp>]
-## (def (<name> x y)
-## (if (<cmp> x y)
-## x
-## y))
-
-## [max int>]
-## [min int<])
-
-## (do-template [<name> <cmp>]
-## (def (<name> n) (<cmp> n 0))
-
-## [neg? int<]
-## [pos? int>=])
-
-## (def (even? n)
-## (int= 0 (int% n 0)))
-
-## (def (odd? n)
-## (not (even? n)))
-
-## (do-template [<name> <done> <step>]
-## (def (<name> n xs)
-## (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-template [<name> <done> <step>]
-## (def (<name> f xs)
-## (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)))
+## (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))])))
-## (#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)
-## (jvm-invokevirtual java.lang.Object "toString" []
-## int []))
+## ## (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)
-## ## (#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)
-## (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 [_ (#Tuple bindings)]) (#Cons [body #Nil])])
-## (let [output (fold (lambda [body binding]
-## (case' binding
-## [lhs rhs]
-## (` (bind (lambda [(~ lhs)] (~ body))
-## (~ rhs)))))
-## body
-## (reverse (as-pairs bindings)))]
-## (return (list output)))))
-
-## (def (map% f xs)
-## (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))) (list)]))))
-
-## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) (#Cons [(#Meta [_ (#Tuple params)]) #Nil])])
-## (return (list (` (#DataT [(~ (_meta (#Text class-name))) (~ (untemplate-list params))]))))))
-
-## (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)
-## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object]
-## x [y]))
-
-## (def (replace-ident ident value 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))
+## ## [(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))) (list)]))))
+
+## ## (#Cons [(#Meta [_ (#Symbol [_ class-name])]) (#Cons [(#Meta [_ (#Tuple params)]) #Nil])])
+## ## (return (list (` (#DataT [(~ (_meta (#Text class-name))) (~ (untemplate-list params))]))))))
+
+## ## (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
@@ -1026,6 +1184,7 @@
## ## (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)]
@@ -1120,20 +1279,20 @@
## ## (= x y)))
## ## (zip2 xs ys)))))
-## ## (def (with tokens)
-## ## ...)
+## ## ## ## (def (with tokens)
+## ## ## ## ...)
-## ## TODO: Full pattern-matching
-## ## TODO: Type-related macros
-## ## TODO: (Im|Ex)ports-related macros
-## ## TODO: Macro-related macros
+## ## ## ## 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")
+## ## ## ## (import "lux")
+## ## ## ## (module-alias "lux" "l")
+## ## ## ## (def-alias "lux;map" "map")
-## ## (def (require tokens)
-## ## (case tokens
-## ## ...))
+## ## ## ## (def (require tokens)
+## ## ## ## (case tokens
+## ## ## ## ...))
-## ## (require lux #as l #refer [map])
+## ## ## ## (require lux #as l #refer [map])
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 9ed75b83d..80f2cd252 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -2,7 +2,7 @@
(:require (clojure [template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return fail]]
+ (lux [base :as & :refer [exec return fail |list]]
[reader :as &reader]
[parser :as &parser]
[type :as &type]
@@ -15,19 +15,22 @@
;; [Utils]
(defn ^:private parse-handler [[catch+ finally+] token]
(matchv ::M/objects [token]
- [["lux;Meta" [meta ["Form" ["Cons" [["lux;Meta" [_ ["Symbol" [_ "jvm-catch"]]]]
- ["Cons" [["lux;Meta" [_ ["Symbol" [_ ?ex-class]]]]
- ["Cons" [["lux;Meta" [_ ["Symbol" [_ ?ex-arg]]]]
- ["Cons" [?catch-body
- ["Nil" _]]]]]]]]]]]]]
- [(concat catch+ (list [?ex-class ?ex-arg ?catch-body])) finally+]
-
- [["lux;Meta" [meta ["Form" ["Cons" [["lux;Meta" [_ ["Symbol" [_ "jvm-finally"]]]]
- ["Cons" [?finally-body
- ["Nil" _]]]]]]]]]
- [catch+ ?finally-body]))
-
-(defn ^:private analyse-basic-ast [analyse eval! token]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-catch"]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?ex-class]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?ex-arg]]]]
+ ["lux;Cons" [?catch-body
+ ["lux;Nil" _]]]]]]]]]]]]]
+ (&/T (&/|++ catch+ (|list (&/T ?ex-class ?ex-arg ?catch-body))) finally+)
+
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "jvm-finally"]]]]
+ ["lux;Cons" [?finally-body
+ ["lux;Nil" _]]]]]]]]]
+ (&/T catch+ ?finally-body)))
+
+(defn ^:private _meta [token]
+ (&/V "lux;Meta" (&/T (&/T "" -1 -1) token)))
+
+(defn ^:private analyse-basic-ast [analyse eval! exo-type token]
;; (prn 'analyse-basic-ast (aget token 0))
;; (when (= "lux;Tag" (aget token 0))
;; (prn 'analyse-basic-ast/tag (aget token 1)))
@@ -35,37 +38,34 @@
(matchv ::M/objects [token]
;; Standard special forms
[["lux;Meta" [meta ["lux;Bool" ?value]]]]
- (return (&/|list (&/V "Expression" (&/T (&/V "bool" ?value) (&/V "lux;DataT" (&/T "java.lang.Boolean" (&/V "lux;Nil" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "bool" ?value) (&/V "lux;DataT" (&/T "java.lang.Boolean" (|list)))))))
[["lux;Meta" [meta ["lux;Int" ?value]]]]
- (return (&/|list (&/V "Expression" (&/T (&/V "int" ?value) (&/V "lux;DataT" (&/T "java.lang.Long" (&/V "lux;Nil" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "int" ?value) (&/V "lux;DataT" (&/T "java.lang.Long" (|list)))))))
[["lux;Meta" [meta ["lux;Real" ?value]]]]
- (return (&/|list (&/V "Expression" (&/T (&/V "real" ?value) (&/V "lux;DataT" (&/T "java.lang.Double" (&/V "lux;Nil" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "real" ?value) (&/V "lux;DataT" (&/T "java.lang.Double" (|list)))))))
[["lux;Meta" [meta ["lux;Char" ?value]]]]
- (return (&/|list (&/V "Expression" (&/T (&/V "char" ?value) (&/V "lux;DataT" (&/T "java.lang.Character" (&/V "lux;Nil" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "char" ?value) (&/V "lux;DataT" (&/T "java.lang.Character" (|list)))))))
[["lux;Meta" [meta ["lux;Text" ?value]]]]
- (return (&/|list (&/V "Expression" (&/T (&/V "text" ?value) (&/V "lux;DataT" (&/T "java.lang.String" (&/V "lux;Nil" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "text" ?value) (&/V "lux;DataT" (&/T "java.lang.String" (|list)))))))
[["lux;Meta" [meta ["lux;Tuple" ?elems]]]]
- (&&lux/analyse-tuple analyse ?elems)
+ (&&lux/analyse-tuple analyse exo-type ?elems)
[["lux;Meta" [meta ["lux;Record" ?elems]]]]
(&&lux/analyse-record analyse ?elems)
- [["lux;Meta" [meta ["lux;Tag" [?module ?name]]]]]
- (let [tuple-type (&/V "lux;TupleT" (&/V "lux;Nil" nil))
- ?tag (str ?module ";" ?name)]
- (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag (&/V "Expression" (&/T (&/V "tuple" (&/|list)) tuple-type))))
- (&/V "lux;VariantT" (&/V "lux;Cons" (&/T (&/T ?tag tuple-type) (&/V "lux;Nil" nil)))))))))
-
+ [["lux;Meta" [meta ["lux;Tag" ?ident]]]]
+ (&&lux/analyse-variant analyse exo-type ?ident (_meta (&/V "lux;Tuple" (|list))))
+
[["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]]
- (return (&/|list (&/V "Expression" (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" (&/T "null" (&/V "lux;Nil" nil)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" (&/T "null" (|list)))))))
[["lux;Meta" [meta ["lux;Symbol" ?ident]]]]
- (&&lux/analyse-ident analyse ?ident)
+ (&&lux/analyse-symbol analyse exo-type ?ident)
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "case'"]]]]
["lux;Cons" [?variant ?branches]]]]]]]]
@@ -76,7 +76,7 @@
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?arg]]]]
["lux;Cons" [?body
["lux;Nil" _]]]]]]]]]]]]]
- (&&lux/analyse-lambda analyse ?self ?arg ?body)
+ (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body)
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "def'"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?name]]]]
@@ -84,7 +84,7 @@
["lux;Nil" _]]]]]]]]]]]
(do ;; (when (= "if" ?name)
;; (prn "if" (&/show-ast ?value)))
- (&&lux/analyse-def analyse ?name ?value))
+ (&&lux/analyse-def analyse exo-type ?name ?value))
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "declare-macro'"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?ident]]]
@@ -100,7 +100,7 @@
["lux;Cons" [?type
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]
- (&&lux/analyse-check analyse eval! ?type ?value)
+ (&&lux/analyse-check analyse eval! exo-type ?type ?value)
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "coerce'"]]]]
["lux;Cons" [?type
@@ -421,34 +421,28 @@
[_]
(fail (str "[Analyser Error] Unmatched token: " (&/show-ast token)))))
-(defn ^:private analyse-ast [eval!]
- (fn [token]
- ;; (prn 'analyse-ast token)
- (matchv ::M/objects [token]
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Tag" [?module ?name]]]] ?values]]]]]]
- (exec [;; :let [_ (prn 'PRE-ASSERT)]
- :let [?tag (str ?module ";" ?name)]
- :let [_ (assert (= 1 (&/|length ?values)) (str "[Analyser Error] Can only tag 1 value: " (pr-str token)))]
- ;; :let [_ (prn 'POST-ASSERT)]
- =value (&&/analyse-1 (analyse-ast eval!) (&/|head ?values))
- =value-type (&&/expr-type =value)]
- (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag =value)) (&/V "lux;VariantT" (&/V "lux;Cons" (&/T (&/T ?tag =value-type) (&/V "lux;Nil" nil)))))))))
-
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [?fn ?args]]]]]]
- (fn [state]
- ;; (prn '(&/show-ast ?fn) (&/show-ast ?fn))
- (matchv ::M/objects [((&&/analyse-1 (analyse-ast eval!) ?fn) state)]
- [["lux;Right" [state* =fn]]]
- ((&&lux/analyse-apply (analyse-ast eval!) =fn ?args) state*)
-
- [_]
- (do ;; (prn 'analyse-ast/token (aget token 0) (&/show-state state))
- ((analyse-basic-ast (analyse-ast eval!) eval! token) state))))
-
- [_]
- (analyse-basic-ast (analyse-ast eval!) eval! token))))
+(defn ^:private analyse-ast [eval! exo-type token]
+ ;; (prn 'analyse-ast token)
+ (matchv ::M/objects [token]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Tag" ?ident]]] ?values]]]]]]
+ (do (assert (= 1 (&/|length ?values)) "[Analyser Error] Can only tag 1 value.")
+ (&&lux/analyse-variant (partial analyse-ast eval!) exo-type ?ident (&/|head ?values)))
+
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [?fn ?args]]]]]]
+ (fn [state]
+ ;; (prn '(&/show-ast ?fn) (&/show-ast ?fn))
+ (matchv ::M/objects [((&&/analyse-1 (partial analyse-ast eval!) exo-type ?fn) state)]
+ [["lux;Right" [state* =fn]]]
+ ((&&lux/analyse-apply (partial analyse-ast eval!) exo-type =fn ?args) state*)
+
+ [_]
+ (do ;; (prn 'analyse-ast/token (aget token 0) (&/show-state state))
+ ((analyse-basic-ast (partial analyse-ast eval!) eval! exo-type token) state))))
+
+ [_]
+ (analyse-basic-ast (partial analyse-ast eval!) eval! exo-type token)))
;; [Resources]
(defn analyse [eval!]
(exec [asts &parser/parse]
- (&/flat-map% (analyse-ast eval!) asts)))
+ (&/flat-map% (partial analyse-ast eval! &type/Nothing) asts)))
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 827d0336e..62ccedb51 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -16,8 +16,8 @@
[["Statement" _]]
(fail (str "[Analyser Error] Can't retrieve the type of a statement: " (pr-str syntax+)))))
-(defn analyse-1 [analyse elem]
- (exec [output (analyse elem)]
+(defn analyse-1 [analyse exo-type elem]
+ (exec [output (analyse exo-type elem)]
(do ;; (prn 'analyse-1 (aget output 0))
(matchv ::M/objects [output]
[["lux;Cons" [x ["lux;Nil" _]]]]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index aa205bf06..e38d10117 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -2,7 +2,7 @@
(:require (clojure [template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return return* fail fail* |let]]
+ (lux [base :as & :refer [exec return return* fail fail* |let |list]]
[parser :as &parser]
[type :as &type]
[macro :as &macro]
@@ -13,15 +13,35 @@
[env :as &&env]
[def :as &&def])))
-;; [Resources]
-(defn analyse-tuple [analyse ?elems]
- (exec [=elems (&/flat-map% analyse ?elems)
+(defn ^:private analyse-1+ [analyse]
+ (fn [?token]
+ (&&/with-var #(&&/analyse-1 analyse % ?token))))
+
+;; [Exports]
+(defn analyse-tuple [analyse exo-type ?elems]
+ (exec [=elems (&/map% (analyse-1+ analyse) ?elems)
=elems-types (&/map% &&/expr-type =elems)
;; :let [_ (prn 'analyse-tuple =elems)]
+ :let [endo-type (&/V "lux;TupleT" =elems-types)]
+ _ (&type/solve exo-type endo-type)
+ ;; :let [_ (prn 'analyse-tuple 'DONE)]
]
- (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems) (&/V "lux;TupleT" =elems-types)))))))
+ (return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems)
+ exo-type))))))
-(defn analyse-record [analyse ?elems]
+(defn analyse-variant [analyse exo-type ident ?value]
+ (|let [[?module ?name] ident
+ ?tag (str ?module ";" ?name)]
+ (exec [=value ((analyse-1+ analyse) ?value)
+ =value-type (&&/expr-type =value)
+ :let [endo-type (&/V "lux;VariantT" (|list (&/T ?tag =value-type)))]
+ _ (&type/solve exo-type endo-type)
+ ;; :let [_ (prn 'analyse-variant 'DONE)]
+ ]
+ (return (&/|list (&/V "Expression" (&/T (&/V "variant" (&/T ?tag =value))
+ exo-type)))))))
+
+(defn analyse-record [analyse exo-type ?elems]
(exec [=elems (&/map% (fn [kv]
(matchv ::M/objects [kv]
[[k v]]
@@ -38,19 +58,10 @@
]
(return (&/|list (&/V "Expression" (&/T (&/V "lux;record" =elems) (&/V "lux;RecordT" =elems-types)))))))
-(defn ^:private resolve-global [ident state]
- (|let [[?module ?name] ident
- ident* (str ?module ";" ?name)]
- (if-let [global (->> state (&/get$ "lux;global-env") &/from-some (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ident*))]
- (return* state (&/|list global))
- (fail* (str "[Analyser Error] Unresolved identifier: " ident*)))))
-
-(defn analyse-ident [analyse ident]
+(defn analyse-symbol [analyse exo-type ident]
(|let [[?module ?name] ident]
(do ;; (prn 'analyse-ident ?module ?name)
- (exec [module-name &/get-module-name]
- (if (not= module-name ?module)
- (partial resolve-global ident)
+ (exec [module-name &/get-module-name]
(fn [state]
;; (when (and (= "lux" ?module)
;; (= "output" ?name))
@@ -59,44 +70,40 @@
;; (prn '(&/get$ "local-envs" state) (&/get$ "local-envs" state))
;; (prn '(&/->seq (&/get$ "local-envs" state)) (&/->seq (&/get$ "local-envs" state)))
;; (println (&/show-state state))
- (let [stack (&/get$ "lux;local-envs" state)]
- (matchv ::M/objects [stack]
+ (|let [stack (&/get$ "lux;local-envs" state)
+ no-binding? #(and (->> % (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|contains? ?name) not)
+ (->> % (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|contains? ?name) not))
+ [inner outer] (&/|split-with no-binding? stack)]
+ (matchv ::M/objects [outer]
[["lux;Nil" _]]
- (resolve-global ident state)
-
- [["lux;Cons" [top stack*]]]
- (if-let [=bound (or (->> stack &/|head (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ?name))
- (->> stack &/|head (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get ?name)))]
- (return* state (&/|list =bound))
- (|let [no-binding? #(and (->> % (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|contains? ?name) not)
- (->> % (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|contains? ?name) not))
- [inner outer] (&/|split-with no-binding? stack*)]
- (matchv ::M/objects [outer]
- [["lux;Nil" _]]
- (resolve-global ident state)
-
- [["lux;Cons" [top-outer _]]]
- (|let [in-stack (&/|cons top inner)
- scopes (&/|tail (&/folds #(&/|cons (&/get$ "lux;name" %2) %1)
- (&/|map #(&/get$ "lux;name" %) outer)
- (&/|reverse in-stack)))
- ;; _ (prn 'in-stack module-name ident (&/->seq (&/|map #(&/get$ "name" %) in-stack)) scopes)
- [=local inner*] (&/fold (fn [register+new-inner frame+in-scope]
- (|let [[register new-inner] register+new-inner
- [frame in-scope] frame+in-scope
- [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ?name register frame)]
- (&/T register* (&/|cons frame* new-inner))))
- (&/T (or (->> top-outer (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ?name))
- (->> top-outer (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get ?name)))
- (&/|list))
- (&/zip2 (&/|reverse in-stack) scopes))]
- (return* (&/set$ "lux;local-envs" (&/|++ inner* outer) state) (&/|list =local)))
- )))
- ))
- ))
- ))))
-
-(defn ^:private analyse-apply* [analyse =fn ?args]
+ (|let [[?module ?name] ident
+ ident* (str ?module ";" ?name)]
+ (if-let [global (->> state (&/get$ "lux;global-env") &/from-some (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ident*))]
+ (&/run-state (exec [=global-type (&&/expr-type global)
+ _ (&type/solve exo-type =global-type)]
+ (return (&/|list global)))
+ state)
+ (fail* (str "[Analyser Error] Unresolved identifier: " ident*))))
+
+ [["lux;Cons" [top-outer _]]]
+ (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ "lux;name" %2) %1)
+ (&/|map #(&/get$ "lux;name" %) outer)
+ (&/|reverse inner)))
+ ;; _ (prn 'inner module-name ident (&/->seq (&/|map #(&/get$ "name" %) inner)) scopes)
+ [=local inner*] (&/fold (fn [register+new-inner frame+in-scope]
+ (|let [[register new-inner] register+new-inner
+ [frame in-scope] frame+in-scope
+ [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ?name register frame)]
+ (&/T register* (&/|cons frame* new-inner))))
+ (&/T (or (->> top-outer (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get ?name))
+ (->> top-outer (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get ?name)))
+ (&/|list))
+ (&/zip2 (&/|reverse inner) scopes))]
+ (return* (&/set$ "lux;local-envs" (&/|++ inner* outer) state) (&/|list =local)))
+ )))
+ ))))
+
+(defn ^:private analyse-apply* [analyse exo-type =fn ?args]
(exec [=args (&/flat-map% analyse ?args)
=fn-type (&&/expr-type =fn)
[=apply _] (&/fold% (fn [[=fn =fn-type] =input]
@@ -113,7 +120,7 @@
=args)]
(return (&/|list =apply))))
-(defn analyse-apply [analyse =fn ?args]
+(defn analyse-apply [analyse exo-type =fn ?args]
;; (prn 'analyse-apply1 (aget =fn 0))
(exec [loader &/loader]
(matchv ::M/objects [=fn]
@@ -136,7 +143,7 @@
(fail "[Analyser Error] Can't call a statement!"))
))
-(defn analyse-case [analyse ?value ?branches]
+(defn analyse-case [analyse exo-type ?value ?branches]
;; (prn 'analyse-case (aget ?branches 0) (aget ?branches 1 1 0)
;; (&/->seq ?branches))
;; (prn 'analyse-case (&/show-ast ?value))
@@ -160,12 +167,13 @@
;; :let [_ (prn '=bodies =bodies)]
;; :let [_ (prn 'analyse-case/=bodies =bodies)]
=body-types (&/map% &&/expr-type =bodies)
+ :let [_ (prn 'analyse-case (->> =body-types (&/|map &type/show-type) (&/|interpose " ") (&/fold str "")))]
=case-type (&/fold% &type/merge (&/V "lux;NothingT" nil) =body-types)
:let [=branches (&/zip2 (&/|map &/|first branches) =bodies)]]
(return (&/|list (&/V "Expression" (&/T (&/V "case" (&/T =value base-register max-locals =branches))
=case-type))))))
-(defn analyse-lambda [analyse ?self ?arg ?body]
+(defn analyse-lambda [analyse exo-type ?self ?arg ?body]
;; (prn 'analyse-lambda ?self ?arg ?body)
(exec [=lambda-type* &type/fresh-lambda]
(matchv ::M/objects [=lambda-type*]
@@ -192,18 +200,21 @@
]
(return (&/|list (&/V "Expression" (&/T (&/V "lambda" (&/T =scope =captured ?arg =body)) =lambda-type))))))))
-(defn analyse-def [analyse ?name ?value]
+(defn analyse-def [analyse exo-type ?name ?value]
;; (prn 'analyse-def ?name ?value)
- (exec [module-name &/get-module-name]
+ (exec [_ (&type/solve &type/Nothing exo-type)
+ module-name &/get-module-name]
(&/if% (&&def/defined? module-name ?name)
(fail (str "[Analyser Error] Can't redefine " ?name))
(exec [=value (&/with-scope ?name
- (&&/analyse-1 analyse ?value))
+ (&&/with-var
+ #(&&/analyse-1 analyse % ?value)))
=value-type (&&/expr-type =value)
+ :let [_ (prn 'analyse-def ?name (&type/show-type =value-type))]
_ (&&def/define module-name ?name =value-type)]
(return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value)))))))))
-(defn analyse-declare-macro [ident]
+(defn analyse-declare-macro [exo-type ident]
(|let [[?module ?name] ident]
(exec [module-name &/get-module-name]
(if (= ?module module-name)
@@ -211,23 +222,18 @@
(return (&/|list)))
(fail "Can't declare macros from foreign modules.")))))
-(defn analyse-import [analyse ?path]
+(defn analyse-import [analyse exo-type ?path]
(assert false)
(return (&/|list)))
-(defn analyse-check [analyse eval! ?type ?value]
+(defn analyse-check [analyse eval! exo-type ?type ?value]
(println "analyse-check#0")
- (exec [=type (&&/analyse-1 analyse ?type)
+ (exec [=type (&&/analyse-1 analyse &type/Type ?type)
:let [_ (println "analyse-check#1")]
- =type-type (&&/expr-type =type)
- :let [_ (println "analyse-check#2")
- _ (println 1 (&type/show-type &type/Type))
- _ (println 2 (&type/show-type =type-type))]
- _ (&type/solve &type/init-fixpoints &type/Type =type-type)
- :let [_ (println "analyse-check#3")]
==type (eval! =type)
+ _ (&type/solve &type/init-fixpoints exo-type ==type)
:let [_ (println "analyse-check#4" (&type/show-type ==type))]
- =value (&&/analyse-1 analyse ?value)
+ =value (&&/analyse-1 analyse ==type ?value)
:let [_ (println "analyse-check#5")]]
(matchv ::M/objects [=value]
[["Expression" [?expr ?expr-type]]]
@@ -236,7 +242,7 @@
:let [_ (println "analyse-check#7")]]
(return (&/|list (&/V "Expression" (&/T ?expr ==type))))))))
-(defn analyse-coerce [analyse eval! ?type ?value]
+(defn analyse-coerce [analyse eval! exo-type ?type ?value]
(exec [=type (&&/analyse-1 analyse ?type)
=type-type (&&/expr-type =type)
_ (&type/solve &type/init-fixpoints &type/Type =type-type)
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 29ecfd123..cd5801660 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -312,12 +312,15 @@
(do-template [<name> <joiner>]
(defn <name> [f xs]
+ ;; (prn '<name> 0 (aget xs 0))
(matchv ::M/objects [xs]
[["lux;Nil" _]]
(return xs)
[["lux;Cons" [x xs*]]]
(exec [y (f x)
+ ;; :let [_ (prn '<name> 1 (class y))
+ ;; _ (prn '<name> 2 (aget y 0))]
ys (<name> f xs*)]
(return (<joiner> y ys)))))
@@ -658,7 +661,7 @@
(monad state))
(defn show-ast [ast]
- ;; (prn 'show-ast (aget ast 0))
+ (prn 'show-ast (aget ast 0))
;; (prn 'show-ast (aget ast 1 1 0))
;; (cond (= "lux;Meta" (aget ast 1 1 0))
;; (prn 'EXTRA 'show-ast (aget ast 1 1 1 1 0))
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 918ddc7d9..4dc46f41c 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -80,10 +80,9 @@
(def ^:private lex-ident
(&/try-all% (&/|list (exec [[_ [meta _]] (&reader/read-text ";")
- [_ [_ token]] (&reader/read-regex +ident-re+)
- module-name &/get-module-name]
- (return (&/V "lux;Meta" (&/T meta (&/T module-name token)))))
- (exec [[_ [metma token]] (&reader/read-regex +ident-re+)]
+ [_ [_ token]] (&reader/read-regex +ident-re+)]
+ (return (&/V "lux;Meta" (&/T meta (&/T "lux" token)))))
+ (exec [[_ [meta token]] (&reader/read-regex +ident-re+)]
(&/try-all% (&/|list (exec [_ (&reader/read-text ";")
[_ [_ local-token]] (&reader/read-regex +ident-re+)]
(&/try-all% (&/|list (exec [unaliased (&def/unalias-module token)]
@@ -93,8 +92,7 @@
(return (&/V "lux;Meta" (&/T meta (&/T token local-token))))
(fail (str "[Lexer Error] Unknown module: " token))))
)))
- (exec [module-name &/get-module-name]
- (return (&/V "lux;Meta" (&/T meta (&/T module-name token)))))
+ (return (&/V "lux;Meta" (&/T meta (&/T "" token))))
)))
)))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 7d05d65b4..77025b62e 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -67,12 +67,12 @@
[["lux;LambdaT" [?arg ?return]]]
(exec [=arg (clean tvar ?arg)
=return (clean tvar ?return)]
- (return (&/V "lux;LambdaT" (to-array [=arg =return]))))
+ (return (&/V "lux;LambdaT" (&/T =arg =return))))
[["lux;AppT" [?lambda ?param]]]
(exec [=lambda (clean tvar ?lambda)
=param (clean tvar ?param)]
- (return (&/V "lux;AppT" (to-array [=lambda =param]))))
+ (return (&/V "lux;AppT" (&/T =lambda =param))))
[["lux;TupleT" ?members]]
(exec [=members (&/map% (partial clean tvar) ?members)]
@@ -81,23 +81,23 @@
[["lux;VariantT" ?members]]
(exec [=members (&/map% (fn [[k v]]
(exec [=v (clean tvar v)]
- (return (to-array [k =v]))))
+ (return (&/T k =v))))
?members)]
(return (&/V "lux;VariantT" =members)))
[["lux;RecordT" ?members]]
(exec [=members (&/map% (fn [[k v]]
(exec [=v (clean tvar v)]
- (return (to-array [k =v]))))
+ (return (&/T k =v))))
?members)]
(return (&/V "lux;RecordT" =members)))
[["lux;AllT" [?env ?name ?arg ?body]]]
(exec [=env (&/map% (fn [[k v]]
(exec [=v (clean tvar v)]
- (return (to-array [k =v]))))
+ (return (&/T k =v))))
?env)]
- (return (&/V "lux;AllT" (to-array [=env ?name ?arg ?body]))))
+ (return (&/V "lux;AllT" (&/T =env ?name ?arg ?body))))
[_]
(return type)
@@ -113,7 +113,9 @@
"Nothing"
[["lux;DataT" [name params]]]
- (str "(^ " name " [" (->> params (&/|map show-type) (&/|interpose " ") (&/fold str "")) "])")
+ (if (&/|empty? params)
+ "(,)"
+ (str "(^ " name " [" (->> params (&/|map show-type) (&/|interpose " ") (&/fold str "")) "])"))
[["lux;TupleT" elems]]
(str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")")
@@ -217,8 +219,8 @@
(type= xbody ybody))
[_ _]
- (do (prn 'type= (show-type x) (show-type y))
- false)
+ (do ;; (prn 'type= (show-type x) (show-type y))
+ false)
))
(defn ^:private fp-get [k xs]
@@ -275,7 +277,7 @@
(if-let [bound (&/|get ?name env)]
(do ;; (prn 'beta-reduce "lux;BoundT" ?name (->> (&/|keys env) (&/|interpose " ") (&/fold str ""))
;; (show-type bound))
- (beta-reduce env bound))
+ (beta-reduce env bound))
type)
[_]
@@ -294,7 +296,7 @@
(def +dont-care+ (&/V "lux;AnyT" nil))
(defn apply-type [type-fn param]
- (prn 'apply-type (aget type-fn 0) (aget param 0))
+ ;; (prn 'apply-type (aget type-fn 0) (aget param 0))
(matchv ::M/objects [type-fn]
[["lux;AllT" [local-env local-name local-arg local-def]]]
(return (beta-reduce (->> local-env
@@ -311,24 +313,24 @@
(def init-fixpoints (&/|list))
-(defn solve [fixpoints expected actual]
- (prn 'solve (aget expected 0) (aget actual 0))
- ;; (prn 'solve (show-type expected) (show-type actual))
+(defn ^:private solve* [fixpoints expected actual]
+ (prn 'solve* (aget expected 0) (aget actual 0))
+ ;; (prn 'solve* (show-type expected) (show-type actual))
(matchv ::M/objects [expected actual]
- [["Any" _] _]
+ [["lux;AnyT" _] _]
success
- [_ ["Nothing" _]]
+ [_ ["lux;NothingT" _]]
success
[["lux;VarT" ?id] _]
(&/try-all% (&/|list (exec [bound (deref ?id)]
- (solve fixpoints bound actual))
+ (solve* fixpoints bound actual))
(reset ?id actual)))
[_ ["lux;VarT" ?id]]
(&/try-all% (&/|list (exec [bound (deref ?id)]
- (solve fixpoints expected bound))
+ (solve* fixpoints expected bound))
(reset ?id expected)))
[["lux;AppT" [F A]] _]
@@ -341,21 +343,21 @@
(fail (solve-error expected actual)))
[["lux;None" _]]
- (solve (fp-put fp-pair true fixpoints) expected* actual)))
+ (solve* (fp-put fp-pair true fixpoints) expected* actual)))
[_ ["lux;AppT" [F A]]]
(exec [actual* (apply-type F A)]
- (solve fixpoints expected actual*))
+ (solve* fixpoints expected actual*))
[["lux;AllT" _] _]
(exec [$var fresh-var
expected* (apply-type expected $var)]
- (solve fixpoints expected* actual))
+ (solve* fixpoints expected* actual))
[_ ["lux;AllT" _]]
(exec [$var fresh-var
actual* (apply-type actual $var)]
- (solve fixpoints expected actual*))
+ (solve* fixpoints expected actual*))
[["lux;DataT" [e!name e!params]] ["lux;DataT" [a!name a!params]]]
(cond (not= e!name a!name)
@@ -367,22 +369,23 @@
:else
(exec [_ (&/map% (fn [ea]
(|let [[e a] ea]
- (solve fixpoints e a)))
+ (solve* fixpoints e a)))
(&/zip2 e!params a!params))]
success))
[["lux;LambdaT" [eI eO]] ["lux;LambdaT" [aI aO]]]
- (exec [_ (solve fixpoints aI eI)]
- (solve fixpoints eO aO))
+ (exec [_ (solve* fixpoints aI eI)]
+ (solve* fixpoints eO aO))
[["lux;TupleT" e!members] ["lux;TupleT" a!members]]
(if (= (&/|length e!members) (&/|length a!members))
(exec [_ (&/map% (fn [ea]
(|let [[e a] ea]
- (do (prn "lux;TupleT" 'ITER (show-type e) (show-type a))
- (solve fixpoints e a))))
+ (do ;; (prn "lux;TupleT" 'ITER (show-type e) (show-type a))
+ (solve* fixpoints e a))))
(&/zip2 e!members a!members))
- :let [_ (prn "lux;TupleT" 'DONE)]]
+ ;; :let [_ (prn "lux;TupleT" 'DONE)]
+ ]
success)
(do ;; (prn "lux;TupleT" (&/|length e!members) (&/|length a!members))
;; (prn "lux;TupleT"
@@ -395,7 +398,7 @@
(exec [_ (&/map% (fn [kv]
(|let [[k av] kv]
(if-let [ev (&/|get k e!cases)]
- (solve fixpoints ev av)
+ (solve* fixpoints ev av)
(fail (str "[Type Error] The expected variant cannot handle case: #" k)))))
a!cases)]
success)
@@ -405,33 +408,41 @@
(exec [_ (&/map% (fn [slot]
(if-let [e!type (&/|get e!fields slot)]
(if-let [a!type (&/|get a!fields slot)]
- (solve fixpoints e!type a!type)
+ (solve* fixpoints e!type a!type)
(fail (solve-error expected actual)))
(fail (solve-error expected actual))))
(&/|keys e!fields))]
success)
(fail "[Type Error] Records don't match in size."))
- [["lux;BoundT" name] _]
- (do (prn "lux;BoundT" name)
- (assert false))
+ ;; [["lux;BoundT" name] _]
+ ;; (do (prn "lux;BoundT" name)
+ ;; (assert false))
;; ...
;; [_ ["lux;BoundT" name]]
;; ...
))
+(def solve (partial solve* init-fixpoints))
+
(defn apply-lambda [func param]
(matchv ::M/objects [func]
[["lux;LambdaT" [input output]]]
- (exec [_ (solve init-fixpoints input param)]
+ (exec [_ (solve* init-fixpoints input param)]
(return output))
+ [["lux;AllT" [local-env local-name local-arg local-def]]]
+ (exec [$var fresh-var
+ func* (apply-type func $var)]
+ (apply-lambda func* param))
+
[_]
(fail (str "[Type System] Can't apply type " (show-type func) " to type " (show-type param)))
))
(def Any (&/V "lux;AnyT" nil))
+(def Nothing (&/V "lux;NothingT" nil))
(def Int (&/V "lux;DataT" (&/T "java.lang.Long" (&/|list))))
(def Text (&/V "lux;DataT" (&/T "java.lang.String" (&/|list))))
@@ -483,7 +494,7 @@
(matchv ::M/objects [kv]
[[k v]]
(if-let [cv (&/|get k cases)]
- (exec [_ (solve init-fixpoints cv v)]
+ (exec [_ (solve* init-fixpoints cv v)]
(return cases))
(return (&/|put k v cases)))))
x!cases
@@ -496,7 +507,7 @@
(matchv ::M/objects [kv]
[[k v]]
(if-let [cv (&/|get k fields)]
- (exec [_ (solve init-fixpoints cv v)]
+ (exec [_ (solve* init-fixpoints cv v)]
(return fields))
(fail (str "[Type System Error] Incompatible records: " (show-type x) " and " (show-type y))))))
x!fields
@@ -513,7 +524,7 @@
(&/V "lux;VariantT" (&/|list (&/T "lux;Nil" (&/V "lux;TupleT" (&/|list)))))))))))
)
- (matchv ::M/objects [((solve init-fixpoints Type RealT)
+ (matchv ::M/objects [((solve Type RealT)
(&/init-state nil))]
[["lux;Left" ?msg]]
(assert false ?msg)
@@ -521,7 +532,7 @@
[_]
(println "YEAH!"))
- (matchv ::M/objects [((solve init-fixpoints List (&/V "lux;AppT" (&/T List Real)))
+ (matchv ::M/objects [((solve List (&/V "lux;AppT" (&/T List Real)))
(&/init-state nil))]
[["lux;Left" ?msg]]
(assert false ?msg)
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-25 06:10:11 +0000