aboutsummaryrefslogtreecommitdiff
path: root/test2.lux
diff options
context:
space:
mode:
authorEduardo Julian2015-01-16 03:43:55 -0400
committerEduardo Julian2015-01-16 03:43:55 -0400
commitd1e7c4dd03a72a93dbca15cbc1b0ac29ab49efbc (patch)
tree46ac79134b26c46e97d2cec2e797f6a54961bced /test2.lux
parentb0b17a0270fdad3e890cf00bab399fd8dac80fa9 (diff)
Fixed a bug in the ' macro.
Diffstat (limited to 'test2.lux')
-rw-r--r--test2.lux144
1 files changed, 92 insertions, 52 deletions
diff --git a/test2.lux b/test2.lux
index af17b4c7a..d24c9d10b 100644
--- a/test2.lux
+++ b/test2.lux
@@ -75,30 +75,21 @@
(jvm/invokevirtual java.io.PrintStream "println" [Object]
(jvm/getstatic System out) [x]))
-(def (++ xs ys)
+(defmacro (list xs)
(case xs
#Nil
- ys
+ (#Tag "Nil")
(#Cons x xs*)
- (#Cons x (++ xs* ys))))
+ (#Form (#Cons (#Tag "Cons") (#Cons x (#Cons (list xs*) #Nil))))))
-(def (template elems)
- (case elems
+(def (++ xs ys)
+ (case xs
#Nil
- elems
-
- (#Cons head tail)
- (case head
- (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil)))
- (#Cons unquoted (template tail))
-
- (#Form (#Cons (#Ident "~@") (#Cons spliced #Nil)))
- (#Cons (#Ident "++") (#Cons spliced (template tail)))
+ ys
- _
- (#Cons head (template tail))
- )))
+ (#Cons x xs*)
+ (#Cons x (++ xs* ys))))
(def (map f xs)
(case xs
@@ -108,42 +99,51 @@
(#Cons x xs*)
(#Cons (f x) (map f xs*))))
-(def (convert-list f xs)
- (case xs
+(def (untemplate-list untemplate tokens)
+ (case tokens
#Nil
(#Tag "Nil")
- (#Cons x xs*)
- (#Form (#Cons (#Tag "Cons") (#Cons (f x) (#Cons (convert-list f xs*) #Nil))))))
+ (#Cons token tokens')
+ (#Form (list (#Tag "Cons") (untemplate token) (untemplate-list untemplate tokens')))))
-(def (convert token)
+(def (untemplate token)
(case token
- (#Tag tag)
- (#Form (#Cons (#Tag "Tag") (#Cons (#Text tag) #Nil)))
+ (#Bool elem)
+ (#Form (list (#Tag "Bool") (#Bool elem)))
+
+ (#Int elem)
+ (#Form (list (#Tag "Int") (#Int elem)))
+
+ (#Real elem)
+ (#Form (list (#Tag "Real") (#Real elem)))
+
+ (#Char elem)
+ (#Form (list (#Tag "Char") (#Char elem)))
+
+ (#Text elem)
+ (#Form (list (#Tag "Text") (#Text elem)))
+
+ (#Tag elem)
+ (#Form (list (#Tag "Tag") (#Text elem)))
- (#Text text)
- (#Form (#Cons (#Tag "Text") (#Cons (#Text text) #Nil)))
+ (#Ident elem)
+ (#Form (list (#Tag "Ident") (#Text elem)))
- (#Ident ident)
- (#Form (#Cons (#Tag "Ident") (#Cons (#Text ident) #Nil)))
+ (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil)))
+ unquoted
(#Tuple elems)
- (#Form (#Cons (#Tag "Tuple") (#Cons (convert-list convert elems) #Nil)))
+ (#Form (list (#Tag "Tuple") (untemplate-list untemplate elems)))
(#Form elems)
- (#Form (#Cons (#Tag "Form") (#Cons (convert-list convert elems) #Nil)))
+ (#Form (list (#Tag "Form") (untemplate-list untemplate elems)))
))
(defmacro (' form)
(case form
- (#Cons form* #Nil)
- (case form*
- (#Form elems)
- (convert (#Form (template elems)))
-
- _
- (convert form)
- )))
+ (#Cons token #Nil)
+ (untemplate token)))
## Utils
(def (fail* message)
@@ -170,12 +170,6 @@
_
inputs))))
-## Ideally, this is what I want...
-## (exec [yolo lol
-## #let [foo (bar 1 2 3)]
-## #when true]
-## (meme yolo foo))
-
(def (+ x y)
(jvm/i+ x y))
@@ -208,13 +202,10 @@
_
#Nil))
-(defmacro (list xs)
- (case xs
- #Nil
- (#Tag "Nil")
-
- (#Cons x xs*)
- (#Form (#Cons (#Tag "Cons") (#Cons x (#Cons (list xs*) #Nil))))))
+## Ideally, this is what I want...
+## (exec [yolo lol
+## #let [foo (bar 1 2 3)]]
+## (meme yolo foo))
(defmacro (exec tokens)
(case tokens
@@ -229,6 +220,55 @@
(as-pairs steps))
(#Text "Oh no!"))))
+(def (try-m monad)
+ (lambda [state]
+ (case (monad state)
+ (#Ok [?state ?datum])
+ (return* ?state (#Just ?datum))
+
+ (#Failure _)
+ (return* state #Nothing))))
+
+(def (repeat-m monad)
+ (lambda [state]
+ (case (monad state)
+ (#Ok [?state ?head])
+ (case ((repeat-m monad) ?state)
+ (#Ok [?state* ?tail])
+ (return* ?state* (#Cons ?head ?tail)))
+
+ (#Failure ?message)
+ (return* state #Nil))))
+
+(def (try-all-m monads)
+ (lambda [state]
+ (case monads
+ #Nil
+ (fail* "No alternative worked!")
+ (#Cons monad monads')
+ (let output (monad state)
+ (case output
+ (#Ok _)
+ output
+
+ (#Failure _)
+ (case monads'
+ #Nil
+ output
+ (#Cons _ _)
+ ((try-all-m monads') state))
+ ))
+ )))
+
+(def (map-m f inputs)
+ (case inputs
+ #Nil
+ (return #Nil)
+ (#Cons input inputs')
+ (exec [output (f input)
+ outputs (map-m f inputs')]
+ (return (#Cons output outputs)))))
+
(def (cons tail head)
(#Cons head tail))
@@ -257,7 +297,7 @@
## Program
(def (main args)
(case (' ((~ "Oh yeah...")))
- (#Form (#Cons (#Text text) #Nil))
+ (#Form (#Cons text #Nil))
(do (println text)
(println (+ 10 20))
(println (inc 10))