diff options
Diffstat (limited to 'source')
| -rw-r--r-- | source/lux.lux | 1350 |
1 files changed, 675 insertions, 675 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'))) +## (#Cons [x xs']) +## (fold f (f init x) xs'))) -(def (reverse list) - (fold (lambda [tail head] - (#Cons [head tail])) - #Nil - list)) +## (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) +## (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] +## (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])])))) +## (#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')]) +## (def (as-pairs xs) +## (case' xs +## (#Cons [x (#Cons [y xs'])]) +## (#Cons [[x y] (as-pairs xs')]) - _ - #Nil)) +## _ +## #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)])))) +## (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 (. f g) +## (lambda [x] (f (g x)))) -(def (++ xs ys) - (case' xs - #Nil - ys +## (def (++ xs ys) +## (case' xs +## #Nil +## ys - (#Cons [x xs*]) - (#Cons [x (++ xs* ys)]))) +## (#Cons [x xs*]) +## (#Cons [x (++ xs* ys)]))) -(def concat - (fold ++ #Nil)) +## (def concat +## (fold ++ #Nil)) -(def (map f xs) - (case' xs - #Nil - #Nil +## (def (map f xs) +## (case' xs +## #Nil +## #Nil - (#Cons [x xs']) - (#Cons [(f x) (map f xs')]))) +## (#Cons [x xs']) +## (#Cons [(f x) (map f xs')]))) -(def flat-map (. concat map)) +## (def flat-map (. concat map)) -(def (untemplate-list tokens) - (case' tokens - #Nil - (#Tag "Nil") +## (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])])))) +## (#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))) +## (def (untemplate token) +## (case' token +## (#Bool value) +## (#Form (list (#Tag "Bool") (#Bool value))) - (#Int value) - (#Form (list (#Tag "Int") (#Int value))) +## (#Int value) +## (#Form (list (#Tag "Int") (#Int value))) - (#Real value) - (#Form (list (#Tag "Real") (#Real value))) +## (#Real value) +## (#Form (list (#Tag "Real") (#Real value))) - (#Char value) - (#Form (list (#Tag "Char") (#Char value))) +## (#Char value) +## (#Form (list (#Tag "Char") (#Char value))) - (#Text value) - (#Form (list (#Tag "Text") (#Text value))) +## (#Text value) +## (#Form (list (#Tag "Text") (#Text value))) - (#Tag value) - (#Form (list (#Tag "Tag") (#Text value))) +## (#Tag value) +## (#Form (list (#Tag "Tag") (#Text value))) - (#Ident value) - (#Form (list (#Tag "Ident") (#Text value))) +## (#Symbol value) +## (#Form (list (#Tag "Symbol") (#Text value))) - (#Tuple elems) - (#Form (list (#Tag "Tuple") (untemplate-list (map untemplate elems)))) +## (#Tuple elems) +## (#Form (list (#Tag "Tuple") (untemplate-list (map untemplate elems)))) - (#Form (#Cons [(#Ident "~") (#Cons [unquoted #Nil])])) - unquoted +## (#Form (#Cons [(#Symbol "~") (#Cons [unquoted #Nil])])) +## unquoted - (#Form elems) - (#Form (list (#Tag "Form") (untemplate-list (map untemplate elems)))) - )) +## (#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 (` 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))))]))) +## (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 +## (def (filter p xs) +## (case' xs +## #Nil +## #Nil - (#Cons [x xs*]) - (if (p x) - (filter p xs*) - (#Cons [x (filter p xs*)])))) +## (#Cons [x xs*]) +## (if (p x) +## (filter p xs*) +## (#Cons [x (filter p xs*)])))) -(def (return val) - (lambda [state] - (#Right [state val]))) +## (def (return val) +## (lambda [state] +## (#Right [state val]))) -(def (fail msg) - (lambda [_] - (#Left msg))) +## (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)))) +## (#Left msg) +## (#Left msg)))) -(def (first pair) - (case' pair - [f s] - f)) +## (def (first pair) +## (case' pair +## [f s] +## f)) -(def (second pair) - (case' pair - [f s] - s)) +## (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 (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 (export tokens) +## (return (map (lambda [t] (` (export' (~ t)))) +## tokens))) -(defmacro (and tokens) - (let [as-if (case' tokens - #Nil - (` true) +## (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)))) +## (#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) +## (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)))) +## (#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)) +## (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))) +## (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))))) +## _ +## (` ((~ app) (~ acc))))) +## init +## apps))))) -(defmacro ($ tokens) - (case' tokens - (#Cons [op (#Cons [init args])]) - (return (list (fold (lambda [acc elem] - (` ((~ op) (~ acc) (~ elem)))) - init - args))))) +## (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 (const x) +## (lambda [_] x)) -(def (int> x y) - (jvm-lgt x y)) +## (def (int> x y) +## (jvm-lgt x y)) -(def (int< x y) - (jvm-llt x y)) +## (def (int< x y) +## (jvm-llt x y)) -(def inc (int+ 1)) -(def dec (int+ -1)) +## (def inc (int+ 1)) +## (def dec (int+ -1)) -(def (repeat n x) - (if (int> n 0) - (#Cons [x (repeat (dec n) x)]) - #Nil)) +## (def (repeat n x) +## (if (int> n 0) +## (#Cons [x (repeat (dec n) x)]) +## #Nil)) -(def size - (fold (lambda [acc _] (inc acc)) 0)) +## (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 (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''])) +## (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]))))) +## _ +## (#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)))))) +## (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')) +## (def (interleave xs ys) +## (case' [xs ys] +## [(#Cons [x xs']) (#Cons [y ys'])] +## (list+ x y (interleave xs' ys')) - _ - #Nil)) +## _ +## #Nil)) -(def (interpose sep xs) - (case' xs - #Nil - xs +## (def (interpose sep xs) +## (case' xs +## #Nil +## xs - (#Cons [x #Nil]) - xs +## (#Cons [x #Nil]) +## xs - (#Cons [x xs']) - (list+ x sep (interpose sep xs')))) +## (#Cons [x xs']) +## (list+ x sep (interpose sep xs')))) -(def (empty? xs) - (case' xs - #Nil true - _ false)) +## (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')))) +## ## (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]) +## ## [every? and] +## ## [any? or]) -(def (range from to) - (if (int< from to) - (#Cons [from (range (inc from) to)]) - #Nil)) +## (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 (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')]) +## (def (zip2 xs ys) +## (case' [xs ys] +## [(#Cons [x xs']) (#Cons [y ys'])] +## (#Cons [[x y] (zip2 xs' ys')]) - _ - #Nil)) +## _ +## #Nil)) -(def (get key map) - (case' map - #Nil - #None +## (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')))) +## (#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 (get-ident x) +## (case' x +## (#Symbol ident) +## ident)) -(def (text-++ x y) - (jvm-invokevirtual java.lang.String "concat" [java.lang.String] - x [y])) +## (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 (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 +## (def (apply-template env template) +## (case' template +## (#Symbol ident) +## (case' (get ident env) +## (#Some subst) +## subst - _ - template) +## _ +## 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)))) +## (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>)) +## ## (do-template [<name> <offset>] +## ## (def <name> (int+ <offset>)) -## [inc 1] -## [dec -1]) +## ## [inc 1] +## ## [dec -1]) -(def (int= x y) - (jvm-leq x y)) +## (def (int= x y) +## (jvm-leq x y)) -(def (int% x y) - (jvm-lrem x y)) +## (def (int% x y) +## (jvm-lrem x y)) -(def (int>= x y) - (or (int= x y) - (int> 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)) +## (do-template [<name> <cmp>] +## (def (<name> x y) +## (if (<cmp> x y) +## x +## y)) - [max int>] - [min int<]) +## [max int>] +## [min int<]) -(do-template [<name> <cmp>] - (def (<name> n) (<cmp> n 0)) +## (do-template [<name> <cmp>] +## (def (<name> n) (<cmp> n 0)) - [neg? int<] - [pos? int>=]) +## [neg? int<] +## [pos? int>=]) -(def (even? n) - (int= 0 (int% n 0))) +## (def (even? n) +## (int= 0 (int% n 0))) -(def (odd? n) - (not (even? n))) +## (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>)) +## (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')]) +## [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))) +## (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')]) +## [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))) +## (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)))) +## (#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))) +## (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 (#Cons [value #Nil])]) +## (` (lambda [record] (set@' (~ tag) (~ value) record))) - (#Cons [tag #Nil]) - (` (lambda [value record] (set@' (~ tag) value record))))] - (return (list output)))) +## (#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_))) +## (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 (#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)))) +## (#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 (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)) "__"))])) +## (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>)) +## ## (do-template [<name> <member>] +## ## (def (<name> pair) +## ## (case' pair +## ## [f s] +## ## <member>)) -## [first f] -## [second s]) +## ## [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 []) - (#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))) ")") - )) +## (#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))))) +## (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 (map% f xs) +## (case' xs +## #Nil +## (return xs) - (#Cons [x xs']) - (do [y (f x) - ys (map% f xs')] - (return (#Cons [y ys]))))) +## (#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 ($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 ($or tokens) +## (case' tokens +## (#Cons [(#Tuple patterns) (#Cons [body #Nil])]) +## (return (flat-map (lambda [pattern] (list pattern body)) +## patterns)))) -(def null jvm-null) +## (def null jvm-null) -(defmacro (^ tokens) - (case' tokens - (#Cons [(#Ident class-name) #Nil]) - (return (list (` (#Data (~ (#Text class-name)))))))) +## (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) +## (return (list (#Form (list+ (#Tag "Tuple") (untemplate-list members)))))) -(defmacro (| members) - (let [members' (map (lambda [m] - (case' m - (#Tag tag) - [tag (` (#Tuple (list)))] +## (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))))))) +## (#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 (& 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))) +## (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) +## (def (replace-ident ident value syntax) +## (case' syntax +## (#Symbol test) +## (if (= test ident) +## value +## syntax) - (#Form members) - (#Form (map (replace-ident ident value) members)) +## (#Form members) +## (#Form (map (replace-ident ident value) members)) - (#Tuple members) - (#Tuple (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)) +## (#Record members) +## (#Record (map (lambda [kv] +## (case kv +## [k v] +## [k (replace-ident ident value v)])) +## members)) - _ - syntax)) +## _ +## syntax)) -(defmacro (All tokens) - (let [[name args body] (case' tokens - (#Cons [(#Ident name) (#Cons [(#Tuple args) (#Cons [body #Nil])])]) - [name args body] +## (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))))))))) +## (#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))))))) +## (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)) +## (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 (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 #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 (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 #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))))) +## (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)))) +## (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))))) +## (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] +## (#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] +## #Pattern +## (do [expansion (macro-expand piece)] +## (case' expansion +## #Nil +## [#Pattern #Nil #Nil] - (#Cons exp #Nil) - [#Body (list exp) #Nil] +## (#Cons exp #Nil) +## [#Body (list exp) #Nil] - (#Cons exp exps) - [#Body (list exp) exps])) - )] - (recur kind' (++ expanded new-pieces) (++ more-pieces pieces)))) - ))) +## (#Cons exp exps) +## [#Body (list exp) exps])) +## )] +## (recur kind' (++ expanded new-pieces) (++ more-pieces pieces)))) +## ))) -(def (defsyntax tokens) - ...) +## (def (defsyntax tokens) +## ...) -(deftype (State s a) - (-> s (, s a))) +## (deftype (State s a) +## (-> s (, s a))) -(deftype (Parser a) - (State (List Syntax) 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)]] +## (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]])) +## (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 (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)))))))) +## (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))))) +## (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)) +## (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]) |