## Base interfaces & classes
(jvm-interface Function
               (: apply (-> [java.lang.Object] java.lang.Object)))

## Base functions & macros
(def' let'
  (lambda' _ tokens
           (lambda' _ state
                    (case' tokens
                           (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
                           (#Ok [state
                                 (#Cons [(#Form (#Cons [(#Ident "case'") (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
                                         #Nil])]))
                    )))
(declare-macro let')

(def' lambda
  (lambda' _ tokens
           (lambda' _ state
                    (let' output (case' tokens
                                        (#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])])
                                        (#Form (#Cons [(#Ident "lambda'")
                                                       (#Cons [(#Ident "")
                                                               (#Cons [arg
                                                                       (#Cons [(case' args'
                                                                                      #Nil
                                                                                      body

                                                                                      _
                                                                                      (#Form (#Cons [(#Ident "lux;lambda")
                                                                                                     (#Cons [(#Tuple args')
                                                                                                             (#Cons [body #Nil])])])))
                                                                               #Nil])])])]))

                                        (#Cons [(#Ident self) (#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])])])
                                        (#Form (#Cons [(#Ident "lambda'")
                                                       (#Cons [(#Ident self)
                                                               (#Cons [arg
                                                                       (#Cons [(case' args'
                                                                                      #Nil
                                                                                      body

                                                                                      _
                                                                                      (#Form (#Cons [(#Ident "lux;lambda")
                                                                                                     (#Cons [(#Tuple args')
                                                                                                             (#Cons [body #Nil])])])))
                                                                               #Nil])])])])))
                          (#Ok [state (#Cons [output #Nil])]))
                    )))
(declare-macro lambda)

(def' def
  (lambda [tokens state]
    (let' output (case' tokens
                        (#Cons [(#Ident name) (#Cons [body #Nil])])
                        (#Form (#Cons [(#Ident "def'") tokens]))

                        (#Cons [(#Form (#Cons [(#Ident name) args]))
                                (#Cons [body #Nil])])
                        (#Form (#Cons [(#Ident "def'")
                                       (#Cons [(#Ident name)
                                               (#Cons [(#Form (#Cons [(#Ident "lux;lambda")
                                                                      (#Cons [(#Ident name)
                                                                              (#Cons [(#Tuple args)
                                                                                      (#Cons [body #Nil])])])]))
                                                       #Nil])])])))
          (#Ok [state (#Cons [output #Nil])]))))
(declare-macro def)

(def (defmacro tokens state)
  (let' [fn-name fn-def] (case' tokens
                                (#Cons [(#Form (#Cons [(#Ident name) args]))
                                        (#Cons [body #Nil])])
                                [name
                                 (#Form (#Cons [(#Ident "lux;def")
                                                (#Cons [(#Form (#Cons [(#Ident name) args]))
                                                        (#Cons [body
                                                                #Nil])])]))])
        (let' declaration (#Form (#Cons [(#Ident "declare-macro") (#Cons [(#Ident fn-name) #Nil])]))
              (#Ok [state (#Cons [fn-def (#Cons [declaration #Nil])])]))))
(declare-macro defmacro)

(defmacro (comment tokens state)
  (#Ok [state #Nil]))

(def (int+ x y)
  (jvm-ladd x y))

(def (id x)
  x)

(def (print x)
  (jvm-invokevirtual java.io.PrintStream "print" [java.lang.Object]
                     (jvm-getstatic java.lang.System "out") [x]))

(def (println x)
  (jvm-invokevirtual java.io.PrintStream "println" [java.lang.Object]
                     (jvm-getstatic java.lang.System "out") [x]))

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

(def (reverse list)
  (fold (lambda [tail head]
          (#Cons [head tail]))
        #Nil
        list))

(defmacro (list xs state)
  (let' xs' (reverse xs)
        (let' output (fold (lambda [tail head]
                             (#Form (#Cons [(#Tag "Cons")
                                            (#Cons [(#Tuple (#Cons [head (#Cons [tail #Nil])]))
                                                    #Nil])])))
                           (#Tag "Nil")
                           xs')
              (#Ok [state (#Cons [output #Nil])]))))

(defmacro (list+ xs state)
  (case' (reverse xs)
         #Nil
         [#Nil state]

         (#Cons [last init'])
         (let' output (fold (lambda [tail head]
                              (#Form (list (#Tag "Cons") (#Tuple (list head tail)))))
                            last
                            init')
               (#Ok [state (#Cons [output #Nil])]))))

(def (as-pairs xs)
  (case' xs
         (#Cons [x (#Cons [y xs'])])
         (#Cons [[x y] (as-pairs xs')])

         _
         #Nil))

(defmacro (let tokens state)
  (case' tokens
         (#Cons [(#Tuple bindings) (#Cons [body #Nil])])
         (let' output (fold (lambda [body binding]
                              (case' binding
                                     [label value]
                                     (#Form (list (#Ident "lux;let'") label value body))))
                            body
                            (reverse (as-pairs bindings)))
               (#Ok [state (list output)]))))

(def (. f g)
  (lambda [x] (f (g x))))

(def (++ xs ys)
  (case' xs
         #Nil
         ys

         (#Cons [x xs*])
         (#Cons [x (++ xs* ys)])))

(def concat
  (fold ++ #Nil))

(def (map f xs)
  (case' xs
         #Nil
         #Nil

         (#Cons [x xs'])
         (#Cons [(f x) (map f xs')])))

(def flat-map (. concat map))

(def (untemplate-list tokens)
  (case' tokens
         #Nil
         (#Tag "Nil")

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

(def (untemplate token)
  (case' token
         (#Bool value)
         (#Form (list (#Tag "Bool") (#Bool value)))

         (#Int value)
         (#Form (list (#Tag "Int") (#Int value)))

         (#Real value)
         (#Form (list (#Tag "Real") (#Real value)))

         (#Char value)
         (#Form (list (#Tag "Char") (#Char value)))

         (#Text value)
         (#Form (list (#Tag "Text") (#Text value)))

         (#Tag value)
         (#Form (list (#Tag "Tag") (#Text value)))

         (#Ident value)
         (#Form (list (#Tag "Ident") (#Text value)))

         (#Tuple elems)
         (#Form (list (#Tag "Tuple") (untemplate-list (map untemplate elems))))

         (#Form (#Cons [(#Ident "~") (#Cons [unquoted #Nil])]))
         unquoted

         (#Form elems)
         (#Form (list (#Tag "Form") (untemplate-list (map untemplate elems))))
         ))

(defmacro (` tokens state)
  (case' tokens
         (#Cons [template #Nil])
         (#Ok [state (list (untemplate template))])))

(defmacro (if tokens state)
  (case' tokens
         (#Cons [test (#Cons [then (#Cons [else #Nil])])])
         (#Ok [state
               (list (` (case' (~ test)
                               true  (~ then)
                               false (~ else))))])))

(def (filter p xs)
  (case' xs
         #Nil
         #Nil

         (#Cons [x xs*])
         (if (p x)
           (filter p xs*)
           (#Cons [x (filter p xs*)]))))

(def (return val)
  (lambda [state]
    (#Ok [state val])))

(def (fail msg)
  (lambda [_]
    (#Error msg)))

(def (bind f v)
  (lambda [state]
    (case' (v state)
           (#Ok [state' x])
           (f x state')
           
           (#Error msg)
           (#Error msg))))

(def (first pair)
  (case' pair
         [f s]
         f))

(def (second pair)
  (case' pair
         [f s]
         s))

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

(defmacro (export tokens)
  (return (map (lambda [t] (` (export' (~ t))))
               tokens)))

(defmacro (and tokens)
  (let [as-if (case' tokens
                     #Nil
                     (` true)

                     (#Cons [init tests])
                     (fold (lambda [prev next]
                             (` (if (~ prev) (~ next) false)))
                           init
                           tokens)
                     )]
    (return (list as-if))))

(defmacro (or tokens)
  (let [as-if (case' tokens
                     #Nil
                     (` false)

                     (#Cons [init tests])
                     (fold (lambda [prev next]
                             (` (if (~ prev) true (~ next))))
                           init
                           tokens)
                     )]
    (return (list as-if))))

(def (not x)
  (case' x
         true  false
         false true))

(defmacro (|> tokens)
  (case' tokens
         (#Cons [init apps])
         (return (list (fold (lambda [acc app]
                               (case' app
                                      (#Form parts)
                                      (#Form (++ parts (list acc)))

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

(defmacro ($ tokens)
  (case' tokens
         (#Cons [op (#Cons [init args])])
         (return (list (fold (lambda [acc elem]
                               (` ((~ op) (~ acc) (~ elem))))
                             init
                             args)))))

(def (const x)
  (lambda [_] x))

(def (int> x y)
  (jvm-lgt x y))

(def (int< x y)
  (jvm-llt x y))

(def inc (int+  1))
(def dec (int+ -1))

(def (repeat n x)
  (if (int> n 0)
    (#Cons [x (repeat (dec n) x)])
    #Nil))

(def size
  (fold (lambda [acc _] (inc acc)) 0))

(def (last xs)
  (case' xs
         #Nil             #None
         (#Cons [x #Nil]) (#Some x)
         (#Cons [_ xs'])  (last xs')))

(def (init xs)
  (case' xs
         #Nil             #None
         (#Cons [_ #Nil]) (#Some #Nil)
         (#Cons [x xs'])  (case' (init xs')
                                 (#Some xs'')
                                 (#Some (#Cons [x xs'']))

                                 _
                                 (#Some (#Cons [x #Nil])))))

(defmacro (cond tokens)
  (case' (reverse tokens)
         (#Cons [else branches'])
         (return (list (fold (lambda [else branch]
                               (case' branch
                                      [test then]
                                      (` (if (~ test) (~ then) (~ else)))))
                             else
                             (|> branches' reverse as-pairs))))))

(def (interleave xs ys)
  (case' [xs ys]
         [(#Cons [x xs']) (#Cons [y ys'])]
         (list+ x y (interleave xs' ys'))

         _
         #Nil))

(def (interpose sep xs)
  (case' xs
         #Nil
         xs
         
         (#Cons [x #Nil])
         xs

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

(def (empty? xs)
  (case' xs
         #Nil true
         _    false))

## (do-template [<name> <op>]
##              (def (<name> p xs)
##                (case xs
##                  #Nil true
##                  (#Cons [x xs']) (<op> (p x) (<name> p xs'))))

##              [every? and]
##              [any?   or])

(def (range from to)
  (if (int< from to)
    (#Cons [from (range (inc from) to)])
    #Nil))

(def (tuple->list tuple)
  (case' tuple
         (#Tuple list)
         list))

(def (zip xs ys)
  (case' [xs ys]
         [(#Cons [x xs']) (#Cons [y ys'])]
         (#Cons [[x y] (zip xs' ys')])

         _
         #Nil))

(def (get key map)
  (case' map
         #Nil
         #None

         (#Cons [[k v] map'])
         (if (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object]
                                k [key])
           (#Some v)
           (get key map'))))

(def (get-ident x)
  (case' x
         (#Ident ident)
         ident))

(def (text-++ x y)
  (jvm-invokevirtual java.lang.String "concat" [java.lang.String]
                     x [y]))

(def (show-env env)
  (|> env (map first) (interpose ", ") (fold text-++ "")))

(def (apply-template env template)
  (case' template
         (#Ident ident)
         (case' (get ident env)
                (#Some subst)
                subst

                _
                template)
         
         (#Tuple elems)
         (#Tuple (map (apply-template env) elems))

         (#Form elems)
         (#Form (map (apply-template env) elems))

         (#Record members)
         (#Record (map (lambda [kv]
                         (case' kv
                                [slot value]
                                [(apply-template env slot) (apply-template env value)]))
                       members))

         _
         template))

(defmacro (do-template tokens)
  (case' tokens
         (#Cons [bindings (#Cons [template data])])
         (let [bindings-list (map get-ident (tuple->list bindings))
               data-lists (map tuple->list data)
               apply (lambda [env] (apply-template env template))]
           (|> data-lists
               (map (. apply (zip bindings-list)))
               return))))

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

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

(def (int= x y)
  (jvm-leq x y))

(def (int% x y)
  (jvm-lrem x y))

(def (int>= x y)
  (or (int= x y)
      (int> x y)))

(do-template [<name> <cmp>]
             (def (<name> x y)
               (if (<cmp> x y)
                 x
                 y))

             [max int>]
             [min int<])

(do-template [<name> <cmp>]
             (def (<name> n) (<cmp> n 0))

             [neg? int<]
             [pos? int>=])

(def (even? n)
  (int= 0 (int% n 0)))

(def (odd? n)
  (not (even? n)))

(do-template [<name> <done> <step>]
             (def (<name> n xs)
               (if (int> n 0)
                 (case' xs
                        #Nil            #Nil
                        (#Cons [x xs']) <step>)
                 <done>))

             [take #Nil (list+ x (take (dec n) xs'))]
             [drop xs   (drop (dec n) xs')])

(do-template [<name> <done> <step>]
             (def (<name> f xs)
               (case' xs
                      #Nil            #Nil
                      (#Cons [x xs']) (if (f x) <step> #Nil)))

             [take-while #Nil (list+ x (take-while f xs'))]
             [drop-while xs   (drop-while f xs')])

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

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

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

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

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

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

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

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

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

(def gen-ident
  (lambda [state]
    [(update@ #gen-seed inc state)
     (#Ident ($ text-++ "__" (show-int (get@ #gen-seed state)) "__"))]))

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

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

(def (show-syntax syntax)
  (case' syntax
         (#Bool value)
         (jvm-invokevirtual java.lang.Object "toString" []
                            value [])
         
         (#Int value)
         (jvm-invokevirtual java.lang.Object "toString" []
                            value [])
         
         (#Real value)
         (jvm-invokevirtual java.lang.Object "toString" []
                            value [])
         
         (#Char value)
         (jvm-invokevirtual java.lang.Object "toString" []
                            value [])
         
         (#Text value)
         (jvm-invokevirtual java.lang.Object "toString" []
                            value [])

         (#Ident ident)
         ident

         (#Tag tag)
         (text-++ "#" tag)

         (#Tuple members)
         ($ text-++ "[" (fold text-++ "" (interpose " " (map show-syntax members))) "]")
         
         (#Form members)
         ($ text-++ "(" (fold text-++ "" (interpose " " (map show-syntax members))) ")")
         ))

(defmacro (do tokens)
  (case' tokens
         (#Cons [(#Tuple bindings) (#Cons [body #Nil])])
         (let [output (fold (lambda [body binding]
                              (case' binding
                                     [lhs rhs]
                                     (` (bind (lambda [(~ lhs)] (~ body))
                                              (~ rhs)))))
                            body
                            (reverse (as-pairs bindings)))]
           (return (list output)))))

(def (map% f xs)
  (case' xs
         #Nil
         (return xs)

         (#Cons [x xs'])
         (do [y (f x)
              ys (map% f xs')]
           (return (#Cons [y ys])))))

(defmacro ($keys tokens)
  (case' tokens
         (#Cons [(#Tuple fields) #Nil])
         (return (list (#Record (map (lambda [slot]
                                       (case' slot
                                              (#Tag name)
                                              [(#Tag name) (#Ident name)]))
                                     fields))))))

(defmacro ($or tokens)
  (case' tokens
         (#Cons [(#Tuple patterns) (#Cons [body #Nil])])
         (return (flat-map (lambda [pattern] (list pattern body))
                           patterns))))

(def null jvm-null)

(defmacro (^ tokens)
  (case' tokens
         (#Cons [(#Ident class-name) #Nil])
         (return (list (` (#Data (~ (#Text class-name))))))))

(defmacro (, members)
  (return (list (#Form (list+ (#Tag "Tuple") (untemplate-list members))))))

(defmacro (| members)
  (let [members' (map (lambda [m]
                        (case' m
                               (#Tag tag)
                               [tag (` (#Tuple (list)))]
                               
                               (#Form (#Cons [tag (#Cons [value #Nil])]))
                               [tag (` (#Tuple (~ value)))]))
                      members)]
    (return (list (#Form (list+ (#Tag "Variant") (untemplate-list members)))))))

(defmacro (& members)
  (let [members' (map (lambda [m]
                        (case' m
                               (#Form (#Cons [tag (#Cons [value #Nil])]))
                               [tag (` (#Tuple (~ value)))]))
                      members)]
    (return (list (#Form (list+ (#Tag "Record") (untemplate-list members)))))))

(defmacro (-> tokens)
  (case' (reverse tokens)
         (#Cons [f-return f-args])
         (fold (lambda [f-return f-arg]
                 (#Lambda [f-arg f-return]))
               f-return f-args)))

(def (replace-ident ident value syntax)
  (case' syntax
         (#Ident test)
         (if (= test ident)
           value
           syntax)

         (#Form members)
         (#Form (map (replace-ident ident value) members))

         (#Tuple members)
         (#Tuple (map (replace-ident ident value) members))

         (#Record members)
         (#Record (map (lambda [kv]
                         (case kv
                           [k v]
                           [k (replace-ident ident value v)]))
                       members))

         _
         syntax))

(defmacro (All tokens)
  (let [[name args body] (case' tokens
                                (#Cons [(#Ident name) (#Cons [(#Tuple args) (#Cons [body #Nil])])])
                                [name args body]
                                
                                (#Cons [(#Tuple args) (#Cons [body #Nil])])
                                ["" args body])
        rolled (fold (lambda [body arg]
                       (case' arg
                              (#Ident arg-name)
                              (` (#All (list) (~ (#Text "")) (~ arg) (~ (replace-ident arg-name (` (#Bound (~ (#Text arg-name))))
                                                                                       body))))))
                     body args)]
    (case' rolled
           (#Form (#Cons [(#Tag "All") (#Cons [env (#Cons [(#Test "") (#Cons [arg (#Cons [body #Nil])])])])]))
           (return (list (` (#All (~ env) (~ (#Text name)) (~ arg)
                                  (~ (replace-ident arg-name (` (#Bound (~ (#Text name))))
                                                    body)))))))))

(defmacro (Exists tokens)
  (case' tokens
         (#Cons [args (#Cons [body #Nil])])
         (return (list (` (All (~ args) (~ body)))))))

(def Any (| #Any))
(def Nothing (| #Nothing))
(def Text (^ java.lang.String))
(def Int (^ java.lang.Long))

(deftype (List a)
  (| #Nil
     (#Cons (, a (List a)))))

(deftype #rec Type
  (| #Any
     #Nothing
     (#Data Text)
     (#Tuple (List Type))
     (#Variant (List (, Text Type)))
     (#Record (List (, Text Type)))
     (#Lambda (, Type Type))
     (#Bound Text)
     (#Var Int)
     (#All (, (List (, Text Type)) Text Text Type))
     (#App (, Type Type))))

(deftype (Either l r)
  (| (#Left l)
     (#Right r)))

(deftype #rec Syntax
  (| (#Bool Bool)
     (#Int Int)
     (#Real Real)
     (#Char Char)
     (#Text Text)
     (#Form (List Syntax))
     (#Tuple (List Syntax))
     (#Record (List (, Text Syntax)))))

(deftype Macro
  (-> (List Syntax) CompilerState
      (Either Text (, CompilerState (List Syntax)))))

(def (macro-expand syntax)
  (case' syntax
         (#Form (#Cons [(#Ident macro-name) args]))
         (do [macro (get-macro macro-name)]
           ((coerce macro Macro) args))))

(defmacro (case tokens)
  (case' tokens
         (#Cons value branches)
         (loop [kind #Pattern
                pieces branches
                new-pieces (list)]
           (case' pieces
                  #Nil
                  (return (list (' (case' (~ value) (~@ new-pieces)))))

                  (#Cons piece pieces')
                  (let [[kind' expanded more-pieces] (case' kind
                                                            #Body
                                                            [#Pattern (list piece) #Nil]

                                                            #Pattern
                                                            (do [expansion (macro-expand piece)]
                                                              (case' expansion
                                                                     #Nil
                                                                     [#Pattern #Nil #Nil]

                                                                     (#Cons exp #Nil)
                                                                     [#Body (list exp) #Nil]

                                                                     (#Cons exp exps)
                                                                     [#Body (list exp) exps]))
                                                            )]
                    (recur kind' (++ expanded new-pieces) (++ more-pieces pieces))))
           )))

(def (defsyntax tokens)
  ...)

(deftype (State s a)
  (-> s (, s a)))

(deftype (Parser a)
  (State (List Syntax) a))

(def (parse-ctor tokens)
  (Parser (, Syntax (List Syntax)))
  (case tokens
    (list+ (#Ident name) tokens')
    [tokens' [(#Ident name) (list)]]
    
    (list+ (#Form (list+ (#Ident name) args)) tokens')
    [tokens' [(#Ident name) args]]))

(defsyntax (defsig [[name args] parse-ctor] [anns ($+ $1)])
  (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body))))
                       (` (#Record (~ (untemplate-list ...))))
                       args)]
    (return (list (` (def (~ name) (~ def-body)))))))

(defsyntax (defstruct [[name args] parse-ctor] sig [defs ($+ $1)])
  (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body))))
                       (` (#Record (~ (untemplate-list ...))))
                       args)]
    (return (list (` (def (~ name)
                       (: (~ def-body) (~ sig))))))))

(defsig (Monad m)
  (: return (All [a] (-> a (m a))))
  (: bind (All [a b] (-> (-> a (m b)) (m a) (m b)))))

(defstruct ListMonad (Monad List)
  (def (return x)
    (list x))
  
  (def bind (. concat map)))

## (def (with tokens)
##   ...)

## TODO: Full pattern-matching
## TODO: Type-related macros
## TODO: (Im|Ex)ports-related macros
## TODO: Macro-related macros

## (import "lux")
## (module-alias "lux" "l")
## (def-alias "lux;map" "map")

## (def (require tokens)
##   (case tokens
##     ...))

## (require lux #as l #refer [map])