path: root/source/lux.lux

## 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])])])
                 [(#Cons [(#Form (#Cons [(#Ident "case'") (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
                          #Nil])
                  state])
          )))
(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])])])])))
                [(#Cons [output #Nil]) state])
          )))
(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])])])))
          [(#Cons [output #Nil]) state])))
(declare-macro def)

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

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

(def (int+ x y)
  (jvm-iadd 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))

(def (list xs state)
  (let' xs' (reverse xs)
        (let' output (fold (lambda [tail head]
                             (#Form (#Cons [(#Tag "Cons")
                                            (#Cons [(#Tuple (#Cons [head
                                                                    (#Cons [(#Form (#Cons [(#Tag "Cons")
                                                                                           (#Cons [(#Tuple (#Cons [tail
                                                                                                                   (#Cons [(#Tag "Nil") #Nil])])) #Nil])])) #Nil])])) #Nil])])))
                           (#Tag "Nil")
                           xs')
              [(#Cons [output #Nil]) state])))
(declare-macro list)

(def (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))))
                              (#Form (#Cons [(#Tag "Cons") (#Cons [(#Tuple (#Cons [head (#Cons [tail #Nil])])) #Nil])])))
                            last
                            init')
               [(#Cons [output #Nil]) state])))
(declare-macro list+)

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

         _
         #Nil))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(def (' tokens state)
  [(map untemplate tokens) state])
(declare-macro ')

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

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

(def (bind f v)
  (lambda [state]
    (case (v state)
      [state' x]
      ((f x) state'))))

(def (if tokens)
  (case' tokens
         (#Cons [test (#Cons [then (#Cons [else #Nil])])])
         (return (list (' (case' (~ test)
                                 true  (~ then)
                                 false (~ else)))))))
(declare-macro if)

(def (apply-template env template)
  (case template
    (#Ident ident)
    (if-let [subst (get ident env)]
            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))

(def (do-template tokens)
  (case tokens
    (list+ bindings template data)
    (let [bindings-list (tuple->list bindings)
          data-lists (map tuple->list data)]
      (return (map (lambda [env] (apply-template env template))
                   (map (zip 2 bindings) data-lists))))))
(declare-macro do-template)

(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 (loop tokens)
  (case' tokens
         (#Cons [bindings (#Cons [body #Nil])])
         (let [pairs (as-pairs bindings)]
           (return (list (' ((lambda (~ (#Ident "recur")) (~ (#Tuple (map first pairs)))
                               (~ body))
                             (~@ (map second pairs)))))))))
(declare-macro loop)

(def (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))))
           )))
(declare-macro case)

(def (do tokens state)
  (case tokens
    (list (#Tuple bindings) body)
    (let [output (fold (lambda [inner binding]
                         (case binding
                           [lhs rhs]
                           (' (bind (lambda [(~ lhs)] (~ body))
                                    (~ rhs)))))
                       body
                       (reverse (as-pairs bindings)))]
      [(list output) state])))
(declare-macro do)

(def (export tokens)
  (return (map (lambda [t]
                 (' (export' (~ t))))
               tokens)))
(declare-macro export)

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

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

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

(def (type tokens)
  (case tokens
    (#Tuple elems)
    (return (list (' (#Tuple (~ (map untemplate elems))))))
    
    (#Record fields)
    (return (list (' (#Record (~ (map (lambda [kv]
                                        (case kv
                                          [(#Tag tag) val]
                                          [tag (untemplate val)]))
                                      fields))))))

    (#Form (list+ (#Ident "|") options))
    (do [options' (map% (lambda [opt]
                          (case opt
                            (#Tag tag)
                            [tag (#Tuple (list))]
                            
                            (#Form (list (#Tag tag) value))
                            [tag value]
                            
                            _
                            (fail "")))
                        options)]
      (#Variant options'))
    ))
(declare-macro type)

## (type (| #Nil
##          (#Cons [a (List a)])))

## (type [Int Bool Text])

## (type {#id Int #alive? Bool #name Text})

(def (All tokens)
  (let [[name args body] (case tokens
                           (list (#Tuple args) body)
                           ["" args body]

                           (list (#Ident name) (#Tuple args) body)
                           [name args body])]
    (return (list (' (#All (~ name) [(~@ (map (lambda [arg]
                                                (case arg
                                                  (#Ident arg')
                                                  (#Text arg')))
                                              args))]
                           (~ body)))))))
(declare-macro All)

(def (Exists tokens)
  (case tokens
    (list (#Ident name) body)
    (return (list (' (#Exists (~ name) (~ body)))))))
(declare-macro Exists)

(def (deftype tokens)
  (case tokens
    (list (#Ident name) definition)
    (return (list (' (def (~ (#Ident name))
                       (type (~ definition))))))
    
    (list (#Form (list+ (#Ident name) args)) definition)
    (let [name' (#Ident name)]
      (return (list (' (def (~ name')
                         (All (~ name') [(~@ args)]
                              (type (~ definition))))))))
    ))
(declare-macro deftype)

(def (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))))
(declare-macro and)

(def (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))))
(declare-macro or)

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

(def (get@ tokens)
  (let [output (case tokens
                 (list (#Tag tag) record)
                 (' (get@' (~ (#Tag tag)) (~ record)))

                 (list (#Tag tag))
                 (' (lambda [record] (get@' (~ (#Tag tag)) record))))]
    (return (list output))))
(declare-macro get@)

(def (set@ tokens)
  (let [output (case tokens
                 (list (#Tag tag) value record)
                 (' (set@' (~ (#Tag tag)) (~ value) (~ record)))

                 (list (#Tag tag) value)
                 (' (lambda [record] (set@' (~ (#Tag tag)) (~ value) record)))

                 (list (#Tag tag))
                 (' (lambda [value record] (set@' (~ (#Tag tag)) value record))))]
    (return (list output))))
(declare-macro set@)

(def (update@ tokens)
  (let [output (case tokens
                 (list tag func record)
                 (` (let [_record_ (~ record)]
                      (set@ (~ tag) _record_ ((~ func) (get@ (~ tag) _record_)))))
                 
                 (list (#Tag tag) func)
                 (' (lambda [record]
                      (` (set@ (~ tag) record ((~ func) (get@ (~ tag) record))))))

                 (list (#Tag tag))
                 (' (lambda [func record]
                      (set@ (~ tag) record (func (get@ (~ tag) record))))))]
    (return (list output))))
(declare-macro update@)

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

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

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

(def ($ tokens)
  (case tokens
    (list+ op init args)
    (return (list (fold (lambda [acc elem]
                          (` (~ op) (~ acc) (~ elem)))
                        init
                        args)))))

(def ($keys tokens)
  (case tokens
    (list (#Tuple fields))
    (let [record (#Record (map (lambda [slot]
                                 (case slot
                                   (#Tag name)
                                   [(#Tag name) (#Ident name)]))
                               fields))]
      (return (list record)))))

(def ($or tokens)
  (case tokens
    (list (#Tuple patterns) body)
    (return (flat-map (lambda [pattern] (list pattern body))
                      patterns))))

(def (-> 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 (defsyntax tokens)
  ...)

(def (defsig tokens)
  ...)

(def (defstruct tokens)
  ...)

(def (with tokens)
  ...)

## (deftype (List a)
##   (| #Nil
##      (#Cons [a (List a)])))

(def (complement f)
  (lambda [x] (not (f x))))

(def (cond tokens)
  (let [else (last tokens)
        branches (as-pairs (init tokens))]
    (return (list (fold (lambda [else branch]
                          (case branch
                            [test then]
                            (` (if (~ test) (~ then) (~ else)))))
                        else
                        branches)))))
(declare-macro cond)

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

(def (repeat n x)
  (if (> n 0)
    (list+ x (repeat (dec n) x))
    #Nil))

(def (size xs)
  (case xs
    #Nil 0
    (#Cons [_ xs']) (int+ 1 (size xs'))))

(def (last xs)
  (case xs
    #Nil          #None
    (list x)      (#Some x)
    (list+ _ xs') (last xs')))

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

                      _
                      #None)))

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

             [inc  1]
             [dec -1])

(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
    (#Cons [x #Nil])
    xs

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

(def (flatten xss)
  (fold ++ (list) xs))

(def (flat-map f xs)
  (flatten (map f xs)))

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

             [max >]
             [min <])

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

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

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

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

(do-template [<name> <done> <step>]
             (def (<name> n xs)
               (if (> n 0)
                 (case xs
                   #Nil          #Nil
                   (list+ 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
                 (list+ x xs') (if (f x) <step> #Nil)))

             [take-while #Nil (list+ x (take-while f xs'))]
             [drop-while xs   (drop-while f 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 (< from to)
    (list+ from (range (inc from) to))
    #Nil))
)#