diff options
Diffstat (limited to '')
| -rw-r--r-- | source/lux.lux | 836 |
1 files changed, 420 insertions, 416 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 |