From a14d86d958af652f7bc4ce669dffcc100d2a084c Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 19 Jan 2015 01:45:02 -0400
Subject: [Enhancements] Source code is looked-up inside a "source" directory.

---
 another.lux          |   4 -
 source/another.lux   |   4 +
 source/test2.lux     | 491 +++++++++++++++++++++++++++++++++++++++++++++++++++
 src/lux.clj          |   2 +-
 src/lux/compiler.clj |   2 +-
 test2.lux            | 491 ---------------------------------------------------
 6 files changed, 497 insertions(+), 497 deletions(-)
 delete mode 100644 another.lux
 create mode 100644 source/another.lux
 create mode 100644 source/test2.lux
 delete mode 100644 test2.lux

diff --git a/another.lux b/another.lux
deleted file mode 100644
index ff5bb6f0a..000000000
--- a/another.lux
+++ /dev/null
@@ -1,4 +0,0 @@
-
-## (ann id #type (All [x] (-> [x] x)))
-(def (id x)
-  x)
diff --git a/source/another.lux b/source/another.lux
new file mode 100644
index 000000000..ff5bb6f0a
--- /dev/null
+++ b/source/another.lux
@@ -0,0 +1,4 @@
+
+## (ann id #type (All [x] (-> [x] x)))
+(def (id x)
+  x)
diff --git a/source/test2.lux b/source/test2.lux
new file mode 100644
index 000000000..d036bbde4
--- /dev/null
+++ b/source/test2.lux
@@ -0,0 +1,491 @@
+## (use "./another" as another)
+
+(jvm/definterface Function
+  (: apply (-> [java.lang.Object] java.lang.Object)))
+
+(jvm/defclass Tuple0 java.lang.Object
+  [])
+(jvm/defclass Tuple1 java.lang.Object
+  [[java.lang.Object _1]])
+(jvm/defclass Tuple2 java.lang.Object
+  [[java.lang.Object _1] [java.lang.Object _2]])
+(jvm/defclass Tuple3 java.lang.Object
+  [[java.lang.Object _1] [java.lang.Object _2]
+   [java.lang.Object _3]])
+(jvm/defclass Tuple4 java.lang.Object
+  [[java.lang.Object _1] [java.lang.Object _2]
+   [java.lang.Object _3] [java.lang.Object _4]])
+(jvm/defclass Tuple5 java.lang.Object
+  [[java.lang.Object _1] [java.lang.Object _2]
+   [java.lang.Object _3] [java.lang.Object _4]
+   [java.lang.Object _5]])
+(jvm/defclass Tuple6 java.lang.Object
+  [[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/defclass Tuple7 java.lang.Object
+  [[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/defclass Tuple8 java.lang.Object
+  [[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]])
+
+(jvm/defclass Variant java.lang.Object
+  [[java.lang.String tag]])
+(jvm/defclass Variant0 test2.Variant
+  [])
+(jvm/defclass Variant1 test2.Variant
+  [[java.lang.Object _1]])
+(jvm/defclass Variant2 test2.Variant
+  [[java.lang.Object _1] [java.lang.Object _2]])
+(jvm/defclass Variant3 test2.Variant
+  [[java.lang.Object _1] [java.lang.Object _2]
+   [java.lang.Object _3]])
+(jvm/defclass Variant4 test2.Variant
+  [[java.lang.Object _1] [java.lang.Object _2]
+   [java.lang.Object _3] [java.lang.Object _4]])
+(jvm/defclass Variant5 test2.Variant
+  [[java.lang.Object _1] [java.lang.Object _2]
+   [java.lang.Object _3] [java.lang.Object _4]
+   [java.lang.Object _5]])
+(jvm/defclass Variant6 test2.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/defclass Variant7 test2.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/defclass Variant8 test2.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]])
+
+(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]))
+
+(defmacro (list xs)
+  (case xs
+    #Nil
+    (#Tag "Nil")
+
+    (#Cons x xs*)
+    (#Form (#Cons (#Tag "Cons") (#Cons x (#Cons (list xs*) #Nil))))))
+
+(def (++ xs ys)
+  (case xs
+    #Nil
+    ys
+
+    (#Cons x xs*)
+    (#Cons x (++ xs* ys))))
+
+(def (map f xs)
+  (case xs
+    #Nil
+    #Nil
+
+    (#Cons x xs*)
+    (#Cons (f x) (map f xs*))))
+
+(def (untemplate-list untemplate tokens)
+  (case tokens
+    #Nil
+    (#Tag "Nil")
+
+    (#Cons token tokens')
+    (#Form (list (#Tag "Cons") (untemplate token) (untemplate-list untemplate tokens')))))
+
+(def (untemplate token)
+  (case token
+    (#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)))
+
+    (#Ident elem)
+    (#Form (list (#Tag "Ident") (#Text elem)))
+
+    (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil)))
+    unquoted
+
+    (#Tuple elems)
+    (#Form (list (#Tag "Tuple") (untemplate-list untemplate elems)))
+
+    (#Form elems)
+    (#Form (list (#Tag "Form") (untemplate-list untemplate elems)))
+    ))
+
+(defmacro (' form)
+  (case form
+    (#Cons token #Nil)
+    (untemplate token)))
+
+## Utils
+(def (fail* message)
+  (#Failure message))
+
+(def (return* state value)
+  (#Ok [state value]))
+
+(def (fail message)
+  (lambda [state]
+     (#Failure message)))
+
+(def (return value)
+  (lambda [state]
+     (#Ok [state value])))
+
+(def (bind m-value step)
+  (lambda [state]
+     (let inputs (m-value state)
+          (case inputs
+            (#Ok [?state ?datum])
+            (step ?datum ?state)
+            
+            _
+            inputs))))
+
+(def (+ x y)
+  (jvm/i+ x y))
+
+(def inc (+ 1))
+
+(def (id x)
+  x)
+
+(def (fold f init values)
+  (case values
+    #Nil
+    init
+    (#Cons x xs)
+    (fold f (f init x) xs)))
+
+(def length (fold (lambda [l x] (inc l)) 0))
+
+(def (rem dividend divisor)
+  (jvm/irem dividend divisor))
+
+(def (= x y)
+  (jvm/invokevirtual Object "equals" [Object]
+                     x [y]))
+
+(def (as-pairs list)
+  (case list
+    (#Cons x (#Cons y list*))
+    (#Cons [x y] (as-pairs list*))
+
+    _
+    #Nil))
+
+## Ideally, this is what I want...
+## (exec [yolo lol
+##        #let [foo (bar 1 2 3)]]
+##   (meme yolo foo))
+
+(defmacro (exec tokens)
+  (case tokens
+    (#Cons (#Tuple steps) (#Cons return #Nil))
+    (if (= 0 (rem (length steps) 2))
+      (fold (lambda [inner pair]
+               (case pair
+                 [label computation]
+                 (' (bind (~ computation)
+                          (lambda [(~ label)] (~ inner))))))
+            return
+            (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 (fold-m f init inputs)
+  (case inputs
+    #Nil              (return init)
+    (#Cons x inputs') (exec [init* (f init x)]
+                        (fold-m f init* inputs'))))
+
+(def (apply-m monad call-state)
+  (lambda [state]
+     (let output (monad call-state)
+          (case output
+            (#Ok [?state ?datum])
+            (#Ok [state ?datum])
+
+            _
+            output))))
+
+(def (assert test message)
+  (if test
+    (return [])
+    (fail message)))
+
+(def (pass %value)
+  (lambda [state]
+     %value))
+
+(def get-state
+  (lambda [state]
+     (return* state state)))
+
+(def (show x)
+  (jvm/invokevirtual Object "toString" []
+                     x []))
+
+(def (concat t1 t2)
+  (jvm/invokevirtual String "concat" [String]
+                     t1 [t2]))
+
+(def (normalize-char char)
+  (case char
+    #"*" "_ASTER_"
+    #"+" "_PLUS_"
+    #"-" "_DASH_"
+    #"/" "_SLASH_"
+    #"_" "_UNDERS_"
+    #"%" "_PERCENT_"
+    #"$" "_DOLLAR_"
+    #"'" "_QUOTE_"
+    #"`" "_BQUOTE_"
+    #"@" "_AT_"
+    #"^" "_CARET_"
+    #"&" "_AMPERS_"
+    #"=" "_EQ_"
+    #"!" "_BANG_"
+    #"?" "_QM_"
+    #":" "_COLON_"
+    #";" "_SCOLON_"
+    #"." "_PERIOD_"
+    #"," "_COMMA_"
+    #"<" "_LT_"
+    #">" "_GT_"
+    #"~" "_TILDE_"
+    ##;;#"\" "_BSLASH_"
+    _    (show char)
+    ))
+
+(def (range from to)
+  (if (= from to)
+    #Nil
+    (#Cons from (range (inc from) to))))
+
+(def (text->list text)
+  (let length (jvm/invokevirtual String "length" []
+                                 text [])
+       (map (lambda [idx]
+               (jvm/invokevirtual String "charAt" [int]
+                                  text [idx]))
+            (range 0 length))))
+
+(def (normalize-ident ident)
+  (fold concat "" (map normalize-char (text->list ident))))
+
+(def (fresh-class-loader path)
+  (let file (jvm/new java.io.File [String] [path])
+       (let url (jvm/invokevirtual java.io.File "toURL" []
+                                   file [])
+            (let urls (jvm/new-array java.net.URL 1)
+                 (do (jvm/aastore urls 0 url)
+                   (jvm/new java.net.URLClassLoader [(Array java.net.URL)] [urls]))))
+       ))
+
+(def (cons tail head)
+  (#Cons head tail))
+
+(def (reverse list)
+  (fold cons #Nil list))
+
+(def (enumerate list)
+  (case (fold (lambda [state x]
+                 (case state
+                   [idx list']
+                   [(inc idx) (#Cons [idx x] list')]))
+              [0 #Nil]
+              list)
+    [_ list']
+    (reverse list')))
+
+(def (print-enum enum)
+  (case enum
+    #Nil
+    (println "")
+    
+    (#Cons [idx x] enum')
+    (do (print "[") (print idx) (print ":") (print x) (print "]") (print " ")
+        (print-enum enum'))))
+
+(def get-state
+  (lambda [state]
+     (#Ok [state state])))
+
+(def list-map #Nil)
+
+(def (put key val map)
+  (case map
+    #Nil
+    (#Cons [key val] map)
+
+    (#Cons [?key ?val] map')
+    (if (= key ?key)
+      (#Cons [?key val] map')
+      (#Cons [?key ?val] (put key val map')))))
+
+(def (get key map)
+  (case map
+    #Nil
+    #None
+    
+    (#Cons [?key ?val] map')
+    (if (= key ?key)
+      (#Some ?val)
+      (get key map'))))
+
+(def (show-kv kv)
+  (case kv
+    [?key ?val]
+    (fold concat "" (list "#" ?key " " (show ?val)))))
+
+(def (within slot monad)
+  (lambda [state]
+     (let =return (monad (get slot state))
+          (case =return
+            (#Ok ?state ?value)
+            (#Ok (put slot ?state state) ?value)
+            
+            _
+            =return))))
+
+(def monadic-dup
+  (exec [foo get-state
+         bar get-state
+         baz (return 1000)]
+    (return (+ (+ foo bar) baz))))
+
+(def (run-state monad state)
+  (monad state))
+
+(def (interpose elem list)
+  (case list
+    (#Cons x (#Cons y list'))
+    (#Cons x (#Cons elem (#Cons y list')))
+
+    _
+    list))
+
+(def (print-map list-map)
+  (do (print "{")
+    (print (fold concat "" (interpose " " (map show-kv list-map))))
+    (println "}")))
+
+(def (show-list xs)
+  (case xs
+    #Nil
+    "#Nil"
+    (#Cons x xs')
+    (fold concat "" (list "(#Cons " (show x) " " (show-list xs') ")"))))
+
+## Program
+(def (main args)
+  (case (' ((~ "Oh yeah...")))
+    (#Form (#Cons text #Nil))
+    (do (println text)
+      (println (+ 10 20))
+      (println (inc 10))
+      (println (jvm/i- 10 20))
+      (println (jvm/i* 10 20))
+      (println (jvm/i/ 10 2))
+      (let xs (list 1 2 3 4 5 6 7 8 9)
+           (do (println (fold + 0 xs))
+             (println (length xs))))
+      (println (rem 21 6))
+      (println (rem 21 7))
+      (println (= false false))
+      (println (= false true))
+      (println (= true false))
+      (println (= true true))
+      (case (run-state monadic-dup 123)
+        (#Ok [_ ?value])
+        (println ?value)
+
+        (#Failure ?message)
+        (println ?message))
+      (print-enum (enumerate (list #"a" #"b" #"c" #"d" #"e")))
+      (print-map (put "Nyan" "cat" (put "Yolo" "lol" list-map)))
+      (let char #"*"
+           (do (print (show char)) (print " -> ")
+               (println (normalize-char char))))
+      (println (show-list (range 0 10)))
+      (println (normalize-ident "text->list"))
+      (println (fresh-class-loader "./"))
+      )
+    ))
diff --git a/src/lux.clj b/src/lux.clj
index f21a336e0..6efbcc207 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -24,7 +24,7 @@
   ;; TODO: Reinplement "if" as a macro on top of case.
   ;; TODO: 
 
-  (let [source-code (slurp "test2.lux")
+  (let [source-code (slurp "source/test2.lux")
         tokens (&lexer/lex source-code)
         ;; _ (prn 'tokens tokens)
         syntax (&parser/parse tokens)
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 2a347aa46..5b901c08e 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -1105,7 +1105,7 @@
   [::&analyser/use ?file ?alias]
   (let [module-name (re-find #"[^/]+$" ?file)
         ;; _ (prn 'module-name module-name)
-        source-code (slurp (str module-name ".lux"))
+        source-code (slurp (str "source/" module-name ".lux"))
         ;; _ (prn 'source-code source-code)
         tokens (&lexer/lex source-code)
         ;; _ (prn 'tokens tokens)
diff --git a/test2.lux b/test2.lux
deleted file mode 100644
index d036bbde4..000000000
--- a/test2.lux
+++ /dev/null
@@ -1,491 +0,0 @@
-## (use "./another" as another)
-
-(jvm/definterface Function
-  (: apply (-> [java.lang.Object] java.lang.Object)))
-
-(jvm/defclass Tuple0 java.lang.Object
-  [])
-(jvm/defclass Tuple1 java.lang.Object
-  [[java.lang.Object _1]])
-(jvm/defclass Tuple2 java.lang.Object
-  [[java.lang.Object _1] [java.lang.Object _2]])
-(jvm/defclass Tuple3 java.lang.Object
-  [[java.lang.Object _1] [java.lang.Object _2]
-   [java.lang.Object _3]])
-(jvm/defclass Tuple4 java.lang.Object
-  [[java.lang.Object _1] [java.lang.Object _2]
-   [java.lang.Object _3] [java.lang.Object _4]])
-(jvm/defclass Tuple5 java.lang.Object
-  [[java.lang.Object _1] [java.lang.Object _2]
-   [java.lang.Object _3] [java.lang.Object _4]
-   [java.lang.Object _5]])
-(jvm/defclass Tuple6 java.lang.Object
-  [[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/defclass Tuple7 java.lang.Object
-  [[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/defclass Tuple8 java.lang.Object
-  [[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]])
-
-(jvm/defclass Variant java.lang.Object
-  [[java.lang.String tag]])
-(jvm/defclass Variant0 test2.Variant
-  [])
-(jvm/defclass Variant1 test2.Variant
-  [[java.lang.Object _1]])
-(jvm/defclass Variant2 test2.Variant
-  [[java.lang.Object _1] [java.lang.Object _2]])
-(jvm/defclass Variant3 test2.Variant
-  [[java.lang.Object _1] [java.lang.Object _2]
-   [java.lang.Object _3]])
-(jvm/defclass Variant4 test2.Variant
-  [[java.lang.Object _1] [java.lang.Object _2]
-   [java.lang.Object _3] [java.lang.Object _4]])
-(jvm/defclass Variant5 test2.Variant
-  [[java.lang.Object _1] [java.lang.Object _2]
-   [java.lang.Object _3] [java.lang.Object _4]
-   [java.lang.Object _5]])
-(jvm/defclass Variant6 test2.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/defclass Variant7 test2.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/defclass Variant8 test2.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]])
-
-(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]))
-
-(defmacro (list xs)
-  (case xs
-    #Nil
-    (#Tag "Nil")
-
-    (#Cons x xs*)
-    (#Form (#Cons (#Tag "Cons") (#Cons x (#Cons (list xs*) #Nil))))))
-
-(def (++ xs ys)
-  (case xs
-    #Nil
-    ys
-
-    (#Cons x xs*)
-    (#Cons x (++ xs* ys))))
-
-(def (map f xs)
-  (case xs
-    #Nil
-    #Nil
-
-    (#Cons x xs*)
-    (#Cons (f x) (map f xs*))))
-
-(def (untemplate-list untemplate tokens)
-  (case tokens
-    #Nil
-    (#Tag "Nil")
-
-    (#Cons token tokens')
-    (#Form (list (#Tag "Cons") (untemplate token) (untemplate-list untemplate tokens')))))
-
-(def (untemplate token)
-  (case token
-    (#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)))
-
-    (#Ident elem)
-    (#Form (list (#Tag "Ident") (#Text elem)))
-
-    (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil)))
-    unquoted
-
-    (#Tuple elems)
-    (#Form (list (#Tag "Tuple") (untemplate-list untemplate elems)))
-
-    (#Form elems)
-    (#Form (list (#Tag "Form") (untemplate-list untemplate elems)))
-    ))
-
-(defmacro (' form)
-  (case form
-    (#Cons token #Nil)
-    (untemplate token)))
-
-## Utils
-(def (fail* message)
-  (#Failure message))
-
-(def (return* state value)
-  (#Ok [state value]))
-
-(def (fail message)
-  (lambda [state]
-     (#Failure message)))
-
-(def (return value)
-  (lambda [state]
-     (#Ok [state value])))
-
-(def (bind m-value step)
-  (lambda [state]
-     (let inputs (m-value state)
-          (case inputs
-            (#Ok [?state ?datum])
-            (step ?datum ?state)
-            
-            _
-            inputs))))
-
-(def (+ x y)
-  (jvm/i+ x y))
-
-(def inc (+ 1))
-
-(def (id x)
-  x)
-
-(def (fold f init values)
-  (case values
-    #Nil
-    init
-    (#Cons x xs)
-    (fold f (f init x) xs)))
-
-(def length (fold (lambda [l x] (inc l)) 0))
-
-(def (rem dividend divisor)
-  (jvm/irem dividend divisor))
-
-(def (= x y)
-  (jvm/invokevirtual Object "equals" [Object]
-                     x [y]))
-
-(def (as-pairs list)
-  (case list
-    (#Cons x (#Cons y list*))
-    (#Cons [x y] (as-pairs list*))
-
-    _
-    #Nil))
-
-## Ideally, this is what I want...
-## (exec [yolo lol
-##        #let [foo (bar 1 2 3)]]
-##   (meme yolo foo))
-
-(defmacro (exec tokens)
-  (case tokens
-    (#Cons (#Tuple steps) (#Cons return #Nil))
-    (if (= 0 (rem (length steps) 2))
-      (fold (lambda [inner pair]
-               (case pair
-                 [label computation]
-                 (' (bind (~ computation)
-                          (lambda [(~ label)] (~ inner))))))
-            return
-            (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 (fold-m f init inputs)
-  (case inputs
-    #Nil              (return init)
-    (#Cons x inputs') (exec [init* (f init x)]
-                        (fold-m f init* inputs'))))
-
-(def (apply-m monad call-state)
-  (lambda [state]
-     (let output (monad call-state)
-          (case output
-            (#Ok [?state ?datum])
-            (#Ok [state ?datum])
-
-            _
-            output))))
-
-(def (assert test message)
-  (if test
-    (return [])
-    (fail message)))
-
-(def (pass %value)
-  (lambda [state]
-     %value))
-
-(def get-state
-  (lambda [state]
-     (return* state state)))
-
-(def (show x)
-  (jvm/invokevirtual Object "toString" []
-                     x []))
-
-(def (concat t1 t2)
-  (jvm/invokevirtual String "concat" [String]
-                     t1 [t2]))
-
-(def (normalize-char char)
-  (case char
-    #"*" "_ASTER_"
-    #"+" "_PLUS_"
-    #"-" "_DASH_"
-    #"/" "_SLASH_"
-    #"_" "_UNDERS_"
-    #"%" "_PERCENT_"
-    #"$" "_DOLLAR_"
-    #"'" "_QUOTE_"
-    #"`" "_BQUOTE_"
-    #"@" "_AT_"
-    #"^" "_CARET_"
-    #"&" "_AMPERS_"
-    #"=" "_EQ_"
-    #"!" "_BANG_"
-    #"?" "_QM_"
-    #":" "_COLON_"
-    #";" "_SCOLON_"
-    #"." "_PERIOD_"
-    #"," "_COMMA_"
-    #"<" "_LT_"
-    #">" "_GT_"
-    #"~" "_TILDE_"
-    ##;;#"\" "_BSLASH_"
-    _    (show char)
-    ))
-
-(def (range from to)
-  (if (= from to)
-    #Nil
-    (#Cons from (range (inc from) to))))
-
-(def (text->list text)
-  (let length (jvm/invokevirtual String "length" []
-                                 text [])
-       (map (lambda [idx]
-               (jvm/invokevirtual String "charAt" [int]
-                                  text [idx]))
-            (range 0 length))))
-
-(def (normalize-ident ident)
-  (fold concat "" (map normalize-char (text->list ident))))
-
-(def (fresh-class-loader path)
-  (let file (jvm/new java.io.File [String] [path])
-       (let url (jvm/invokevirtual java.io.File "toURL" []
-                                   file [])
-            (let urls (jvm/new-array java.net.URL 1)
-                 (do (jvm/aastore urls 0 url)
-                   (jvm/new java.net.URLClassLoader [(Array java.net.URL)] [urls]))))
-       ))
-
-(def (cons tail head)
-  (#Cons head tail))
-
-(def (reverse list)
-  (fold cons #Nil list))
-
-(def (enumerate list)
-  (case (fold (lambda [state x]
-                 (case state
-                   [idx list']
-                   [(inc idx) (#Cons [idx x] list')]))
-              [0 #Nil]
-              list)
-    [_ list']
-    (reverse list')))
-
-(def (print-enum enum)
-  (case enum
-    #Nil
-    (println "")
-    
-    (#Cons [idx x] enum')
-    (do (print "[") (print idx) (print ":") (print x) (print "]") (print " ")
-        (print-enum enum'))))
-
-(def get-state
-  (lambda [state]
-     (#Ok [state state])))
-
-(def list-map #Nil)
-
-(def (put key val map)
-  (case map
-    #Nil
-    (#Cons [key val] map)
-
-    (#Cons [?key ?val] map')
-    (if (= key ?key)
-      (#Cons [?key val] map')
-      (#Cons [?key ?val] (put key val map')))))
-
-(def (get key map)
-  (case map
-    #Nil
-    #None
-    
-    (#Cons [?key ?val] map')
-    (if (= key ?key)
-      (#Some ?val)
-      (get key map'))))
-
-(def (show-kv kv)
-  (case kv
-    [?key ?val]
-    (fold concat "" (list "#" ?key " " (show ?val)))))
-
-(def (within slot monad)
-  (lambda [state]
-     (let =return (monad (get slot state))
-          (case =return
-            (#Ok ?state ?value)
-            (#Ok (put slot ?state state) ?value)
-            
-            _
-            =return))))
-
-(def monadic-dup
-  (exec [foo get-state
-         bar get-state
-         baz (return 1000)]
-    (return (+ (+ foo bar) baz))))
-
-(def (run-state monad state)
-  (monad state))
-
-(def (interpose elem list)
-  (case list
-    (#Cons x (#Cons y list'))
-    (#Cons x (#Cons elem (#Cons y list')))
-
-    _
-    list))
-
-(def (print-map list-map)
-  (do (print "{")
-    (print (fold concat "" (interpose " " (map show-kv list-map))))
-    (println "}")))
-
-(def (show-list xs)
-  (case xs
-    #Nil
-    "#Nil"
-    (#Cons x xs')
-    (fold concat "" (list "(#Cons " (show x) " " (show-list xs') ")"))))
-
-## Program
-(def (main args)
-  (case (' ((~ "Oh yeah...")))
-    (#Form (#Cons text #Nil))
-    (do (println text)
-      (println (+ 10 20))
-      (println (inc 10))
-      (println (jvm/i- 10 20))
-      (println (jvm/i* 10 20))
-      (println (jvm/i/ 10 2))
-      (let xs (list 1 2 3 4 5 6 7 8 9)
-           (do (println (fold + 0 xs))
-             (println (length xs))))
-      (println (rem 21 6))
-      (println (rem 21 7))
-      (println (= false false))
-      (println (= false true))
-      (println (= true false))
-      (println (= true true))
-      (case (run-state monadic-dup 123)
-        (#Ok [_ ?value])
-        (println ?value)
-
-        (#Failure ?message)
-        (println ?message))
-      (print-enum (enumerate (list #"a" #"b" #"c" #"d" #"e")))
-      (print-map (put "Nyan" "cat" (put "Yolo" "lol" list-map)))
-      (let char #"*"
-           (do (print (show char)) (print " -> ")
-               (println (normalize-char char))))
-      (println (show-list (range 0 10)))
-      (println (normalize-ident "text->list"))
-      (println (fresh-class-loader "./"))
-      )
-    ))
-- 
cgit v1.2.3