diff options
Diffstat (limited to 'source/lux.lux')
| -rw-r--r-- | source/lux.lux | 469 |
1 files changed, 246 insertions, 223 deletions
diff --git a/source/lux.lux b/source/lux.lux index f11e8031b..8c1cb5695 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -34,193 +34,163 @@ [java.lang.Object _7] [java.lang.Object _8]]) (jvm;class Variant java.lang.Object - [[java.lang.String tag]]) -(jvm;class Variant0 lux.Variant - []) -(jvm;class Variant1 lux.Variant - [[java.lang.Object _1]]) -(jvm;class Variant2 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2]]) -(jvm;class Variant3 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3]]) -(jvm;class Variant4 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4]]) -(jvm;class Variant5 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5]]) -(jvm;class Variant6 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6]]) -(jvm;class Variant7 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7]]) -(jvm;class Variant8 lux.Variant - [[java.lang.Object _1] [java.lang.Object _2] - [java.lang.Object _3] [java.lang.Object _4] - [java.lang.Object _5] [java.lang.Object _6] - [java.lang.Object _7] [java.lang.Object _8]]) + [[java.lang.String tag] [java.lang.Object value]]) ## Base functions & macros (def' let' (lambda' _ tokens (lambda' _ state (case' tokens - (#Cons lhs (#Cons rhs (#Cons body #Nil))) - [(#Cons (#Form (#Cons (#Ident "case'") (#Cons rhs (#Cons lhs (#Cons body #Nil))))) - #Nil) + (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) + [(#Cons [(#Form (#Cons [(#Ident "case'") (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) + #Nil]) state]) ))) -(def' lambda - (lambda' _ tokens - (lambda' _ state - (let' output (case' tokens - (#Cons (#Form (#Cons self (#Cons arg args'))) (#Cons body #Nil)) - (#Form (#Cons (#Ident "lambda'") - (#Cons self - (#Cons arg - (#Cons (case args' - #Nil - body - - _ - (#Form (#Cons (#Ident "lux;lambda") - (#Cons (#Form (#Cons (#Ident "_") args')) - (#Cons body #Nil))))) - #Nil)))))) - [(#Cons output #Nil) state]) - ))) -(declare-macro lambda) - -(def' def - (lambda (_ tokens state) - (let' output (case' tokens - (#Cons (#Ident name) (#Cons body #Nil)) - (#Form (#Cons (#Ident "def'") - (#Cons (#Ident name) - (#Cons body #Nil)))) - - (#Cons (#Form (#Cons (#Ident name) args)) - (#Cons body #Nil)) - (#Form (#Cons (#Ident "def'") - (#Cons (#Ident name) - (#Cons (#Form (#Cons (#Ident "lux:lambda") - (#Cons (#Form (#Cons (#Ident name) args)) - (#Cons body #Nil)))) - #Nil))))) - [(#Cons output #Nil) state]))) -(declare-macro def) - -(def (comment tokens state) - [#Nil state]) -(declare-macro comment) - -(def (+ x y) - (jvm;iadd x y)) - -(def (id x) - x) - -(def (print x) - (jvm;invokevirtual java.io.PrintStream "print" [Object] - (jvm;getstatic System out) [x])) - -(def (println x) - (jvm;invokevirtual java.io.PrintStream "println" [Object] - (jvm;getstatic System out) [x])) - -(def (fold f init xs) - (do (print "fold ") (print init) (print " ") (println xs) - (case' xs - #Nil - init +## (def' lambda +## (lambda' _ tokens +## (lambda' _ state +## (let' output (case' tokens +## (#Cons [(#Form (#Cons [self (#Cons [arg args'])])) (#Cons [body #Nil])]) +## (#Form (#Cons [(#Ident "lambda'") +## (#Cons [self +## (#Cons [arg +## (#Cons [(case args' +## #Nil +## body + +## _ +## (#Form (#Cons [(#Ident "lux;lambda") +## (#Cons [(#Form (#Cons [(#Ident "_") args'])) +## (#Cons [body #Nil])])]))) +## #Nil])])])]))) +## [(#Cons output #Nil) state]) +## ))) +## (declare-macro lambda) + +## (def' def +## (lambda (_ tokens state) +## (let' output (case' tokens +## (#Cons (#Ident name) (#Cons body #Nil)) +## (#Form (#Cons (#Ident "def'") +## (#Cons (#Ident name) +## (#Cons body #Nil)))) + +## (#Cons (#Form (#Cons (#Ident name) args)) +## (#Cons body #Nil)) +## (#Form (#Cons (#Ident "def'") +## (#Cons (#Ident name) +## (#Cons (#Form (#Cons (#Ident "lux:lambda") +## (#Cons (#Form (#Cons (#Ident name) args)) +## (#Cons body #Nil)))) +## #Nil))))) +## [(#Cons output #Nil) state]))) +## (declare-macro def) + +## (def (comment tokens state) +## [#Nil state]) +## (declare-macro comment) + +## (def (+ x y) +## (jvm;iadd x y)) + +## (def (id x) +## x) + +## (def (print x) +## (jvm;invokevirtual java.io.PrintStream "print" [Object] +## (jvm;getstatic System out) [x])) + +## (def (println x) +## (jvm;invokevirtual java.io.PrintStream "println" [Object] +## (jvm;getstatic System out) [x])) + +## (def (fold f init xs) +## (do (print "fold ") (print init) (print " ") (println xs) +## (case' xs +## #Nil +## init - (#Cons x xs') - (let' init' (f init x) - (do (print "init': ") (println init') - (fold f init' xs'))) - #((fold f (f init x) xs'))# - ))) - -(def (reverse list) - (do (print "reverse ") (println list) - (let' reversed (fold (lambda [tail head] - (do (print "reverse/0 ") (print "tail: ") (print tail) (print " head: ") (println head) - (#Cons head tail))) - #Nil - list) - (do (print "!reversed ") (println reversed) - reversed)))) - -(def (list xs state) - (let' xs' (reverse xs) - (let' output (fold (lambda [tail head] - (do (print "tail: ") (print tail) (print " head: ") (println head) - (#Form (#Cons (#Tag "Cons") - (#Cons head - (#Cons tail #Nil)))))) - (#Tag "Nil") - (do (print "REVERSED: ") (println xs') - xs')) - (do (print "output: ") (println output) - [(#Cons output #Nil) state])))) -(declare-macro list) - -(def (list+ xs state) - (case' (reverse xs) - #Nil - [#Nil state] - - (#Cons last init') - (let' output (fold (lambda [tail head] - (#Form (#Cons (#Tag "Cons") - (#Cons head tail)))) - last - init') - [(#Cons output #Nil) state]))) -(declare-macro list+) - -(def (->pairs xs) - (case' xs - (#Cons x (#Cons y xs')) - (#Cons [x y] (->pairs xs')) - - _ - #Nil)) - -(def (let tokens state) - (case' tokens - (#Cons (#Tuple bindings) (#Cons body #Nil)) - (let' output (fold (lambda [body binding] - (case binding - [label value] - (#Form (list (#Ident "let'") label value body)))) - body - (reverse (->pairs bindings))) - [(list output) state]))) -(declare-macro let) - -(def (++-list xs ys) - (case' xs - #Nil - ys - - (#Cons x xs*) - (#Cons x (++-list xs* ys)))) - -(def (map-list f xs) - (case' xs - #Nil - #Nil - - (#Cons x xs*) - (#Cons (f x) (map-list f xs*)))) +## (#Cons x xs') +## (let' init' (f init x) +## (do (print "init': ") (println init') +## (fold f init' xs'))) +## #((fold f (f init x) xs'))# +## ))) + +## (def (reverse list) +## (do (print "reverse ") (println list) +## (let' reversed (fold (lambda [tail head] +## (do (print "reverse/0 ") (print "tail: ") (print tail) (print " head: ") (println head) +## (#Cons head tail))) +## #Nil +## list) +## (do (print "!reversed ") (println reversed) +## reversed)))) + +## (def (list xs state) +## (let' xs' (reverse xs) +## (let' output (fold (lambda [tail head] +## (do (print "tail: ") (print tail) (print " head: ") (println head) +## (#Form (#Cons (#Tag "Cons") +## (#Cons head +## (#Cons tail #Nil)))))) +## (#Tag "Nil") +## (do (print "REVERSED: ") (println xs') +## xs')) +## (do (print "output: ") (println output) +## [(#Cons output #Nil) state])))) +## (declare-macro list) + +## (def (list+ xs state) +## (case' (reverse xs) +## #Nil +## [#Nil state] + +## (#Cons last init') +## (let' output (fold (lambda [tail head] +## (#Form (#Cons (#Tag "Cons") +## (#Cons head tail)))) +## last +## init') +## [(#Cons output #Nil) state]))) +## (declare-macro list+) + +## (def (->pairs xs) +## (case' xs +## (#Cons x (#Cons y xs')) +## (#Cons [x y] (->pairs xs')) + +## _ +## #Nil)) + +## (def (let tokens state) +## (case' tokens +## (#Cons (#Tuple bindings) (#Cons body #Nil)) +## (let' output (fold (lambda [body binding] +## (case binding +## [label value] +## (#Form (list (#Ident "let'") label value body)))) +## body +## (reverse (->pairs bindings))) +## [(list output) state]))) +## (declare-macro let) + +## (def (++-list xs ys) +## (case' xs +## #Nil +## ys + +## (#Cons x xs*) +## (#Cons x (++-list xs* ys)))) + +## (def (map-list f xs) +## (case' xs +## #Nil +## #Nil + +## (#Cons x xs*) +## (#Cons (f x) (map-list f xs*)))) #( (def (untemplate-list untemplate tokens) @@ -763,95 +733,95 @@ n #( (deftype (Session i o s) - (All [s' r] - (-> (-> i s' r) - (-> o s [i s']) - r)) - - (All [s' s''] (-> (-> c s' [p s'']) - (-> [] s [c s']) (Session c p s) - [p s''])) - (All [] (-> (-> c s p) - (-> p []))) - (All [r] (-> c (Session r p s) p))) +(All [s' r] +(-> (-> i s' r) +(-> o s [i s']) +r)) + +(All [s' s''] (-> (-> c s' [p s'']) +(-> [] s [c s']) (Session c p s) +[p s''])) +(All [] (-> (-> c s p) +(-> p []))) +(All [r] (-> c (Session r p s) p))) (Session Int [] (Session Int (Session [] Int <END>))) (bind (session' []) - (lambda [x session'] - (bind (session' []) - (lambda [y session''] - (session'' (+ x y)))))) +(lambda [x session'] +(bind (session' []) +(lambda [y session''] +(session'' (+ x y)))))) (defstruct SessionMonad - (Monad Session) - (def (return v) - (lambda [k session] - (k v session))) - (def (bind step m-value) - (lambda [k session] - (let [[v session'] (m-value [] session)] - (k (step v) session'))))) +(Monad Session) +(def (return v) +(lambda [k session] +(k v session))) +(def (bind step m-value) +(lambda [k session] +(let [[v session'] (m-value [] session)] +(k (step v) session'))))) ## Not really "do"; but oh, well... (deftype <NIL> - (| #Nil)) +(| #Nil)) (deftype (HList h t) - (| (#Cons h t))) +(| (#Cons h t))) (deftype (Session c p s) - (All [r] (-> c (-> p s r) r))) +(All [r] (-> c (-> p s r) r))) (deftype (Session c p s) - (-> (-> p s c) c)) +(-> (-> p s c) c)) (deftype (? r s) - (Session r [] s)) +(Session r [] s)) (deftype (! w s) - (Session [] w s)) +(Session [] w s)) (deftype #rec <END> - (Session [] [] <END>)) +(Session [] [] <END>)) (def << - (lambda [k session] - (k [] session))) +(lambda [k session] +(k [] session))) (def (>> val) - (lambda [k session] - (session val k))) +(lambda [k session] +(session val k))) (<$> << (>> 5)) (def (<$> consumer producer) - (producer [] consumer)) +(producer [] consumer)) (HList Int (HList Int <NIL>)) (<.> (? Int) (? Int) (! Int) <END>) (def fn-session - (do [x << - y <<] - (>> (+ x y)))) +(do [x << +y <<] +(>> (+ x y)))) (<.> (! Int) (! Int) (? Int) <END>) (def call-session - (do [_ (>> 5) - _ (>> 10)] - <<)) +(do [_ (>> 5) +_ (>> 10)] +<<)) (<$> fn-session call-session) (def << - (lambda [chan] - (chan (lambda [])))) +(lambda [chan] +(chan (lambda [])))) (def (>> value) - (lambda [chan] - (chan value))) +(lambda [chan] +(chan value))) )# ## (defsig (Equal a) @@ -875,7 +845,7 @@ n ## (defstruct (ListShow x) ## [&show (Show a)] ## (Show (List a)) - + ## (def (show xs) ## (<> "(" (interpose ", " (map (:: &show show) xs)) ")"))) @@ -884,3 +854,56 @@ n ## {#show (lambda show [xs] ## (<> "(" (interpose ", " (map (:: &show show) xs)) ")"))}) ## (-> (Show a) (Show (List a))))) + +## (deftype (Identity a) a) + +## (deftype (List a) +## (| #Nil +## (#Cons a (List a)))) + +## (def (ListT m) +## (All [a] (List (m a)))) + +## (ListT Identity) + +## (defsig (Monad m) +## (: return (All [a] (-> a (m a)))) +## (: bind (All [a b] (-> (-> a (m b)) (m a) (m b))))) + +## (def Monad +## (All [m] +## (sig (: return (All [a] (-> a (m a)))) +## (: bind (All [a b] (-> (-> a (m b)) (m a) (m b))))))) + +## (defstruct Monad<Identity> (Monad Identity) +## (def (return x) +## x) +## (def (bind f x) +## (f x))) + +## (: Monad<Identity> (Monad Identity)) +## (def Monad<Identity> +## (struct +## (def (return x) +## x) +## (def (bind f x) +## (f x)))) + +## (defstruct Monad<List> (All [m] (-> (Monad m) +## (Monad (ListT m)))) +## (def (return x) +## (list x)) +## (def (bind f xs) +## (case xs +## #Nil #Nil +## (#Cons x xs') (#Cons (f x) (bind f xs'))))) + +## (deftype #rec Type +## ($data #Any +## #Nothing +## (#Data Text (List Type)) +## (#Lambda Type Type) +## (#All (List [Text Type]) Text Text Type) +## (#Exists (List [Text Type]) Text Type) +## (#Lookup Text) +## (#Var Int))) |