aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux2020
1 files changed, 1100 insertions, 920 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 34b15fd49..db579f2d8 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -1,4 +1,4 @@
-## Base interfaces & classes
+## First things first, must define functions
(jvm-interface Function
(: apply (-> [java.lang.Object] java.lang.Object)))
@@ -22,938 +22,1118 @@
## (jvm-invokevirtual lux.Function "apply2" [java.lang.Object java.lang.Object]
## this [arg1 arg2]) [arg3]))]))
-## Base functions & macros
-(def' _meta
- (lambda' _ data
- (#Meta [["" -1 -1] data])))
-
-(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])]))
- )))
-(declare-macro let')
-
-(def' lambda
- (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
- (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)))
-
- (#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 []))
-## (def gensym
-## (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 (` (#TData [(~ (_meta (#Text class-name))) (list)]))))
-
- (#Cons [(#Meta [_ (#Symbol [_ class-name])]) (#Cons [(#Meta [_ (#Tuple params)]) #Nil])])
- (return (list (` (#TData [(~ (_meta (#Text class-name))) (~ (untemplate-list params))]))))))
-
-(defmacro (, members)
- (return (list (_meta (#Form (list+ (_meta (#Tag ["lux" "TTuple"])) (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" "TVariant"])) (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" "TRecord"])) (untemplate-list members))))))))
-
-(defmacro (-> tokens)
- (case' (reverse tokens)
- (#Cons [f-return f-args])
- (fold (lambda [f-return f-arg]
- (` (#TLambda [(~ 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])])
- (` (#TAll (list) "" (~ (_meta (#Text arg-name))) (~ (replace-ident [arg-module arg-name]
- (` (#TBound (~ (#Text arg-name))))
- body))))))
- body
- args)]
- (case' rolled
- (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ["lux" "TAll"])]) (#Cons [env (#Cons [(#Meta [_ (#Text "")]) (#Cons [(#Meta [_ (#Text arg-name)]) (#Cons [body #Nil])])])])]))])
- (return (list (` (#TAll (~ env) (~ (#Text name)) (~ (#Text arg-name))
- (~ (replace-ident arg-name (` (#TBound (~ (#Text name))))
- body)))))))))
-
-(defmacro (Exists tokens)
- (case' tokens
- (#Cons [args (#Cons [body #Nil])])
- (return (list (` (All (~ args) (~ body)))))))
-
-(def Any #TAny)
-(def Nothing #TNothing)
-(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))
+## Basic types
+(def' Any #AnyT)
+(def' Bool (#DataT ["java.lang.Boolean" #Nil]))
+(def' Int (#DataT ["java.lang.Long" #Nil]))
+(def' Real (#DataT ["java.lang.Double" #Nil]))
+(def' Char (#DataT ["java.lang.Character" #Nil]))
+(def' Text (#DataT ["java.lang.String" #Nil]))
## (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
-## (| #TAny
-## #TNothing
-## (#TData Text)
-## (#TTuple (List Type))
-## (#TVariant (List (, Text Type)))
-## (#TRecord (List (, Text Type)))
-## (#TLambda (, Type Type))
-## (#TBound Text)
-## (#TVar Int)
-## (#TAll (, (List (, Text Type)) Text Text Type))
-## (#TApp (, Type Type))))
-
-## (deftype (Either l r)
-## (| (#Left l)
-## (#Right r)))
+## (| #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" (#TupleT (#Cons [Text (#Cons [(#AppT [List Type]) #Nil])]))]
+ (#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 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
-## (| (#Bool Bool)
-## (#Int Int)
-## (#Real Real)
-## (#Char Char)
-## (#Text Text)
-## (#Form (List Syntax))
-## (#Tuple (List Syntax))
-## (#Record (List (, Text 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
-## (Either Text (, CompilerState (List Syntax)))))
+## [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]))))
+
+## (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 (macro-expand syntax)
+## (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)))
+
+## (#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 []))
+
+## ## (def gensym
+## ## (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
-## (#Form (#Cons [(#Symbol macro-name) args]))
-## (do [macro (get-macro macro-name)]
-## ((coerce macro Macro) args))))
+## (#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 [])
-## (defmacro (case tokens)
+## (#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 value branches)
-## (loop [kind #Pattern
-## pieces branches
-## new-pieces (list)]
-## (case' pieces
-## #Nil
-## (return (list (' (case' (~ value) (~@ new-pieces)))))
-
-## (#Cons piece pieces')
-## (let [[kind' expanded more-pieces] (case' kind
-## #Body
-## [#Pattern (list piece) #Nil]
-
-## #Pattern
-## (do [expansion (macro-expand piece)]
-## (case' expansion
-## #Nil
-## [#Pattern #Nil #Nil]
-
-## (#Cons exp #Nil)
-## [#Body (list exp) #Nil]
-
-## (#Cons exp exps)
-## [#Body (list exp) exps]))
-## )]
-## (recur kind' (++ expanded new-pieces) (++ more-pieces pieces))))
-## )))
-
-## (def (defsyntax tokens)
-## ...)
-
-## (deftype (State s a)
-## (-> s (, s a)))
-
-## (deftype (Parser a)
-## (State (List Syntax) a))
-
-## (def (parse-ctor tokens)
-## (Parser (, Syntax (List Syntax)))
-## (case tokens
-## (list+ (#Symbol name) tokens')
-## [tokens' [(#Symbol name) (list)]]
-
-## (list+ (#Form (list+ (#Symbol name) args)) tokens')
-## [tokens' [(#Symbol name) args]]))
-
-## (defsyntax (defsig
-## [[name args] parse-ctor]
-## [anns ($+ $1)])
-## (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body))))
-## (` (#Record (~ (untemplate-list ...))))
-## args)]
-## (return (list (` (def (~ name) (~ def-body)))))))
-
-## (defsyntax (defstruct
-## [[name args] parse-ctor]
-## signature
-## [defs ($+ $1)])
-## (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body))))
-## (` (#Record (~ (untemplate-list ...))))
-## args)]
-## (return (list (` (def (~ name)
-## (: (~ def-body) (~ signature))))))))
-
-## (defsig (Monad m)
-## (: return (All [a] (-> a (m a))))
-## (: bind (All [a b] (-> (-> a (m b)) (m a) (m b)))))
-
-## (defstruct ListMonad (Monad List)
-## (def (return x)
-## (list x))
-
-## (def bind (. concat map)))
-
-## (defsig (Eq a)
-## (: = (-> a a Bool)))
-
-## (defstruct (List_Eq A_Eq)
-## (All [a] (-> (Eq a) (Eq (List a))))
-
-## (def (= xs ys)
-## (and (= (length xs) (length ys))
-## (map (lambda [[x y]]
-## (with A_Eq
-## (= x y)))
-## (zip2 xs ys)))))
-
-## (def (with tokens)
-## ...)
-
-## TODO: Full pattern-matching
-## TODO: Type-related macros
-## TODO: (Im|Ex)ports-related macros
-## TODO: Macro-related macros
-
-## (import "lux")
-## (module-alias "lux" "l")
-## (def-alias "lux;map" "map")
-
-## (def (require tokens)
-## (case tokens
-## ...))
-
-## (require lux #as l #refer [map])
+## (#Cons [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)
+## ## (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])