path: root/source/lux.lux

##   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
               (:' (-> [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)

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

## (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
                (#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)
##      (#AliasD Ident)))
(def' DefData'
  (#AllT [#None "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)))
(def' LuxVar
  (#VariantT (#Cons [["lux;Local" Int]
                     (#Cons [["lux;Global" Ident]
                             #Nil])])))
(export' LuxVar)

## (deftype #rec CompilerState
##   (& #source         (Maybe Reader)
##      #modules        (List (, Text (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE CompilerState (List Syntax)))))))))
##      #module-aliases (List Void)
##      #envs           (List (Env Text (, LuxVar Type)))
##      #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 [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList
                                                                                                                                                                                                 (#AppT [(#AppT [StateE (#AppT [(#BoundT "CompilerState")
                                                                                                                                                                                                                                (#BoundT "")])])
                                                                                                                                                                                                         SyntaxList])])])
                                                                                                                                                                     #Nil])]))
                                                                                                                                       #Nil])]))])
                                                                                                 #Nil])]))])]
                                            (#Cons [["lux;module-aliases" (#AppT [List Void])]
                                                    (#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]
                                                                                    #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' $text
  (:' (#LambdaT [Text Syntax])
      (lambda' _ text
               (_meta (#Text text)))))

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

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

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

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

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

(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 (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 subst token)
  (->' Text 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])])
         (let [module' (case' module
                              ""
                              subst

                              _
                              module)]
           (wrap-meta ($form (list ($tag ["lux" "Tag"]) ($tuple (list ($text module') ($text name)))))))

         (#Meta [_ (#Symbol [module name])])
         (let [module' (case' module
                              ""
                              subst

                              _
                              module)]
           (wrap-meta ($form (list ($tag ["lux" "Symbol"]) ($tuple (list ($text module') ($text name)))))))

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

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

         (#Meta [_ (#Form elems)])
         (splice (untemplate subst) ($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 subst k) (untemplate subst v))))))
                                                       fields)))))
         ))

(defmacro (`' 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__ #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)
  (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 (get-module-name state)
  ($' Lux Text)
  (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 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 ($' List (, Text (, Bool ($' DefData' (-> ($' List Syntax) ($' StateE CompilerState ($' List Syntax)))))))))
      Text Text Text
      ($' Maybe Macro))
  (do Maybe:Monad
    [bindings (get module modules)
     gdef (get name bindings)]
    (case' (:' (, 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]
      (:' ($' Lux ($' Maybe Macro))
          (lambda [state]
            (case' state
                   {#source source #modules modules #module-aliases module-aliases
                    #envs   envs   #types   types   #host           host
                    #seed   seed}
                   (#Right [state (find-macro' modules current-module module name)])))))))

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

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

                              (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))])
                              (do Lux:Monad
                                [ident (normalize ident)]
                                (;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]
                                (do Lux:Monad
                                  [ident (normalize ident)]
                                  (;return (:' Syntax (`' [(~ ($text (ident->text ident))) (~ value)]))))
                                
                                _
                                (fail "Wrong syntax for &"))))
                   (as-pairs tokens))]
      (;return (:' 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)))
  (case' xs
         #Nil
         xs

         (#Cons [x #Nil])
         xs

         (#Cons [x xs'])
         (list& x sep (interpose sep xs'))))

(def__ #export (syntax:show syntax)
  (-> Syntax Text)
  (case' syntax
         (#Meta [_ (#Bool value)])
         (->text value)

         (#Meta [_ (#Int value)])
         (->text value)

         (#Meta [_ (#Real value)])
         (->text value)

         (#Meta [_ (#Char value)])
         ($ text:++ "#\"" (->text value) "\"")

         (#Meta [_ (#Text value)])
         value

         (#Meta [_ (#Symbol ident)])
         (ident->text ident)

         (#Meta [_ (#Tag ident)])
         (text:++ "#" (ident->text ident))

         (#Meta [_ (#Tuple members)])
         ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]")

         (#Meta [_ (#Form members)])
         ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")")

         (#Meta [_ (#Record slots)])
         ($ text:++ "{" (|> slots
                            (map (:' (-> (, Syntax Syntax) Text)
                                     (lambda [slot]
                                       (let [[k v] slot]
                                         ($ text:++ (syntax:show k) " " (syntax:show v))))))
                            (interpose " ") (fold text:++ "")) "}")
         ))

(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 ($form (list:++ harg+ (list:join (:' ($' List ($' List Syntax)) 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& (`' (def' (~ name) (;type` (~ 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 Syntax)
                      (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")))

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

                                    _
                                    [false tokens]))
        parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
                 (case' tokens'
                        (#Cons [(#Meta [_ (#Form (#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 [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])])
                        (#Some [name args #None body])
                        
                        (#Cons [name (#Cons [body #Nil])])
                        (#Some [name #Nil #None body])

                        _
                        #None))]
    (case' parts
           (#Some [name args ?type body])
           (let [body' (: Syntax
                          (case' args
                                 #Nil
                                 body

                                 _
                                 (`' (;lambda (~ name) [(~@ args)] (~ body)))))
                 body'' (: Syntax
                           (case' ?type
                                  (#Some type)
                                  (`' (: (~ type) (~ body')))
                                  
                                  #None
                                  body'))]
             (return (: (List Syntax) (list& (`' (def' (~ name) (~ body'')))
                                             (if export?
                                               (list (`' (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)
  (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
                                            (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol 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:join (: (List (List (, Syntax Syntax))) expansions))))

                                            _
                                            (;return (: (List (, Syntax Syntax)) (list branch)))))))
                             (as-pairs branches))]
           (;return (: (List Syntax)
                       (list (`' (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 (: (List (List Syntax)) 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 (: (List Syntax)
                  (list (untemplate (: Text module-name) template))))

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

(def #export (gensym prefix state)
  (-> Text (Lux Syntax))
  (case state
    {#source source #modules modules #module-aliases module-aliases
     #envs   envs   #types   types   #host           host
     #seed   seed}
    (#Right [{#source source #modules modules #module-aliases module-aliases
              #envs   envs   #types   types   #host           host
              #seed   (inc seed)}
             ($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 [_ (#Form (list (#Meta [_ (#Symbol ["" ":'"])]) type (#Meta [_ (#Symbol name)])))]))
                          (do Lux:Monad
                            [name' (normalize name)]
                            (;return (: (, Ident Syntax) [name' type])))

                          _
                          (fail "Signatures require typed members!"))))
                   (: (List Syntax) tokens'))]
    (;return (: (List Syntax)
                (list (`' (#;RecordT (list (~@ (map (: (-> (, Ident Syntax) Syntax)
                                                      (lambda [pair]
                                                        (let [[name type] pair]
                                                          (`' [(~ (|> name ident->text $text))
                                                              (~ type)]))))
                                                   (: (List (, Ident Syntax)) members)))))))))))

(defmacro #export (defsig tokens)
  (let [[export? tokens'] (: (, Bool (List Syntax))
                             (case tokens
                               (\ (list& (#Meta [_ (#Tag ["" "export"])]) tokens'))
                               [true tokens']

                               _
                               [false tokens]))
        ?parts (: (Maybe (, Syntax (List Syntax) (List Syntax)))
                  (case tokens'
                    (\ (list& (#Meta [_ (#Form (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& (`' (def' (~ name) (~ sigs')))
                          (if export?
                            (list (`' (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 [_ (#Form (list (#Meta [_ (#Symbol ["" "def'"])]) (#Meta [_ (#Symbol name)]) value))]))
                          (do Lux:Monad
                            [name' (normalize name)]
                            (;return (: (, Syntax Syntax) [($tag name') value])))

                          _
                          (fail "Structures require defined members!"))))
                   (: (List Syntax) tokens'))]
    (;return (: (List Syntax)
                (list ($record members))))))

(defmacro #export (defstruct tokens)
  (let [[export? tokens'] (: (, Bool (List Syntax))
                             (case tokens
                               (\ (list& (#Meta [_ (#Tag ["" "export"])]) tokens'))
                               [true tokens']

                               _
                               [false tokens]))
        ?parts (: (Maybe (, Syntax (List Syntax) Syntax (List Syntax)))
                  (case tokens'
                    (\ (list& (#Meta [_ (#Form (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 (`' (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 (fold (: (-> 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 (alias-lux tokens state)
  (case state
    {#source source #modules modules #module-aliases module-aliases
     #envs   envs   #types   types   #host           host
     #seed   seed}
    (case (get "lux" modules)
      (#Some lux)
      (let [to-alias (map (: (-> (, Text (, Bool (DefData' (-> (List Syntax) (StateE CompilerState (List Syntax))))))
                                 (List Text))
                             (lambda [gdef]
                               (let [[name [export? _]] gdef]
                                 (if export?
                                   (list name)
                                   (list)))))
                          lux)]
        (#Right [state (map (: (-> Text Syntax)
                               (lambda [name]
                                 (` ((~ ($symbol ["" "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 (,))
  (jvm-invokevirtual java.io.PrintStream print [java.lang.Object]
                     (jvm-getstatic java.lang.System out) [x]))

(def #export (println x)
  (-> Text (,))
  (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 [_ (#Symbol vname)])
      (let [vname' (ident->text vname)]
        (case state
          {#source source #modules modules #module-aliases module-aliases
           #envs   envs   #types   types   #host           host
           #seed   seed}
          (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))
                      _ (println (text:++ "Using pattern: " (syntax:show pattern)))]
                  (#Right [state (list (` (case' (~ struct) (~ pattern) (~ body))))]))

                _
                (#Left "Can only \"use\" records."))))))

      _
      (let [dummy ($symbol ["" ""])]
        (#Right [state (list (` (case' (~ struct)
                                       (~ dummy)
                                       (using (~ dummy) (~ body)))))])))

    _
    (#Left "Wrong syntax for defsig")))

## (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)])))))))

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

## (do-template [<name> <member> <type>]
##   (def (<name> pair)
##     (All [a b] (-> (, a b) <type>))
##     (case pair
##       [f s]
##       <member>))

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