From d1e7c4dd03a72a93dbca15cbc1b0ac29ab49efbc Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 16 Jan 2015 03:43:55 -0400
Subject: Fixed a bug in the ' macro.

---
 test2.lux | 144 +++++++++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 92 insertions(+), 52 deletions(-)

(limited to 'test2.lux')

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))
-- 
cgit v1.2.3