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