## First things first, must define functions
(jvm-interface Function
               (:' (-> [java.lang.Object] java.lang.Object)
                   apply))

## Basic types
(def' Bool (#DataT "java.lang.Boolean"))
(export' Bool)

(def' Int (#DataT "java.lang.Long"))
(export' Int)

(def' Real (#DataT "java.lang.Double"))
(export' Real)

(def' Char (#DataT "java.lang.Character"))
(export' Char)

(def' Text (#DataT "java.lang.String"))
(export' Text)

(def' Void (#VariantT #Nil))
(export' Void)

## (deftype (List a)
##   (| #Nil
##      (#Cons (, a (List a)))))
(def' List
  (#AllT [#None "List" "a"
          (#VariantT (#Cons [["lux;Nil" (#TupleT #Nil)]
                             (#Cons [["lux;Cons" (#TupleT (#Cons [(#BoundT "a")
                                                                  (#Cons [(#AppT [(#BoundT "List") (#BoundT "a")])
                                                                          #Nil])]))]
                                     #Nil])]))]))
(export' List)

## (deftype (Maybe a)
##   (| #None
##      (#Some a)))
(def' Maybe
  (#AllT [#None "Maybe" "a"
          (#VariantT (#Cons [["lux;None" (#TupleT #Nil)]
                             (#Cons [["lux;Some" (#BoundT "a")]
                                     #Nil])]))]))
(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))))
(def' Type
  (case' (#AppT [(#BoundT "Type") (#BoundT "_")])
         Type
         (case' (#AppT [List (#TupleT (#Cons [Text (#Cons [Type #Nil])]))])
                TypeEnv
                (#AppT [(#AllT [#None "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]))))
(export' Type)

## (deftype (Bindings k v)
##   (& #counter Int
##      #mappings (List (, k v))))
(def' Bindings
  (#AllT [#None "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)))
(def' Env
  (#AllT [#None "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))
(def' Cursor
  (#TupleT (#Cons [Text (#Cons [Int (#Cons [Int #Nil])])])))

## (deftype (Meta m v)
##   (| (#Meta (, m v))))
(def' Meta
  (#AllT [#None "Meta" "m"
          (#AllT [#None "" "v"
                  (#VariantT (#Cons [["lux;Meta" (#TupleT (#Cons [(#BoundT "m")
                                                                  (#Cons [(#BoundT "v")
                                                                          #Nil])]))]
                                     #Nil]))])]))
(export' Meta)

## (deftype (Syntax' w)
##   (| (#Bool Bool)
##      (#Int Int)
##      (#Real Real)
##      (#Char Char)
##      (#Text Text)
##      (#Symbol (, Text Text))
##      (#Tag (, Text Text))
##      (#Form (List (w (Syntax' w))))
##      (#Tuple (List (w (Syntax' w))))
##      (#Record (List (, (w (Syntax' w)) (w (Syntax' w)))))))
(def' Syntax'
  (case' (#AppT [(#BoundT "w")
                 (#AppT [(#BoundT "Syntax'")
                         (#BoundT "w")])])
         Syntax
         (case' (#AppT [List Syntax])
                SyntaxList
                (case' (#TupleT (#Cons [Text (#Cons [Text #Nil])]))
                       Ident
                       (#AllT [#None "Syntax'" "w"
                               (#VariantT (#Cons [["lux;Bool" Bool]
                                                  (#Cons [["lux;Int" Int]
                                                          (#Cons [["lux;Real" Real]
                                                                  (#Cons [["lux;Char" Char]
                                                                          (#Cons [["lux;Text" Text]
                                                                                  (#Cons [["lux;Symbol" Ident]
                                                                                          (#Cons [["lux;Tag" Ident]
                                                                                                  (#Cons [["lux;Form" SyntaxList]
                                                                                                          (#Cons [["lux;Tuple" SyntaxList]
                                                                                                                  (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])]
                                                                                                                          #Nil])
                                                                                                                  ])])])])])])])])])
                                          )])
                       ))))
(export' Syntax')

## (deftype Syntax
##   (Meta Cursor (Syntax' (Meta Cursor))))
(def' Syntax
  (case' (#AppT [Meta Cursor])
         w
         (#AppT [w (#AppT [Syntax' w])])))
(export' Syntax)

(def' SyntaxList (#AppT [List Syntax]))

## (deftype (Either l r)
##   (| (#Left l)
##      (#Right r)))
(def' Either
  (#AllT [#None "_" "l"
          (#AllT [#None "" "r"
                  (#VariantT (#Cons [["lux;Left" (#BoundT "l")]
                                     (#Cons [["lux;Right" (#BoundT "r")]
                                             #Nil])]))])]))
(export' Either)

## (deftype (StateE s a)
##   (-> s (Either Text (, s a))))
(def' StateE
  (#AllT [#None "StateE" "s"
          (#AllT [#None "" "a"
                  (#LambdaT [(#BoundT "s")
                             (#AppT [(#AppT [Either Text])
                                     (#TupleT (#Cons [(#BoundT "s")
                                                      (#Cons [(#BoundT "a")
                                                              #Nil])]))])])])]))

## (def' Reader
##   (List (Meta Cursor Text)))
(def' Reader
  (#AppT [List
          (#AppT [(#AppT [Meta Cursor])
                  Text])]))
(export' Reader)

## (deftype HostState
##   (& #writer    (^ org.objectweb.asm.ClassWriter)
##      #loader    (^ java.net.URLClassLoader)
##      #eval-ctor Int))
(def' HostState
  (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")]
                    (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")]
                            (#Cons [["lux;eval-ctor" Int]
                                    #Nil])])])))

## (deftype (DefData' m)
##   (| #TypeD
##      (#ValueD Type)
##      (#MacroD m)))
(def' DefData'
  (#AllT [#None "DefData'" ""
          (#VariantT (#Cons [["lux;TypeD" (#TupleT #Nil)]
                             (#Cons [["lux;ValueD" Type]
                                     (#Cons [["lux;MacroD" (#BoundT "")]
                                             #Nil])])]))]))

## (deftype #rec CompilerState
##   (& #source         (Maybe Reader)
##      #modules        (List (, Text (List (, Text (DefData' (-> (List Syntax) (StateE CompilerState (List Syntax))))))))
##      #module-aliases (List Void)
##      #envs           (List (Env Text Void))
##      #types          (Bindings Int Type)
##      #host           HostState))
(def' CompilerState
  (#AppT [(#AllT [#None "CompilerState" ""
                  (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])]
                                    (#Cons [["lux;modules" (#AppT [List (#TupleT (#Cons [Text
                                                                                         (#Cons [(#AppT [List (#TupleT (#Cons [Text
                                                                                                                               (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList
                                                                                                                                                                   (#AppT [(#AppT [StateE (#AppT [(#BoundT "CompilerState")
                                                                                                                                                                                                  (#BoundT "")])])
                                                                                                                                                                           SyntaxList])])])
                                                                                                                                       #Nil])]))])
                                                                                                 #Nil])]))])]
                                            (#Cons [["lux;module-aliases" (#AppT [List Void])]
                                                    (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) Void])])]
                                                            (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])]
                                                                    (#Cons [["lux;host" HostState]
                                                                            (#Cons [["lux;seed" Int]
                                                                                    #Nil])])])])])])]))])
          Void]))
(export' CompilerState)

## (deftype Macro
##   (-> (List Syntax) (StateE CompilerState (List Syntax))))
(def' Macro
  (#LambdaT [SyntaxList
             (#AppT [(#AppT [StateE CompilerState])
                     SyntaxList])]))
(export' Macro)

## Base functions & macros
## (def (_meta data)
##   (-> (Syntax' (Meta Cursor)) Syntax)
##   (#Meta [["" -1 -1] data]))
(def' _meta
  (:' (#LambdaT [(#AppT [Syntax'
                         (#AppT [Meta Cursor])])
                 Syntax])
      (lambda' _ data
               (#Meta [["" -1 -1] data]))))

## (def (return x)
##   (All [a]
##     (-> a CompilerState
##         (Either Text (, CompilerState a))))
##   ...)
(def' return
  (:' (#AllT [#None "" "a"
              (#LambdaT [(#BoundT "a")
                         (#LambdaT [CompilerState
                                    (#AppT [(#AppT [Either Text])
                                            (#TupleT (#Cons [CompilerState
                                                             (#Cons [(#BoundT "a")
                                                                     #Nil])]))])])])])
      (lambda' _ val
               (lambda' _ state
                        (#Right [state val])))))

## (def (fail msg)
##   (All [a]
##     (-> Text CompilerState
##         (Either Text (, CompilerState a))))
##   ...)
(def' fail
  (:' (#AllT [#None "" "a"
              (#LambdaT [Text
                         (#LambdaT [CompilerState
                                    (#AppT [(#AppT [Either Text])
                                            (#TupleT (#Cons [CompilerState
                                                             (#Cons [(#BoundT "a")
                                                                     #Nil])]))])])])])
      (lambda' _ msg
               (lambda' _ state
                        (#Left msg)))))

(def' Ident
  (#TupleT (#Cons [Text (#Cons [Text #Nil])])))
(export' Ident)

(def' $text
  (:' (#LambdaT [Text Syntax])
      (lambda' _ text
               (_meta (#Text text)))))
(export' $text)

(def' $symbol
  (:' (#LambdaT [Ident Syntax])
      (lambda' _ ident
               (_meta (#Symbol ident)))))
(export' $symbol)

(def' $tag
  (:' (#LambdaT [Ident Syntax])
      (lambda' _ ident
               (_meta (#Tag ident)))))
(export' $tag)

(def' $form
  (:' (#LambdaT [(#AppT [List Syntax]) Syntax])
      (lambda' _ tokens
               (_meta (#Form tokens)))))
(export' $form)

(def' $tuple
  (:' (#LambdaT [(#AppT [List Syntax]) Syntax])
      (lambda' _ tokens
               (_meta (#Tuple tokens)))))
(export' $tuple)

(def' $record
  (:' (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax])
      (lambda' _ tokens
               (_meta (#Record tokens)))))
(export' $record)

(def' let'
  (:' Macro
      (lambda' _ tokens
               (case' tokens
                      (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
                      (return (:' SyntaxList
                                  (#Cons [($form (#Cons [($symbol ["" "case'"])
                                                         (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
                                          #Nil])))

                      _
                      (fail "Wrong syntax for let'")))))
(declare-macro' let')

(def' lambda_
  (:' Macro
      (lambda' _ tokens
               (case' tokens
                      (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])
                      (return (:' SyntaxList
                                  (#Cons [(_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])])])])))
                                          #Nil])))

                      (#Cons [(#Meta [_ (#Symbol self)]) (#Cons [(#Meta [_ (#Tuple (#Cons [arg args']))]) (#Cons [body #Nil])])])
                      (return (:' SyntaxList
                                  (#Cons [(_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])])])])))
                                          #Nil])))
                      
                      _
                      (fail "Wrong syntax for lambda")))))
(declare-macro' lambda_)

(def' def_
  (:' Macro
      (lambda_ [tokens]
        (case' tokens
               (#Cons [(#Meta [_ (#Tag ["" "export"])])
                       (#Cons [(#Meta [_ (#Form (#Cons [name args]))])
                               (#Cons [type (#Cons [body #Nil])])])])
               (return (:' SyntaxList
                           (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
                                                         (#Cons [name
                                                                 (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
                                                                                               (#Cons [type
                                                                                                       (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"]))
                                                                                                                                     (#Cons [name
                                                                                                                                             (#Cons [(_meta (#Tuple args))
                                                                                                                                                     (#Cons [body #Nil])])])])))
                                                                                                               #Nil])])])))
                                                                         #Nil])])])))
                                   (#Cons [(_meta (#Form (#Cons [($symbol ["" "export'"]) (#Cons [name #Nil])])))
                                           #Nil])])))

               (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
               (return (:' SyntaxList
                           (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
                                                         (#Cons [name
                                                                 (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
                                                                                               (#Cons [type
                                                                                                       (#Cons [body
                                                                                                               #Nil])])])))
                                                                         #Nil])])])))
                                   (#Cons [(_meta (#Form (#Cons [($symbol ["" "export'"]) (#Cons [name #Nil])])))
                                           #Nil])])))

               (#Cons [(#Meta [_ (#Form (#Cons [name args]))])
                       (#Cons [type (#Cons [body #Nil])])])
               (return (:' SyntaxList
                           (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
                                                         (#Cons [name
                                                                 (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
                                                                                               (#Cons [type
                                                                                                       (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "lambda_"]))
                                                                                                                                     (#Cons [name
                                                                                                                                             (#Cons [(_meta (#Tuple args))
                                                                                                                                                     (#Cons [body #Nil])])])])))
                                                                                                               #Nil])])])))
                                                                         #Nil])])])))
                                   #Nil])))

               (#Cons [name (#Cons [type (#Cons [body #Nil])])])
               (return (:' SyntaxList
                           (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "def'"]))
                                                         (#Cons [name
                                                                 (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" ":'"]))
                                                                                               (#Cons [type
                                                                                                       (#Cons [body
                                                                                                               #Nil])])])))
                                                                         #Nil])])])))
                                   #Nil])))

               _
               (fail "Wrong syntax for def")
               ))))
(declare-macro' def_)

(def_ #export (defmacro tokens)
  Macro
  (case' tokens
         (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])])
         (return (:' SyntaxList
                     (#Cons [($form (#Cons [($symbol ["lux" "def_"])
                                            (#Cons [($form (#Cons [name args]))
                                                    (#Cons [($symbol ["lux" "Macro"])
                                                            (#Cons [body
                                                                    #Nil])])
                                                    ])]))
                             (#Cons [($form (#Cons [($symbol ["" "declare-macro'"]) (#Cons [name #Nil])]))
                                     #Nil])])))

         (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])])])
         (return (:' 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 ["" "declare-macro'"]) (#Cons [name #Nil])]))
                                     #Nil])])))

         _
         (fail "Wrong syntax for defmacro")))
(declare-macro' defmacro)

(defmacro #export (comment tokens)
  (return (:' SyntaxList #Nil)))

(defmacro (->' tokens)
  (case' tokens
         (#Cons [input (#Cons [output #Nil])])
         (return (:' SyntaxList
                     (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"]))
                                                   (#Cons [(_meta (#Tuple (#Cons [input (#Cons [output #Nil])])))
                                                           #Nil])])))
                             #Nil])))

         (#Cons [input (#Cons [output others])])
         (return (:' SyntaxList
                     (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "LambdaT"]))
                                                   (#Cons [(_meta (#Tuple (#Cons [input
                                                                                  (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "->'"]))
                                                                                                                (#Cons [output others])])))
                                                                                          #Nil])])))
                                                           #Nil])])))
                             #Nil])))

         _
         (fail "Wrong syntax for ->'")))

(defmacro (All' tokens)
  (case' tokens
         (#Cons [(#Meta [_ (#Tuple #Nil)])
                 (#Cons [body #Nil])])
         (return (:' SyntaxList
                     (#Cons [body
                             #Nil])))

         (#Cons [(#Meta [_ (#Tuple (#Cons [(#Meta [_ (#Symbol ["" arg-name])]) other-args]))])
                 (#Cons [body #Nil])])
         (return (:' SyntaxList
                     (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AllT"]))
                                                   (#Cons [(_meta (#Tuple (#Cons [(_meta (#Tag ["lux" "None"]))
                                                                                  (#Cons [(_meta (#Text ""))
                                                                                          (#Cons [(_meta (#Text arg-name))
                                                                                                  (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "All'"]))
                                                                                                                                (#Cons [(_meta (#Tuple other-args))
                                                                                                                                        (#Cons [body
                                                                                                                                                #Nil])])])))
                                                                                                          #Nil])])])])))
                                                           #Nil])])))
                             #Nil])))

         _
         (fail "Wrong syntax for All'")))

(defmacro (B' tokens)
  (case' tokens
         (#Cons [(#Meta [_ (#Symbol ["" bound-name])])
                 #Nil])
         (return (:' SyntaxList
                     (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "BoundT"]))
                                                   (#Cons [(_meta (#Text bound-name))
                                                           #Nil])])))
                             #Nil])))

         _
         (fail "Wrong syntax for B'")))

(defmacro ($' tokens)
  (case' tokens
         (#Cons [x #Nil])
         (return tokens)

         (#Cons [x (#Cons [y xs])])
         (return (:' SyntaxList
                     (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["lux" "$'"]))
                                                   (#Cons [(_meta (#Form (#Cons [(_meta (#Tag ["lux" "AppT"]))
                                                                                 (#Cons [(_meta (#Tuple (#Cons [x (#Cons [y #Nil])])))
                                                                                         #Nil])])))
                                                           xs])])))
                             #Nil])))

         _
         (fail "Wrong syntax for $'")))

(def_ #export (fold f init xs)
  (All' [a b]
        (->' (->' (B' a) (B' b) (B' a))
             (B' a)
             ($' List (B' b))
             (B' a))) 
  (case' xs
         #Nil
         init

         (#Cons [x xs'])
         (fold f (f init x) xs')))

(def_ #export (reverse list)
  (All' [a]
        (->' ($' List (B' a)) ($' List (B' a))))
  (fold (:' (All' [a]
                  (->' ($' List (B' a)) (B' a) ($' List (B' a))))
            (lambda_ [tail head]
                     (#Cons [head tail])))
        #Nil
        list))

(defmacro #export (list xs)
  (return (:' SyntaxList
              (#Cons [(fold (:' (->' Syntax Syntax Syntax)
                                (lambda_ [tail head]
                                         (_meta (#Form (#Cons [(_meta (#Tag ["lux" "Cons"]))
                                                               (#Cons [(_meta (#Tuple (#Cons [head (#Cons [tail #Nil])])))
                                                                       #Nil])])))))
                            (_meta (#Tag ["lux" "Nil"]))
                            (reverse xs))
                      #Nil]))))

(defmacro #export (list& xs)
  (case' (reverse xs)
         (#Cons [last init])
         (return (:' SyntaxList
                     (list (fold (:' (->' Syntax Syntax Syntax)
                                     (lambda_ [tail head]
                                              (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
                                                                  (_meta (#Tuple (list head tail))))))))
                                 last
                                 init))))

         _
         (fail "Wrong syntax for list&")))

(defmacro #export (lambda tokens)
  (let' [name tokens'] (:' (#TupleT (list Ident ($' List Syntax)))
                           (case' tokens
                                  (#Cons [(#Meta [_ (#Symbol name)]) tokens'])
                                  [name tokens']

                                  _
                                  [["" ""] tokens]))
        (case' tokens'
               (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])
               (case' args
                      #Nil
                      (fail "lambda requires a non-empty arguments tuple.")
                      
                      (#Cons [harg targs])
                      (let' body' (fold (:' (->' Syntax Syntax Syntax)
                                            (lambda_ [body' arg]
                                                ($form (list ($symbol ["" "lambda'"])
                                                             ($symbol ["" ""])
                                                             arg
                                                             body'))))
                                        body
                                        (reverse targs))
                            (return (:' SyntaxList
                                        (list ($form (list ($symbol ["" "lambda'"])
                                                           ($symbol name)
                                                           harg
                                                           body')))))))

               _
               (fail "Wrong syntax for lambda"))))

(defmacro #export (def tokens)
  (case' tokens
         (#Cons [(#Meta [_ (#Tag ["" "export"])])
                 (#Cons [(#Meta [_ (#Form (#Cons [name args]))])
                         (#Cons [type (#Cons [body #Nil])])])])
         (return (:' SyntaxList
                     (list ($form (list ($symbol ["" "def'"])
                                        name
                                        ($form (list ($symbol ["" ":'"])
                                                     type
                                                     ($form (list ($symbol ["lux" "lambda"])
                                                                  name
                                                                  ($tuple args)
                                                                  body))))))
                           ($form (list ($symbol ["" "export'"]) name)))))

         (#Cons [(#Meta [_ (#Tag ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
         (return (:' SyntaxList
                     (list ($form (list ($symbol ["" "def'"])
                                        name
                                        ($form (list ($symbol ["" ":'"])
                                                     type
                                                     body))))
                           ($form (list ($symbol ["" "export'"]) name)))))

         (#Cons [(#Meta [_ (#Form (#Cons [name args]))])
                 (#Cons [type (#Cons [body #Nil])])])
         (return (:' SyntaxList
                     (list ($form (list ($symbol ["" "def'"])
                                        name
                                        ($form (list ($symbol ["" ":'"])
                                                     type
                                                     ($form (list ($symbol ["lux" "lambda"])
                                                                  name
                                                                  ($tuple args)
                                                                  body)))))))))

         (#Cons [name (#Cons [type (#Cons [body #Nil])])])
         (return (:' SyntaxList
                     (list ($form (list ($symbol ["" "def'"])
                                        name
                                        ($form (list ($symbol ["" ":'"]) type body)))))))

         _
         (fail "Wrong syntax for def")
         ))

(def (as-pairs xs)
  (All' [a]
        (->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a))))))
  (case' xs
         (#Cons [x (#Cons [y xs'])])
         (#Cons [[x y] (as-pairs xs')])

         _
         #Nil))

(defmacro #export (let tokens)
  (case' tokens
         (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])
         (return (:' SyntaxList
                     (list (fold (:' (->' Syntax (#TupleT (list Syntax Syntax))
                                          Syntax)
                                     (lambda [body binding]
                                       (case' binding
                                              [label value]
                                              (_meta (#Form (list (_meta (#Symbol ["lux" "let'"])) label value body))))))
                                 body
                                 (fold (:' (->' ($' List (#TupleT (list Syntax Syntax))) (#TupleT (list Syntax Syntax))
                                                ($' List (#TupleT (list Syntax Syntax))))
                                           (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))))
  (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))
  (case' xs
         #Nil
         false

         (#Cons [x xs'])
         (case' (p x)
                true  true
                false (any? p xs'))))

(def (spliced? token)
  (->' Syntax Bool)
  (case' token
         (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [_ #Nil])]))])
         true

         _
         false))

(def (wrap-meta content)
  (->' Syntax Syntax)
  (_meta (#Form (list (_meta (#Tag ["lux" "Meta"]))
                      (_meta (#Tuple (list (_meta (#Tuple (list (_meta (#Text "")) (_meta (#Int -1)) (_meta (#Int -1)))))
                                           content)))))))

(def (untemplate-list tokens)
  (->' ($' List Syntax) Syntax)
  (case' tokens
         #Nil
         (_meta (#Tag ["lux" "Nil"]))

         (#Cons [token tokens'])
         (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
                             (_meta (#Tuple (list token (untemplate-list tokens')))))))))

(def (list:++ xs ys)
  (All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a))))
  (case' xs
         (#Cons [x xs'])
         (#Cons [x (list:++ xs' ys)])

         #Nil
         ys))

(defmacro #export ($ tokens)
  (case' tokens
         (#Cons [op (#Cons [init args])])
         (return (:' SyntaxList
                     (list (fold (:' (->' Syntax Syntax Syntax)
                                     (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)
  (case' (any? spliced? elems)
         true
         (let [elems' (map (:' (->' Syntax Syntax)
                               (lambda [elem]
                                 (case' elem
                                        (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [spliced #Nil])]))])
                                        spliced

                                        _
                                        ($form (list ($symbol ["" ":'"])
                                                     ($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 token)
  (->' Syntax Syntax)
  (case' token
         (#Meta [_ (#Bool value)])
         (wrap-meta ($form (list ($tag ["lux" "Bool"]) (_meta (#Bool value)))))

         (#Meta [_ (#Int value)])
         (wrap-meta ($form (list ($tag ["lux" "Int"]) (_meta (#Int value)))))

         (#Meta [_ (#Real value)])
         (wrap-meta ($form (list ($tag ["lux" "Real"]) (_meta (#Real value)))))

         (#Meta [_ (#Char value)])
         (wrap-meta ($form (list ($tag ["lux" "Char"]) (_meta (#Char value)))))

         (#Meta [_ (#Text value)])
         (wrap-meta ($form (list ($tag ["lux" "Text"]) (_meta (#Text value)))))

         (#Meta [_ (#Tag [module name])])
         (wrap-meta ($form (list ($tag ["lux" "Tag"]) ($tuple (list (_meta (#Text module)) (_meta (#Text name)))))))

         (#Meta [_ (#Symbol [module name])])
         (wrap-meta ($form (list ($tag ["lux" "Symbol"]) ($tuple (list (_meta (#Text module)) (_meta (#Text name)))))))

         (#Meta [_ (#Tuple elems)])
         (splice untemplate ($tag ["lux" "Tuple"]) elems)

         (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~"])]) (#Cons [unquoted #Nil])]))])
         unquoted

         (#Meta [_ (#Form elems)])
         (splice untemplate ($tag ["lux" "Form"]) elems)

         (#Meta [_ (#Record fields)])
         (wrap-meta ($form (list ($tag ["lux" "Record"])
                                 (untemplate-list (map (:' (->' (#TupleT (list Syntax Syntax)) Syntax)
                                                           (lambda [kv]
                                                             (let [[k v] kv]
                                                               ($tuple (list (untemplate k) (untemplate v))))))
                                                       fields)))))
         ))

(defmacro #export (` tokens)
  (case' tokens
         (#Cons [template #Nil])
         (return (:' SyntaxList
                     (list (untemplate template))))

         _
         (fail "Wrong syntax for `")))

(defmacro #export (|> tokens)
  (case' tokens
         (#Cons [init apps])
         (return (:' SyntaxList
                     (list (fold (:' (->' Syntax Syntax Syntax)
                                     (lambda [acc app]
                                       (case' app
                                              (#Meta [_ (#Form parts)])
                                              ($form (list:++ parts (list acc)))

                                              _
                                              (` ((~ app) (~ acc))))))
                                 init
                                 apps))))

         _
         (fail "Wrong syntax for |>")))

(defmacro #export (if tokens)
  (case' tokens
         (#Cons [test (#Cons [then (#Cons [else #Nil])])])
         (return (:' SyntaxList
                     (list (` (case' (~ test)
                                     true  (~ then)
                                     false (~ else))))))

         _
         (fail "Wrong syntax for if")))

## (deftype (Lux a)
##   (-> CompilerState (Either Text (, CompilerState a))))
(def #export Lux
  Type
  (All' [a]
        (->' CompilerState ($' Either Text (#TupleT (list CompilerState (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]
     (case' ma
            #None     #None
            (#Some a) (f a)))})

(def Lux:Monad
  ($' Monad Lux)
  {#lux;return
   (lambda return [x]
      (lambda [state]
        (#Right [state x])))
   
   #lux;bind
   (lambda [f ma]
     (lambda [state]
       (case' (ma state)
              (#Left msg)
              (#Left msg)

              (#Right [state' a])
              (f a state'))))})

(defmacro #export (^ tokens)
  (case' tokens
         (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil])
         (return (:' SyntaxList
                     (list (` (#;DataT (~ (_meta (#Text class-name))))))))

         _
         (fail "Wrong syntax for ^")))

(defmacro #export (-> tokens)
  (case' (reverse tokens)
         (#Cons [output inputs])
         (return (:' SyntaxList
                     (list (fold (:' (->' Syntax Syntax Syntax)
                                     (lambda [o i]
                                       (` (#;LambdaT [(~ i) (~ o)]))))
                                 output
                                 inputs))))
         
         _
         (fail "Wrong syntax for ->")))

(defmacro #export (, tokens)
  (return (:' SyntaxList
              (list (` (#;TupleT (;list (~@ tokens))))))))

(defmacro (do tokens)
  (case' tokens
         (#Cons [monad (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])])
         (let [body' (fold (:' (-> Syntax (, Syntax Syntax) Syntax)
                               (lambda [body' binding]
                                 (let [[var value] binding]
                                   (case' var
                                          (#Meta [_ (#Tag ["" "let"])])
                                          (` (;let (~ value) (~ body')))

                                          _
                                          (` (;bind (lambda' (~ ($symbol ["" ""]))
                                                        (~ var)
                                                        (~ body'))
                                                    (~ value)))))))
                           body
                           (reverse (as-pairs bindings)))]
           (return (:' SyntaxList
                       (list (` (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]
    (case' xs
           #Nil
           (;return (:' List #Nil))
           
           (#Cons [x xs'])
           (do m
             [y (f x)
              ys (map% m f xs')]
             (;return (:' 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))
  (case' x
         (#Meta [_ (#Symbol ["" sname])])
         (#Some sname)

         _
         #None))

(def (tuple->list tuple)
  (-> Syntax ($' Maybe ($' List Syntax)))
  (case' tuple
         (#Meta [_ (#Tuple members)])
         (#Some members)

         _
         #None))

(def RepEnv
  Type
  ($' List (, Text Syntax)))

(def (make-env xs ys)
  (-> ($' List Text) ($' List Syntax) RepEnv)
  (case' (:' (, ($' 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))
  (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)
  (case' template
         (#Meta [_ (#Symbol ["" sname])])
         (case' (get-rep sname env)
                (#Some subst)
                subst

                _
                template)

         (#Meta [_ (#Tuple elems)])
         ($tuple (map (apply-template env) elems))

         (#Meta [_ (#Form elems)])
         ($form (map (apply-template env) elems))

         (#Meta [_ (#Record members)])
         ($record (map (:' (-> (, 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))))
  (case' xs
         #Nil
         #Nil

         (#Cons [x xs'])
         (list:++ (f x) (join-map f xs'))))

(defmacro (do-template tokens)
  (case' tokens
         (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [(#Meta [_ (#Tuple templates)]) data])])
         (case' (:' (, ($' 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 (:' (-> 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)
  (fold (lambda [acc _] (int:+ 1 acc)) 0 list))

(def #export (not x)
  (-> Bool Bool)
  (if x false true))

(def (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)))

(defmacro #export (| tokens)
  (do Lux:Monad
    [pairs (map% Lux:Monad
                 (:' (-> Syntax ($' Lux Syntax))
                     (lambda [token]
                       (case' token
                              (#Meta [_ (#Tag ident)])
                              (;return (:' Syntax (` [(~ ($text (ident->text ident))) (;,)])))

                              (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))])
                              (;return (:' Syntax (` [(~ ($text (ident->text ident))) (~ value)])))
                              
                              _
                              (fail "Wrong syntax for |"))))
                 tokens)]
    (;return (:' 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
                   (:' (-> (, Syntax Syntax) ($' Lux Syntax))
                       (lambda [pair]
                         (case' pair
                                [(#Meta [_ (#Tag ident)]) value]
                                (;return (:' Syntax (` [(~ ($text (ident->text ident))) (~ value)])))
                                
                                _
                                (fail "Wrong syntax for &"))))
                   (as-pairs tokens))]
      (;return (:' SyntaxList (list (` (#;RecordT (;list (~@ pairs))))))))))

(def (replace-syntax reps syntax)
  (-> RepEnv Syntax Syntax)
  (case' syntax
         (#Meta [_ (#Symbol ["" name])])
         (case' (get-rep name reps)
                (#Some replacement)
                replacement

                #None
                syntax)

         (#Meta [_ (#Form parts)])
         (#Meta [_ (#Form (map (replace-syntax reps) parts))])

         (#Meta [_ (#Tuple members)])
         (#Meta [_ (#Tuple (map (replace-syntax reps) members))])

         (#Meta [_ (#Record slots)])
         (#Meta [_ (#Record (map (:' (-> (, 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'] (:' (, Text SyntaxList)
                                 (case' tokens
                                        (#Cons [(#Meta [_ (#Symbol ["" self-ident])]) tokens'])
                                        [self-ident tokens']

                                        _
                                        ["" tokens]))]
    (case' tokens'
           (#Cons [(#Meta [_ (#Tuple args)]) (#Cons [body #Nil])])
           (case' (map% Maybe:Monad get-ident args)
                  (#Some idents)
                  (case' idents
                         #Nil
                         (return (:' SyntaxList (list body)))
                         
                         (#Cons [harg targs])
                         (let [replacements (map (:' (-> Text (, Text Syntax))
                                                     (lambda [ident] [ident (` (#;BoundT (~ ($text ident))))]))
                                                 (list& self-ident idents))
                               body' (fold (:' (-> Syntax Text Syntax)
                                               (lambda [body' arg']
                                                 (` (#;AllT [#;None "" (~ ($text arg')) (~ body')]))))
                                           (replace-syntax replacements body)
                                           (reverse targs))]
                           (return (:' SyntaxList
                                       (list (` (#;AllT [#;None (~ ($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)))
  (case' plist
         (#Cons [[k' v] plist'])
         (if (text:= k k')
           (#Some v)
           (get k plist'))

         #Nil
         #None))

(def #export (find-macro ident state)
  (-> Ident ($' Lux ($' Maybe Macro)))
  (let [[module name] ident]
    (case' state
           {#source source #modules modules #module-aliases module-aliases
            #envs   envs   #types   types   #host           host
            #seed   seed}
           (#Right [state (do Maybe:Monad
                            [bindings (get module modules)
                             gdef (get name bindings)]
                            (case' (:' ($' DefData' Macro) gdef)
                                   (#MacroD macro')
                                   (#Some macro')

                                   _
                                   #None))]))))

(def (list:join xs)
  (All [a]
    (-> ($' List ($' List a)) ($' List a)))
  (fold list:++ #Nil xs))

(def #export (normalize ident state)
  (-> Ident ($' Lux Ident))
  (case' ident
         ["" name]
         (case' state
                {#source source #modules modules #module-aliases module-aliases
                 #envs   envs   #types   types   #host           host
                 #seed   seed}
                (case' (reverse envs)
                       #Nil
                       (#Left "Can't normalize Ident without a global environment.")

                       (#Cons [{#name prefix #inner-closures _ #locals _ #closure _} _])
                       (#Right [state [prefix name]])))
         
         _
         (#Right [state ident])))

## (def #export (macro-expand syntax)
##   (-> Syntax ($' Lux ($' List Syntax)))
##   (case' syntax
##          (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
##          (do Lux:Monad
##            [macro-name' (normalize macro-name)
##             ?macro (find-macro macro-name')]
##            (case' (:' ($' Maybe Macro) ?macro)
##                   (#Some macro)
##                   (do Lux:Monad
##                     [expansion (macro args)
##                      expansion' (map% Lux:Monad macro-expand expansion)]
##                     (;return (:' SyntaxList (list:join expansion'))))
                  
##                   #None
##                   (do Lux:Monad
##                     [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
##                     (;return (:' SyntaxList (list ($form (list:join parts'))))))))

##          ## (#Meta [_ (#Form (#Cons [harg targs]))])
##          ## (do Lux:Monad
##          ##   [harg+ (macro-expand harg)
##          ##    targs+ (map% Lux:Monad macro-expand targs)]
##          ##   (;return (:' SyntaxList (list:++ harg+ (list:join targs+)))))

##          (#Meta [_ (#Tuple members)])
##          (do Lux:Monad
##            [members' (map% Lux:Monad macro-expand members)]
##            (;return (:' SyntaxList (list ($tuple (list:join members'))))))

##          _
##          (return (:' SyntaxList (list syntax)))))

(def #export (macro-expand syntax)
  (-> Syntax ($' Lux ($' List Syntax)))
  (case' syntax
         (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
         (do Lux:Monad
           [macro-name' (normalize macro-name)
            ?macro (find-macro macro-name')]
           (case' (:' ($' Maybe Macro) ?macro)
                  (#Some macro)
                  (do Lux:Monad
                    [expansion (macro args)
                     expansion' (map% Lux:Monad macro-expand expansion)]
                    (;return (:' SyntaxList (list:join expansion'))))
                  
                  #None
                  (do Lux:Monad
                    [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
                    (;return (:' SyntaxList (list ($form (list:join parts'))))))))

         ## (#Meta [_ (#Form (#Cons [harg targs]))])
         ## (do Lux:Monad
         ##   [harg+ (macro-expand harg)
         ##    targs+ (map% Lux:Monad macro-expand targs)]
         ##   (;return (:' SyntaxList (list:++ harg+ (list:join targs+)))))

         (#Meta [_ (#Tuple members)])
         (do Lux:Monad
           [members' (map% Lux:Monad macro-expand members)]
           (;return (:' SyntaxList (list ($tuple (list:join members'))))))

         _
         (return (:' SyntaxList (list syntax)))))

(def (walk-type type)
  (-> Syntax Syntax)
  (case' type
         (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) parts]))])
         ($form (#Cons [($tag tag) (map walk-type parts)]))

         (#Meta [_ (#Tuple members)])
         ($tuple (map walk-type members))

         (#Meta [_ (#Form (#Cons [type-fn args]))])
         (fold (:' (-> Syntax Syntax Syntax)
                   (lambda [type-fn arg]
                     (` (#;AppT [(~ type-fn) (~ arg)]))))
               (walk-type type-fn)
               (map walk-type args))
         
         _
         type))

(defmacro #export (type` tokens)
  (case' tokens
         (#Cons [type #Nil])
         (do Lux:Monad
           [type+ (macro-expand type)]
           (case' (:' SyntaxList type+)
                  (#Cons [type' #Nil])
                  (;return (:' 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)
  (case' tokens
         (#Cons [type (#Cons [value #Nil])])
         (return (:' SyntaxList (list (` (:' (;type` (~ type)) (~ value))))))

         _
         (fail "Wrong syntax for :")))

(defmacro #export (:! tokens)
  (case' tokens
         (#Cons [type (#Cons [value #Nil])])
         (return (:' SyntaxList (list (` (:!' (;type` (~ type)) (~ value))))))

         _
         (fail "Wrong syntax for :!")))

(defmacro #export (deftype tokens)
  (let [[export? tokens'] (: (, Bool (List Syntax))
                             (case' tokens
                                    (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens'])
                                    [true tokens']

                                    _
                                    [false tokens]))
        ## parts (: (Maybe (, Syntax (List Syntax) Syntax))
        ##          (case' tokens'
        ##                 (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])])
        ##                 (#Some [($symbol name) #Nil type])

        ##                 (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])])
        ##                 (#Some [($symbol name) args type])

        ##                 _
        ##                 #None))
        ]
    (return (: (List Syntax) #Nil))
    ## (case' parts
    ##        (#Some [name args type])
    ##        (let [with-export (: (List Syntax)
    ##                             (if export?
    ##                               (list (` (export' (~ name))))
    ##                               #Nil))
    ##              type' (: Syntax
    ##                       (case' args
    ##                              #Nil
    ##                              type

    ##                              _
    ##                              (` (;All (~ name) [(~@ args)] (~ type)))))]
    ##          (return (: (List Syntax)
    ##                     (list& type' with-export))))

    ##        #None
    ##        (fail "Wrong syntax for deftype"))
    ))

(deftype #export (IO a)
  (-> (,) a))

(defmacro #export (io tokens)
  (case' tokens
         (#Cons [value #Nil])
         (let [blank ($symbol ["" ""])]
           (return (list (` (lambda' (~ blank) (~ blank) (~ value))))))

         _
         (fail "Wrong syntax for io")))

(defmacro #export (exec tokens)
  (case' (reverse tokens)
         (#Cons [value actions])
         (let [dummy ($symbol ["" ""])]
           (return (:' SyntaxList
                       (list (fold (:' (-> Syntax Syntax Syntax)
                                       (lambda [post pre]
                                         (` (case' (~ pre) (~ dummy) (~ post)))))
                                   value
                                   actions)))))

         _
         (fail "Wrong syntax for exec")))

(def (rejoin-pair pair)
  (-> (, Syntax Syntax) (List Syntax))
  (let [[left right] pair]
    (list left right)))

(defmacro #export (case tokens)
  (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]
                                     (case' pattern
                                            (#Cons [(#Meta [_ (#Symbol macro-name)]) macro-args])
                                            (do Lux:Monad
                                              [expansion (macro-expand (list& ($symbol macro-name) body macro-args))]
                                              (map% Lux:Monad expander (as-pairs expansion)))

                                            _
                                            (;return (: (List (, Syntax Syntax)) (list branch)))))))
                             (as-pairs branches))]
           (;return (: (List (, Syntax Syntax))
                       (list (` (case' (~ value)
                                       (~@ (|> expansions list:join (map rejoin-pair) list:join))))))))

         _
         (fail "Wrong syntax for case")))

## (def #export (print x)
##   (-> Text (IO (,)))
##   (io (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")))

## ## (defmacro (loop tokens)
## ##   (case' tokens
## ##          (#Cons [bindings (#Cons [body #Nil])])
## ##          (let [pairs (as-pairs bindings)]
## ##            (return (list (#Form (#Cons [(` (lambda (~ (#Symbol ["" "recur"])) (~ (#Tuple (map first pairs)))
## ##                                               (~ body)))
## ##                                         (map second pairs)])))))))

## ## ## (do-template [<name> <offset>]
## ## ##              (def <name> (int+ <offset>))

## ## ##              [inc  1]
## ## ##              [dec -1])

## ## ## (defmacro (get@ tokens)
## ## ##   (let [output (case' tokens
## ## ##                       (#Cons [tag (#Cons [record #Nil])])
## ## ##                       (` (get@' (~ tag) (~ record)))

## ## ##                       (#Cons [tag #Nil])
## ## ##                       (` (lambda [record] (get@' (~ tag) record))))]
## ## ##     (return (list output))))

## ## ## (defmacro (set@ tokens)
## ## ##   (let [output (case' tokens
## ## ##                       (#Cons [tag (#Cons [value (#Cons [record #Nil])])])
## ## ##                       (` (set@' (~ tag) (~ value) (~ record)))

## ## ##                       (#Cons [tag (#Cons [value #Nil])])
## ## ##                       (` (lambda [record] (set@' (~ tag) (~ value) record)))

## ## ##                       (#Cons [tag #Nil])
## ## ##                       (` (lambda [value record] (set@' (~ tag) value record))))]
## ## ##     (return (list output))))

## ## ## (defmacro (update@ tokens)
## ## ##   (let [output (case' tokens
## ## ##                       (#Cons [tag (#Cons [func (#Cons [record #Nil])])])
## ## ##                       (` (let [_record_ (~ record)]
## ## ##                            (set@' (~ tag) ((~ func) (get@' (~ tag) _record_)) _record_)))

## ## ##                       (#Cons [tag (#Cons [func #Nil])])
## ## ##                       (` (lambda [record]
## ## ##                            (` (set@' (~ tag) ((~ func) (get@' (~ tag) record)) record))))

## ## ##                       (#Cons [tag #Nil])
## ## ##                       (` (lambda [func record]
## ## ##                            (set@' (~ tag) (func (get@' (~ tag) record)) record))))]
## ## ##     (return (list output))))

## ## (def (show-int int)
## ##   (-> Int Text)
## ##   (jvm-invokevirtual java.lang.Object "toString" []
## ##                      int []))

## ## (def gensym
## ##   (LuxStateM Syntax)
## ##   (lambda [state]
## ##     [(update@ [#gen-seed] inc state)
## ##      (_meta (#Symbol ($ text-++ "__" (show-int (get@ [#gen-seed] state)) "__")))]))

## ## (do-template [<name> <member>]
## ##              (def (<name> pair)
## ##                (case' pair
## ##                       [f s]
## ##                       <member>))

## ##              [first  f]
## ##              [second s])