aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2015-03-19 22:53:10 -0400
committerEduardo Julian2015-03-19 22:53:10 -0400
commitb2f4b64467d49904509fd5e87735536f846121b2 (patch)
tree060c1479ae3801d5124b535605dbb335edf4ed55
parent9a037df75e0d06afb5f26b4c4222009bbfc2c9e6 (diff)
[2nd Super Refactoring That Breaks The System: Part 5]
- Changed indents to symbols. - Corrected some of the bugs in the system. Many more still awaiting fixes.
Diffstat
-rw-r--r--source/lux.lux1634
-rw-r--r--src/lux.clj9
-rw-r--r--src/lux/analyser.clj204
-rw-r--r--src/lux/analyser/case.clj2
-rw-r--r--src/lux/analyser/def.clj15
-rw-r--r--src/lux/analyser/env.clj22
-rw-r--r--src/lux/analyser/host.clj75
-rw-r--r--src/lux/analyser/lambda.clj10
-rw-r--r--src/lux/analyser/lux.clj111
-rw-r--r--src/lux/base.clj225
-rw-r--r--src/lux/compiler.clj533
-rw-r--r--src/lux/compiler/base.clj177
-rw-r--r--src/lux/compiler/case.clj101
-rw-r--r--src/lux/compiler/host.clj5
-rw-r--r--src/lux/compiler/lambda.clj37
-rw-r--r--src/lux/compiler/lux.clj61
-rw-r--r--src/lux/host.clj4
-rw-r--r--src/lux/lexer.clj2
-rw-r--r--src/lux/parser.clj17
-rw-r--r--src/lux/type.clj128
20 files changed, 1781 insertions, 1591 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 69b9515e3..9e5885e97 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -9,7 +9,7 @@
(case' tokens
(#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
(#Right [state
- (#Cons [(#Form (#Cons [(#Ident "case'") (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
+ (#Cons [(#Form (#Cons [(#Symbol "case'") (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
#Nil])]))
)))
(declare-macro let')
@@ -19,29 +19,29 @@
(lambda' _ state
(let' output (case' tokens
(#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])])
- (#Form (#Cons [(#Ident "lambda'")
- (#Cons [(#Ident "")
+ (#Form (#Cons [(#Symbol "lambda'")
+ (#Cons [(#Symbol "")
(#Cons [arg
(#Cons [(case' args'
#Nil
body
_
- (#Form (#Cons [(#Ident "lux;lambda")
+ (#Form (#Cons [(#Symbol "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 [(#Symbol self) (#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])])])
+ (#Form (#Cons [(#Symbol "lambda'")
+ (#Cons [(#Symbol self)
(#Cons [arg
(#Cons [(case' args'
#Nil
body
_
- (#Form (#Cons [(#Ident "lux;lambda")
+ (#Form (#Cons [(#Symbol "lux;lambda")
(#Cons [(#Tuple args')
(#Cons [body #Nil])])])))
#Nil])])])])))
@@ -52,15 +52,15 @@
(def' def
(lambda [tokens state]
(let' output (case' tokens
- (#Cons [(#Ident name) (#Cons [body #Nil])])
- (#Form (#Cons [(#Ident "def'") tokens]))
+ (#Cons [(#Symbol name) (#Cons [body #Nil])])
+ (#Form (#Cons [(#Symbol "def'") tokens]))
- (#Cons [(#Form (#Cons [(#Ident name) args]))
+ (#Cons [(#Form (#Cons [(#Symbol name) args]))
(#Cons [body #Nil])])
- (#Form (#Cons [(#Ident "def'")
- (#Cons [(#Ident name)
- (#Cons [(#Form (#Cons [(#Ident "lux;lambda")
- (#Cons [(#Ident name)
+ (#Form (#Cons [(#Symbol "def'")
+ (#Cons [(#Symbol name)
+ (#Cons [(#Form (#Cons [(#Symbol "lux;lambda")
+ (#Cons [(#Symbol name)
(#Cons [(#Tuple args)
(#Cons [body #Nil])])])]))
#Nil])])])))
@@ -69,842 +69,842 @@
(def (defmacro tokens state)
(let' [fn-name fn-def] (case' tokens
- (#Cons [(#Form (#Cons [(#Ident name) args]))
+ (#Cons [(#Form (#Cons [(#Symbol name) args]))
(#Cons [body #Nil])])
[name
- (#Form (#Cons [(#Ident "lux;def")
- (#Cons [(#Form (#Cons [(#Ident name) args]))
+ (#Form (#Cons [(#Symbol "lux;def")
+ (#Cons [(#Form (#Cons [(#Symbol name) args]))
(#Cons [body
#Nil])])]))])
- (let' declaration (#Form (#Cons [(#Ident "declare-macro") (#Cons [(#Ident fn-name) #Nil])]))
+ (let' declaration (#Form (#Cons [(#Symbol "declare-macro") (#Cons [(#Symbol fn-name) #Nil])]))
(#Right [state (#Cons [fn-def (#Cons [declaration #Nil])])]))))
(declare-macro defmacro)
-(defmacro (comment tokens state)
- (#Right [state #Nil]))
+## (defmacro (comment tokens state)
+## (#Right [state #Nil]))
-(def (int+ x y)
- (jvm-ladd x y))
+## (def (int+ x y)
+## (jvm-ladd x y))
-(def (id x)
- x)
+## (def (id x)
+## x)
-(def (print x)
- (jvm-invokevirtual java.io.PrintStream "print" [java.lang.Object]
- (jvm-getstatic java.lang.System "out") [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 (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
+## (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')
- (#Right [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')
- (#Right [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)))
- (#Right [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])
- (#Right [state (list (untemplate template))])))
-
-(defmacro (if tokens state)
- (case' tokens
- (#Cons [test (#Cons [then (#Cons [else #Nil])])])
- (#Right [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]
- (#Right [state val])))
-
-(def (fail msg)
- (lambda [_]
- (#Left msg)))
+## (#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')
+## (#Right [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')
+## (#Right [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 (#Symbol "lux;let'") label value body))))
+## body
+## (reverse (as-pairs bindings)))
+## (#Right [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)))
+
+## (#Symbol value)
+## (#Form (list (#Tag "Symbol") (#Text value)))
+
+## (#Tuple elems)
+## (#Form (list (#Tag "Tuple") (untemplate-list (map untemplate elems))))
+
+## (#Form (#Cons [(#Symbol "~") (#Cons [unquoted #Nil])]))
+## unquoted
+
+## (#Form elems)
+## (#Form (list (#Tag "Form") (untemplate-list (map untemplate elems))))
+## ))
+
+## (defmacro (` tokens state)
+## (case' tokens
+## (#Cons [template #Nil])
+## (#Right [state (list (untemplate template))])))
+
+## (defmacro (if tokens state)
+## (case' tokens
+## (#Cons [test (#Cons [then (#Cons [else #Nil])])])
+## (#Right [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]
+## (#Right [state val])))
+
+## (def (fail msg)
+## (lambda [_]
+## (#Left msg)))
-(def (bind f v)
- (lambda [state]
- (case' (v state)
- (#Right [state' x])
- (f x state')
+## (def (bind f v)
+## (lambda [state]
+## (case' (v state)
+## (#Right [state' x])
+## (f x state')
- (#Left msg)
- (#Left 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
+## (#Left msg)
+## (#Left 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 (~ (#Symbol "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 (zip2 xs ys)
- (case' [xs ys]
- [(#Cons [x xs']) (#Cons [y ys'])]
- (#Cons [[x y] (zip2 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)
+## (#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 (zip2 xs ys)
+## (case' [xs ys]
+## [(#Cons [x xs']) (#Cons [y ys'])]
+## (#Cons [[x y] (zip2 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
+## (#Symbol 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
+## (#Symbol 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 (zip2 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 [])
+## (#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 (zip2 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)
+## (#Symbol ($ 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 [])
+## (#Int value)
+## (jvm-invokevirtual java.lang.Object "toString" []
+## value [])
- (#Real 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 [])
+## (#Char value)
+## (jvm-invokevirtual java.lang.Object "toString" []
+## value [])
- (#Text value)
- (jvm-invokevirtual java.lang.Object "toString" []
- value [])
+## (#Text value)
+## (jvm-invokevirtual java.lang.Object "toString" []
+## value [])
- (#Ident ident)
- ident
+## (#Symbol ident)
+## ident
- (#Tag tag)
- (text-++ "#" tag)
+## (#Tag tag)
+## (text-++ "#" tag)
- (#Tuple members)
- ($ text-++ "[" (fold text-++ "" (interpose " " (map show-syntax members))) "]")
+## (#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 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) (#Symbol 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 [(#Symbol 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]
+## (#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
+## (#Symbol 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 [(#Symbol 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)]]
+## (#Cons [(#Tuple args) (#Cons [body #Nil])])
+## ["" args body])
+## rolled (fold (lambda [body arg]
+## (case' arg
+## (#Symbol 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 [(#Symbol 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+ (#Symbol name) tokens')
+## [tokens' [(#Symbol 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]
- signature
- [defs ($+ $1)])
- (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body))))
- (` (#Record (~ (untemplate-list ...))))
- args)]
- (return (list (` (def (~ name)
- (: (~ def-body) (~ signature))))))))
-
-(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))
+## (list+ (#Form (list+ (#Symbol name) args)) tokens')
+## [tokens' [(#Symbol 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]
+## signature
+## [defs ($+ $1)])
+## (let [def-body (fold (lambda [body arg] (` (lambda [(~ arg)] (~ body))))
+## (` (#Record (~ (untemplate-list ...))))
+## args)]
+## (return (list (` (def (~ name)
+## (: (~ def-body) (~ signature))))))))
+
+## (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 bind (. concat map)))
-(defsig (Eq a)
- (: = (-> a a Bool)))
+## (defsig (Eq a)
+## (: = (-> a a Bool)))
-(defstruct (List_Eq A_Eq)
- (All [a] (-> (Eq a) (Eq (List a))))
+## (defstruct (List_Eq A_Eq)
+## (All [a] (-> (Eq a) (Eq (List a))))
- (def (= xs ys)
- (and (= (length xs) (length ys))
- (map (lambda [[x y]]
- (with A_Eq
- (= x y)))
- (zip2 xs ys)))))
+## (def (= xs ys)
+## (and (= (length xs) (length ys))
+## (map (lambda [[x y]]
+## (with A_Eq
+## (= x y)))
+## (zip2 xs ys)))))
-## (def (with tokens)
-## ...)
+## ## (def (with tokens)
+## ## ...)
-## TODO: Full pattern-matching
-## TODO: Type-related macros
-## TODO: (Im|Ex)ports-related macros
-## TODO: Macro-related macros
+## ## 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")
+## ## (import "lux")
+## ## (module-alias "lux" "l")
+## ## (def-alias "lux;map" "map")
-## (def (require tokens)
-## (case tokens
-## ...))
+## ## (def (require tokens)
+## ## (case tokens
+## ## ...))
-## (require lux #as l #refer [map])
+## ## (require lux #as l #refer [map])
diff --git a/src/lux.clj b/src/lux.clj
index 3516f2a9c..b0a9a3c94 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -1,5 +1,6 @@
(ns lux
- (:require [lux.compiler :as &compiler]
+ (:require [lux.base :as &]
+ [lux.compiler :as &compiler]
:reload-all))
(comment
@@ -13,9 +14,9 @@
;; TODO: All optimizations
;; TODO: Take module-name aliasing into account.
;; TODO:
-
- (time (&compiler/compile-all ["lux"]))
- (time (&compiler/compile-all ["lux" "test2"]))
+
+ (time (&compiler/compile-all (&/|list "lux")))
+ (time (&compiler/compile-all (&/|list "lux" "test2")))
;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2
;; cd output && jar cvf test2.jar * && java -cp "test2.jar" test2 && cd ..
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 235478782..f9c104378 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -14,14 +14,14 @@
;; [Utils]
(defn ^:private parse-handler [[catch+ finally+] token]
(matchv ::M/objects [token]
- [["Form" ["Cons" [["Ident" "jvm-catch"]
- ["Cons" [["Ident" ?ex-class]
- ["Cons" [["Ident" ?ex-arg]
+ [["Form" ["Cons" [["Symbol" "jvm-catch"]
+ ["Cons" [["Symbol" ?ex-class]
+ ["Cons" [["Symbol" ?ex-arg]
["Cons" [?catch-body
["Nil" _]]]]]]]]]]]
[(concat catch+ (list [?ex-class ?ex-arg ?catch-body])) finally+]
- [["Form" ["Cons" [["Ident" "jvm-finally"]
+ [["Form" ["Cons" [["Symbol" "jvm-finally"]
["Cons" [?finally-body
["Nil" _]]]]]]]
[catch+ ?finally-body]))
@@ -56,197 +56,197 @@
(return (&/|list [&/V "Expression" (&/T (&/V "variant" (&/T ?tag (&/V "Expression" (&/T (&/V "tuple" (&/|list)) tuple-type))))
(&/V "Variant" (&/V "Cons" (&/T (&/T ?tag tuple-type) (&/V "Nil" nil)))))])))
- [["Ident" "jvm-null"]]
+ [["Symbol" "jvm-null"]]
(return (&/|list [&/V "Expression" (&/T (&/V "jvm-null" nil) (&/V "Data" (&/T "null" (&/V "Nil" nil))))]))
- [["Ident" ?ident]]
+ [["Symbol" ?ident]]
(&&lux/analyse-ident analyse ?ident)
- [["Form" ["Cons" [["Ident" "case'"]
+ [["Form" ["Cons" [["Symbol" "case'"]
["Cons" [?variant ?branches]]]]]]
(&&lux/analyse-case analyse ?variant ?branches)
- [["Form" ["Cons" [["Ident" "lambda'"]
- ["Cons" [["Ident" ?self]
- ["Cons" [["Ident" ?arg]
+ [["Form" ["Cons" [["Symbol" "lambda'"]
+ ["Cons" [["Symbol" ?self]
+ ["Cons" [["Symbol" ?arg]
["Cons" [?body
["Nil" _]]]]]]]]]]]
(&&lux/analyse-lambda analyse ?self ?arg ?body)
- [["Form" ["Cons" [["Ident" "get@'"] ["Cons" [["Tag" ?slot] ["Cons" [?record ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "get@'"] ["Cons" [["Tag" ?slot] ["Cons" [?record ["Nil" _]]]]]]]]]
(&&lux/analyse-get analyse ?slot ?record)
- [["Form" ["Cons" [["Ident" "set@'"] ["Cons" [["Tag" ?slot] ["Cons" [?value ["Cons" [?record ["Nil" _]]]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "set@'"] ["Cons" [["Tag" ?slot] ["Cons" [?value ["Cons" [?record ["Nil" _]]]]]]]]]]]
(&&lux/analyse-set analyse ?slot ?value ?record)
- [["Form" ["Cons" [["Ident" "def'"] ["Cons" [["Ident" ?name] ["Cons" [?value ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "def'"] ["Cons" [["Symbol" ?name] ["Cons" [?value ["Nil" _]]]]]]]]]
(&&lux/analyse-def analyse ?name ?value)
- [["Form" ["Cons" [["Ident" "declare-macro"] ["Cons" [["Ident" ?ident] ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "declare-macro"] ["Cons" [["Symbol" ?ident] ["Nil" _]]]]]]]
(&&lux/analyse-declare-macro ?ident)
- [["Form" ["Cons" [["Ident" "import'"] ["Cons" [["Text" ?path] ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "import'"] ["Cons" [["Text" ?path] ["Nil" _]]]]]]]
(&&lux/analyse-import analyse ?path)
- [["Form" ["Cons" [["Ident" ":"] ["Cons" [?value ["Cons" [?type ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" ":"] ["Cons" [?value ["Cons" [?type ["Nil" _]]]]]]]]]
(&&lux/analyse-check analyse eval! ?type ?value)
- [["Form" ["Cons" [["Ident" "coerce"] ["Cons" [?type ["Cons" [?value ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "coerce"] ["Cons" [?type ["Cons" [?value ["Nil" _]]]]]]]]]
(&&lux/analyse-coerce analyse eval! ?type ?value)
;; Host special forms
- [["Form" ["Cons" [["Ident" "exec"] ?exprs]]]]
+ [["Form" ["Cons" [["Symbol" "exec"] ?exprs]]]]
(&&host/analyse-exec analyse ?exprs)
;; Integer arithmetic
- [["Form" ["Cons" [["Ident" "jvm-iadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-iadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-iadd analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-isub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-isub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-isub analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-imul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-imul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-imul analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-idiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-idiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-idiv analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-irem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-irem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-irem analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-ieq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ieq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ieq analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-ilt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ilt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ilt analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-igt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-igt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-igt analyse ?x ?y)
;; Long arithmetic
- [["Form" ["Cons" [["Ident" "jvm-ladd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ladd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ladd analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lsub analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lmul analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-ldiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ldiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ldiv analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lrem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lrem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lrem analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-leq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-leq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-leq analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-llt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-llt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-llt analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lgt analyse ?x ?y)
;; Float arithmetic
- [["Form" ["Cons" [["Ident" "jvm-fadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-fadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-fadd analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-fsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-fsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-fsub analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-fmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-fmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-fmul analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-fdiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-fdiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-fdiv analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-frem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-frem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-frem analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-feq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-feq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-feq analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-flt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-flt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-flt analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-fgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-fgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-fgt analyse ?x ?y)
;; Double arithmetic
- [["Form" ["Cons" [["Ident" "jvm-dadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-dadd"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-dadd analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-dsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-dsub"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-dsub analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-dmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-dmul"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-dmul analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-ddiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ddiv"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ddiv analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-drem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-drem"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-drem analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-deq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-deq"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-deq analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-dlt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-dlt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-dlt analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-dgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-dgt"] ["Cons" [?y ["Cons" [?x ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-dgt analyse ?x ?y)
;; Objects
- [["Form" ["Cons" [["Ident" "jvm-null?"] ["Cons" [?object ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-null?"] ["Cons" [?object ["Nil" _]]]]]]]
(&&host/analyse-jvm-null? analyse ?object)
- [["Form" ["Cons" [["Ident" "jvm-new"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-new"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Tuple" ?classes]
["Cons" [["Tuple" ?args]
["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-new analyse ?class ?classes ?args)
- [["Form" ["Cons" [["Ident" "jvm-getstatic"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-getstatic"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?field]
["Nil" _]]]]]]]]]
(&&host/analyse-jvm-getstatic analyse ?class ?field)
- [["Form" ["Cons" [["Ident" "jvm-getfield"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-getfield"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?field]
["Cons" [?object
["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-getfield analyse ?class ?field ?object)
- [["Form" ["Cons" [["Ident" "jvm-putstatic"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-putstatic"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?field]
["Cons" [?value
["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-putstatic analyse ?class ?field ?value)
- [["Form" ["Cons" [["Ident" "jvm-putfield"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-putfield"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?field]
["Cons" [?object
["Cons" [?value
["Nil" _]]]]]]]]]]]]]
(&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value)
- [["Form" ["Cons" [["Ident" "jvm-invokestatic"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-invokestatic"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?method]
["Cons" [["Tuple" ?classes]
["Cons" [["Tuple" ?args]
["Nil" _]]]]]]]]]]]]]
(&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args)
- [["Form" ["Cons" [["Ident" "jvm-invokevirtual"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-invokevirtual"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?method]
["Cons" [["Tuple" ?classes]
["Cons" [?object
@@ -254,8 +254,8 @@
["Nil" _]]]]]]]]]]]]]]]
(&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args)
- [["Form" ["Cons" [["Ident" "jvm-invokeinterface"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-invokeinterface"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?method]
["Cons" [["Tuple" ?classes]
["Cons" [?object
@@ -263,8 +263,8 @@
["Nil" _]]]]]]]]]]]]]]]
(&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args)
- [["Form" ["Cons" [["Ident" "jvm-invokespecial"]
- ["Cons" [["Ident" ?class]
+ [["Form" ["Cons" [["Symbol" "jvm-invokespecial"]
+ ["Cons" [["Symbol" ?class]
["Cons" [["Text" ?method]
["Cons" [["Tuple" ?classes]
["Cons" [?object
@@ -273,117 +273,117 @@
(&&host/analyse-jvm-invokespecial analyse ?class ?method ?classes ?object ?args)
;; Exceptions
- [["Form" ["Cons" [["Ident" "jvm-try"]
+ [["Form" ["Cons" [["Symbol" "jvm-try"]
["Cons" [?body
?handlers]]]]]]
(&&host/analyse-jvm-try analyse ?body (&/fold parse-handler [(list) nil] ?handlers))
- [["Form" ["Cons" [["Ident" "jvm-throw"]
+ [["Form" ["Cons" [["Symbol" "jvm-throw"]
["Cons" [?ex
["Nil" _]]]]]]]
(&&host/analyse-jvm-throw analyse ?ex)
;; Syncronization/monitos
- [["Form" ["Cons" [["Ident" "jvm-monitorenter"]
+ [["Form" ["Cons" [["Symbol" "jvm-monitorenter"]
["Cons" [?monitor
["Nil" _]]]]]]]
(&&host/analyse-jvm-monitorenter analyse ?monitor)
- [["Form" ["Cons" [["Ident" "jvm-monitorexit"]
+ [["Form" ["Cons" [["Symbol" "jvm-monitorexit"]
["Cons" [?monitor
["Nil" _]]]]]]]
(&&host/analyse-jvm-monitorexit analyse ?monitor)
;; Primitive conversions
- [["Form" ["Cons" [["Ident" "jvm-d2f"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-d2f"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-d2f analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-d2i"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-d2i"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-d2i analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-d2l"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-d2l"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-d2l analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-f2d"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-f2d"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-f2d analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-f2i"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-f2i"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-f2i analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-f2l"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-f2l"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-f2l analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2b"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2b"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2b analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2c"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2c"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2c analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2d"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2d"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2d analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2f"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2f"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2f analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2l"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2l"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2l analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-i2s"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-i2s"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-i2s analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-l2d"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-l2d"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-l2d analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-l2f"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-l2f"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-l2f analyse ?value)
- [["Form" ["Cons" [["Ident" "jvm-l2i"] ["Cons" [?value ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-l2i"] ["Cons" [?value ["Nil" _]]]]]]]
(&&host/analyse-jvm-l2i analyse ?value)
;; Bitwise operators
- [["Form" ["Cons" [["Ident" "jvm-iand"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-iand"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-iand analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-ior"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-ior"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-ior analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-land"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-land"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-land analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lor analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lxor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lxor"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lxor analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lshl"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lshl"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lshl analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lshr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lshr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lshr analyse ?x ?y)
- [["Form" ["Cons" [["Ident" "jvm-lushr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-lushr"] ["Cons" [?x ["Cons" [?y ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-lushr analyse ?x ?y)
;; Arrays
- [["Form" ["Cons" [["Ident" "jvm-new-array"] ["Cons" [["Ident" ?class] ["Cons" [["Int" ?length] ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-new-array"] ["Cons" [["Symbol" ?class] ["Cons" [["Int" ?length] ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-new-array analyse ?class ?length)
- [["Form" ["Cons" [["Ident" "jvm-aastore"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Cons" [?elem ["Nil" _]]]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-aastore"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Cons" [?elem ["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-aastore analyse ?array ?idx ?elem)
- [["Form" ["Cons" [["Ident" "jvm-aaload"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-aaload"] ["Cons" [?array ["Cons" [["Int" ?idx] ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-aaload analyse ?array ?idx)
;; Classes & interfaces
- [["Form" ["Cons" [["Ident" "jvm-class"] ["Cons" [["Ident" ?name] ["Cons" [["Ident" ?super-class] ["Cons" [["Tuple" ?fields] ["Nil" _]]]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-class"] ["Cons" [["Symbol" ?name] ["Cons" [["Symbol" ?super-class] ["Cons" [["Tuple" ?fields] ["Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-class analyse ?name ?super-class ?fields)
- [["Form" ["Cons" [["Ident" "jvm-interface"] ["Cons" [["Ident" ?name] ?members]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-interface"] ["Cons" [["Symbol" ?name] ?members]]]]]]
(&&host/analyse-jvm-interface analyse ?name ?members)
;; Programs
- [["Form" ["Cons" [["Ident" "jvm-program"] ["Cons" [["Ident" ?args] ["Cons" [?body ["Nil" _]]]]]]]]]
+ [["Form" ["Cons" [["Symbol" "jvm-program"] ["Cons" [["Symbol" ?args] ["Cons" [?body ["Nil" _]]]]]]]]]
(&&host/analyse-jvm-program analyse ?args ?body)
[_]
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index cd5bf9e39..1574218c3 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -10,7 +10,7 @@
;; [Resources]
(defn locals [member]
(matchv ::M/objects [member]
- [["Ident" ?name]]
+ [["Symbol" ?name]]
(&/|list ?name)
[["Tuple" ?submembers]]
diff --git a/src/lux/analyser/def.clj b/src/lux/analyser/def.clj
index e83bbb85d..45bb5aca7 100644
--- a/src/lux/analyser/def.clj
+++ b/src/lux/analyser/def.clj
@@ -14,7 +14,7 @@
(defn <name> [module name]
(fn [state]
(return* state
- (->> state (&/get$ "modules") (&/|get module) (&/get$ <category>) (&/|get name) boolean))))
+ (->> state (&/get$ "modules") (&/|get module) (&/get$ <category>) (&/|contains? name)))))
defined? "defs"
macro? "macros"
@@ -31,5 +31,16 @@
bound (&/V "Expression" (&/T (&/V "global" (&/T module name)) type))]
(return* (->> state
(&/update$ "modules" (fn [ms] (&/|update module (fn [m] (&/update$ "defs" #(&/|put name type %) m)) ms)))
- (&/update$ "global-env" #(&/|merge (&/|table full-name bound, name bound) %)))
+ (&/update$ "global-env" #(matchv ::M/objects [%]
+ [["None" _]]
+ (assert false)
+
+ [["Some" table]]
+ (&/V "Some" (&/update$ "locals" (fn [locals]
+ (&/update$ "mappings" (fn [mappings]
+ (&/|merge (&/|table full-name bound, name bound)
+ mappings))
+ locals))
+ table))
+ )))
nil))))
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index 816332404..4d1af9aa9 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -13,20 +13,20 @@
(fn [state]
(let [old-mappings (->> state (&/get$ "local-envs") &/|head (&/get$ "locals") (&/get$ "mappings"))
=return (body (&/update$ "local-envs"
- (fn [[top & stack]]
- (let [bound-unit (&/V "local" (-> top (&/get$ "locals") (&/get$ "counter")))]
- (cons (-> top
- (&/update$ "locals" #(&/update$ "counter" inc %))
- (&/update$ "locals" #(&/update$ "mappings" (fn [m] (&/|put name (&/V "Expression" (&/T bound-unit type)) m)) %)))
- stack)))
+ (fn [stack]
+ (let [bound-unit (&/V "local" (->> (&/|head stack) (&/get$ "locals") (&/get$ "counter")))]
+ (&/|cons (->> (&/|head stack)
+ (&/update$ "locals" #(&/update$ "counter" inc %))
+ (&/update$ "locals" #(&/update$ "mappings" (fn [m] (&/|put name (&/V "Expression" (&/T bound-unit type)) m)) %)))
+ (&/|tail stack))))
state))]
(matchv ::M/objects [=return]
[["Right" [?state ?value]]]
- (return* (&/update$ "local-envs" (fn [[top* & stack*]]
- (cons (->> top*
- (&/update$ "locals" #(&/update$ "counter" dec %))
- (&/update$ "locals" #(&/set$ "mappings" old-mappings %)))
- stack*))
+ (return* (&/update$ "local-envs" (fn [stack*]
+ (&/|cons (->> (&/|head stack*)
+ (&/update$ "locals" #(&/update$ "counter" dec %))
+ (&/update$ "locals" #(&/set$ "mappings" old-mappings %)))
+ (&/|tail stack*)))
?state)
?value)
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 15680d681..6fff76590 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -10,21 +10,13 @@
[env :as &&env])))
;; [Utils]
-(defn ^:private ->seq [xs]
- (matchv ::M/objects [xs]
- [["Nil" _]]
- (list)
-
- [["Cons" [x xs*]]]
- (cons x (->seq xs*))))
-
(defn ^:private extract-ident [ident]
(matchv ::M/objects [ident]
- [["Ident" ?ident]]
+ [["Symbol" ?ident]]
(return ?ident)
[_]
- (fail "[Analyser Error] Can't extract Ident.")))
+ (fail "[Analyser Error] Can't extract Symbol.")))
;; [Resources]
(do-template [<name> <output-tag> <input-class> <output-class>]
@@ -144,7 +136,7 @@
(defn analyse-jvm-new-array [analyse ?class ?length]
(exec [=class (&host/full-class-name ?class)]
(return (&/|list (&/V "Expression" (&/T (&/V "jvm-new-array" (&/T =class ?length)) (&/V "array" (&/T (&/V "Data" (to-array [=class (&/V "Nil" nil)]))
- (&/V "Nil" nil)))))))))
+ (&/V "Nil" nil)))))))))
(defn analyse-jvm-aastore [analyse ?array ?idx ?elem]
(exec [=array+=elem (&&/analyse-2 analyse ?array ?elem)
@@ -161,13 +153,13 @@
(defn analyse-jvm-class [analyse ?name ?super-class ?fields]
(exec [?fields (&/map% (fn [?field]
- (matchv ::M/objects [?field]
- [["Tuple" ["Cons" [["Ident" ?class] ["Cons" [["Ident" ?field-name] ["Nil" _]]]]]]]
- (return [?class ?field-name])
-
- [_]
- (fail "[Analyser Error] Fields must be Tuple2 of [Ident, Ident]")))
- ?fields)
+ (matchv ::M/objects [?field]
+ [["Tuple" ["Cons" [["Symbol" ?class] ["Cons" [["Symbol" ?field-name] ["Nil" _]]]]]]]
+ (return [?class ?field-name])
+
+ [_]
+ (fail "[Analyser Error] Fields must be Tuple2 of [Symbol, Symbol]")))
+ ?fields)
:let [=fields (into {} (for [[class field] ?fields]
[field {:access :public
:type class}]))]
@@ -175,25 +167,26 @@
(return (&/|list (&/V "Statement" (&/V "jvm-class" (&/T $module ?name ?super-class =fields {})))))))
(defn analyse-jvm-interface [analyse ?name ?members]
- ;; (prn 'analyse-jvm-interface ?name ?members)
- (exec [?members (&/map% (fn [member]
- ;; (prn 'analyse-jvm-interface (&/show-ast member))
- (matchv ::M/objects [member]
- [["Form" ["Cons" [["Ident" ":"]
- ["Cons" [["Ident" ?member-name]
- ["Cons" [["Form" ["Cons" [["Ident" "->"]
- ["Cons" [["Tuple" ?inputs]
- ["Cons" [["Ident" ?output]
- ["Nil" _]]]]]]]]
- ["Nil" _]]]]]]]]]
- (do ;; (prn 'analyse-jvm-interface ?member-name ?inputs ?output)
- (exec [?inputs (&/map% extract-ident (->seq ?inputs))]
- (return [?member-name [?inputs ?output]])))
-
- [_]
- (fail "[Analyser Error] Invalid method signature!")))
- (->seq ?members))
- :let [=methods (into {} (for [[method [inputs output]] ?members]
+ (prn 'analyse-jvm-interface ?name ?members)
+ (exec [=members (&/map% (fn [member]
+ ;; (prn 'analyse-jvm-interface (&/show-ast member))
+ (matchv ::M/objects [member]
+ [["Form" ["Cons" [["Symbol" ":"]
+ ["Cons" [["Symbol" ?member-name]
+ ["Cons" [["Form" ["Cons" [["Symbol" "->"]
+ ["Cons" [["Tuple" ?inputs]
+ ["Cons" [["Symbol" ?output]
+ ["Nil" _]]]]]]]]
+ ["Nil" _]]]]]]]]]
+ (do ;; (prn 'analyse-jvm-interface ?member-name ?inputs ?output)
+ (exec [?inputs (&/map% extract-ident ?inputs)]
+ (return [?member-name [?inputs ?output]])))
+
+ [_]
+ (fail "[Analyser Error] Invalid method signature!")))
+ ?members)
+ :let [_ (prn '=members =members)
+ =methods (into {} (for [[method [inputs output]] (&/->seq =members)]
[method {:access :public
:type [inputs output]}]))]
$module &/get-module-name]
@@ -208,10 +201,10 @@
(defn analyse-jvm-try [analyse ?body [?catches ?finally]]
(exec [=body (&&/analyse-1 analyse ?body)
=catches (&/map% (fn [[?ex-class ?ex-arg ?catch-body]]
- (&&env/with-local ?ex-arg (&/V "Data" (&/T ?ex-class (&/V "Nil" nil)))
- (exec [=catch-body (&&/analyse-1 analyse ?catch-body)]
- (return [?ex-class ?ex-arg =catch-body]))))
- ?catches)
+ (&&env/with-local ?ex-arg (&/V "Data" (&/T ?ex-class (&/V "Nil" nil)))
+ (exec [=catch-body (&&/analyse-1 analyse ?catch-body)]
+ (return [?ex-class ?ex-arg =catch-body]))))
+ ?catches)
=finally (&&/analyse-1 analyse ?finally)
=body-type (&&/expr-type =body)]
(return (&/|list (&/V "Expression" (&/T (&/V "jvm-try" (&/T =body =catches =finally)) =body-type))))))
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index e70fd7bf6..758d0bb6b 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -13,13 +13,13 @@
(&env/with-local arg arg-type
(exec [=return body
=captured &env/captured-vars]
- (return [scope-name =captured =return])))))))
+ (return (&/T scope-name =captured =return))))))))
(defn close-over [scope ident register frame]
(matchv ::M/objects [register]
[["Expression" [_ register-type]]]
(let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope (->> frame (&/get$ "closure") (&/get$ "counter")) register)) register-type))]
- [register* (&/update$ "closure" #(-> %
- (&/update$ "counter" inc)
- (&/update$ "mappings" (fn [mps] (&/|put ident register* mps))))
- frame)])))
+ (&/T register* (&/update$ "closure" #(->> %
+ (&/update$ "counter" inc)
+ (&/update$ "mappings" (fn [mps] (&/|put ident register* mps))))
+ frame)))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index c0124936e..daec2bd0a 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -2,7 +2,7 @@
(:require (clojure [template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return return* fail fail*]]
+ (lux [base :as & :refer [exec return return* fail fail* |let]]
[parser :as &parser]
[type :as &type]
[macro :as &macro]
@@ -23,48 +23,64 @@
(defn analyse-record [analyse ?elems]
(exec [=elems (&/map% (fn [kv]
- (matchv ::M/objects [kv]
- [[k v]]
- (exec [=v (&&/analyse-1 analyse v)]
- (return (to-array [k =v])))))
- ?elems)
+ (matchv ::M/objects [kv]
+ [[k v]]
+ (exec [=v (&&/analyse-1 analyse v)]
+ (return (to-array [k =v])))))
+ ?elems)
=elems-types (&/map% (fn [kv]
- (matchv ::M/objects [kv]
- [[k v]]
- (exec [=v (&&/expr-type v)]
- (return (to-array [k =v])))))
- =elems)
+ (matchv ::M/objects [kv]
+ [[k v]]
+ (exec [=v (&&/expr-type v)]
+ (return (to-array [k =v])))))
+ =elems)
;; :let [_ (prn 'analyse-tuple =elems)]
]
(return (&/|list (&/V "Expression" (&/T (&/V "record" =elems) (&/V "Record" =elems-types)))))))
(defn analyse-ident [analyse ident]
+ (prn 'analyse-ident ident)
(exec [module-name &/get-module-name]
(fn [state]
- (let [[top & stack*] (&/get$ "local-envs" state)]
- (if-let [=bound (or (->> top (&/get$ "locals") (&/get$ "mappings") (&/|get ident))
- (->> top (&/get$ "closure") (&/get$ "mappings") (&/|get ident)))]
- (return* state (&/|list =bound))
- (let [no-binding? #(and (->> % (&/get$ "locals") (&/get$ "mappings") (&/|contains? ident) not)
- (->> % (&/get$ "closure") (&/get$ "mappings") (&/|contains? ident) not))
- [inner outer] (split-with no-binding? stack*)]
- (if (empty? outer)
- (if-let [global (->> state (&/get$ "global-env") (&/|get ident))]
- (return* state (&/|list global))
- (fail* (str "[Analyser Error] Unresolved identifier: " ident)))
- (let [in-stack (cons top inner)
- scopes (rest (reductions #(cons (&/get$ "name" %2) %1) (map #(&/get$ "name" %) outer) (reverse in-stack)))
- _ (prn 'in-stack module-name ident (map #(&/get$ "name" %) in-stack) scopes)
- [=local inner*] (reduce (fn [[register new-inner] [frame in-scope]]
- (let [[register* frame*] (&&lambda/close-over (cons module-name (reverse in-scope)) ident register frame)]
- [register* (cons frame* new-inner)]))
- [(or (->> outer &/|head (&/get$ "locals") (&/get$ "mappings") (&/|get ident))
- (->> outer &/|head (&/get$ "closure") (&/get$ "mappings") (&/|get ident)))
- '()]
- (map vector (reverse in-stack) scopes)
- )]
- (return* (&/set$ "local-envs" (&/|concat inner* outer) state) (&/|list =local)))
- ))
+ (prn 'module-name module-name)
+ (prn '(&/get$ "local-envs" state) (&/get$ "local-envs" state))
+ (prn '(&/->seq (&/get$ "local-envs" state)) (&/->seq (&/get$ "local-envs" state)))
+ (println (&/show-state state))
+ (let [stack (&/get$ "local-envs" state)]
+ (matchv ::M/objects [(&/get$ "local-envs" state)]
+ [["Nil" _]]
+ (fail* (str "[Analyser Error] Unresolved identifier: " ident))
+
+ [["Cons" [top stack*]]]
+ (if-let [=bound (or (->> stack &/|head (&/get$ "locals") (&/get$ "mappings") (&/|get ident))
+ (->> stack &/|head (&/get$ "closure") (&/get$ "mappings") (&/|get ident)))]
+ (return* state (&/|list =bound))
+ (|let [no-binding? #(and (->> % (&/get$ "locals") (&/get$ "mappings") (&/|contains? ident) not)
+ (->> % (&/get$ "closure") (&/get$ "mappings") (&/|contains? ident) not))
+ [inner outer] (&/|split-with no-binding? stack*)]
+ (matchv ::M/objects [outer]
+ [["Nil" _]]
+ (if-let [global (->> state (&/get$ "global-env") &/from-some (&/get$ "locals") (&/get$ "mappings") (&/|get ident))]
+ (return* state (&/|list global))
+ (fail* (str "[Analyser Error] Unresolved identifier: " ident)))
+
+ [["Cons" [top-outer _]]]
+ (let [in-stack (&/|cons top inner)
+ scopes (&/|tail (&/folds #(&/|cons (&/get$ "name" %2) %1)
+ (&/|map #(&/get$ "name" %) outer)
+ (&/|reverse in-stack)))
+ _ (prn 'in-stack module-name ident (&/->seq (&/|map #(&/get$ "name" %) in-stack)) scopes)
+ [=local inner*] (&/fold (fn [register+new-inner frame+in-scope]
+ (|let [[register new-inner] register+new-inner
+ [frame in-scope] frame+in-scope
+ [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ident register frame)]
+ (&/T register* (&/|cons frame* new-inner))))
+ (&/T (or (->> top-outer (&/get$ "locals") (&/get$ "mappings") (&/|get ident))
+ (->> top-outer (&/get$ "closure") (&/get$ "mappings") (&/|get ident)))
+ (&/|list))
+ (&/zip2 (&/|reverse in-stack) scopes))]
+ (return* (&/set$ "local-envs" (&/|++ inner* outer) state) (&/|list =local)))
+ )))
))
)))
@@ -72,17 +88,18 @@
(exec [=args (&/flat-map% analyse ?args)
=fn-type (&&/expr-type =fn)
=apply+=apply-type (&/fold (fn [[=fn =fn-type] =input]
- (exec [=input-type (&&/expr-type =input)
- =output-type (&type/apply-lambda =fn-type =input-type)]
- (return [(&/V "apply" (&/T =fn =input)) =output-type])))
- [=fn =fn-type]
- =args)
+ (exec [=input-type (&&/expr-type =input)
+ =output-type (&type/apply-lambda =fn-type =input-type)]
+ (return [(&/V "apply" (&/T =fn =input)) =output-type])))
+ [=fn =fn-type]
+ =args)
:let [[=apply =apply-type] (matchv ::M/objects [=apply+=apply-type]
[[=apply =apply-type]]
[=apply =apply-type])]]
(return (&/|list (&/V "Expression" (&/T =apply =apply-type))))))
(defn analyse-apply [analyse =fn ?args]
+ (prn 'analyse-apply (aget =fn 0))
(exec [loader &/loader]
(matchv ::M/objects [=fn]
[["Expression" [=fn-form =fn-type]]]
@@ -90,7 +107,7 @@
[["global" [?module ?name]]]
(exec [macro? (&&def/macro? ?module ?name)]
(if macro?
- (let [macro-class (&host/location (list ?module ?name))]
+ (let [macro-class (&host/location (&/|list ?module ?name))]
(exec [macro-expansion (&macro/expand loader macro-class ?args)
output (&/flat-map% analyse macro-expansion)]
(return output)))
@@ -105,24 +122,24 @@
(defn analyse-case [analyse ?value ?branches]
;; (prn 'analyse-case ?value ?branches)
- (exec [:let [num-branches (count ?branches)]
+ (exec [:let [num-branches (&/|length ?branches)]
_ (&/assert! (and (> num-branches 0) (even? num-branches))
"[Analyser Error] Unbalanced branches in \"case'\" expression.")
- :let [branches (partition 2 ?branches)
- locals-per-branch (map (comp &&case/locals first) branches)
- max-locals (reduce max 0 (map count locals-per-branch))]
+ :let [branches (&/|as-pairs ?branches)
+ locals-per-branch (&/|map (comp &&case/locals &/|first) branches)
+ max-locals (&/fold max 0 (&/|map &/|length locals-per-branch))]
;; :let [_ (prn '[branches locals-per-branch max-locals] [branches locals-per-branch max-locals])]
base-register &&env/next-local-idx
;; :let [_ (prn 'base-register base-register)]
=value (&&/analyse-1 analyse ?value)
;; :let [_ (prn '=value =value)]
=bodies (&/map% (partial &&case/analyse-branch analyse max-locals)
- (map vector locals-per-branch (map second branches)))
+ (&/zip2 locals-per-branch (&/|map &/|second branches)))
;; :let [_ (prn '=bodies =bodies)]
;; :let [_ (prn 'analyse-case/=bodies =bodies)]
=body-types (&/map% &&/expr-type =bodies)
:let [=case-type (&/fold &type/merge (&/|table) =body-types)]
- :let [=branches (map vector (map first branches) =bodies)]]
+ :let [=branches (&/zip2 (&/|map &/|first branches) =bodies)]]
(return (&/|list (&/V "Expression" (&/T (&/V "case" (&/T =value base-register max-locals =branches)) =case-type))))))
(defn analyse-lambda [analyse ?self ?arg ?body]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 0706a563b..74b1a6d9e 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -30,7 +30,8 @@
(loop [idx 0]
(if (< idx size)
(if (= slot (aget record idx))
- (aset record (+ 1 idx) value)
+ (doto record
+ (aset (+ 1 idx) value))
(recur (+ 2 idx)))
(assert false)))))
@@ -45,6 +46,14 @@
(defn return* [state value]
(V "Right" (T state value)))
+(defmacro |let [bindings body]
+ (reduce (fn [inner [left right]]
+ `(matchv ::M/objects [~right]
+ [~left]
+ ~inner))
+ body
+ (reverse (partition 2 bindings))))
+
(defmacro |list [& elems]
(reduce (fn [tail head]
`(V "Cons" (T ~head ~tail)))
@@ -58,13 +67,14 @@
(partition 2 elems)))
(defn |get [slot table]
+ (prn '|get slot (aget table 0))
(matchv ::M/objects [table]
[["Nil" _]]
- (V "Left" (str "Not found: " slot))
+ nil
[["Cons" [[k v] table*]]]
(if (= k slot)
- (V "Right" v)
+ v
(|get slot table*))))
(defn |put [slot value table]
@@ -78,6 +88,7 @@
(V "Cons" (T (T k v) (|put slot value table*))))))
(defn |merge [table1 table2]
+ (prn '|merge (aget table1 0) (aget table2 0))
(matchv ::M/objects [table2]
[["Nil" _]]
table1
@@ -103,6 +114,14 @@
[["Cons" [x _]]]
x))
+(defn |tail [xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ (assert false)
+
+ [["Cons" [_ xs*]]]
+ xs*))
+
;; [Resources/Monads]
(defn fail [message]
(fn [_]
@@ -113,8 +132,10 @@
(V "Right" (T state value))))
(defn bind [m-value step]
+ ;; (prn 'bind m-value step)
(fn [state]
(let [inputs (m-value state)]
+ ;; (prn 'bind/inputs (aget inputs 0))
(matchv ::M/objects [inputs]
[["Right" [?state ?datum]]]
((step ?datum) ?state)
@@ -146,13 +167,14 @@
(defn |cons [head tail]
(V "Cons" (T head tail)))
-(defn |concat [xs ys]
+(defn |++ [xs ys]
+ (prn '|++ (and xs (aget xs 0)) (and ys (aget ys 0)))
(matchv ::M/objects [xs]
[["Nil" _]]
ys
[["Cons" [x xs*]]]
- (V "Cons" (T x (|concat xs* ys)))))
+ (V "Cons" (T x (|++ xs* ys)))))
(defn |map [f xs]
(matchv ::M/objects [xs]
@@ -168,7 +190,18 @@
xs
[["Cons" [x xs*]]]
- (|concat (f x) (flat-map f xs*))))
+ (|++ (f x) (flat-map f xs*))))
+
+(defn |split-with [p xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ (T xs xs)
+
+ [["Cons" [x xs*]]]
+ (if (p x)
+ (|let [[pre post] (|split-with p xs*)]
+ (T (|cons x pre) post))
+ (T (V "Nil" nil) xs))))
(defn |contains? [k table]
(matchv ::M/objects [table]
@@ -187,9 +220,33 @@
[["Cons" [x xs*]]]
(fold f (f init x) xs*)))
+(defn folds [f init xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ (|list init)
+
+ [["Cons" [x xs*]]]
+ (|cons init (folds f (f init x) xs*))))
+
(defn |length [xs]
+ (prn '|length (aget xs 0))
(fold (fn [acc _] (inc acc)) 0 xs))
+(let [|range* (fn |range* [from to]
+ (if (< from to)
+ (V "Cons" (T from (|range* (inc from) to)))
+ (V "Nil" nil)))]
+ (defn |range [n]
+ (|range* 0 n)))
+
+(defn |first [pair]
+ (|let [[_1 _2] pair]
+ _1))
+
+(defn |second [pair]
+ (|let [[_1 _2] pair]
+ _2))
+
(defn zip2 [xs ys]
(matchv ::M/objects [xs ys]
[["Cons" [x xs*]] ["Cons" [y ys*]]]
@@ -217,28 +274,19 @@
[["Cons" [x xs*]]]
(V "Cons" (T x (V "Cons" (T sep (|interpose sep xs*)))))))
-(let [cons% (fn [head tail]
- (V "Cons" (T head tail)))
- ++% (fn ++% [xs ys]
- (matchv ::M/objects [xs]
- [["Nil" _]]
- ys
-
- [["Cons" [x xs*]]]
- (V "Cons" (T x (++% xs* ys)))))]
- (do-template [<name> <joiner>]
- (defn <name> [f xs]
- (matchv ::M/objects [xs]
- [["Nil" _]]
- (return xs)
-
- [["Cons" [x xs*]]]
- (exec [y (f x)
- ys (<name> f xs*)]
- (return (<joiner> y ys)))))
-
- map% cons%
- flat-map% ++%))
+(do-template [<name> <joiner>]
+ (defn <name> [f xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ (return xs)
+
+ [["Cons" [x xs*]]]
+ (exec [y (f x)
+ ys (<name> f xs*)]
+ (return (<joiner> y ys)))))
+
+ map% |cons
+ flat-map% |++)
(defn |as-pairs [xs]
(matchv ::M/objects [xs]
@@ -388,7 +436,7 @@
"locals" +init-bindings+
"closure" +init-bindings+))
-(defn init-state []
+(defn init-state [_]
(R "source" (V "None" nil)
"modules" (|list)
"global-env" (V "None" nil)
@@ -398,18 +446,54 @@
"loader" (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.)
"eval-ctor" 0))
+(defn from-some [some]
+ (matchv ::M/objects [some]
+ [["Some" datum]]
+ datum
+
+ [_]
+ (assert false)))
+
+(defn show-state [state]
+ (let [source (get$ "source" state)
+ modules (get$ "modules" state)
+ global-env (get$ "global-env" state)
+ local-envs (get$ "local-envs" state)
+ types (get$ "types" state)
+ writer (get$ "writer" state)
+ loader (get$ "loader" state)
+ eval-ctor (get$ "eval-ctor" state)]
+ (str "{"
+ (->> (for [slot ["source", "modules", "global-env", "local-envs", "types", "writer", "loader", "eval-ctor"]
+ :let [value (get$ slot state)]]
+ (str "#" slot " " (case slot
+ "source" "???"
+ "modules" "???"
+ "global-env" "???"
+ "local-envs" (|length value)
+ "types" "???"
+ "writer" "???"
+ "loader" "???"
+ "eval-ctor" value)))
+ (interpose " ")
+ (reduce str ""))
+ "}")))
+
(def get-eval-ctor
(fn [state]
(return* (update$ "eval-ctor" inc state) (get$ "eval-ctor" state))))
(def get-writer
(fn [state]
- (matchv ::M/objects [(get$ "writer" state)]
- [["Some" datum]]
- (return* state datum)
+ (let [writer* (get$ "writer" state)]
+ (prn 'get-writer (class writer*))
+ (prn 'get-writer (aget writer* 0))
+ (matchv ::M/objects [writer*]
+ [["Some" datum]]
+ (return* state datum)
- [_]
- (fail* "Writer hasn't been set."))))
+ [_]
+ (fail* "Writer hasn't been set.")))))
(def get-top-local-env
(fn [state]
@@ -417,12 +501,32 @@
(def get-current-module-env
(fn [state]
- (matchv ::M/objects [(get$ "global-env" state)]
- [["Some" datum]]
- (return* state datum)
+ (let [global-env* (get$ "global-env" state)]
+ (prn 'get-current-module-env (aget global-env* 0))
+ (matchv ::M/objects [global-env*]
+ [["Some" datum]]
+ (return* state datum)
- [_]
- (fail* "Module hasn't been set."))))
+ [_]
+ (fail* "Module hasn't been set.")))))
+
+(defn ->seq [xs]
+ (matchv ::M/objects [xs]
+ [["Nil" _]]
+ (list)
+
+ [["Cons" [x xs*]]]
+ (cons x (->seq xs*))))
+
+(defn ->list [seq]
+ (if (empty? seq)
+ (|list)
+ (|cons (first seq) (->list (rest seq)))))
+
+(defn |repeat [n x]
+ (if (> n 0)
+ (|cons x (|repeat (dec n) x))
+ (|list)))
(def get-module-name
(exec [module get-current-module-env]
@@ -430,36 +534,45 @@
(defn ^:private with-scope [name body]
(fn [state]
- (let [output (body (update$ "local-envs" #(conj % (env name)) state))]
+ (let [output (body (update$ "local-envs" #(|cons (env name) %) state))]
(matchv ::M/objects [output]
[["Right" [state* datum]]]
- (return* (update$ "local-envs" rest state*) datum)
+ (return* (update$ "local-envs" |tail state*) datum)
[_]
output))))
(defn with-closure [body]
- (exec [[local? closure-name] (try-all% (list (exec [top get-top-local-env]
- (return [true (->> top (get$ "inner-closures") str)]))
- (exec [global get-current-module-env]
- (return [false (->> global (get$ "inner-closures") str)]))))]
- (fn [state]
- (let [body* (with-scope closure-name
- body)]
- (body* (if local?
- (update$ "local-envs" #(cons (update$ "inner-closures" inc (first %))
- (rest %))
- state)
- (update$ "global-env" #(update$ "inner-closures" inc %) state)))))))
+ (exec [closure-info (try-all% (|list (exec [top get-top-local-env]
+ (return (T true (->> top (get$ "inner-closures") str))))
+ (exec [global get-current-module-env]
+ (return (T false (->> global (get$ "inner-closures") str))))))]
+ (matchv ::M/objects [closure-info]
+ [[local? closure-name]]
+ (fn [state]
+ (let [body* (with-scope closure-name
+ body)]
+ (body* (if local?
+ (update$ "local-envs" #(|cons (update$ "inner-closures" inc (|head %))
+ (|tail %))
+ state)
+ (update$ "global-env" #(matchv ::M/objects [%]
+ [["Some" global-env]]
+ (V "Some" (update$ "inner-closures" inc global-env))
+
+ [_]
+ %)
+ state)))))
+ )))
(def get-scope-name
(exec [module-name get-module-name]
(fn [state]
- (return* state (->> state (get$ "local-envs") (map #(get$ "name" %)) reverse (cons module-name))))))
+ (return* state (->> state (get$ "local-envs") (|map #(get$ "name" %)) |reverse (|cons module-name))))))
(defn with-writer [writer body]
(fn [state]
- (let [output (body (set$ "writer" writer state))]
+ (let [output (body (set$ "writer" (V "Some" writer) state))]
(matchv ::M/objects [output]
[["Right" [?state ?value]]]
(return* (set$ "writer" (get$ "writer" state) ?state) ?value)
@@ -490,7 +603,7 @@
[["Tag" ?tag]]
(str "#" ?tag)
- [["Ident" ?ident]]
+ [["Symbol" ?ident]]
?ident
[["Tuple" ?elems]]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index fd60537e5..1489cceb2 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -28,287 +28,288 @@
;; [Utils/Compilers]
(defn ^:private compile-expression [syntax]
- ;; (prn 'compile-expression syntax)
+ (prn 'compile-expression (aget syntax 0))
(matchv ::M/objects [syntax]
- [["Expression" ?form ?type]]
- (matchv ::M/objects [?form]
- [["bool" ?value]]
- (&&lux/compile-bool compile-expression ?type ?value)
-
- [["int" ?value]]
- (&&lux/compile-int compile-expression ?type ?value)
-
- [["real" ?value]]
- (&&lux/compile-real compile-expression ?type ?value)
-
- [["char" ?value]]
- (&&lux/compile-char compile-expression ?type ?value)
-
- [["text" ?value]]
- (&&lux/compile-text compile-expression ?type ?value)
-
- [["tuple" ?elems]]
- (&&lux/compile-tuple compile-expression ?type ?elems)
-
- [["record" ?elems]]
- (&&lux/compile-record compile-expression ?type ?elems)
-
- [["local" ?idx]]
- (&&lux/compile-local compile-expression ?type ?idx)
-
- [["captured" [?scope ?captured-id ?source]]]
- (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source)
-
- [["global" [?owner-class ?name]]]
- (&&lux/compile-global compile-expression ?type ?owner-class ?name)
-
- [["call" [?fn ?args]]]
- (&&lux/compile-call compile-expression ?type ?fn ?args)
-
- [["variant" [?tag ?members]]]
- (&&lux/compile-variant compile-expression ?type ?tag ?members)
-
- [["case" [?variant ?base-register ?num-registers ?branches]]]
- (&&case/compile-case compile-expression ?type ?variant ?base-register ?num-registers ?branches)
-
- [["lambda" [?scope ?env ?args ?body]]]
- (&&lambda/compile-lambda compile-expression ?scope ?env ?args ?body)
-
- [["get" [?slot ?record]]]
- (&&lux/compile-get compile-expression ?type ?slot ?record)
-
- [["set" [?slot ?value ?record]]]
- (&&lux/compile-set compile-expression ?type ?slot ?value ?record)
-
- ;; Integer arithmetic
- [["jvm-iadd" [?x ?y]]]
- (&&host/compile-jvm-iadd compile-expression ?type ?x ?y)
-
- [["jvm-isub" [?x ?y]]]
- (&&host/compile-jvm-isub compile-expression ?type ?x ?y)
-
- [["jvm-imul" [?x ?y]]]
- (&&host/compile-jvm-imul compile-expression ?type ?x ?y)
-
- [["jvm-idiv" [?x ?y]]]
- (&&host/compile-jvm-idiv compile-expression ?type ?x ?y)
-
- [["jvm-irem" [?x ?y]]]
- (&&host/compile-jvm-irem compile-expression ?type ?x ?y)
-
- [["jvm-ieq" [?x ?y]]]
- (&&host/compile-jvm-ieq compile-expression ?type ?x ?y)
-
- [["jvm-ilt" [?x ?y]]]
- (&&host/compile-jvm-ilt compile-expression ?type ?x ?y)
-
- [["jvm-igt" [?x ?y]]]
- (&&host/compile-jvm-igt compile-expression ?type ?x ?y)
-
- ;; Long arithmetic
- [["jvm-ladd" [?x ?y]]]
- (&&host/compile-jvm-ladd compile-expression ?type ?x ?y)
-
- [["jvm-lsub" [?x ?y]]]
- (&&host/compile-jvm-lsub compile-expression ?type ?x ?y)
-
- [["jvm-lmul" [?x ?y]]]
- (&&host/compile-jvm-lmul compile-expression ?type ?x ?y)
-
- [["jvm-ldiv" [?x ?y]]]
- (&&host/compile-jvm-ldiv compile-expression ?type ?x ?y)
-
- [["jvm-lrem" [?x ?y]]]
- (&&host/compile-jvm-lrem compile-expression ?type ?x ?y)
-
- [["jvm-leq" [?x ?y]]]
- (&&host/compile-jvm-leq compile-expression ?type ?x ?y)
-
- [["jvm-llt" [?x ?y]]]
- (&&host/compile-jvm-llt compile-expression ?type ?x ?y)
-
- [["jvm-lgt" [?x ?y]]]
- (&&host/compile-jvm-lgt compile-expression ?type ?x ?y)
-
- ;; Float arithmetic
- [["jvm-fadd" [?x ?y]]]
- (&&host/compile-jvm-fadd compile-expression ?type ?x ?y)
-
- [["jvm-fsub" [?x ?y]]]
- (&&host/compile-jvm-fsub compile-expression ?type ?x ?y)
-
- [["jvm-fmul" [?x ?y]]]
- (&&host/compile-jvm-fmul compile-expression ?type ?x ?y)
-
- [["jvm-fdiv" [?x ?y]]]
- (&&host/compile-jvm-fdiv compile-expression ?type ?x ?y)
-
- [["jvm-frem" [?x ?y]]]
- (&&host/compile-jvm-frem compile-expression ?type ?x ?y)
-
- [["jvm-feq" [?x ?y]]]
- (&&host/compile-jvm-feq compile-expression ?type ?x ?y)
-
- [["jvm-flt" [?x ?y]]]
- (&&host/compile-jvm-flt compile-expression ?type ?x ?y)
-
- [["jvm-fgt" [?x ?y]]]
- (&&host/compile-jvm-fgt compile-expression ?type ?x ?y)
-
- ;; Double arithmetic
- [["jvm-dadd" [?x ?y]]]
- (&&host/compile-jvm-dadd compile-expression ?type ?x ?y)
-
- [["jvm-dsub" [?x ?y]]]
- (&&host/compile-jvm-dsub compile-expression ?type ?x ?y)
-
- [["jvm-dmul" [?x ?y]]]
- (&&host/compile-jvm-dmul compile-expression ?type ?x ?y)
-
- [["jvm-ddiv" [?x ?y]]]
- (&&host/compile-jvm-ddiv compile-expression ?type ?x ?y)
-
- [["jvm-drem" [?x ?y]]]
- (&&host/compile-jvm-drem compile-expression ?type ?x ?y)
-
- [["jvm-deq" [?x ?y]]]
- (&&host/compile-jvm-deq compile-expression ?type ?x ?y)
-
- [["jvm-dlt" [?x ?y]]]
- (&&host/compile-jvm-dlt compile-expression ?type ?x ?y)
-
- [["jvm-dgt" [?x ?y]]]
- (&&host/compile-jvm-dgt compile-expression ?type ?x ?y)
-
- [["exec" ?exprs]]
- (&&host/compile-exec compile-expression ?type ?exprs)
-
- [["jvm-null" _]]
- (&&host/compile-jvm-null compile-expression ?type)
-
- [["jvm-null?" ?object]]
- (&&host/compile-jvm-null? compile-expression ?type ?object)
-
- [["jvm-new" [?class ?classes ?args]]]
- (&&host/compile-jvm-new compile-expression ?type ?class ?classes ?args)
-
- [["jvm-getstatic" [?class ?field]]]
- (&&host/compile-jvm-getstatic compile-expression ?type ?class ?field)
-
- [["jvm-getfield" [?class ?field ?object]]]
- (&&host/compile-jvm-getfield compile-expression ?type ?class ?field ?object)
-
- [["jvm-putstatic" [?class ?field ?value]]]
- (&&host/compile-jvm-putstatic compile-expression ?type ?class ?field ?value)
-
- [["jvm-putfield" [?class ?field ?object ?value]]]
- (&&host/compile-jvm-putfield compile-expression ?type ?class ?field ?object ?value)
-
- [["jvm-invokestatic" [?class ?method ?classes ?args]]]
- (&&host/compile-jvm-invokestatic compile-expression ?type ?class ?method ?classes ?args)
-
- [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
- (&&host/compile-jvm-invokevirtual compile-expression ?type ?class ?method ?classes ?object ?args)
+ [["Expression" [?form ?type]]]
+ (do (prn 'compile-expression2 (aget ?form 0))
+ (matchv ::M/objects [?form]
+ [["bool" ?value]]
+ (&&lux/compile-bool compile-expression ?type ?value)
+
+ [["int" ?value]]
+ (&&lux/compile-int compile-expression ?type ?value)
+
+ [["real" ?value]]
+ (&&lux/compile-real compile-expression ?type ?value)
+
+ [["char" ?value]]
+ (&&lux/compile-char compile-expression ?type ?value)
+
+ [["text" ?value]]
+ (&&lux/compile-text compile-expression ?type ?value)
+
+ [["tuple" ?elems]]
+ (&&lux/compile-tuple compile-expression ?type ?elems)
+
+ [["record" ?elems]]
+ (&&lux/compile-record compile-expression ?type ?elems)
+
+ [["local" ?idx]]
+ (&&lux/compile-local compile-expression ?type ?idx)
+
+ [["captured" [?scope ?captured-id ?source]]]
+ (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source)
+
+ [["global" [?owner-class ?name]]]
+ (&&lux/compile-global compile-expression ?type ?owner-class ?name)
+
+ [["call" [?fn ?args]]]
+ (&&lux/compile-call compile-expression ?type ?fn ?args)
+
+ [["variant" [?tag ?members]]]
+ (&&lux/compile-variant compile-expression ?type ?tag ?members)
+
+ [["case" [?variant ?base-register ?num-registers ?branches]]]
+ (&&case/compile-case compile-expression ?type ?variant ?base-register ?num-registers ?branches)
+
+ [["lambda" [?scope ?env ?args ?body]]]
+ (&&lambda/compile-lambda compile-expression ?scope ?env ?args ?body)
+
+ [["get" [?slot ?record]]]
+ (&&lux/compile-get compile-expression ?type ?slot ?record)
+
+ [["set" [?slot ?value ?record]]]
+ (&&lux/compile-set compile-expression ?type ?slot ?value ?record)
+
+ ;; Integer arithmetic
+ [["jvm-iadd" [?x ?y]]]
+ (&&host/compile-jvm-iadd compile-expression ?type ?x ?y)
+
+ [["jvm-isub" [?x ?y]]]
+ (&&host/compile-jvm-isub compile-expression ?type ?x ?y)
+
+ [["jvm-imul" [?x ?y]]]
+ (&&host/compile-jvm-imul compile-expression ?type ?x ?y)
+
+ [["jvm-idiv" [?x ?y]]]
+ (&&host/compile-jvm-idiv compile-expression ?type ?x ?y)
+
+ [["jvm-irem" [?x ?y]]]
+ (&&host/compile-jvm-irem compile-expression ?type ?x ?y)
+
+ [["jvm-ieq" [?x ?y]]]
+ (&&host/compile-jvm-ieq compile-expression ?type ?x ?y)
+
+ [["jvm-ilt" [?x ?y]]]
+ (&&host/compile-jvm-ilt compile-expression ?type ?x ?y)
+
+ [["jvm-igt" [?x ?y]]]
+ (&&host/compile-jvm-igt compile-expression ?type ?x ?y)
+
+ ;; Long arithmetic
+ [["jvm-ladd" [?x ?y]]]
+ (&&host/compile-jvm-ladd compile-expression ?type ?x ?y)
+
+ [["jvm-lsub" [?x ?y]]]
+ (&&host/compile-jvm-lsub compile-expression ?type ?x ?y)
+
+ [["jvm-lmul" [?x ?y]]]
+ (&&host/compile-jvm-lmul compile-expression ?type ?x ?y)
+
+ [["jvm-ldiv" [?x ?y]]]
+ (&&host/compile-jvm-ldiv compile-expression ?type ?x ?y)
+
+ [["jvm-lrem" [?x ?y]]]
+ (&&host/compile-jvm-lrem compile-expression ?type ?x ?y)
+
+ [["jvm-leq" [?x ?y]]]
+ (&&host/compile-jvm-leq compile-expression ?type ?x ?y)
+
+ [["jvm-llt" [?x ?y]]]
+ (&&host/compile-jvm-llt compile-expression ?type ?x ?y)
+
+ [["jvm-lgt" [?x ?y]]]
+ (&&host/compile-jvm-lgt compile-expression ?type ?x ?y)
+
+ ;; Float arithmetic
+ [["jvm-fadd" [?x ?y]]]
+ (&&host/compile-jvm-fadd compile-expression ?type ?x ?y)
+
+ [["jvm-fsub" [?x ?y]]]
+ (&&host/compile-jvm-fsub compile-expression ?type ?x ?y)
+
+ [["jvm-fmul" [?x ?y]]]
+ (&&host/compile-jvm-fmul compile-expression ?type ?x ?y)
+
+ [["jvm-fdiv" [?x ?y]]]
+ (&&host/compile-jvm-fdiv compile-expression ?type ?x ?y)
+
+ [["jvm-frem" [?x ?y]]]
+ (&&host/compile-jvm-frem compile-expression ?type ?x ?y)
+
+ [["jvm-feq" [?x ?y]]]
+ (&&host/compile-jvm-feq compile-expression ?type ?x ?y)
+
+ [["jvm-flt" [?x ?y]]]
+ (&&host/compile-jvm-flt compile-expression ?type ?x ?y)
+
+ [["jvm-fgt" [?x ?y]]]
+ (&&host/compile-jvm-fgt compile-expression ?type ?x ?y)
+
+ ;; Double arithmetic
+ [["jvm-dadd" [?x ?y]]]
+ (&&host/compile-jvm-dadd compile-expression ?type ?x ?y)
+
+ [["jvm-dsub" [?x ?y]]]
+ (&&host/compile-jvm-dsub compile-expression ?type ?x ?y)
+
+ [["jvm-dmul" [?x ?y]]]
+ (&&host/compile-jvm-dmul compile-expression ?type ?x ?y)
+
+ [["jvm-ddiv" [?x ?y]]]
+ (&&host/compile-jvm-ddiv compile-expression ?type ?x ?y)
+
+ [["jvm-drem" [?x ?y]]]
+ (&&host/compile-jvm-drem compile-expression ?type ?x ?y)
+
+ [["jvm-deq" [?x ?y]]]
+ (&&host/compile-jvm-deq compile-expression ?type ?x ?y)
+
+ [["jvm-dlt" [?x ?y]]]
+ (&&host/compile-jvm-dlt compile-expression ?type ?x ?y)
+
+ [["jvm-dgt" [?x ?y]]]
+ (&&host/compile-jvm-dgt compile-expression ?type ?x ?y)
+
+ [["exec" ?exprs]]
+ (&&host/compile-exec compile-expression ?type ?exprs)
+
+ [["jvm-null" _]]
+ (&&host/compile-jvm-null compile-expression ?type)
+
+ [["jvm-null?" ?object]]
+ (&&host/compile-jvm-null? compile-expression ?type ?object)
+
+ [["jvm-new" [?class ?classes ?args]]]
+ (&&host/compile-jvm-new compile-expression ?type ?class ?classes ?args)
+
+ [["jvm-getstatic" [?class ?field]]]
+ (&&host/compile-jvm-getstatic compile-expression ?type ?class ?field)
+
+ [["jvm-getfield" [?class ?field ?object]]]
+ (&&host/compile-jvm-getfield compile-expression ?type ?class ?field ?object)
+
+ [["jvm-putstatic" [?class ?field ?value]]]
+ (&&host/compile-jvm-putstatic compile-expression ?type ?class ?field ?value)
+
+ [["jvm-putfield" [?class ?field ?object ?value]]]
+ (&&host/compile-jvm-putfield compile-expression ?type ?class ?field ?object ?value)
+
+ [["jvm-invokestatic" [?class ?method ?classes ?args]]]
+ (&&host/compile-jvm-invokestatic compile-expression ?type ?class ?method ?classes ?args)
+
+ [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
+ (&&host/compile-jvm-invokevirtual compile-expression ?type ?class ?method ?classes ?object ?args)
- [["jvm-invokeinterface" [?class ?method ?classes ?object ?args]]]
- (&&host/compile-jvm-invokeinterface compile-expression ?type ?class ?method ?classes ?object ?args)
+ [["jvm-invokeinterface" [?class ?method ?classes ?object ?args]]]
+ (&&host/compile-jvm-invokeinterface compile-expression ?type ?class ?method ?classes ?object ?args)
- [["jvm-invokespecial" [?class ?method ?classes ?object ?args]]]
- (&&host/compile-jvm-invokespecial compile-expression ?type ?class ?method ?classes ?object ?args)
-
- [["jvm-new-array" [?class ?length]]]
- (&&host/compile-jvm-new-array compile-expression ?type ?class ?length)
+ [["jvm-invokespecial" [?class ?method ?classes ?object ?args]]]
+ (&&host/compile-jvm-invokespecial compile-expression ?type ?class ?method ?classes ?object ?args)
+
+ [["jvm-new-array" [?class ?length]]]
+ (&&host/compile-jvm-new-array compile-expression ?type ?class ?length)
- [["jvm-aastore" [?array ?idx ?elem]]]
- (&&host/compile-jvm-aastore compile-expression ?type ?array ?idx ?elem)
+ [["jvm-aastore" [?array ?idx ?elem]]]
+ (&&host/compile-jvm-aastore compile-expression ?type ?array ?idx ?elem)
- [["jvm-aaload" [?array ?idx]]]
- (&&host/compile-jvm-aaload compile-expression ?type ?array ?idx)
+ [["jvm-aaload" [?array ?idx]]]
+ (&&host/compile-jvm-aaload compile-expression ?type ?array ?idx)
- [["jvm-try" [?body ?catches ?finally]]]
- (&&host/compile-jvm-try compile-expression ?type ?body ?catches ?finally)
+ [["jvm-try" [?body ?catches ?finally]]]
+ (&&host/compile-jvm-try compile-expression ?type ?body ?catches ?finally)
- [["jvm-throw" ?ex]]
- (&&host/compile-jvm-throw compile-expression ?type ?ex)
+ [["jvm-throw" ?ex]]
+ (&&host/compile-jvm-throw compile-expression ?type ?ex)
- [["jvm-monitorenter" ?monitor]]
- (&&host/compile-jvm-monitorenter compile-expression ?type ?monitor)
+ [["jvm-monitorenter" ?monitor]]
+ (&&host/compile-jvm-monitorenter compile-expression ?type ?monitor)
- [["jvm-monitorexit" ?monitor]]
- (&&host/compile-jvm-monitorexit compile-expression ?type ?monitor)
+ [["jvm-monitorexit" ?monitor]]
+ (&&host/compile-jvm-monitorexit compile-expression ?type ?monitor)
- [["jvm-d2f" ?value]]
- (&&host/compile-jvm-d2f compile-expression ?type ?value)
+ [["jvm-d2f" ?value]]
+ (&&host/compile-jvm-d2f compile-expression ?type ?value)
- [["jvm-d2i" ?value]]
- (&&host/compile-jvm-d2i compile-expression ?type ?value)
+ [["jvm-d2i" ?value]]
+ (&&host/compile-jvm-d2i compile-expression ?type ?value)
- [["jvm-d2l" ?value]]
- (&&host/compile-jvm-d2l compile-expression ?type ?value)
-
- [["jvm-f2d" ?value]]
- (&&host/compile-jvm-f2d compile-expression ?type ?value)
+ [["jvm-d2l" ?value]]
+ (&&host/compile-jvm-d2l compile-expression ?type ?value)
+
+ [["jvm-f2d" ?value]]
+ (&&host/compile-jvm-f2d compile-expression ?type ?value)
- [["jvm-f2i" ?value]]
- (&&host/compile-jvm-f2i compile-expression ?type ?value)
+ [["jvm-f2i" ?value]]
+ (&&host/compile-jvm-f2i compile-expression ?type ?value)
- [["jvm-f2l" ?value]]
- (&&host/compile-jvm-f2l compile-expression ?type ?value)
-
- [["jvm-i2b" ?value]]
- (&&host/compile-jvm-i2b compile-expression ?type ?value)
+ [["jvm-f2l" ?value]]
+ (&&host/compile-jvm-f2l compile-expression ?type ?value)
+
+ [["jvm-i2b" ?value]]
+ (&&host/compile-jvm-i2b compile-expression ?type ?value)
- [["jvm-i2c" ?value]]
- (&&host/compile-jvm-i2c compile-expression ?type ?value)
+ [["jvm-i2c" ?value]]
+ (&&host/compile-jvm-i2c compile-expression ?type ?value)
- [["jvm-i2d" ?value]]
- (&&host/compile-jvm-i2d compile-expression ?type ?value)
+ [["jvm-i2d" ?value]]
+ (&&host/compile-jvm-i2d compile-expression ?type ?value)
- [["jvm-i2f" ?value]]
- (&&host/compile-jvm-i2f compile-expression ?type ?value)
+ [["jvm-i2f" ?value]]
+ (&&host/compile-jvm-i2f compile-expression ?type ?value)
- [["jvm-i2l" ?value]]
- (&&host/compile-jvm-i2l compile-expression ?type ?value)
+ [["jvm-i2l" ?value]]
+ (&&host/compile-jvm-i2l compile-expression ?type ?value)
- [["jvm-i2s" ?value]]
- (&&host/compile-jvm-i2s compile-expression ?type ?value)
+ [["jvm-i2s" ?value]]
+ (&&host/compile-jvm-i2s compile-expression ?type ?value)
- [["jvm-l2d" ?value]]
- (&&host/compile-jvm-l2d compile-expression ?type ?value)
+ [["jvm-l2d" ?value]]
+ (&&host/compile-jvm-l2d compile-expression ?type ?value)
- [["jvm-l2f" ?value]]
- (&&host/compile-jvm-l2f compile-expression ?type ?value)
+ [["jvm-l2f" ?value]]
+ (&&host/compile-jvm-l2f compile-expression ?type ?value)
- [["jvm-l2i" ?value]]
- (&&host/compile-jvm-l2i compile-expression ?type ?value)
+ [["jvm-l2i" ?value]]
+ (&&host/compile-jvm-l2i compile-expression ?type ?value)
- [["jvm-iand" [?x ?y]]]
- (&&host/compile-jvm-iand compile-expression ?type ?x ?y)
+ [["jvm-iand" [?x ?y]]]
+ (&&host/compile-jvm-iand compile-expression ?type ?x ?y)
- [["jvm-ior" [?x ?y]]]
- (&&host/compile-jvm-ior compile-expression ?type ?x ?y)
+ [["jvm-ior" [?x ?y]]]
+ (&&host/compile-jvm-ior compile-expression ?type ?x ?y)
- [["jvm-land" [?x ?y]]]
- (&&host/compile-jvm-land compile-expression ?type ?x ?y)
+ [["jvm-land" [?x ?y]]]
+ (&&host/compile-jvm-land compile-expression ?type ?x ?y)
- [["jvm-lor" [?x ?y]]]
- (&&host/compile-jvm-lor compile-expression ?type ?x ?y)
+ [["jvm-lor" [?x ?y]]]
+ (&&host/compile-jvm-lor compile-expression ?type ?x ?y)
- [["jvm-lxor" [?x ?y]]]
- (&&host/compile-jvm-lxor compile-expression ?type ?x ?y)
+ [["jvm-lxor" [?x ?y]]]
+ (&&host/compile-jvm-lxor compile-expression ?type ?x ?y)
- [["jvm-lshl" [?x ?y]]]
- (&&host/compile-jvm-lshl compile-expression ?type ?x ?y)
+ [["jvm-lshl" [?x ?y]]]
+ (&&host/compile-jvm-lshl compile-expression ?type ?x ?y)
- [["jvm-lshr" [?x ?y]]]
- (&&host/compile-jvm-lshr compile-expression ?type ?x ?y)
+ [["jvm-lshr" [?x ?y]]]
+ (&&host/compile-jvm-lshr compile-expression ?type ?x ?y)
- [["jvm-lushr" [?x ?y]]]
- (&&host/compile-jvm-lushr compile-expression ?type ?x ?y)
+ [["jvm-lushr" [?x ?y]]]
+ (&&host/compile-jvm-lushr compile-expression ?type ?x ?y)
- [["jvm-program" ?body]]
- (&&host/compile-jvm-program compile-expression ?type ?body)
- )
+ [["jvm-program" ?body]]
+ (&&host/compile-jvm-program compile-expression ?type ?body)
+ ))
[_]
(fail "[Compiler Error] Can't compile statements as expressions.")))
@@ -317,15 +318,16 @@
;; (prn 'compile-statement syntax)
(matchv ::M/objects [syntax]
[["Statement" ?form]]
- (matchv ::M/objects [?form]
- [["def" ?name ?body]]
- (&&lux/compile-def compile-expression ?name ?body)
-
- [["jvm-interface" ?package ?name ?methods]]
- (&&host/compile-jvm-interface compile-expression ?package ?name ?methods)
+ (do (prn 'compile-statement (aget syntax 0) (aget ?form 0))
+ (matchv ::M/objects [?form]
+ [["def" [?name ?body]]]
+ (&&lux/compile-def compile-expression ?name ?body)
+
+ [["jvm-interface" [?package ?name ?methods]]]
+ (&&host/compile-jvm-interface compile-expression ?package ?name ?methods)
- [["jvm-class" ?package ?name ?super-class ?fields ?methods]]
- (&&host/compile-jvm-class compile-expression ?package ?name ?super-class ?fields ?methods))
+ [["jvm-class" [?package ?name ?super-class ?fields ?methods]]]
+ (&&host/compile-jvm-class compile-expression ?package ?name ?super-class ?fields ?methods)))
[_]
(fail "[Compiler Error] Can't compile expressions as top-level forms.")))
@@ -361,7 +363,7 @@
(let [compiler-step (exec [analysis+ (&optimizer/optimize eval!)
;; :let [_ (prn 'analysis+ analysis+)]
]
- (&/flat-map% compile-statement analysis+))]
+ (&/map% compile-statement analysis+))]
(defn ^:private compile-module [name]
(fn [state]
(if (->> state (&/get$ "modules") (&/|contains? name))
@@ -369,13 +371,14 @@
(let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
(&host/->class name) nil "java/lang/Object" nil))]
- (matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (-> state
- (&/set$ "source" (slurp (str "source/" name ".lux")))
- (&/set$ "global-env" (&/env name))
- (&/set$ "writer" =class)
- (&/update$ "modules" #(&/|put name &a-def/init-module %))))]
+ (matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (->> state
+ (&/set$ "source" (slurp (str "source/" name ".lux")))
+ (&/set$ "global-env" (&/V "Some" (&/env name)))
+ (&/set$ "writer" (&/V "Some" =class))
+ (&/update$ "modules" #(&/|put name &a-def/init-module %))))]
[["Right" [?state ?vals]]]
(do (.visitEnd =class)
+ (prn 'compile-module 'DONE name)
;; (prn 'compile-module/?vals ?vals)
(&/run-state (&&/save-class! name (.toByteArray =class)) ?state))
@@ -385,7 +388,7 @@
;; [Resources]
(defn compile-all [modules]
(.mkdir (java.io.File. "output"))
- (matchv ::M/objects [(&/run-state (&/map% compile-module modules) (&/init-state))]
+ (matchv ::M/objects [(&/run-state (&/map% compile-module modules) (&/init-state nil))]
[["Right" [?state _]]]
(println (str "Compilation complete! " (pr-str modules)))
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index f09008ca8..09fc811d8 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -32,97 +32,104 @@
(return nil)))
(defn total-locals [expr]
+ (prn 'total-locals1 (aget expr 0))
(matchv ::M/objects [expr]
- [["case" [?variant ?base-register ?num-registers ?branches]]]
- (+ ?num-registers (&/fold max 0 (&/|map (comp total-locals second) ?branches)))
-
- [["tuple" ?members]]
- (&/fold max 0 (&/|map total-locals ?members))
+ [["Expression" [?struct ?type]]]
+ (do (prn 'total-locals2 (aget ?struct 0))
+ (matchv ::M/objects [?struct]
+ [["case" [?variant ?base-register ?num-registers ?branches]]]
+ (+ ?num-registers (&/fold max 0 (&/|map (comp total-locals second) ?branches)))
+
+ [["tuple" ?members]]
+ (&/fold max 0 (&/|map total-locals ?members))
- [["variant" ?tag ?value]]
- (total-locals ?value)
+ [["variant" [?tag ?value]]]
+ (total-locals ?value)
- [["call" [?fn ?args]]]
- (&/fold max 0 (&/|map total-locals (&/|cons ?fn ?args)))
-
- [["jvm-iadd" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-isub" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-imul" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-idiv" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-irem" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-ladd" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-lsub" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-lmul" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-ldiv" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-lrem" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-fadd" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-fsub" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-fmul" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-fdiv" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-frem" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-dadd" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-dsub" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-dmul" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-ddiv" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
-
- [["jvm-drem" [?x ?y]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+ [["call" [?fn ?args]]]
+ (&/fold max 0 (&/|map total-locals (&/|cons ?fn ?args)))
+
+ [["jvm-iadd" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-isub" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-imul" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-idiv" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-irem" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-ladd" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-lsub" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-lmul" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-ldiv" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-lrem" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-fadd" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-fsub" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-fmul" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-fdiv" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-frem" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-dadd" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-dsub" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-dmul" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-ddiv" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
+
+ [["jvm-drem" [?x ?y]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?x ?y)))
- [["exec" ?exprs]]
- (&/fold max 0 (&/|map total-locals ?exprs))
+ [["exec" ?exprs]]
+ (&/fold max 0 (&/|map total-locals ?exprs))
- [["jvm-new" [?class ?classes ?args]]]
- (&/fold max 0 (&/|map total-locals ?args))
+ [["jvm-new" [?class ?classes ?args]]]
+ (&/fold max 0 (&/|map total-locals ?args))
- [["jvm-invokestatic" [?class ?method ?classes ?args]]]
- (&/fold max 0 (&/|map total-locals ?args))
+ [["jvm-invokestatic" [?class ?method ?classes ?args]]]
+ (&/fold max 0 (&/|map total-locals ?args))
- [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
- (&/fold max 0 (&/|map total-locals ?args))
+ [["jvm-invokevirtual" [?class ?method ?classes ?object ?args]]]
+ (&/fold max 0 (&/|map total-locals ?args))
- [["jvm-aastore" [?array ?idx ?elem]]]
- (&/fold max 0 (&/|map total-locals (&/|list ?array ?elem)))
+ [["jvm-aastore" [?array ?idx ?elem]]]
+ (&/fold max 0 (&/|map total-locals (&/|list ?array ?elem)))
- [["jvm-aaload" [?array ?idx]]]
- (total-locals ?array)
-
- ;; [_]
- ;; 0
- ))
+ [["jvm-aaload" [?array ?idx]]]
+ (total-locals ?array)
+
+ [["lambda" _]]
+ 0
+
+ ;; [_]
+ ;; 0
+ ))))
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 6f9fd998a..336d0c645 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -3,7 +3,7 @@
[template :refer [do-template]])
[clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return* return fail fail*]]
+ (lux [base :as & :refer [exec return* return fail fail* |let]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -17,51 +17,56 @@
;; [Utils]
(defn ^:private ->match [$body register token]
+ (prn '->match token)
+ (prn '->match (aget token 0))
(matchv ::M/objects [token]
- [["Ident" ?name]]
- [(inc register) (&/V "Pattern" (&/T $body [&/V "StoreMatch" register]))]
+ [["Symbol" ?name]]
+ (&/T (inc register) (&/V "Pattern" (&/T $body [&/V "StoreMatch" register])))
[["Bool" ?value]]
- [register (&/V "Pattern" (&/T $body [&/V "BoolMatch" ?value]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "BoolMatch" ?value])))
[["Int" ?value]]
- [register (&/V "Pattern" (&/T $body [&/V "IntMatch" ?value]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "IntMatch" ?value])))
[["Real" ?value]]
- [register (&/V "Pattern" (&/T $body [&/V "RealMatch" ?value]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "RealMatch" ?value])))
[["Char" ?value]]
- [register (&/V "Pattern" (&/T $body [&/V "CharMatch" ?value]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "CharMatch" ?value])))
[["Text" ?value]]
- [register (&/V "Pattern" (&/T $body [&/V "TextMatch" ?value]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "TextMatch" ?value])))
[["Tuple" ?members]]
- (let [[register* =members] (&/fold (fn [[register =members] member]
- (let [[register* =member] (->match $body register member)]
- [register* (cons =member =members)]))
- [register (list)]
- ?members)]
- [register* (&/V "Pattern" (&/T $body [&/V "TupleMatch" (reverse =members)]))])
+ (|let [[register* =members] (&/fold (fn [[register =members] member]
+ (|let [[register* =member] (->match $body register member)]
+ (&/T register* (&/|cons =member =members))))
+ (&/T register (&/|list))
+ ?members)]
+ (&/T register* (&/V "Pattern" (&/T $body [&/V "TupleMatch" (&/|reverse =members)]))))
[["Tag" ?tag]]
- [register (&/V "Pattern" (&/T $body [&/V "VariantMatch" (&/T ?tag [&/V "Pattern" (&/T $body [&/V "TupleMatch" (list)])])]))]
+ (&/T register (&/V "Pattern" (&/T $body [&/V "VariantMatch" (&/T ?tag [&/V "Pattern" (&/T $body [&/V "TupleMatch" (list)])])])))
[["Form" ["Cons" [["Tag" ?tag]
["Cons" [?value
["Nil" _]]]]]]]
- (let [[register* =value] (->match $body register ?value)]
+ (|let [[register* =value] (->match $body register ?value)]
- [register* (&/V "Pattern" (&/T $body [&/V "VariantMatch" (&/T ?tag =value)]))])
+ (&/T register* (&/V "Pattern" (&/T $body [&/V "VariantMatch" (&/T ?tag =value)]))))
))
(defn ^:private process-branches [base-register branches]
- (let [[_ mappings pms] (reduce (fn [[$id mappings =matches] [pattern body]]
- (let [[_ =match] (->match $id base-register pattern)]
- [(inc $id) (assoc mappings $id body) (cons =match =matches)]))
- [0 {} (list)]
- branches)]
- [mappings (reverse pms)]))
+ (prn 'process-branches base-register branches)
+ (|let [[_ mappings pms] (&/fold (fn [$id+mappings+=matches pattern+body]
+ (|let [[$id mappings =matches] $id+mappings+=matches
+ [pattern body] pattern+body
+ [_ =match] (->match $id base-register pattern)]
+ (&/T (inc $id) (&/|put $id body mappings) (&/|cons =match =matches))))
+ (&/T 0 (&/|table) (&/|list))
+ branches)]
+ (&/T mappings (&/|reverse pms))))
(let [+tag-sig+ (&host/->type-signature "java.lang.String")
+oclass+ (&host/->class "java.lang.Object")
@@ -131,9 +136,10 @@
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $else)
(.visitLabel $next))
- (->> (doseq [[idx [_ _ member]] (map vector (range (count ?members)) ?members)
- :let [$next (new Label)
- $sub-else (new Label)]])))
+ (->> (|let [[idx [_ _ member]] idx+member
+ $next (new Label)
+ $sub-else (new Label)])
+ (doseq [idx+member (&/->seq (&/zip2 (&/|range (&/|length ?members)) ?members))])))
(.visitInsn Opcodes/POP)
(.visitJumpInsn Opcodes/GOTO $target))
@@ -162,16 +168,19 @@
(let [ex-class (&host/->class "java.lang.IllegalStateException")]
(defn ^:private compile-pattern-matching [writer compile mappings patterns $end]
- ;; (prn 'compile-pattern-matching patterns)
- (let [entries (for [[?branch ?body] mappings
- :let [label (new Label)]]
- [[?branch label]
- [label ?body]])
- mappings* (into {} (map first entries))]
+ (prn 'compile-pattern-matching mappings patterns $end)
+ (let [entries (&/|map (fn [?branch+?body]
+ (|let [[?branch ?body] ?branch+?body
+ label (new Label)]
+ (&/T (&/T ?branch label)
+ (&/T label ?body))))
+ mappings)
+ mappings* (&/|map &/|first entries)]
(doto writer
- (-> (doto (compile-match ?match (get mappings* ?body) $else)
+ (-> (doto (compile-match ?match (&/|get ?body mappings*) $else)
(.visitLabel $else))
- (->> (doseq [[_ ?body ?match :as pattern] patterns
+ (->> (|let [[_ ?body ?match] ?body+?match])
+ (doseq [?body+?match (&/->seq patterns)
:let [;; _ (prn 'compile-pattern-matching/pattern pattern)
$else (new Label)]])))
(.visitInsn Opcodes/POP)
@@ -179,20 +188,22 @@
(.visitInsn Opcodes/DUP)
(.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
(.visitInsn Opcodes/ATHROW))
- (&/map% (fn [[?label ?body]]
- (exec [:let [_ (.visitLabel writer ?label)]
- ret (compile ?body)
- :let [_ (.visitJumpInsn writer Opcodes/GOTO $end)]]
- (return ret)))
- (map second entries))
+ (&/map% (fn [?label+?body]
+ (|let [[?label ?body] ?label+?body]
+ (exec [:let [_ (.visitLabel writer ?label)]
+ ret (compile ?body)
+ :let [_ (.visitJumpInsn writer Opcodes/GOTO $end)]]
+ (return ret))))
+ (&/|map &/|second entries))
)))
;; [Resources]
(defn compile-case [compile *type* ?variant ?base-register ?num-registers ?branches]
(exec [*writer* &/get-writer
:let [$end (new Label)]
- _ (compile ?variant)
- :let [[mappings patterns] (process-branches ?base-register ?branches)]
- _ (compile-pattern-matching *writer* compile mappings patterns $end)
- :let [_ (.visitLabel *writer* $end)]]
- (return nil)))
+ _ (compile ?variant)]
+ (|let [[mappings patterns] (process-branches ?base-register ?branches)]
+ (exec [_ (compile-pattern-matching *writer* compile mappings patterns $end)
+ :let [_ (.visitLabel *writer* $end)]]
+ (return nil)))
+ ))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 08a00b536..c14924efd 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -310,6 +310,7 @@
(&&/save-class! full-name (.toByteArray =class))))
(defn compile-jvm-interface [compile ?package ?name ?methods]
+ (prn 'compile-jvm-interface ?package ?name ?methods)
(let [parent-dir (&host/->package ?package)
full-name (str parent-dir "/" ?name)
=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
@@ -317,10 +318,12 @@
full-name nil "java/lang/Object" nil))
_ (do (doseq [[?method ?props] ?methods
:let [[?args ?return] (:type ?props)
- signature (str "(" (reduce str "" (map &host/->type-signature ?args)) ")" (&host/->type-signature ?return))]]
+ signature (str "(" (&/fold str "" (&/|map &host/->type-signature ?args)) ")" (&host/->type-signature ?return))
+ _ (prn 'signature signature)]]
(.visitMethod =interface (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) ?method signature nil nil))
(.visitEnd =interface)
(.mkdirs (java.io.File. (str "output/" parent-dir))))]
+ (prn 'SAVED_CLASS full-name)
(&&/save-class! full-name (.toByteArray =interface))))
(defn compile-exec [compile *type* ?exprs]
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 45a75337c..c249924ec 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -12,7 +12,8 @@
[host :as &host])
[lux.analyser.base :as &a]
(lux.compiler [base :as &&])
- :reload)
+ ;; :reload
+ )
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -24,11 +25,10 @@
(def ^:private <init>-return "V")
(def ^:private lambda-impl-signature
- (str (reduce str "(" clo-field-sig) ")"
- lambda-return-sig))
+ (str "(" clo-field-sig ")" lambda-return-sig))
(defn ^:private lambda-<init>-signature [env]
- (str "(" (reduce str "" (repeat (count env) clo-field-sig)) ")"
+ (str "(" (&/fold str "" (&/|repeat (&/|length env) clo-field-sig)) ")"
<init>-return))
(defn ^:private add-lambda-<init> [class class-name env]
@@ -40,9 +40,9 @@
(.visitVarInsn Opcodes/ALOAD (inc ?captured-id))
(.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
- (matchv ::M/objects [?captured]
- [["Expression" [["captured" [_ ?captured-id ?source]] _]]])
- (doseq [[?name ?captured] env])))
+ (matchv ::M/objects [?name+?captured]
+ [[?name ["Expression" [["captured" [_ ?captured-id ?source]] _]]]])
+ (doseq [?name+?captured (&/->seq env)])))
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
(.visitEnd)))
@@ -77,25 +77,28 @@
(return ret))))
(defn ^:private instance-closure [compile lambda-class closed-over init-signature]
+ (prn 'instance-closure lambda-class closed-over init-signature)
(exec [*writer* &/get-writer
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/NEW lambda-class)
(.visitInsn Opcodes/DUP))]
_ (->> closed-over
- (sort #(matchv ::M/objects [(second %1) (second %2)]
+ &/->seq
+ (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)]
[["Expression" [["captured" [_ ?cid1 _]] _]]
["Expression" [["captured" [_ ?cid2 _]] _]]]
(< ?cid1 ?cid2)))
- (&/map% (fn [[?name ?captured]]
- (matchv ::M/objects [?captured]
- [["Expression" [["captured" [_ _ ?source]] _]]]
- (compile ?source)))))
+ &/->list
+ (&/map% (fn [?name+?captured]
+ (matchv ::M/objects [?name+?captured]
+ [[?name ["Expression" [["captured" [_ _ ?source]] _]]]]
+ (compile ?source)))))
:let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]]
(return nil)))
;; [Exports]
(defn compile-lambda [compile ?scope ?env ?arg ?body]
- (prn 'compile-lambda ?scope ?arg)
+ (prn 'compile-lambda ?scope (&host/location ?scope) ?arg ?env)
(exec [:let [lambda-class (&host/location ?scope)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
@@ -103,10 +106,10 @@
(-> (doto (.visitField (+ Opcodes/ACC_PRIVATE Opcodes/ACC_FINAL) captured-name clo-field-sig nil nil)
(.visitEnd))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
- (matchv ::M/objects [?captured]
- [["Expression" [["captured" [_ ?captured-id ?source]] _]]])
- (doseq [[?name ?captured] ?env
- ;; :let [_ (prn '?captured ?captured)]
+ (matchv ::M/objects [?name+?captured]
+ [[?name ["Expression" [["captured" [_ ?captured-id ?source]] _]]]])
+ (doseq [?name+?captured (&/->seq ?env)
+ ;; :let [_ (prn '?captured ?name ?captured)]
])))
(add-lambda-apply lambda-class ?env)
(add-lambda-<init> lambda-class ?env)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 9ce0da213..22018808a 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -4,7 +4,7 @@
[template :refer [do-template]])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
- (lux [base :as & :refer [exec return* return fail fail*]]
+ (lux [base :as & :refer [exec return* return fail fail* |let]]
[type :as &type]
[lexer :as &lexer]
[parser :as &parser]
@@ -50,40 +50,42 @@
(defn compile-tuple [compile *type* ?elems]
(exec [*writer* &/get-writer
- :let [num-elems (count ?elems)
+ :let [num-elems (&/|length ?elems)
_ (doto *writer*
(.visitLdcInsn (int num-elems))
(.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
- _ (&/map% (fn [[idx elem]]
- (exec [:let [_ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int idx)))]
- ret (compile elem)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
- (return ret)))
- (map vector (range num-elems) ?elems))]
+ _ (&/map% (fn [idx+elem]
+ (|let [[idx elem] idx+elem]
+ (exec [:let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int idx)))]
+ ret (compile elem)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ (return ret))))
+ (&/zip2 (&/|range num-elems) ?elems))]
(return nil)))
(defn compile-record [compile *type* ?elems]
(exec [*writer* &/get-writer
- :let [num-elems (count ?elems)
+ :let [num-elems (&/|length ?elems)
_ (doto *writer*
(.visitLdcInsn (int (* 2 num-elems)))
(.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))]
- _ (&/map% (fn [[idx [k v]]]
- (exec [:let [idx* (* 2 idx)
- _ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int idx*))
- (.visitLdcInsn k)
- (.visitInsn Opcodes/AASTORE))]
- :let [_ (doto *writer*
- (.visitInsn Opcodes/DUP)
- (.visitLdcInsn (int (inc idx*))))]
- ret (compile v)
- :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
- (return ret)))
- (map vector (range num-elems) ?elems))]
+ _ (&/map% (fn [idx+kv]
+ (|let [[idx [k v]] idx+kv]
+ (exec [:let [idx* (* 2 idx)
+ _ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int idx*))
+ (.visitLdcInsn k)
+ (.visitInsn Opcodes/AASTORE))]
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (int (inc idx*))))]
+ ret (compile v)
+ :let [_ (.visitInsn *writer* Opcodes/AASTORE)]]
+ (return ret))))
+ (&/zip2 (&/|range num-elems) ?elems))]
(return nil)))
(defn compile-variant [compile *type* ?tag ?value]
@@ -119,7 +121,7 @@
(defn compile-global [compile *type* ?owner-class ?name]
(exec [*writer* &/get-writer
- :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]]
+ :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]]
(return nil)))
(defn compile-call [compile *type* ?fn ?args]
@@ -237,17 +239,22 @@
current-class nil "java/lang/Object" (into-array [(&host/->class &host/function-class)]))
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil)
(doto (.visitEnd))))]
+ :let [_ (prn 'compile-def/pre-body)]
_ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
(exec [*writer* &/get-writer
:let [_ (.visitCode *writer*)]
+ :let [_ (prn 'compile-def/pre-body2)]
_ (compile ?body)
+ :let [_ (prn 'compile-def/post-body2)]
:let [_ (doto *writer*
(.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig)
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
(.visitEnd))]]
(return nil)))
+ :let [_ (prn 'compile-def/post-body)]
:let [_ (.visitEnd *writer*)]
+ :let [_ (prn 'compile-def/_1 ?name current-class)]
_ (&&/save-class! current-class (.toByteArray =class))
- :let [_ (prn 'compile-def ?name)]]
+ :let [_ (prn 'compile-def/_2 ?name)]]
(return nil)))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 0becee945..e76f6625f 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -96,10 +96,10 @@
(defn extract-jvm-param [token]
(matchv ::M/objects [token]
- [["Ident" ?ident]]
+ [["Symbol" ?ident]]
(full-class-name ?ident)
- [["Form" ["Cons" [["Ident" "Array"] ["Cons" [["Ident" ?inner] ["Nil" _]]]]]]]
+ [["Form" ["Cons" [["Symbol" "Array"] ["Cons" [["Symbol" ?inner] ["Nil" _]]]]]]]
(exec [=inner (full-class-name ?inner)]
(return (str "[L" (->class =inner) ";")))
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 1c506950c..bebf9423e 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -75,7 +75,7 @@
^:private lex-bool "Bool" #"^(true|false)"
^:private lex-real "Real" #"^-?(0|[1-9][0-9]*)\.[0-9]+"
^:private lex-int "Int" #"^-?(0|[1-9][0-9]*)"
- ^:private lex-ident "Ident" +ident-re+)
+ ^:private lex-ident "Symbol" +ident-re+)
(def ^:private lex-char
(exec [_ (lex-prefix "#\"")
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index 49a636bd6..56d8eb38f 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -12,7 +12,8 @@
token &lexer/lex]
(matchv ::M/objects [token]
[[<close-token> _]]
- (return (&/|list (&/V <tag> (&/|concat elems))))
+ (return (&/|list (&/V <tag> (&/fold &/|++ (&/|list) elems))))
+
[_]
(fail (str "[Parser Error] Unbalanced " <description> ".")))))
@@ -23,7 +24,7 @@
(defn ^:private parse-record [parse]
(exec [elems* (&/repeat% parse)
token &lexer/lex
- :let [elems (&/|concat elems*)]]
+ :let [elems (&/fold &/|++ (&/|list) elems*)]]
(matchv ::M/objects [token]
[["Close_Brace" _]]
(fail (str "[Parser Error] Unbalanced braces."))
@@ -37,6 +38,7 @@
(def parse
(exec [token &lexer/lex
;; :let [_ (prn 'parse/token token)]
+ ;; :let [_ (prn 'parse (aget token 0))]
]
(matchv ::M/objects [token]
[["White_Space" _]]
@@ -60,8 +62,8 @@
[["Text" ?value]]
(return (&/|list (&/V "Text" ?value)))
- [["Ident" ?value]]
- (return (&/|list (&/V "Ident" ?value)))
+ [["Symbol" ?value]]
+ (return (&/|list (&/V "Symbol" ?value)))
[["Tag" ?value]]
(return (&/|list (&/V "Tag" ?value)))
@@ -69,9 +71,12 @@
[["Open_Paren" _]]
(parse-form parse)
- [["Open-Bracket" _]]
+ [["Open_Bracket" _]]
(parse-tuple parse)
- [["Open_Brace"]]
+ [["Open_Brace" _]]
(parse-record parse)
+
+ [_]
+ (fail "[Parser Error] Unknown lexer token.")
)))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index a59ef19ca..927110cc6 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -9,8 +9,13 @@
(defn ^:private deref [id]
(fn [state]
- (if-let [type (->> state (&/get$ "types") (&/get$ "mappings") (&/|get id))]
- (return* state type)
+ (if-let [type* (->> state (&/get$ "types") (&/get$ "mappings") (&/|get id))]
+ (matchv ::M/objects [type*]
+ [["Some" type]]
+ (return* state type)
+
+ [["None" _]]
+ (fail* (str "Unbound type-var: " id)))
(fail* (str "Unknown type-var: " id)))))
(defn ^:private reset [id type]
@@ -26,9 +31,9 @@
(def fresh-var
(fn [state]
(let [id (->> state (&/get$ "types") (&/get$ "counter"))]
- (return* (&/update$ "types" #(-> %
- (&/update$ "counter" inc)
- (&/update$ "mappings" (fn [ms] (&/|put id (&/V "None" nil) ms))))
+ (return* (&/update$ "types" #(->> %
+ (&/update$ "counter" inc)
+ (&/update$ "mappings" (fn [ms] (&/|put id (&/V "None" nil) ms))))
state)
(&/V "Var" id)))))
@@ -82,7 +87,7 @@
(def +list+
[::All (&/|list) "List" "a"
[::Variant (&/|list ["Cons" [::Tuple (&/|list [::Bound "a"] [::App [::Bound "List"] [::Bound "a"]])]]
- ["Nil" [::Tuple (&/|list)]])]])
+ ["Nil" [::Tuple (&/|list)]])]])
(def +type+
(let [text [::Data "java.lang.String" (&/|list)]
@@ -105,52 +110,58 @@
["All" [::Tuple (&/|list string=>type text text type)]]
)]])))
-(defn clean [type]
- (matchv ::M/objects [type]
- [["Var" ?id]]
- (exec [=type (deref ?id)]
- (clean =type))
-
- [["Lambda" [?arg ?return]]]
- (exec [=arg (clean ?arg)
- =return (clean ?return)]
- (return (&/V "Lambda" (to-array [=arg =return]))))
-
- [["App" [?lambda ?param]]]
- (exec [=lambda (clean ?lambda)
- =param (clean ?param)]
- (return (&/V "App" (to-array [=lambda =param]))))
-
- [["Tuple" ?members]]
- (exec [=members (&/map% clean ?members)]
- (return (&/V "Tuple" =members)))
-
- [["Variant" ?members]]
- (exec [=members (&/map% (fn [[k v]]
- (exec [=v (clean v)]
- (return (to-array [k =v]))))
- ?members)]
- (return (&/V "Variant" =members)))
-
- [["Record" ?members]]
- (exec [=members (&/map% (fn [[k v]]
- (exec [=v (clean v)]
+(defn clean [tvar type]
+ (matchv ::M/objects [tvar]
+ [["Var" ?tid]]
+ (matchv ::M/objects [type]
+ [["Var" ?id]]
+ (if (= ?tid ?id)
+ (&/try-all% (&/|list (exec [=type (deref ?id)]
+ (clean tvar =type))
+ (return type)))
+ (return type))
+
+ [["Lambda" [?arg ?return]]]
+ (exec [=arg (clean tvar ?arg)
+ =return (clean tvar ?return)]
+ (return (&/V "Lambda" (to-array [=arg =return]))))
+
+ [["App" [?lambda ?param]]]
+ (exec [=lambda (clean tvar ?lambda)
+ =param (clean tvar ?param)]
+ (return (&/V "App" (to-array [=lambda =param]))))
+
+ [["Tuple" ?members]]
+ (exec [=members (&/map% (partial clean tvar) ?members)]
+ (return (&/V "Tuple" =members)))
+
+ [["Variant" ?members]]
+ (exec [=members (&/map% (fn [[k v]]
+ (exec [=v (clean tvar v)]
+ (return (to-array [k =v]))))
+ ?members)]
+ (return (&/V "Variant" =members)))
+
+ [["Record" ?members]]
+ (exec [=members (&/map% (fn [[k v]]
+ (exec [=v (clean tvar v)]
+ (return (to-array [k =v]))))
+ ?members)]
+ (return (&/V "Record" =members)))
+
+ [["All" [?env ?name ?arg ?body]]]
+ (exec [=env (&/map% (fn [[k v]]
+ (exec [=v (clean tvar v)]
(return (to-array [k =v]))))
- ?members)]
- (return (&/V "Record" =members)))
-
- [["All" [?env ?name ?arg ?body]]]
- (exec [=env (&/map% (fn [[k v]]
- (exec [=v (clean v)]
- (return (to-array [k =v]))))
- ?env)]
- (return (&/V "All" (to-array [=env ?name ?arg ?body]))))
+ ?env)]
+ (return (&/V "All" (to-array [=env ?name ?arg ?body]))))
- [_]
- (return type)
- ))
+ [_]
+ (return type)
+ )))
(defn ^:private show-type [type]
+ (prn 'show-type (aget type 0))
(matchv ::M/objects [type]
[["Any" _]]
"Any"
@@ -206,6 +217,7 @@
(str "Type " (show-type expected) " does not subsume type " (show-type actual)))
(defn solve [expected actual]
+ (prn 'solve (aget expected 0) (aget actual 0))
(matchv ::M/objects [expected actual]
[["Any" _] _]
success
@@ -243,16 +255,20 @@
(solve e!output a!output))
[["Var" e!id] _]
- (exec [=e!type (deref e!id)
- _ (solve =e!type actual)
- _ (reset e!id =e!type)]
- success)
+ (&/try-all% (&/|list (exec [=e!type (deref e!id)
+ _ (solve =e!type actual)
+ _ (reset e!id =e!type)]
+ success)
+ (exec [_ (reset e!id actual)]
+ success)))
[_ ["Var" a!id]]
- (exec [=a!type (deref a!id)
- _ (solve expected =a!type)
- _ (reset a!id =a!type)]
- success)
+ (&/try-all% (&/|list (exec [=a!type (deref a!id)
+ _ (solve expected =a!type)
+ _ (reset a!id =a!type)]
+ success)
+ (exec [_ (reset a!id expected)]
+ success)))
[_ _]
(solve-error expected actual)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 14:18:38 +0000