From 5e9e876131901204dd34ce1548a4df3cb6cba95f Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 20 Jun 2015 20:19:02 -0400
Subject: - The directory for source-code is now named "input". - Implemented
 module-caching to avoid the waiting too much during program compilation.

---
 input/lux.lux | 2173 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 2173 insertions(+)
 create mode 100644 input/lux.lux

(limited to 'input/lux.lux')

diff --git a/input/lux.lux b/input/lux.lux
new file mode 100644
index 000000000..6c9a50f9d
--- /dev/null
+++ b/input/lux.lux
@@ -0,0 +1,2173 @@
+##   Copyright (c) Eduardo Julian. All rights reserved.
+##   The use and distribution terms for this software are covered by the
+##   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+##   which can be found in the file epl-v10.html at the root of this distribution.
+##   By using this software in any fashion, you are agreeing to be bound by
+##   the terms of this license.
+##   You must not remove this notice, or any other, from this software.
+
+## First things first, must define functions
+(_jvm_interface "Function" []
+  (apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"]))
+
+## (_jvm_class "lux.MyFunction" "java.lang.Object" ["lux.Function"]
+##             [(foo "java.lang.Object" ["public" "static"])]
+##             (<init> [] "void"
+##                     ["public"]
+##                     (_jvm_invokespecial java.lang.Object <init> [] this []))
+##             (apply [(arg "java.lang.Object")] "java.lang.Object"
+##                    ["public"]
+##                    "YOLO"))
+
+## Basic types
+(_lux_def Bool (#DataT "java.lang.Boolean"))
+(_lux_export Bool)
+
+(_lux_def Int (#DataT "java.lang.Long"))
+(_lux_export Int)
+
+(_lux_def Real (#DataT "java.lang.Double"))
+(_lux_export Real)
+
+(_lux_def Char (#DataT "java.lang.Character"))
+(_lux_export Char)
+
+(_lux_def Text (#DataT "java.lang.String"))
+(_lux_export Text)
+
+(_lux_def Void (#VariantT #Nil))
+(_lux_export Void)
+
+(_lux_def Ident (#TupleT (#Cons [Text (#Cons [Text #Nil])])))
+(_lux_export Ident)
+
+## (deftype (List a)
+##   (| #Nil
+##      (#Cons (, a (List a)))))
+(_lux_def List
+  (#AllT [(#Some #Nil) "lux;List" "a"
+          (#VariantT (#Cons [["lux;Nil" (#TupleT #Nil)]
+                             (#Cons [["lux;Cons" (#TupleT (#Cons [(#BoundT "a")
+                                                                  (#Cons [(#AppT [(#BoundT "lux;List") (#BoundT "a")])
+                                                                          #Nil])]))]
+                                     #Nil])]))]))
+(_lux_export List)
+
+## (deftype (Maybe a)
+##   (| #None
+##      (#Some a)))
+(_lux_def Maybe
+  (#AllT [(#Some #Nil) "lux;Maybe" "a"
+          (#VariantT (#Cons [["lux;None" (#TupleT #Nil)]
+                             (#Cons [["lux;Some" (#BoundT "a")]
+                                     #Nil])]))]))
+(_lux_export Maybe)
+
+## (deftype #rec Type
+##   (| (#DataT Text)
+##      (#TupleT (List Type))
+##      (#VariantT (List (, Text Type)))
+##      (#RecordT (List (, Text Type)))
+##      (#LambdaT (, Type Type))
+##      (#BoundT Text)
+##      (#VarT Int)
+##      (#AllT (, (Maybe (List (, Text Type))) Text Text Type))
+##      (#AppT (, Type Type))))
+(_lux_def Type
+  (_lux_case (#AppT [(#BoundT "Type") (#BoundT "_")])
+    Type
+    (_lux_case (#AppT [List (#TupleT (#Cons [Text (#Cons [Type #Nil])]))])
+      TypeEnv
+      (#AppT [(#AllT [(#Some #Nil) "Type" "_"
+                      (#VariantT (#Cons [["lux;DataT" Text]
+                                         (#Cons [["lux;TupleT" (#AppT [List Type])]
+                                                 (#Cons [["lux;VariantT" TypeEnv]
+                                                         (#Cons [["lux;RecordT" TypeEnv]
+                                                                 (#Cons [["lux;LambdaT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))]
+                                                                         (#Cons [["lux;BoundT" Text]
+                                                                                 (#Cons [["lux;VarT" Int]
+                                                                                         (#Cons [["lux;AllT" (#TupleT (#Cons [(#AppT [Maybe TypeEnv]) (#Cons [Text (#Cons [Text (#Cons [Type #Nil])])])]))]
+                                                                                                 (#Cons [["lux;AppT" (#TupleT (#Cons [Type (#Cons [Type #Nil])]))]
+                                                                                                         (#Cons [["lux;ExT" Int]
+                                                                                                                 #Nil])])])])])])])])])]))])
+              Void]))))
+(_lux_export Type)
+
+## (deftype (Bindings k v)
+##   (& #counter Int
+##      #mappings (List (, k v))))
+(_lux_def Bindings
+  (#AllT [(#Some #Nil) "lux;Bindings" "k"
+          (#AllT [#None "" "v"
+                  (#RecordT (#Cons [["lux;counter" Int]
+                                    (#Cons [["lux;mappings" (#AppT [List
+                                                                    (#TupleT (#Cons [(#BoundT "k")
+                                                                                     (#Cons [(#BoundT "v")
+                                                                                             #Nil])]))])]
+                                            #Nil])]))])]))
+
+## (deftype (Env k v)
+##   (& #name Text
+##      #inner-closures Int
+##      #locals  (Bindings k v)
+##      #closure (Bindings k v)))
+(_lux_def Env
+  (#AllT [(#Some #Nil) "lux;Env" "k"
+          (#AllT [#None "" "v"
+                  (#RecordT (#Cons [["lux;name" Text]
+                                    (#Cons [["lux;inner-closures" Int]
+                                            (#Cons [["lux;locals" (#AppT [(#AppT [Bindings (#BoundT "k")])
+                                                                          (#BoundT "v")])]
+                                                    (#Cons [["lux;closure" (#AppT [(#AppT [Bindings (#BoundT "k")])
+                                                                                   (#BoundT "v")])]
+                                                            #Nil])])])]))])]))
+
+## (deftype Cursor
+##   (, Text Int Int))
+(_lux_def Cursor
+  (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))
+
+## (deftype (Meta m v)
+##   (| (#Meta (, m v))))
+(_lux_def Meta
+  (#AllT [(#Some #Nil) "lux;Meta" "m"
+          (#AllT [#None "" "v"
+                  (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m")
+                                                                  (#Cons [(#BoundT "v")
+                                                                          #Nil])]))]
+                                     #Nil]))])]))
+(_lux_export Meta)
+
+## (deftype (Syntax' w)
+##   (| (#BoolS Bool)
+##      (#IntS Int)
+##      (#RealS Real)
+##      (#CharS Char)
+##      (#TextS Text)
+##      (#SymbolS (, Text Text))
+##      (#TagS (, Text Text))
+##      (#FormS (List (w (Syntax' w))))
+##      (#TupleS (List (w (Syntax' w))))
+##      (#RecordS (List (, (w (Syntax' w)) (w (Syntax' w)))))))
+(_lux_def Syntax'
+  (_lux_case (#AppT [(#BoundT "w")
+                     (#AppT [(#BoundT "lux;Syntax'")
+                             (#BoundT "w")])])
+    Syntax
+    (_lux_case (#AppT [List Syntax])
+      SyntaxList
+      (#AllT [(#Some #Nil) "lux;Syntax'" "w"
+              (#VariantT (#Cons [["lux;BoolS" Bool]
+                                 (#Cons [["lux;IntS" Int]
+                                         (#Cons [["lux;RealS" Real]
+                                                 (#Cons [["lux;CharS" Char]
+                                                         (#Cons [["lux;TextS" Text]
+                                                                 (#Cons [["lux;SymbolS" Ident]
+                                                                         (#Cons [["lux;TagS" Ident]
+                                                                                 (#Cons [["lux;FormS" SyntaxList]
+                                                                                         (#Cons [["lux;TupleS" SyntaxList]
+                                                                                                 (#Cons [["lux;RecordS" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])]
+                                                                                                         #Nil])
+                                                                                                 ])])])])])])])])])
+                         )]))))
+(_lux_export Syntax')
+
+## (deftype Syntax
+##   (Meta Cursor (Syntax' (Meta Cursor))))
+(_lux_def Syntax
+  (_lux_case (#AppT [Meta Cursor])
+    w
+    (#AppT [w (#AppT [Syntax' w])])))
+(_lux_export Syntax)
+
+(_lux_def SyntaxList (#AppT [List Syntax]))
+
+## (deftype (Either l r)
+##   (| (#Left l)
+##      (#Right r)))
+(_lux_def Either
+  (#AllT [(#Some #Nil) "lux;Either" "l"
+          (#AllT [#None "" "r"
+                  (#VariantT (#Cons [["lux;Left" (#BoundT "l")]
+                                     (#Cons [["lux;Right" (#BoundT "r")]
+                                             #Nil])]))])]))
+(_lux_export Either)
+
+## (deftype (StateE s a)
+##   (-> s (Either Text (, s a))))
+(_lux_def StateE
+  (#AllT [(#Some #Nil) "lux;StateE" "s"
+          (#AllT [#None "" "a"
+                  (#LambdaT [(#BoundT "s")
+                             (#AppT [(#AppT [Either Text])
+                                     (#TupleT (#Cons [(#BoundT "s")
+                                                      (#Cons [(#BoundT "a")
+                                                              #Nil])]))])])])]))
+
+## (deftype Reader
+##   (List (Meta Cursor Text)))
+(_lux_def Reader
+  (#AppT [List
+          (#AppT [(#AppT [Meta Cursor])
+                  Text])]))
+(_lux_export Reader)
+
+## (deftype HostState
+##   (& #writer    (^ org.objectweb.asm.ClassWriter)
+##      #loader    (^ java.net.URLClassLoader)
+##      #classes   (^ clojure.lang.Atom)))
+(_lux_def HostState
+  (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")]
+                    (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")]
+                            (#Cons [["lux;classes" (#DataT "clojure.lang.Atom")]
+                                    #Nil])])])))
+
+## (deftype (DefData' m)
+##   (| #TypeD
+##      (#ValueD Type)
+##      (#MacroD m)
+##      (#AliasD Ident)))
+(_lux_def DefData'
+  (#AllT [(#Some #Nil) "lux;DefData'" ""
+          (#VariantT (#Cons [["lux;TypeD" (#TupleT #Nil)]
+                             (#Cons [["lux;ValueD" Type]
+                                     (#Cons [["lux;MacroD" (#BoundT "")]
+                                             (#Cons [["lux;AliasD" Ident]
+                                                     #Nil])])])]))]))
+
+## (deftype LuxVar
+##   (| (#Local Int)
+##      (#Global Ident)))
+(_lux_def LuxVar
+  (#VariantT (#Cons [["lux;Local" Int]
+                     (#Cons [["lux;Global" Ident]
+                             #Nil])])))
+(_lux_export LuxVar)
+
+## (deftype (Module Compiler)
+##   (& #module-aliases (List (, Text Text))
+##      #defs (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax)))))))
+##      #imports (List Text)
+##      ))
+(_lux_def Module
+  (#AllT [(#Some #Nil) "lux;Module" "Compiler"
+          (#RecordT (#Cons [["lux;module-aliases" (#AppT [List (#TupleT (#Cons [Text (#Cons [Text #Nil])]))])]
+                            (#Cons [["lux;defs" (#AppT [List (#TupleT (#Cons [Text
+                                                                              (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList
+                                                                                                                                                (#AppT [(#AppT [StateE (#BoundT "Compiler")])
+                                                                                                                                                        SyntaxList])])])
+                                                                                                                    #Nil])]))
+                                                                                      #Nil])]))])]
+                                    (#Cons [["lux;imports" (#AppT [List Text])]
+                                            #Nil])])]))]))
+(_lux_export Module)
+
+## (deftype #rec Compiler
+##   (& #source       Reader
+##      #modules      (List (, Text (Module Compiler)))
+##      #envs         (List (Env Text (, LuxVar Type)))
+##      #types        (Bindings Int Type)
+##      #host         HostState
+##      #seed         Int
+##      #seen-sources (List Text)
+##      #eval?        Bool))
+(_lux_def Compiler
+  (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" ""
+                  (#RecordT (#Cons [["lux;source" Reader]
+                                    (#Cons [["lux;modules" (#AppT [List (#TupleT (#Cons [Text
+                                                                                         (#Cons [(#AppT [Module (#AppT [(#BoundT "lux;Compiler") (#BoundT "")])])
+                                                                                                 #Nil])]))])]
+                                            (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text])
+                                                                                     (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])]
+                                                    (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])]
+                                                            (#Cons [["lux;host" HostState]
+                                                                    (#Cons [["lux;seed" Int]
+                                                                            (#Cons [["lux;seen-sources" (#AppT [List Text])]
+                                                                                    (#Cons [["lux;eval?" Bool]
+                                                                                            #Nil])])])])])])])]))])
+          Void]))
+(_lux_export Compiler)
+
+## (deftype Macro
+##   (-> (List Syntax) (StateE Compiler (List Syntax))))
+(_lux_def Macro
+  (#LambdaT [SyntaxList
+             (#AppT [(#AppT [StateE Compiler])
+                     SyntaxList])]))
+(_lux_export Macro)
+
+## Base functions & macros
+## (def (_meta data)
+##   (-> (Syntax' (Meta Cursor)) Syntax)
+##   (#Meta [["" -1 -1] data]))
+(_lux_def _meta
+  (_lux_: (#LambdaT [(#AppT [Syntax'
+                             (#AppT [Meta Cursor])])
+                     Syntax])
+          (_lux_lambda _ data
+            (#Meta [["" -1 -1] data]))))
+
+## (def (return x)
+##   (All [a]
+##     (-> a Compiler
+##         (Either Text (, Compiler a))))
+##   ...)
+(_lux_def return
+  (_lux_: (#AllT [(#Some #Nil) "" "a"
+                  (#LambdaT [(#BoundT "a")
+                             (#LambdaT [Compiler
+                                        (#AppT [(#AppT [Either Text])
+                                                (#TupleT (#Cons [Compiler
+                                                                 (#Cons [(#BoundT "a")
+                                                                         #Nil])]))])])])])
+          (_lux_lambda _ val
+            (_lux_lambda _ state
+              (#Right [state val])))))
+
+## (def (fail msg)
+##   (All [a]
+##     (-> Text Compiler
+##         (Either Text (, Compiler a))))
+##   ...)
+(_lux_def fail
+  (_lux_: (#AllT [(#Some #Nil) "" "a"
+                  (#LambdaT [Text
+                             (#LambdaT [Compiler
+                                        (#AppT [(#AppT [Either Text])
+                                                (#TupleT (#Cons [Compiler
+                                                                 (#Cons [(#BoundT "a")
+                                                                         #Nil])]))])])])])
+          (_lux_lambda _ msg
+            (_lux_lambda _ state
+              (#Left msg)))))
+
+(_lux_def $text
+  (_lux_: (#LambdaT [Text Syntax])
+          (_lux_lambda _ text
+            (_meta (#TextS text)))))
+
+(_lux_def $symbol
+  (_lux_: (#LambdaT [Ident Syntax])
+          (_lux_lambda _ ident
+            (_meta (#SymbolS ident)))))
+
+(_lux_def $tag
+  (_lux_: (#LambdaT [Ident Syntax])
+          (_lux_lambda _ ident
+            (_meta (#TagS ident)))))
+
+(_lux_def $form
+  (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax])
+          (_lux_lambda _ tokens
+            (_meta (#FormS tokens)))))
+
+(_lux_def $tuple
+  (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax])
+          (_lux_lambda _ tokens
+            (_meta (#TupleS tokens)))))
+
+(_lux_def $record
+  (_lux_: (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax])
+          (_lux_lambda _ tokens
+            (_meta (#RecordS tokens)))))
+
+(_lux_def let'
+  (_lux_: Macro
+          (_lux_lambda _ tokens
+            (_lux_case tokens
+              (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
+              (return (_lux_: SyntaxList
+                              (#Cons [($form (#Cons [($symbol ["" "_lux_case"])
+                                                     (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
+                                      #Nil])))
+
+              _
+              (fail "Wrong syntax for let'")))))
+(_lux_declare-macro let')
+
+(_lux_def lambda'
+  (_lux_: Macro
+          (_lux_lambda _ tokens
+            (_lux_case tokens
+              (#Cons [(#Meta [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])])
+              (return (_lux_: SyntaxList
+                              (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"]))
+                                                             (#Cons [(_meta (#SymbolS ["" ""]))
+                                                                     (#Cons [arg
+                                                                             (#Cons [(_lux_case args'
+                                                                                       #Nil
+                                                                                       body
+
+                                                                                       _
+                                                                                       (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"]))
+                                                                                                              (#Cons [(_meta (#TupleS args'))
+                                                                                                                      (#Cons [body #Nil])])]))))
+                                                                                     #Nil])])])])))
+                                      #Nil])))
+
+              (#Cons [(#Meta [_ (#SymbolS self)]) (#Cons [(#Meta [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])])])
+              (return (_lux_: SyntaxList
+                              (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"]))
+                                                             (#Cons [(_meta (#SymbolS self))
+                                                                     (#Cons [arg
+                                                                             (#Cons [(_lux_case args'
+                                                                                       #Nil
+                                                                                       body
+
+                                                                                       _
+                                                                                       (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"]))
+                                                                                                              (#Cons [(_meta (#TupleS args'))
+                                                                                                                      (#Cons [body #Nil])])]))))
+                                                                                     #Nil])])])])))
+                                      #Nil])))
+              
+              _
+              (fail "Wrong syntax for lambda")))))
+(_lux_declare-macro lambda')
+
+(_lux_def def'
+  (_lux_: Macro
+          (lambda' [tokens]
+                   (_lux_case tokens
+                     (#Cons [(#Meta [_ (#TagS ["" "export"])])
+                             (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+                                     (#Cons [type (#Cons [body #Nil])])])])
+                     (return (_lux_: SyntaxList
+                                     (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+                                                                    (#Cons [name
+                                                                            (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+                                                                                                           (#Cons [type
+                                                                                                                   (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"]))
+                                                                                                                                                  (#Cons [name
+                                                                                                                                                          (#Cons [(_meta (#TupleS args))
+                                                                                                                                                                  (#Cons [body #Nil])])])])))
+                                                                                                                           #Nil])])])))
+                                                                                    #Nil])])])))
+                                             (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])])))
+                                                     #Nil])])))
+
+                     (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
+                     (return (_lux_: SyntaxList
+                                     (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+                                                                    (#Cons [name
+                                                                            (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+                                                                                                           (#Cons [type
+                                                                                                                   (#Cons [body
+                                                                                                                           #Nil])])])))
+                                                                                    #Nil])])])))
+                                             (#Cons [(_meta (#FormS (#Cons [($symbol ["" "_lux_export"]) (#Cons [name #Nil])])))
+                                                     #Nil])])))
+
+                     (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+                             (#Cons [type (#Cons [body #Nil])])])
+                     (return (_lux_: SyntaxList
+                                     (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+                                                                    (#Cons [name
+                                                                            (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+                                                                                                           (#Cons [type
+                                                                                                                   (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"]))
+                                                                                                                                                  (#Cons [name
+                                                                                                                                                          (#Cons [(_meta (#TupleS args))
+                                                                                                                                                                  (#Cons [body #Nil])])])])))
+                                                                                                                           #Nil])])])))
+                                                                                    #Nil])])])))
+                                             #Nil])))
+
+                     (#Cons [name (#Cons [type (#Cons [body #Nil])])])
+                     (return (_lux_: SyntaxList
+                                     (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+                                                                    (#Cons [name
+                                                                            (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+                                                                                                           (#Cons [type
+                                                                                                                   (#Cons [body
+                                                                                                                           #Nil])])])))
+                                                                                    #Nil])])])))
+                                             #Nil])))
+
+                     _
+                     (fail "Wrong syntax for def")
+                     ))))
+(_lux_declare-macro def')
+
+(def' #export (defmacro tokens)
+  Macro
+  (_lux_case tokens
+    (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])
+    (return (_lux_: SyntaxList
+                    (#Cons [($form (#Cons [($symbol ["lux" "def'"])
+                                           (#Cons [($form (#Cons [name args]))
+                                                   (#Cons [($symbol ["lux" "Macro"])
+                                                           (#Cons [body
+                                                                   #Nil])])
+                                                   ])]))
+                            (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])]))
+                                    #Nil])])))
+
+    (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])])
+    (return (_lux_: SyntaxList
+                    (#Cons [($form (#Cons [($symbol ["lux" "def'"])
+                                           (#Cons [($tag ["" "export"])
+                                                   (#Cons [($form (#Cons [name args]))
+                                                           (#Cons [($symbol ["lux" "Macro"])
+                                                                   (#Cons [body
+                                                                           #Nil])])
+                                                           ])])]))
+                            (#Cons [($form (#Cons [($symbol ["" "_lux_declare-macro"]) (#Cons [name #Nil])]))
+                                    #Nil])])))
+
+    _
+    (fail "Wrong syntax for defmacro")))
+(_lux_declare-macro defmacro)
+
+(defmacro #export (comment tokens)
+  (return (_lux_: SyntaxList #Nil)))
+
+(defmacro (->' tokens)
+  (_lux_case tokens
+    (#Cons [input (#Cons [output #Nil])])
+    (return (_lux_: SyntaxList
+                    (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"]))
+                                                   (#Cons [(_meta (#TupleS (#Cons [input (#Cons [output #Nil])])))
+                                                           #Nil])])))
+                            #Nil])))
+
+    (#Cons [input (#Cons [output others])])
+    (return (_lux_: SyntaxList
+                    (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "LambdaT"]))
+                                                   (#Cons [(_meta (#TupleS (#Cons [input
+                                                                                   (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "->'"]))
+                                                                                                                  (#Cons [output others])])))
+                                                                                           #Nil])])))
+                                                           #Nil])])))
+                            #Nil])))
+
+    _
+    (fail "Wrong syntax for ->'")))
+
+(defmacro (All' tokens)
+  (_lux_case tokens
+    (#Cons [(#Meta [_ (#TupleS #Nil)])
+            (#Cons [body #Nil])])
+    (return (_lux_: SyntaxList
+                    (#Cons [body
+                            #Nil])))
+
+    (#Cons [(#Meta [_ (#TupleS (#Cons [(#Meta [_ (#SymbolS ["" arg-name])]) other-args]))])
+            (#Cons [body #Nil])])
+    (return (_lux_: SyntaxList
+                    (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AllT"]))
+                                                   (#Cons [(_meta (#TupleS (#Cons [(_meta (#TagS ["lux" "None"]))
+                                                                                   (#Cons [(_meta (#TextS ""))
+                                                                                           (#Cons [(_meta (#TextS arg-name))
+                                                                                                   (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "All'"]))
+                                                                                                                                  (#Cons [(_meta (#TupleS other-args))
+                                                                                                                                          (#Cons [body
+                                                                                                                                                  #Nil])])])))
+                                                                                                           #Nil])])])])))
+                                                           #Nil])])))
+                            #Nil])))
+
+    _
+    (fail "Wrong syntax for All'")))
+
+(defmacro (B' tokens)
+  (_lux_case tokens
+    (#Cons [(#Meta [_ (#SymbolS ["" bound-name])])
+            #Nil])
+    (return (_lux_: SyntaxList
+                    (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "BoundT"]))
+                                                   (#Cons [(_meta (#TextS bound-name))
+                                                           #Nil])])))
+                            #Nil])))
+
+    _
+    (fail "Wrong syntax for B'")))
+
+(defmacro ($' tokens)
+  (_lux_case tokens
+    (#Cons [x #Nil])
+    (return tokens)
+
+    (#Cons [x (#Cons [y xs])])
+    (return (_lux_: SyntaxList
+                    (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "$'"]))
+                                                   (#Cons [(_meta (#FormS (#Cons [(_meta (#TagS ["lux" "AppT"]))
+                                                                                  (#Cons [(_meta (#TupleS (#Cons [x (#Cons [y #Nil])])))
+                                                                                          #Nil])])))
+                                                           xs])])))
+                            #Nil])))
+
+    _
+    (fail "Wrong syntax for $'")))
+
+(def' #export (foldL f init xs)
+  (All' [a b]
+        (->' (->' (B' a) (B' b) (B' a))
+             (B' a)
+             ($' List (B' b))
+             (B' a))) 
+  (_lux_case xs
+    #Nil
+    init
+
+    (#Cons [x xs'])
+    (foldL f (f init x) xs')))
+
+(def' #export (foldR f init xs)
+  (All' [a b]
+        (->' (->' (B' b) (B' a) (B' a))
+             (B' a)
+             ($' List (B' b))
+             (B' a))) 
+  (_lux_case xs
+    #Nil
+    init
+
+    (#Cons [x xs'])
+    (f x (foldR f init xs'))))
+
+(def' #export (reverse list)
+  (All' [a]
+        (->' ($' List (B' a)) ($' List (B' a))))
+  (foldL (_lux_: (All' [a]
+                       (->' ($' List (B' a)) (B' a) ($' List (B' a))))
+                 (lambda' [tail head]
+                          (#Cons [head tail])))
+         #Nil
+         list))
+
+(defmacro #export (list xs)
+  (return (_lux_: SyntaxList
+                  (#Cons [(foldL (lambda' [tail head]
+                                          (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"]))
+                                                                 (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])])))
+                                                                         #Nil])]))))
+                                 (_meta (#TagS ["lux" "Nil"]))
+                                 (reverse xs))
+                          #Nil]))))
+
+(defmacro #export (list& xs)
+  (_lux_case (reverse xs)
+    (#Cons [last init])
+    (return (_lux_: SyntaxList
+                    (list (foldL (lambda' [tail head]
+                                          (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
+                                                               (_meta (#TupleS (list head tail)))))))
+                                 last
+                                 init))))
+
+    _
+    (fail "Wrong syntax for list&")))
+
+(defmacro #export (lambda tokens)
+  (let' [name tokens'] (_lux_: (#TupleT (list Ident ($' List Syntax)))
+                               (_lux_case tokens
+                                 (#Cons [(#Meta [_ (#SymbolS name)]) tokens'])
+                                 [name tokens']
+
+                                 _
+                                 [["" ""] tokens]))
+        (_lux_case tokens'
+          (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
+          (_lux_case args
+            #Nil
+            (fail "lambda requires a non-empty arguments tuple.")
+            
+            (#Cons [harg targs])
+            (return (_lux_: SyntaxList
+                            (list ($form (list ($symbol ["" "_lux_lambda"])
+                                               ($symbol name)
+                                               harg
+                                               (foldL (lambda' [body' arg]
+                                                               ($form (list ($symbol ["" "_lux_lambda"])
+                                                                            ($symbol ["" ""])
+                                                                            arg
+                                                                            body')))
+                                                      body
+                                                      (reverse targs))))))))
+
+          _
+          (fail "Wrong syntax for lambda"))))
+
+(defmacro (def'' tokens)
+  (_lux_case tokens
+    (#Cons [(#Meta [_ (#TagS ["" "export"])])
+            (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+                    (#Cons [type (#Cons [body #Nil])])])])
+    (return (_lux_: SyntaxList
+                    (list ($form (list ($symbol ["" "_lux_def"])
+                                       name
+                                       ($form (list ($symbol ["" "_lux_:"])
+                                                    type
+                                                    ($form (list ($symbol ["lux" "lambda"])
+                                                                 name
+                                                                 ($tuple args)
+                                                                 body))))))
+                          ($form (list ($symbol ["" "_lux_export"]) name)))))
+
+    (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
+    (return (_lux_: SyntaxList
+                    (list ($form (list ($symbol ["" "_lux_def"])
+                                       name
+                                       ($form (list ($symbol ["" "_lux_:"])
+                                                    type
+                                                    body))))
+                          ($form (list ($symbol ["" "_lux_export"]) name)))))
+
+    (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+            (#Cons [type (#Cons [body #Nil])])])
+    (return (_lux_: SyntaxList
+                    (list ($form (list ($symbol ["" "_lux_def"])
+                                       name
+                                       ($form (list ($symbol ["" "_lux_:"])
+                                                    type
+                                                    ($form (list ($symbol ["lux" "lambda"])
+                                                                 name
+                                                                 ($tuple args)
+                                                                 body)))))))))
+
+    (#Cons [name (#Cons [type (#Cons [body #Nil])])])
+    (return (_lux_: SyntaxList
+                    (list ($form (list ($symbol ["" "_lux_def"])
+                                       name
+                                       ($form (list ($symbol ["" "_lux_:"]) type body)))))))
+
+    _
+    (fail "Wrong syntax for def")
+    ))
+
+(def'' (as-pairs xs)
+  (All' [a]
+        (->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a))))))
+  (_lux_case xs
+    (#Cons [x (#Cons [y xs'])])
+    (#Cons [[x y] (as-pairs xs')])
+
+    _
+    #Nil))
+
+(defmacro #export (let tokens)
+  (_lux_case tokens
+    (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])
+    (return (_lux_: SyntaxList
+                    (list (foldL (_lux_: (->' Syntax (#TupleT (list Syntax Syntax))
+                                              Syntax)
+                                         (lambda [body binding]
+                                           (_lux_case binding
+                                             [label value]
+                                             (_meta (#FormS (list (_meta (#SymbolS ["lux" "let'"])) label value body))))))
+                                 body
+                                 (foldL (_lux_: (All' [a]
+                                                      (->' ($' List (B' a)) (B' a) ($' List (B' a))))
+                                                (lambda [tail head] (#Cons [head tail])))
+                                        #Nil
+                                        (as-pairs bindings))))))
+
+    _
+    (fail "Wrong syntax for let")))
+
+(def'' #export (map f xs)
+  (All' [a b]
+        (->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b))))
+  (_lux_case xs
+    #Nil
+    #Nil
+
+    (#Cons [x xs'])
+    (#Cons [(f x) (map f xs')])))
+
+(def'' #export (any? p xs)
+  (All' [a]
+        (->' (->' (B' a) Bool) ($' List (B' a)) Bool))
+  (_lux_case xs
+    #Nil
+    false
+
+    (#Cons [x xs'])
+    (_lux_case (p x)
+      true  true
+      false (any? p xs'))))
+
+(def'' (spliced? token)
+  (->' Syntax Bool)
+  (_lux_case token
+    (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [_ #Nil])]))])
+    true
+
+    _
+    false))
+
+(def'' (wrap-meta content)
+  (->' Syntax Syntax)
+  (_meta (#FormS (list (_meta (#TagS ["lux" "Meta"]))
+                       (_meta (#TupleS (list (_meta (#TupleS (list (_meta (#TextS "")) (_meta (#IntS -1)) (_meta (#IntS -1)))))
+                                             content)))))))
+
+(def'' (untemplate-list tokens)
+  (->' ($' List Syntax) Syntax)
+  (_lux_case tokens
+    #Nil
+    (_meta (#TagS ["lux" "Nil"]))
+
+    (#Cons [token tokens'])
+    (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
+                         (_meta (#TupleS (list token (untemplate-list tokens')))))))))
+
+(def'' (list:++ xs ys)
+  (All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a))))
+  (_lux_case xs
+    (#Cons [x xs'])
+    (#Cons [x (list:++ xs' ys)])
+
+    #Nil
+    ys))
+
+(defmacro #export ($ tokens)
+  (_lux_case tokens
+    (#Cons [op (#Cons [init args])])
+    (return (_lux_: SyntaxList
+                    (list (foldL (lambda [a1 a2] ($form (list op a1 a2)))
+                                 init
+                                 args))))
+    
+    _
+    (fail "Wrong syntax for $")))
+
+(def'' (splice untemplate tag elems)
+  (->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
+  (_lux_case (any? spliced? elems)
+    true
+    (let [elems' (map (_lux_: (->' Syntax Syntax)
+                              (lambda [elem]
+                                (_lux_case elem
+                                  (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))])
+                                  spliced
+
+                                  _
+                                  ($form (list ($symbol ["" "_lux_:"])
+                                               ($symbol ["lux" "SyntaxList"])
+                                               ($form (list ($symbol ["lux" "list"]) (untemplate elem))))))))
+                      elems)]
+      (wrap-meta ($form (list tag
+                              ($form (list& ($symbol ["lux" "$"])
+                                            ($symbol ["lux" "list:++"])
+                                            elems'))))))
+
+    false
+    (wrap-meta ($form (list tag (untemplate-list (map untemplate elems)))))))
+
+(def'' (untemplate subst token)
+  (->' Text Syntax Syntax)
+  (_lux_case token
+    (#Meta [_ (#BoolS value)])
+    (wrap-meta ($form (list ($tag ["lux" "BoolS"]) (_meta (#BoolS value)))))
+
+    (#Meta [_ (#IntS value)])
+    (wrap-meta ($form (list ($tag ["lux" "IntS"]) (_meta (#IntS value)))))
+
+    (#Meta [_ (#RealS value)])
+    (wrap-meta ($form (list ($tag ["lux" "RealS"]) (_meta (#RealS value)))))
+
+    (#Meta [_ (#CharS value)])
+    (wrap-meta ($form (list ($tag ["lux" "CharS"]) (_meta (#CharS value)))))
+
+    (#Meta [_ (#TextS value)])
+    (wrap-meta ($form (list ($tag ["lux" "TextS"]) (_meta (#TextS value)))))
+
+    (#Meta [_ (#TagS [module name])])
+    (let [module' (_lux_case module
+                    ""
+                    subst
+
+                    _
+                    module)]
+      (wrap-meta ($form (list ($tag ["lux" "TagS"]) ($tuple (list ($text module') ($text name)))))))
+
+    (#Meta [_ (#SymbolS [module name])])
+    (let [module' (_lux_case module
+                    ""
+                    subst
+
+                    _
+                    module)]
+      (wrap-meta ($form (list ($tag ["lux" "SymbolS"]) ($tuple (list ($text module') ($text name)))))))
+
+    (#Meta [_ (#TupleS elems)])
+    (splice (untemplate subst) ($tag ["lux" "TupleS"]) elems)
+
+    (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))])
+    unquoted
+
+    (#Meta [_ (#FormS elems)])
+    (splice (untemplate subst) ($tag ["lux" "FormS"]) elems)
+
+    (#Meta [_ (#RecordS fields)])
+    (wrap-meta ($form (list ($tag ["lux" "RecordS"])
+                            (untemplate-list (map (_lux_: (->' (#TupleT (list Syntax Syntax)) Syntax)
+                                                          (lambda [kv]
+                                                            (let [[k v] kv]
+                                                              ($tuple (list (untemplate subst k) (untemplate subst v))))))
+                                                  fields)))))
+    ))
+
+(defmacro (`' tokens)
+  (_lux_case tokens
+    (#Cons [template #Nil])
+    (return (_lux_: SyntaxList
+                    (list (untemplate "" template))))
+
+    _
+    (fail "Wrong syntax for `'")))
+
+(defmacro #export (|> tokens)
+  (_lux_case tokens
+    (#Cons [init apps])
+    (return (_lux_: SyntaxList
+                    (list (foldL (_lux_: (->' Syntax Syntax Syntax)
+                                         (lambda [acc app]
+                                           (_lux_case app
+                                             (#Meta [_ (#FormS parts)])
+                                             ($form (list:++ parts (list acc)))
+
+                                             _
+                                             (`' ((~ app) (~ acc))))))
+                                 init
+                                 apps))))
+
+    _
+    (fail "Wrong syntax for |>")))
+
+(defmacro #export (if tokens)
+  (_lux_case tokens
+    (#Cons [test (#Cons [then (#Cons [else #Nil])])])
+    (return (_lux_: SyntaxList
+                    (list (`' (_lux_case (~ test)
+                                true  (~ then)
+                                false (~ else))))))
+
+    _
+    (fail "Wrong syntax for if")))
+
+## (deftype (Lux a)
+##   (-> Compiler (Either Text (, Compiler a))))
+(def'' #export Lux
+  Type
+  (All' [a]
+        (->' Compiler ($' Either Text (#TupleT (list Compiler (B' a)))))))
+
+## (defsig (Monad m)
+##   (: (All [a] (-> a (m a)))
+##      return)
+##   (: (All [a b] (-> (-> a (m b)) (m a) (m b)))
+##      bind))
+(def'' Monad
+  Type
+  (All' [m]
+        (#RecordT (list ["lux;return" (All' [a] (->' (B' a) ($' (B' m) (B' a))))]
+                        ["lux;bind" (All' [a b] (->' (->' (B' a) ($' (B' m) (B' b)))
+                                                     ($' (B' m) (B' a))
+                                                     ($' (B' m) (B' b))))]))))
+
+(def'' Maybe:Monad
+  ($' Monad Maybe)
+  {#lux;return
+   (lambda return [x]
+      (#Some x))
+   
+   #lux;bind
+   (lambda [f ma]
+     (_lux_case ma
+       #None     #None
+       (#Some a) (f a)))})
+
+(def'' Lux:Monad
+  ($' Monad Lux)
+  {#lux;return
+   (lambda [x]
+     (lambda [state]
+       (#Right [state x])))
+   
+   #lux;bind
+   (lambda [f ma]
+     (lambda [state]
+       (_lux_case (ma state)
+         (#Left msg)
+         (#Left msg)
+
+         (#Right [state' a])
+         (f a state'))))})
+
+(defmacro #export (^ tokens)
+  (_lux_case tokens
+    (#Cons [(#Meta [_ (#SymbolS ["" class-name])]) #Nil])
+    (return (_lux_: SyntaxList
+                    (list (`' (#;DataT (~ (_meta (#TextS class-name))))))))
+
+    _
+    (fail "Wrong syntax for ^")))
+
+(defmacro #export (-> tokens)
+  (_lux_case (reverse tokens)
+    (#Cons [output inputs])
+    (return (_lux_: SyntaxList
+                    (list (foldL (_lux_: (->' Syntax Syntax Syntax)
+                                         (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)]))))
+                                 output
+                                 inputs))))
+    
+    _
+    (fail "Wrong syntax for ->")))
+
+(defmacro #export (, tokens)
+  (return (_lux_: SyntaxList
+                  (list (`' (#;TupleT (;list (~@ tokens))))))))
+
+(defmacro (do tokens)
+  (_lux_case tokens
+    (#Cons [monad (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])])
+    (let [body' (foldL (_lux_: (-> Syntax (, Syntax Syntax) Syntax)
+                               (lambda [body' binding]
+                                 (let [[var value] binding]
+                                   (_lux_case var
+                                     (#Meta [_ (#TagS ["" "let"])])
+                                     (`' (;let (~ value) (~ body')))
+
+                                     _
+                                     (`' (;bind (_lux_lambda (~ ($symbol ["" ""]))
+                                                  (~ var)
+                                                  (~ body'))
+                                                (~ value)))))))
+                       body
+                       (reverse (as-pairs bindings)))]
+      (return (_lux_: SyntaxList
+                      (list (`' (_lux_case (~ monad)
+                                  {#;return ;return #;bind ;bind}
+                                  (~ body')))))))
+
+    _
+    (fail "Wrong syntax for do")))
+
+(def'' (map% m f xs)
+  ## (All [m a b]
+  ##   (-> (Monad m) (-> a (m b)) (List a) (m (List b))))
+  (All' [m a b]
+        (-> ($' Monad (B' m))
+            (-> (B' a) ($' (B' m) (B' b)))
+            ($' List (B' a))
+            ($' (B' m) ($' List (B' b)))))
+  (let [{#;return ;return #;bind _} m]
+    (_lux_case xs
+      #Nil
+      (;return (_lux_: List #Nil))
+      
+      (#Cons [x xs'])
+      (do m
+        [y (f x)
+         ys (map% m f xs')]
+        (;return (_lux_: List (#Cons [y ys]))))
+      )))
+
+(def'' #export (. f g)
+  (All' [a b c]
+        (-> (-> (B' b) (B' c)) (-> (B' a) (B' b)) (-> (B' a) (B' c))))
+  (lambda [x]
+    (f (g x))))
+
+(def'' (get-ident x)
+  (-> Syntax ($' Maybe Text))
+  (_lux_case x
+    (#Meta [_ (#SymbolS ["" sname])])
+    (#Some sname)
+
+    _
+    #None))
+
+(def'' (tuple->list tuple)
+  (-> Syntax ($' Maybe ($' List Syntax)))
+  (_lux_case tuple
+    (#Meta [_ (#TupleS members)])
+    (#Some members)
+
+    _
+    #None))
+
+(def'' RepEnv
+  Type
+  ($' List (, Text Syntax)))
+
+(def'' (make-env xs ys)
+  (-> ($' List Text) ($' List Syntax) RepEnv)
+  (_lux_case (_lux_: (, ($' List Text) ($' List Syntax))
+                     [xs ys])
+    [(#Cons [x xs']) (#Cons [y ys'])]
+    (#Cons [[x y] (make-env xs' ys')])
+
+    _
+    #Nil))
+
+(def'' (text:= x y)
+  (-> Text Text Bool)
+  (_jvm_invokevirtual java.lang.Object equals [java.lang.Object]
+                      x [y]))
+
+(def'' (get-rep key env)
+  (-> Text RepEnv ($' Maybe Syntax))
+  (_lux_case env
+    #Nil
+    #None
+
+    (#Cons [[k v] env'])
+    (if (text:= k key)
+      (#Some v)
+      (get-rep key env'))))
+
+(def'' (apply-template env template)
+  (-> RepEnv Syntax Syntax)
+  (_lux_case template
+    (#Meta [_ (#SymbolS ["" sname])])
+    (_lux_case (get-rep sname env)
+      (#Some subst)
+      subst
+
+      _
+      template)
+
+    (#Meta [_ (#TupleS elems)])
+    ($tuple (map (apply-template env) elems))
+
+    (#Meta [_ (#FormS elems)])
+    ($form (map (apply-template env) elems))
+
+    (#Meta [_ (#RecordS members)])
+    ($record (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax))
+                          (lambda [kv]
+                            (let [[slot value] kv]
+                              [(apply-template env slot) (apply-template env value)])))
+                  members))
+
+    _
+    template))
+
+(def'' (join-map f xs)
+  (All' [a b]
+        (-> (-> (B' a) ($' List (B' b))) ($' List (B' a)) ($' List (B' b))))
+  (_lux_case xs
+    #Nil
+    #Nil
+
+    (#Cons [x xs'])
+    (list:++ (f x) (join-map f xs'))))
+
+(defmacro #export (do-template tokens)
+  (_lux_case tokens
+    (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [(#Meta [_ (#TupleS templates)]) data])])
+    (_lux_case (_lux_: (, ($' Maybe ($' List Text)) ($' Maybe ($' List ($' List Syntax))))
+                       [(map% Maybe:Monad get-ident bindings)
+                        (map% Maybe:Monad tuple->list data)])
+      [(#Some bindings') (#Some data')]
+      (let [apply (_lux_: (-> RepEnv ($' List Syntax))
+                          (lambda [env] (map (apply-template env) templates)))]
+        (|> data'
+            (join-map (. apply (make-env bindings')))
+            return))
+
+      _
+      (fail "All the do-template bindigns must be symbols."))
+
+    _
+    (fail "Wrong syntax for do-template")))
+
+(do-template [<name> <cmp> <type>]
+  [(def'' #export (<name> x y)
+     (-> <type> <type> Bool)
+     (<cmp> x y))]
+
+  [int:=  _jvm_leq Int]
+  [int:>  _jvm_lgt Int]
+  [int:<  _jvm_llt Int]
+  [real:= _jvm_deq Real]
+  [real:> _jvm_dgt Real]
+  [real:< _jvm_dlt Real]
+  )
+
+(do-template [<name> <cmp> <type>]
+  [(def'' #export (<name> x y)
+     (-> <type> <type> <type>)
+     (<cmp> x y))]
+
+  [int:+  _jvm_ladd Int]
+  [int:-  _jvm_lsub Int]
+  [int:*  _jvm_lmul Int]
+  [int:/  _jvm_ldiv Int]
+  [int:%  _jvm_lrem Int]
+  [real:+ _jvm_dadd Real]
+  [real:- _jvm_dsub Real]
+  [real:* _jvm_dmul Real]
+  [real:/ _jvm_ddiv Real]
+  [real:% _jvm_drem Real]
+  )
+
+(def'' (multiple? div n)
+  (-> Int Int Bool)
+  (int:= 0 (int:% n div)))
+
+(def'' #export (length list)
+  (-> List Int)
+  (foldL (lambda [acc _] (int:+ 1 acc)) 0 list))
+
+(def'' #export (not x)
+  (-> Bool Bool)
+  (if x false true))
+
+(def'' #export (text:++ x y)
+  (-> Text Text Text)
+  (_jvm_invokevirtual java.lang.String concat [java.lang.String]
+                      x [y]))
+
+(def'' (ident->text ident)
+  (-> Ident Text)
+  (let [[module name] ident]
+    ($ text:++ module ";" name)))
+
+(def'' (replace-syntax reps syntax)
+  (-> RepEnv Syntax Syntax)
+  (_lux_case syntax
+    (#Meta [_ (#SymbolS ["" name])])
+    (_lux_case (get-rep name reps)
+      (#Some replacement)
+      replacement
+
+      #None
+      syntax)
+
+    (#Meta [_ (#FormS parts)])
+    (#Meta [_ (#FormS (map (replace-syntax reps) parts))])
+
+    (#Meta [_ (#TupleS members)])
+    (#Meta [_ (#TupleS (map (replace-syntax reps) members))])
+
+    (#Meta [_ (#RecordS slots)])
+    (#Meta [_ (#RecordS (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax))
+                                     (lambda [slot]
+                                       (let [[k v] slot]
+                                         [(replace-syntax reps k) (replace-syntax reps v)])))
+                             slots))])
+    
+    _
+    syntax)
+  )
+
+(defmacro #export (All tokens)
+  (let [[self-ident tokens'] (_lux_: (, Text SyntaxList)
+                                     (_lux_case tokens
+                                       (#Cons [(#Meta [_ (#SymbolS ["" self-ident])]) tokens'])
+                                       [self-ident tokens']
+
+                                       _
+                                       ["" tokens]))]
+    (_lux_case tokens'
+      (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
+      (_lux_case (map% Maybe:Monad get-ident args)
+        (#Some idents)
+        (_lux_case idents
+          #Nil
+          (return (_lux_: SyntaxList
+                          (list body)))
+          
+          (#Cons [harg targs])
+          (let [replacements (map (_lux_: (-> Text (, Text Syntax))
+                                          (lambda [ident] [ident (`' (#;BoundT (~ ($text ident))))]))
+                                  (list& self-ident idents))
+                body' (foldL (_lux_: (-> Syntax Text Syntax)
+                                     (lambda [body' arg']
+                                       (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')]))))
+                             (replace-syntax replacements body)
+                             (reverse targs))]
+            (return (_lux_: SyntaxList
+                            (list (`' (#;AllT [(#;Some #;Nil) (~ ($text self-ident)) (~ ($text harg)) (~ body')])))))))
+        
+        #None
+        (fail "'All' arguments must be symbols."))
+      
+      _
+      (fail "Wrong syntax for All"))
+    ))
+
+(def'' (get k plist)
+  (All [a]
+    (-> Text ($' List (, Text a)) ($' Maybe a)))
+  (_lux_case plist
+    (#Cons [[k' v] plist'])
+    (if (text:= k k')
+      (#Some v)
+      (get k plist'))
+
+    #Nil
+    #None))
+
+(def'' #export (get-module-name state)
+  ($' Lux Text)
+  (_lux_case state
+    {#source source #modules modules
+     #envs   envs   #types   types   #host           host
+     #seed   seed   #seen-sources seen-sources #eval? eval?}
+    (_lux_case (reverse envs)
+      #Nil
+      (#Left "Can't get the module name without a module!")
+
+      (#Cons [{#name module-name #inner-closures _ #locals _ #closure _} _])
+      (#Right [state module-name]))))
+
+(def'' (find-macro' modules current-module module name)
+  (-> ($' List (, Text ($' Module Compiler)))
+      Text Text Text
+      ($' Maybe Macro))
+  (do Maybe:Monad
+    [$module (get module modules)
+     gdef (let [{#module-aliases _ #defs bindings #imports _} (_lux_: ($' Module Compiler) $module)]
+            (get name bindings))]
+    (_lux_case (_lux_: (, Bool ($' DefData' Macro)) gdef)
+      [exported? (#MacroD macro')]
+      (if exported?
+        (#Some macro')
+        (if (text:= module current-module)
+          (#Some macro')
+          #None))
+
+      [_ (#AliasD [r-module r-name])]
+      (find-macro' modules current-module r-module r-name)
+      
+      _
+      #None)))
+
+(def'' #export (find-macro ident)
+  (-> Ident ($' Lux ($' Maybe Macro)))
+  (do Lux:Monad
+    [current-module get-module-name]
+    (let [[module name] ident]
+      (lambda [state]
+        (_lux_case state
+          {#source source #modules modules
+           #envs   envs   #types   types   #host           host
+           #seed   seed   #seen-sources seen-sources #eval? eval?}
+          (#Right [state (find-macro' modules current-module module name)]))))))
+
+(def'' (list:join xs)
+  (All [a]
+    (-> ($' List ($' List a)) ($' List a)))
+  (foldL list:++ #Nil xs))
+
+(def'' #export (normalize ident)
+  (-> Ident ($' Lux Ident))
+  (_lux_case ident
+    ["" name]
+    (do Lux:Monad
+      [module-name get-module-name]
+      (;return (_lux_: Ident [module-name name])))
+
+    _
+    (return ident)))
+
+(defmacro #export (| tokens)
+  (do Lux:Monad
+    [pairs (map% Lux:Monad
+                 (_lux_: (-> Syntax ($' Lux Syntax))
+                         (lambda [token]
+                           (_lux_case token
+                             (#Meta [_ (#TagS ident)])
+                             (do Lux:Monad
+                               [ident (normalize ident)]
+                               (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (;,)]))))
+
+                             (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) (#Cons [value #Nil])]))])
+                             (do Lux:Monad
+                               [ident (normalize ident)]
+                               (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (~ value)]))))
+                             
+                             _
+                             (fail "Wrong syntax for |"))))
+                 tokens)]
+    (;return (_lux_: SyntaxList
+                     (list (`' (#;VariantT (;list (~@ pairs)))))))))
+
+(defmacro #export (& tokens)
+  (if (not (multiple? 2 (length tokens)))
+    (fail "& expects an even number of arguments.")
+    (do Lux:Monad
+      [pairs (map% Lux:Monad
+                   (_lux_: (-> (, Syntax Syntax) ($' Lux Syntax))
+                           (lambda [pair]
+                             (_lux_case pair
+                               [(#Meta [_ (#TagS ident)]) value]
+                               (do Lux:Monad
+                                 [ident (normalize ident)]
+                                 (;return (_lux_: Syntax (`' [(~ ($text (ident->text ident))) (~ value)]))))
+                               
+                               _
+                               (fail "Wrong syntax for &"))))
+                   (as-pairs tokens))]
+      (;return (_lux_: SyntaxList
+                       (list (`' (#;RecordT (;list (~@ pairs))))))))))
+
+(def'' #export (->text x)
+  (-> (^ java.lang.Object) Text)
+  (_jvm_invokevirtual java.lang.Object toString [] x []))
+
+(def'' #export (interpose sep xs)
+  (All [a]
+    (-> a ($' List a) ($' List a)))
+  (_lux_case xs
+    #Nil
+    xs
+
+    (#Cons [x #Nil])
+    xs
+
+    (#Cons [x xs'])
+    (list& x sep (interpose sep xs'))))
+
+(def'' #export (syntax:show syntax)
+  (-> Syntax Text)
+  (_lux_case syntax
+    (#Meta [_ (#BoolS value)])
+    (->text value)
+
+    (#Meta [_ (#IntS value)])
+    (->text value)
+
+    (#Meta [_ (#RealS value)])
+    (->text value)
+
+    (#Meta [_ (#CharS value)])
+    ($ text:++ "#\"" (->text value) "\"")
+
+    (#Meta [_ (#TextS value)])
+    value
+
+    (#Meta [_ (#SymbolS ident)])
+    (ident->text ident)
+
+    (#Meta [_ (#TagS ident)])
+    (text:++ "#" (ident->text ident))
+
+    (#Meta [_ (#TupleS members)])
+    ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (foldL text:++ "")) "]")
+
+    (#Meta [_ (#FormS members)])
+    ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (foldL text:++ "")) ")")
+
+    (#Meta [_ (#RecordS slots)])
+    ($ text:++ "{"
+       (|> slots
+           (map (_lux_: (-> (, Syntax Syntax) Text)
+                        (lambda [slot]
+                          (let [[k v] slot]
+                            ($ text:++ (syntax:show k) " " (syntax:show v))))))
+           (interpose " ")
+           (foldL text:++ ""))
+       "}")
+    ))
+
+(def'' #export (macro-expand syntax)
+  (-> Syntax ($' Lux ($' List Syntax)))
+  (_lux_case syntax
+    (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))])
+    (do Lux:Monad
+      [macro-name' (normalize macro-name)
+       ?macro (find-macro (_lux_: Ident macro-name'))]
+      (_lux_case (_lux_: ($' Maybe Macro) ?macro)
+        (#Some macro)
+        (do Lux:Monad
+          [expansion (macro args)
+           expansion' (map% Lux:Monad macro-expand (_lux_: SyntaxList expansion))]
+          (;return (_lux_: SyntaxList (list:join (_lux_: ($' List SyntaxList) expansion')))))
+        
+        #None
+        (do Lux:Monad
+          [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
+          (;return (_lux_: SyntaxList (list ($form (list:join (_lux_: ($' List SyntaxList) parts')))))))))
+
+    (#Meta [_ (#FormS (#Cons [harg targs]))])
+    (do Lux:Monad
+      [harg+ (macro-expand harg)
+       targs+ (map% Lux:Monad macro-expand (_lux_: SyntaxList targs))]
+      (;return (_lux_: SyntaxList (list ($form (list:++ harg+ (list:join (_lux_: ($' List SyntaxList) targs+))))))))
+
+    (#Meta [_ (#TupleS members)])
+    (do Lux:Monad
+      [members' (map% Lux:Monad macro-expand members)]
+      (;return (_lux_: SyntaxList (list ($tuple (list:join (_lux_: ($' List SyntaxList) members')))))))
+
+    _
+    (return (_lux_: SyntaxList (list syntax)))))
+
+(def'' (walk-type type)
+  (-> Syntax Syntax)
+  (_lux_case type
+    (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS tag)]) parts]))])
+    ($form (#Cons [($tag tag) (map walk-type parts)]))
+
+    (#Meta [_ (#TupleS members)])
+    ($tuple (map walk-type members))
+
+    (#Meta [_ (#FormS (#Cons [type-fn args]))])
+    (foldL (_lux_: (-> Syntax Syntax Syntax)
+                   (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)]))))
+           (walk-type type-fn)
+           (map walk-type args))
+    
+    _
+    type))
+
+(defmacro #export (type` tokens)
+  (_lux_case tokens
+    (#Cons [type #Nil])
+    (do Lux:Monad
+      [type+ (macro-expand type)]
+      (_lux_case (_lux_: SyntaxList type+)
+        (#Cons [type' #Nil])
+        (;return (_lux_: SyntaxList
+                         (list (walk-type type'))))
+        
+        _
+        (fail "type`: The expansion of the type-syntax had to yield a single element.")))
+
+    _
+    (fail "Wrong syntax for type`")))
+
+(defmacro #export (: tokens)
+  (_lux_case tokens
+    (#Cons [type (#Cons [value #Nil])])
+    (return (_lux_: SyntaxList
+                    (list (`' (_lux_: (;type` (~ type)) (~ value))))))
+
+    _
+    (fail "Wrong syntax for :")))
+
+(defmacro #export (:! tokens)
+  (_lux_case tokens
+    (#Cons [type (#Cons [value #Nil])])
+    (return (: (List Syntax)
+               (list (`' (_lux_:! (;type` (~ type)) (~ value))))))
+
+    _
+    (fail "Wrong syntax for :!")))
+
+(defmacro #export (deftype tokens)
+  (let [[export? tokens'] (: (, Bool (List Syntax))
+                             (_lux_case tokens
+                               (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
+                               [true tokens']
+
+                               _
+                               [false tokens]))
+        parts (: (Maybe (, Syntax (List Syntax) Syntax))
+                 (_lux_case tokens'
+                   (#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])])
+                   (#Some [($symbol name) #Nil type])
+
+                   (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS name)]) args]))]) (#Cons [type #Nil])])
+                   (#Some [($symbol name) args type])
+
+                   _
+                   #None))]
+    (_lux_case parts
+      (#Some [name args type])
+      (let [with-export (: (List Syntax)
+                           (if export?
+                             (list (`' (_lux_export (~ name))))
+                             #Nil))
+            type' (: Syntax
+                     (_lux_case args
+                       #Nil
+                       type
+
+                       _
+                       (`' (;All (~ name) [(~@ args)] (~ type)))))]
+        (return (: (List Syntax)
+                   (list& (`' (_lux_def (~ name) (;type` (~ type'))))
+                          with-export))))
+
+      #None
+      (fail "Wrong syntax for deftype"))
+    ))
+
+(deftype #export (IO a)
+  (-> (,) a))
+
+(defmacro #export (io tokens)
+  (_lux_case tokens
+    (#Cons [value #Nil])
+    (let [blank ($symbol ["" ""])]
+      (return (_lux_: SyntaxList
+                      (list (`' (_lux_lambda (~ blank) (~ blank) (~ value)))))))
+
+    _
+    (fail "Wrong syntax for io")))
+
+(defmacro #export (exec tokens)
+  (_lux_case (reverse tokens)
+    (#Cons [value actions])
+    (let [dummy ($symbol ["" ""])]
+      (return (_lux_: SyntaxList
+                      (list (foldL (: (-> Syntax Syntax Syntax)
+                                      (lambda [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post)))))
+                                   value
+                                   actions)))))
+
+    _
+    (fail "Wrong syntax for exec")))
+
+(defmacro #export (def tokens)
+  (let [[export? tokens'] (: (, Bool (List Syntax))
+                             (_lux_case tokens
+                               (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
+                               [true tokens']
+
+                               _
+                               [false tokens]))
+        parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
+                 (_lux_case tokens'
+                   (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])])
+                   (#Some [name args (#Some type) body])
+                   
+                   (#Cons [name (#Cons [type (#Cons [body #Nil])])])
+                   (#Some [name #Nil (#Some type) body])
+                   
+                   (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])
+                   (#Some [name args #None body])
+                   
+                   (#Cons [name (#Cons [body #Nil])])
+                   (#Some [name #Nil #None body])
+
+                   _
+                   #None))]
+    (_lux_case parts
+      (#Some [name args ?type body])
+      (let [body' (: Syntax
+                     (_lux_case args
+                       #Nil
+                       body
+
+                       _
+                       (`' (;lambda (~ name) [(~@ args)] (~ body)))))
+            body'' (: Syntax
+                      (_lux_case ?type
+                        (#Some type)
+                        (`' (: (~ type) (~ body')))
+                        
+                        #None
+                        body'))]
+        (return (: (List Syntax)
+                   (list& (`' (_lux_def (~ name) (~ body'')))
+                          (if export?
+                            (list (`' (_lux_export (~ name))))
+                            #Nil)))))
+      
+      #None
+      (fail "Wrong syntax for def"))))
+
+(def (rejoin-pair pair)
+  (-> (, Syntax Syntax) (List Syntax))
+  (let [[left right] pair]
+    (list left right)))
+
+(defmacro #export (case tokens)
+  (_lux_case tokens
+    (#Cons [value branches])
+    (do Lux:Monad
+      [expansions (map% Lux:Monad
+                        (: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax))))
+                           (lambda expander [branch]
+                              (let [[pattern body] branch]
+                                (_lux_case pattern
+                                  (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) macro-args]))])
+                                  (do Lux:Monad
+                                    [expansion (macro-expand ($form (list& ($symbol macro-name) body macro-args)))
+                                     expansions (map% Lux:Monad expander (as-pairs (: (List Syntax) expansion)))]
+                                    (;return (: (List (, Syntax Syntax)) (list:join (: (List (List (, Syntax Syntax))) expansions)))))
+
+                                  _
+                                  (;return (: (List (, Syntax Syntax)) (list branch)))))))
+                        (as-pairs branches))]
+      (;return (_lux_: SyntaxList
+                       (list (`' (_lux_case (~ value)
+                                   (~@ (|> (: (List (List (, Syntax Syntax))) expansions)
+                                           list:join (map rejoin-pair) list:join))))))))
+
+    _
+    (fail "Wrong syntax for case")))
+
+(defmacro #export (\ tokens)
+  (case tokens
+    (#Cons [body (#Cons [pattern #Nil])])
+    (do Lux:Monad
+      [pattern+ (macro-expand pattern)]
+      (case (: (List Syntax) pattern+)
+        (#Cons [pattern' #Nil])
+        (;return (: (List Syntax)
+                    (list pattern' body)))
+        
+        _
+        (fail "\\ can only expand to 1 pattern.")))
+    
+    _
+    (fail "Wrong syntax for \\")))
+
+(defmacro #export (\or tokens)
+  (case tokens
+    (#Cons [body patterns])
+    (case patterns
+      #Nil
+      (fail "\\or can't have 0 patterns")
+
+      _
+      (do Lux:Monad
+        [patterns' (map% Lux:Monad macro-expand patterns)]
+        (;return (: (List Syntax)
+                    (list:join (map (: (-> Syntax (List Syntax))
+                                       (lambda [pattern] (list pattern body)))
+                                    (list:join patterns')))))))
+    
+    _
+    (fail "Wrong syntax for \\or")))
+
+(do-template [<name> <offset>]
+  [(def #export <name> (int:+ <offset>))]
+
+  [inc  1]
+  [dec -1])
+
+(def (int:show int)
+  (-> Int Text)
+  (_jvm_invokevirtual java.lang.Object toString []
+                      int []))
+
+(defmacro #export (` tokens)
+  (do Lux:Monad
+    [module-name get-module-name]
+    (case tokens
+      (\ (list template))
+      (;return (_lux_: SyntaxList
+                       (list (untemplate module-name template))))
+
+      _
+      (fail "Wrong syntax for `"))))
+
+(def #export (gensym prefix state)
+  (-> Text (Lux Syntax))
+  (case state
+    {#source source #modules modules
+     #envs   envs   #types   types   #host           host
+     #seed   seed   #seen-sources seen-sources #eval? eval?}
+    (#Right [{#source source #modules modules
+              #envs   envs   #types   types   #host           host
+              #seed   (inc seed) #seen-sources seen-sources #eval? eval?}
+             ($symbol ["__gensym__" (int:show seed)])])))
+
+(def #export (macro-expand-1 token)
+  (-> Syntax (Lux Syntax))
+  (do Lux:Monad
+    [token+ (macro-expand token)]
+    (case (: (List Syntax) token+)
+      (\ (list token'))
+      (;return token')
+
+      _
+      (fail "Macro expanded to more than 1 element."))))
+
+(defmacro #export (sig tokens)
+  (do Lux:Monad
+    [tokens' (map% Lux:Monad macro-expand-1 tokens)
+     members (map% Lux:Monad
+                   (: (-> Syntax (Lux (, Ident Syntax)))
+                      (lambda [token]
+                        (case token
+                          (\ (#Meta [_ (#FormS (list (#Meta [_ (#SymbolS ["" "_lux_:"])]) type (#Meta [_ (#SymbolS name)])))]))
+                          (do Lux:Monad
+                            [name' (normalize name)]
+                            (;return (: (, Ident Syntax) [name' type])))
+
+                          _
+                          (fail "Signatures require typed members!"))))
+                   tokens')]
+    (;return (: (List Syntax)
+                (list (`' (#;RecordT (list (~@ (map (: (-> (, Ident Syntax) Syntax)
+                                                       (lambda [pair]
+                                                         (let [[name type] pair]
+                                                           (`' [(~ (|> name ident->text $text))
+                                                                (~ type)]))))
+                                                    members))))))))))
+
+(defmacro #export (defsig tokens)
+  (let [[export? tokens'] (: (, Bool (List Syntax))
+                             (case tokens
+                               (\ (list& (#Meta [_ (#TagS ["" "export"])]) tokens'))
+                               [true tokens']
+
+                               _
+                               [false tokens]))
+        ?parts (: (Maybe (, Syntax (List Syntax) (List Syntax)))
+                  (case tokens'
+                    (\ (list& (#Meta [_ (#FormS (list& name args))]) sigs))
+                    (#Some [name args sigs])
+
+                    (\ (list& name sigs))
+                    (#Some [name #Nil sigs])
+
+                    _
+                    #None))]
+    (case ?parts
+      (#Some [name args sigs])
+      (let [sigs' (: Syntax
+                     (case args
+                       #Nil
+                       (`' (;sig (~@ sigs)))
+
+                       _
+                       (`' (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))]
+        (return (: (List Syntax)
+                   (list& (`' (_lux_def (~ name) (~ sigs')))
+                          (if export?
+                            (list (`' (_lux_export (~ name))))
+                            #Nil)))))
+
+      #None
+      (fail "Wrong syntax for defsig"))))
+
+(defmacro #export (struct tokens)
+  (do Lux:Monad
+    [tokens' (map% Lux:Monad macro-expand-1 tokens)
+     members (map% Lux:Monad
+                   (: (-> Syntax (Lux (, Syntax Syntax)))
+                      (lambda [token]
+                        (case token
+                          (\ (#Meta [_ (#FormS (list (#Meta [_ (#SymbolS ["" "_lux_def"])]) (#Meta [_ (#SymbolS name)]) value))]))
+                          (do Lux:Monad
+                            [name' (normalize name)]
+                            (;return (: (, Syntax Syntax) [($tag name') value])))
+
+                          _
+                          (fail "Structures require defined members!"))))
+                   tokens')]
+    (;return (: (List Syntax)
+                (list ($record members))))))
+
+(defmacro #export (defstruct tokens)
+  (let [[export? tokens'] (: (, Bool (List Syntax))
+                             (case tokens
+                               (\ (list& (#Meta [_ (#TagS ["" "export"])]) tokens'))
+                               [true tokens']
+
+                               _
+                               [false tokens]))
+        ?parts (: (Maybe (, Syntax (List Syntax) Syntax (List Syntax)))
+                  (case tokens'
+                    (\ (list& (#Meta [_ (#FormS (list& name args))]) type defs))
+                    (#Some [name args type defs])
+
+                    (\ (list& name type defs))
+                    (#Some [name #Nil type defs])
+
+                    _
+                    #None))]
+    (case ?parts
+      (#Some [name args type defs])
+      (let [defs' (: Syntax
+                     (case args
+                       #Nil
+                       (`' (;struct (~@ defs)))
+
+                       _
+                       (`' (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))]
+        (return (: (List Syntax)
+                   (list& (`' (def (~ name) (~ type) (~ defs')))
+                          (if export?
+                            (list (`' (_lux_export (~ name))))
+                            #Nil)))))
+
+      #None
+      (fail "Wrong syntax for defsig"))))
+
+(defsig #export (Eq a)
+  (: (-> a a Bool)
+     =))
+
+(do-template [<name> <type> <test>]
+  [(defstruct #export <name> (Eq <type>)
+     (def (= x y)
+       (<test> x y)))]
+
+  [Int:Eq  Int  _jvm_leq]
+  [Real:Eq Real _jvm_deq])
+
+(def #export (id x)
+  (All [a] (-> a a))
+  x)
+
+(defsig #export (Show a)
+  (: (-> a Text)
+     show))
+
+(do-template [<name> <type> <body>]
+  [(defstruct #export <name> (Show <type>)
+     (def (show x)
+       <body>))]
+
+  [Bool:Show Bool (->text x)]
+  [Int:Show  Int  (->text x)]
+  [Real:Show Real (->text x)]
+  [Char:Show Char ($ text:++ "#\"" (->text x) "\"")])
+
+(defsig #export (Ord a)
+  (: (-> a a Bool)
+     <)
+  (: (-> a a Bool)
+     <=)
+  (: (-> a a Bool)
+     >)
+  (: (-> a a Bool)
+     >=))
+
+(do-template [<name> <form> <message>]
+  [(defmacro #export (<name> tokens)
+     (case (reverse tokens)
+       (\ (list& last init))
+       (return (: (List Syntax)
+                  (list (foldL (: (-> Syntax Syntax Syntax)
+                                  (lambda [post pre] (` <form>)))
+                               last
+                               init))))
+       
+       _
+       (fail <message>)))]
+
+  [and (if (~ pre) true (~ post))  "and requires >=1 clauses."]
+  [or  (if (~ pre) (~ post) false) "or requires >=1 clauses."])
+
+(do-template [<name> <type> <lt> <gt> <eq>]
+  [(defstruct #export <name> (Ord <type>)
+     (def (< x y)
+       (<lt> x y))
+     
+     (def (<= x y)
+       (or (<lt> x y)
+           (<eq> x y)))
+     
+     (def (> x y)
+       (<gt> x y))
+     
+     (def (>= x y)
+       (or (<gt> x y)
+           (<eq> x y))))]
+
+  [Int:Ord  Int  _jvm_llt _jvm_lgt _jvm_leq]
+  [Real:Ord Real _jvm_dlt _jvm_dgt _jvm_deq])
+
+(defmacro #export (lux tokens state)
+  (case state
+    {#source source #modules modules
+     #envs   envs   #types   types   #host           host
+     #seed   seed   #seen-sources seen-sources #eval? eval?}
+    (case (get "lux" modules)
+      (#Some lux)
+      (let [to-alias (map (: (-> (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax))))))
+                                 (List Text))
+                             (lambda [gdef]
+                               (let [[name [export? _]] gdef]
+                                 (if export?
+                                   (exec (_jvm_invokevirtual java.io.PrintStream print [java.lang.Object]
+                                                             (_jvm_getstatic java.lang.System out) [($ text:++ "Importing: " name "\n")])
+                                     (list name))
+                                   (list)))))
+                          (let [{#module-aliases _ #defs defs #imports _} lux]
+                            defs))]
+        (#Right [state (: (List Syntax)
+                          (map (: (-> Text Syntax)
+                                  (lambda [name]
+                                    (` ((~ ($symbol ["" "_lux_def"])) (~ ($symbol ["" name])) (~ ($symbol ["lux" name]))))))
+                               (list:join to-alias)))]))
+      
+      #None
+      (#Left "Uh, oh... The universe is not working properly..."))
+    ))
+
+(def #export (print x)
+  (-> Text (IO (,)))
+  (lambda [_]
+    (exec (_jvm_invokevirtual java.io.PrintStream print [java.lang.Object]
+                              (_jvm_getstatic java.lang.System out) [x])
+      [])))
+
+(def #export (println x)
+  (-> Text (IO (,)))
+  (print (text:++ x "\n")))
+
+(def #export (some f xs)
+  (All [a b]
+    (-> (-> a (Maybe b)) (List a) (Maybe b)))
+  (case xs
+    #Nil
+    #None
+
+    (#Cons [x xs'])
+    (case (f x)
+      #None
+      (some f xs')
+
+      (#Some y)
+      (#Some y))))
+
+
+(def (index-of part text)
+  (-> Text Text Int)
+  (_jvm_i2l (_jvm_invokevirtual java.lang.String indexOf [java.lang.String]
+                                text [part])))
+
+(def (substring1 idx text)
+  (-> Int Text Text)
+  (_jvm_invokevirtual java.lang.String substring [int]
+                      text [(_jvm_l2i idx)]))
+
+(def (substring2 idx1 idx2 text)
+  (-> Int Int Text Text)
+  (_jvm_invokevirtual java.lang.String substring [int int]
+                      text [(_jvm_l2i idx1) (_jvm_l2i idx2)]))
+
+(def (split-slot slot)
+  (-> Text (, Text Text))
+  (let [idx (index-of ";" slot)
+        module (substring2 0 idx slot)
+        name (substring1 (inc idx) slot)]
+    [module name]))
+
+(def (resolve-struct-type type)
+  (-> Type (Maybe Type))
+  (case type
+    (#RecordT slots)
+    (#Some type)
+
+    (#AppT [fun arg])
+    (resolve-struct-type fun)
+
+    (#AllT [_ _ _ body])
+    (resolve-struct-type body)
+
+    _
+    #None))
+
+(defmacro #export (using tokens state)
+  (case tokens
+    (\ (list struct body))
+    (case struct
+      (#Meta [_ (#SymbolS vname)])
+      (let [vname' (ident->text vname)]
+        (case state
+          {#source source #modules modules
+           #envs   envs   #types   types   #host           host
+           #seed   seed   #seen-sources seen-sources #eval? eval?}
+          (let [?struct-type (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type))
+                                      (lambda [env]
+                                        (case env
+                                          {#name _ #inner-closures _ #locals {#counter _ #mappings mappings} #closure _}
+                                          (some (: (-> (, Text (, LuxVar Type)) (Maybe Type))
+                                                   (lambda [binding]
+                                                     (let [[bname [_ type]] binding]
+                                                       (if (text:= vname' bname)
+                                                         (#Some type)
+                                                         #None))))
+                                                mappings))))
+                                   envs)]
+            (case ?struct-type
+              #None
+              (#Left ($ text:++ "Unknown structure: " vname'))
+
+              (#Some struct-type)
+              (case (resolve-struct-type struct-type)
+                (#Some (#RecordT slots))
+                (let [pattern ($record (map (: (-> (, Text Type) (, Syntax Syntax))
+                                               (lambda [slot]
+                                                 (let [[sname stype] slot
+                                                       [module name] (split-slot sname)]
+                                                   [($tag [module name]) ($symbol ["" name])])))
+                                            slots))]
+                  (#Right [state (: (List Syntax)
+                                    (list (` (_lux_case (~ struct) (~ pattern) (~ body)))))]))
+
+                _
+                (#Left "Can only \"use\" records."))))))
+
+      _
+      (let [dummy ($symbol ["" ""])]
+        (#Right [state (: (List Syntax)
+                          (list (` (_lux_case (~ struct)
+                                     (~ dummy)
+                                     (using (~ dummy)
+                                       (~ body))))))])))
+
+    _
+    (#Left "Wrong syntax for defsig")))
+
+(def #export (flip f)
+  (All [a b c]
+    (-> (-> a b c) (-> b a c)))
+  (lambda [y x]
+    (f x y)))
+
+## (def #export (curry f)
+##   (All [a b c]
+##     (-> (-> (, a b) c)
+##         (-> a b c)))
+##   (lambda [x y]
+##     (f [x y])))
+
+## (def #export (uncurry f)
+##   (All [a b c]
+##     (-> (-> a b c)
+##         (-> (, a b) c)))
+##   (lambda [[x y]]
+##     (f x y)))
+
+## (defmacro (loop tokens)
+##   (_lux_case tokens
+##          (#Cons [bindings (#Cons [body #Nil])])
+##          (let [pairs (as-pairs bindings)]
+##            (return (list (#FormS (#Cons [(` (lambda (~ (#SymbolS ["" "recur"])) (~ (#TupleS (map first pairs)))
+##                                               (~ body)))
+##                                         (map second pairs)])))))))
+
+## (defmacro (get@ tokens)
+##   (let [output (_lux_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 (_lux_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 (_lux_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))))
-- 
cgit v1.2.3