aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux836
-rw-r--r--src/lux/analyser.clj4
-rw-r--r--src/lux/analyser/case.clj2
-rw-r--r--src/lux/analyser/host.clj4
-rw-r--r--src/lux/analyser/lux.clj11
-rw-r--r--src/lux/base.clj7
-rw-r--r--src/lux/compiler.clj9
-rw-r--r--src/lux/compiler/case.clj11
-rw-r--r--src/lux/compiler/host.clj7
-rw-r--r--src/lux/compiler/lambda.clj4
-rw-r--r--src/lux/compiler/lux.clj4
-rw-r--r--src/lux/macro.clj2
-rw-r--r--src/lux/type.clj110
13 files changed, 513 insertions, 498 deletions
diff --git a/source/lux.lux b/source/lux.lux
index ccc1476de..427057386 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -312,282 +312,282 @@
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
+(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
-## (#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)
+ (#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))
+ (#Tuple elems)
+ (#Tuple (map (apply-template env) elems))
-## (#Form elems)
-## (#Form (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))
+ (#Record members)
+ (#Record (map (lambda [kv]
+ (case' kv
+ [slot value]
+ [(apply-template env slot) (apply-template env value)]))
+ members))
-## _
-## template))
+ _
+ 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 []))
+(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
+## (def gensym
## (lambda [state]
## [(update@ #gen-seed inc state)
## (#Symbol ($ text-++ "__" (show-int (get@ #gen-seed state)) "__"))]))
@@ -601,168 +601,172 @@
## ## [first f]
## ## [second s])
-## (def (show-syntax syntax)
-## (case' syntax
-## (#Bool value)
-## (jvm-invokevirtual java.lang.Object "toString" []
-## value [])
+(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 [])
-## (#Symbol 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))) ")")
-## ))
+ (#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))))
+(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)
-## (def null jvm-null)
+ (#Cons [x xs'])
+ (do [y (f x)
+ ys (map% f xs')]
+ (return (#Cons [y ys])))))
-## (defmacro (^ tokens)
-## (case' tokens
-## (#Cons [(#Symbol class-name) #Nil])
-## (return (list (` (#Data (~ (#Text class-name))))))))
+(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))))
-## (defmacro (, members)
-## (return (list (#Form (list+ (#Tag "Tuple") (untemplate-list members))))))
+(def null jvm-null)
-## (defmacro (| members)
-## (let [members' (map (lambda [m]
-## (case' m
-## (#Tag tag)
-## [tag (` (#Tuple (list)))]
+(defmacro (^ tokens)
+ (case' tokens
+ (#Cons [(#Symbol class-name) #Nil])
+ (return (list (` (#Data [(~ (#Text class-name)) (list)]))))))
+
+(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
-## (#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]
+ (#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 (text= x y)
+ (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object]
+ x [y]))
+
+(def (replace-ident ident value syntax)
+ (case' syntax
+ (#Symbol test)
+ (if (text= 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
-## (#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 Bool (^ java.lang.Boolean))
-## (def Int (^ java.lang.Long))
-## (def Real (^ java.lang.Double))
-## (def Char (^ java.lang.Character))
-## (def Text (^ java.lang.String))
+ (#Cons [(#Tuple args) (#Cons [body #Nil])])
+ ["" args body])
+ rolled (fold (lambda [body arg]
+ (case' arg
+ (#Symbol arg-name)
+ (` (#All (list) (~ (#Text "")) (~ (#Text arg-name)) (~ (replace-ident arg-name (` (#Bound (~ (#Text arg-name))))
+ body))))))
+ body args)]
+ (case' rolled
+ (#Form (#Cons [(#Tag "All") (#Cons [env (#Cons [(#Test "") (#Cons [(#Text arg-name) (#Cons [body #Nil])])])])]))
+ (return (list (` (#All (~ env) (~ (#Text name)) (~ (#Text arg-name))
+ (~ (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 Bool (^ java.lang.Boolean))
+(def Int (^ java.lang.Long))
+(def Real (^ java.lang.Double))
+(def Char (^ java.lang.Character))
+(def Text (^ java.lang.String))
## (deftype (List a)
## (| #Nil
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index a4c1a3836..1497a990f 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -403,13 +403,13 @@
[["Form" ["Cons" [?fn ?args]]]]
(fn [state]
- (prn '(&/show-ast ?fn) (&/show-ast ?fn))
+ ;; (prn '(&/show-ast ?fn) (&/show-ast ?fn))
(matchv ::M/objects [((&&/analyse-1 (analyse-ast eval!) ?fn) state)]
[["Right" [state* =fn]]]
((&&lux/analyse-apply (analyse-ast eval!) =fn ?args) state*)
[_]
- (do (prn 'analyse-ast/token (aget token 0) (&/show-state state))
+ (do ;; (prn 'analyse-ast/token (aget token 0) (&/show-state state))
((analyse-basic-ast (analyse-ast eval!) eval! token) state))))
[_]
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 93036daa6..db96dbf2f 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -24,7 +24,7 @@
(defn analyse-branch [analyse max-registers bindings+body]
(|let [[bindings body] bindings+body]
- (do (prn 'analyse-branch max-registers (&/|length bindings) body)
+ (do ;; (prn 'analyse-branch max-registers (&/|length bindings) body)
(&/fold (fn [body* name]
(&&/with-var
(fn [=var]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 5379b225e..34d3fa1bc 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -167,7 +167,7 @@
(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)
+ ;; (prn 'analyse-jvm-interface ?name ?members)
(exec [=members (&/map% (fn [member]
;; (prn 'analyse-jvm-interface (&/show-ast member))
(matchv ::M/objects [member]
@@ -185,7 +185,7 @@
[_]
(fail "[Analyser Error] Invalid method signature!")))
?members)
- :let [_ (prn '=members =members)
+ :let [;; _ (prn '=members =members)
=methods (into {} (for [[method [inputs output]] (&/->seq =members)]
[method {:access :public
:type [inputs output]}]))]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index edf707adc..d30096ab1 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -127,15 +127,16 @@
))
(defn analyse-case [analyse ?value ?branches]
- (prn 'analyse-case (aget ?branches 0) (aget ?branches 1 1 0)
- (&/->seq ?branches))
+ ;; (prn 'analyse-case (aget ?branches 0) (aget ?branches 1 1 0)
+ ;; (&/->seq ?branches))
(exec [:let [num-branches (&/|length ?branches)
- _ (prn 'analyse-case ?value (&/|length ?branches)
- (and (> num-branches 0) (even? num-branches)))]
+ ;; _ (prn 'analyse-case ?value (&/|length ?branches)
+ ;; (and (> num-branches 0) (even? num-branches)))
+ ]
_ (&/assert! (and (> num-branches 0) (even? num-branches))
"[Analyser Error] Unbalanced branches in \"case'\" expression.")
:let [branches (&/|as-pairs ?branches)
- _ (prn '(&/|length branches) (&/|length branches))
+ ;; _ (prn '(&/|length branches) (&/|length 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])]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 661451714..e4fc5b98f 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -64,7 +64,7 @@
(reduce (fn [table [k v]]
`(|put ~k ~v ~table))
`(|list)
- (partition 2 elems)))
+ (reverse (partition 2 elems))))
(defn |get [slot table]
;; (prn '|get slot (aget table 0))
@@ -515,7 +515,10 @@
(def get-top-local-env
(fn [state]
- (return* state (|head (get$ "local-envs" state)))))
+ (try (let [top (|head (get$ "local-envs" state))]
+ (return* state top))
+ (catch Throwable _
+ (fail "No local environment.")))))
(def get-current-module-env
(fn [state]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 586727b15..395d12779 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -318,7 +318,7 @@
;; (prn 'compile-statement syntax)
(matchv ::M/objects [syntax]
[["Statement" ?form]]
- (do (prn 'compile-statement (aget syntax 0) (aget ?form 0))
+ (do ;; (prn 'compile-statement (aget syntax 0) (aget ?form 0))
(matchv ::M/objects [?form]
[["def" [?name ?body]]]
(&&lux/compile-def compile-expression ?name ?body)
@@ -378,7 +378,7 @@
(&/update$ "modules" #(&/|put name &a-def/init-module %))))]
[["Right" [?state ?vals]]]
(do (.visitEnd =class)
- (prn 'compile-module 'DONE name)
+ ;; (prn 'compile-module 'DONE name)
;; (prn 'compile-module/?vals ?vals)
(&/run-state (&&/save-class! name (.toByteArray =class)) ?state))
@@ -390,7 +390,10 @@
(.mkdir (java.io.File. "output"))
(matchv ::M/objects [(&/run-state (&/map% compile-module modules) (&/init-state nil))]
[["Right" [?state _]]]
- (println (str "Compilation complete! " (pr-str modules)))
+ (println (str "Compilation complete! " (str "[" (->> modules
+ (&/|interpose " ")
+ (&/fold str ""))
+ "]")))
[["Left" ?message]]
(do (prn 'compile-all '?message ?message)
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 22349bbca..b54d2e83a 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -40,10 +40,10 @@
[["Tuple" ?members]]
(|let [[register* =members] (&/fold (fn [register+=members member]
- (prn 'register+=members (alength register+=members))
+ ;; (prn 'register+=members (alength register+=members))
(|let [[_register =members] register+=members
[__register =member] (let [matched (->match $body _register member)]
- (prn 'matched (alength matched))
+ ;; (prn 'matched (alength matched))
matched)]
(&/T __register (&/|cons =member =members))))
(&/T register (&/|list))
@@ -186,7 +186,7 @@
(->> (|let [["Pattern" [?body ?match]] ?body+?match])
(doseq [?body+?match (&/->seq patterns)
:let [;; _ (prn 'compile-pattern-matching/pattern pattern)
- _ (prn '?body+?match (alength ?body+?match) (aget ?body+?match 0))
+ ;; _ (prn '?body+?match (alength ?body+?match) (aget ?body+?match 0))
$else (new Label)]])))
(.visitInsn Opcodes/POP)
(.visitTypeInsn Opcodes/NEW ex-class)
@@ -204,12 +204,13 @@
;; [Resources]
(defn compile-case [compile *type* ?variant ?base-register ?num-registers ?branches]
- (prn 'compile-case ?variant ?base-register ?num-registers (&/|length ?branches))
+ ;; (prn 'compile-case ?variant ?base-register ?num-registers (&/|length ?branches))
(exec [*writer* &/get-writer
:let [$end (new Label)]
_ (compile ?variant)]
(|let [[mappings patterns] (process-branches ?base-register ?branches)
- _ (prn '[(&/|length mappings) (&/|length patterns)] [(&/|length mappings) (&/|length patterns)])]
+ ;; _ (prn '[(&/|length mappings) (&/|length patterns)] [(&/|length mappings) (&/|length patterns)])
+ ]
(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 09e772ff8..4789a9b7e 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -311,7 +311,7 @@
(&&/save-class! full-name (.toByteArray =class))))
(defn compile-jvm-interface [compile ?package ?name ?methods]
- (prn 'compile-jvm-interface ?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)
@@ -320,11 +320,12 @@
_ (do (doseq [[?method ?props] ?methods
:let [[?args ?return] (:type ?props)
signature (str "(" (&/fold str "" (&/|map &host/->type-signature ?args)) ")" (&host/->type-signature ?return))
- _ (prn 'signature signature)]]
+ ;; _ (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)
+ ;; (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 c249924ec..2b9913fe9 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -77,7 +77,7 @@
(return ret))))
(defn ^:private instance-closure [compile lambda-class closed-over init-signature]
- (prn 'instance-closure 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)
@@ -98,7 +98,7 @@
;; [Exports]
(defn compile-lambda [compile ?scope ?env ?arg ?body]
- (prn 'compile-lambda ?scope (&host/location ?scope) ?arg ?env)
+ ;; (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)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index c1763818d..412055956 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -241,9 +241,9 @@
_ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil)
(exec [*writer* &/get-writer
:let [_ (.visitCode *writer*)]
- :let [_ (prn 'compile-def/pre-body2)]
+ ;; :let [_ (prn 'compile-def/pre-body2)]
_ (compile ?body)
- :let [_ (prn 'compile-def/post-body2)]
+ ;; :let [_ (prn 'compile-def/post-body2)]
:let [_ (doto *writer*
(.visitFieldInsn Opcodes/PUTSTATIC current-class "_datum" datum-sig)
(.visitInsn Opcodes/RETURN)
diff --git a/src/lux/macro.clj b/src/lux/macro.clj
index 91d71cf39..d31c22d78 100644
--- a/src/lux/macro.clj
+++ b/src/lux/macro.clj
@@ -6,7 +6,7 @@
;; [Resources]
(defn expand [loader macro-class tokens]
(fn [state]
- (prn 'expand macro-class tokens state)
+ ;; (prn 'expand macro-class tokens state)
(-> (.loadClass loader macro-class)
(.getField "_datum")
(.get nil)
diff --git a/src/lux/type.clj b/src/lux/type.clj
index a77baf191..a142aba8e 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -219,61 +219,63 @@
(defn solve [expected actual]
;; (prn 'solve expected actual)
;; (prn 'solve (aget expected 0) (aget actual 0))
- (matchv ::M/objects [expected actual]
- [["Any" _] _]
- success
-
- [_ ["Nothing" _]]
- success
-
- [["Data" [e!name e!params]] ["Data" [a!name a!params]]]
- (if (or (= e!name a!name)
- (.isAssignableFrom (Class/forName e!name) (Class/forName a!name)))
- success
- (fail (str "not (" actual " <= " expected ")")))
+ success
+ ;; (matchv ::M/objects [expected actual]
+ ;; [["Any" _] _]
+ ;; success
+
+ ;; [_ ["Nothing" _]]
+ ;; success
+
+ ;; [["Data" [e!name e!params]] ["Data" [a!name a!params]]]
+ ;; (if (or (= e!name a!name)
+ ;; (.isAssignableFrom (Class/forName e!name) (Class/forName a!name)))
+ ;; success
+ ;; (fail (str "not (" actual " <= " expected ")")))
- [["Tuple" e!elems] ["Tuple" a!elems]]
- (exec [_ (assert! (= (&/|length e!elems) (&/|length a!elems))
- "Tuples must have matching element sizes.")
- _ (&/map% (fn [n g] (solve n g))
- (&/zip2 e!elems a!elems))]
- success)
-
- [["Variant" e!cases] ["Variant" a!cases]]
- (exec [_ (&/map% (fn [slot]
- (solve (&/|get e!cases slot) (&/|get a!cases slot)))
- (&/|keys a!cases))]
- success)
-
- [["Record" e!fields] ["Record" a!fields]]
- (exec [_ (&/map% (fn [slot]
- (solve (&/|get e!fields slot) (&/|get a!fields slot)))
- (&/|keys e!fields))]
- success)
-
- [["Lambda" [e!input e!output]] ["Lambda" [a!input a!output]]]
- (exec [_ (solve a!input e!input)]
- (solve e!output a!output))
-
- [["Var" e!id] _]
- (&/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]]
- (&/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)
- ))
+ ;; [["Tuple" e!elems] ["Tuple" a!elems]]
+ ;; (exec [_ (assert! (= (&/|length e!elems) (&/|length a!elems))
+ ;; "Tuples must have matching element sizes.")
+ ;; _ (&/map% (fn [n g] (solve n g))
+ ;; (&/zip2 e!elems a!elems))]
+ ;; success)
+
+ ;; [["Variant" e!cases] ["Variant" a!cases]]
+ ;; (exec [_ (&/map% (fn [slot]
+ ;; (solve (&/|get e!cases slot) (&/|get a!cases slot)))
+ ;; (&/|keys a!cases))]
+ ;; success)
+
+ ;; [["Record" e!fields] ["Record" a!fields]]
+ ;; (exec [_ (&/map% (fn [slot]
+ ;; (solve (&/|get e!fields slot) (&/|get a!fields slot)))
+ ;; (&/|keys e!fields))]
+ ;; success)
+
+ ;; [["Lambda" [e!input e!output]] ["Lambda" [a!input a!output]]]
+ ;; (exec [_ (solve a!input e!input)]
+ ;; (solve e!output a!output))
+
+ ;; [["Var" e!id] _]
+ ;; (&/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]]
+ ;; (&/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)
+ ;; )
+ )
(let [&& #(and %1 %2)]
(defn merge [x y]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-28 06:49:06 +0000