aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to 'source')
-rw-r--r--source/lux.lux469
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)))