Fixed a bug in the ' macro.

4 files changed, 142 insertions, 89 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 6b823b3ee..1aa2d587b 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -477,39 +477,39 @@
   ;; (prn '->token x)
   (match x
     [::&parser/bool ?bool]
-    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+    (doto (.newInstance (.loadClass @loader "test2.Variant1"))
       (-> .-tag (set! "Bool"))
       (-> .-_1 (set! ?bool)))
     [::&parser/int ?int]
-    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+    (doto (.newInstance (.loadClass @loader "test2.Variant1"))
       (-> .-tag (set! "Int"))
       (-> .-_1 (set! ?int)))
     [::&parser/real ?real]
-    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+    (doto (.newInstance (.loadClass @loader "test2.Variant1"))
       (-> .-tag (set! "Real"))
       (-> .-_1 (set! ?real)))
     [::&parser/char ?elem]
-    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+    (doto (.newInstance (.loadClass @loader "test2.Variant1"))
       (-> .-tag (set! "Char"))
       (-> .-_1 (set! ?elem)))
     [::&parser/text ?text]
-    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+    (doto (.newInstance (.loadClass @loader "test2.Variant1"))
       (-> .-tag (set! "Text"))
       (-> .-_1 (set! ?text)))
     [::&parser/tag ?tag]
-    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+    (doto (.newInstance (.loadClass @loader "test2.Variant1"))
       (-> .-tag (set! "Tag"))
       (-> .-_1 (set! ?tag)))
     [::&parser/ident ?ident]
-    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+    (doto (.newInstance (.loadClass @loader "test2.Variant1"))
       (-> .-tag (set! "Ident"))
       (-> .-_1 (set! ?ident)))
     [::&parser/tuple ?elems]
-    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+    (doto (.newInstance (.loadClass @loader "test2.Variant1"))
       (-> .-tag (set! "Tuple"))
       (-> .-_1 (set! (->tokens ?elems))))
     [::&parser/form ?elems]
-    (doto (.newInstance (.loadClass loader "test2.Variant1"))
+    (doto (.newInstance (.loadClass @loader "test2.Variant1"))
       (-> .-tag (set! "Form"))
       (-> .-_1 (set! (->tokens ?elems))))
     ))
@@ -517,11 +517,11 @@
 (defn ->tokens [xs]
   (reduce (fn [tail x]
             ;; (prn 'tail (.-tag tail) 'x x)
-            (doto (.newInstance (.loadClass loader "test2.Variant2"))
+            (doto (.newInstance (.loadClass @loader "test2.Variant2"))
               (-> .-tag (set! "Cons"))
               (-> .-_1 (set! (->token x)))
               (-> .-_2 (set! tail))))
-          (doto (.newInstance (.loadClass loader "test2.Variant0"))
+          (doto (.newInstance (.loadClass @loader "test2.Variant0"))
             (-> .-tag (set! "Nil")))
           (reverse xs)))
 
@@ -557,12 +557,12 @@
              :let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)]]
         (if (and macro? (not scoped?))
           (let [macro-class (str ?module "$" (normalize-ident ?name))
-                transformed (-> (.loadClass loader macro-class)
+                transformed (-> (.loadClass @loader macro-class)
                                 .newInstance
                                 (.apply (->tokens ?args))
                                 ->clojure-token)
                 _ (prn 'analyse-call/transformed transformed)]
-            (-> (.loadClass loader macro-class)
+            (-> (.loadClass @loader macro-class)
                 .newInstance
                 (.apply (->tokens ?args))
                 ->clojure-token
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index aea9ea1e2..31b440b88 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -8,7 +8,7 @@
                                          repeat-m try-m try-all-m map-m reduce-m
                                          apply-m within
                                          normalize-ident
-                                         loader]]
+                                         loader reset-loader!]]
                  [type :as &type]
                  [lexer :as &lexer]
                  [parser :as &parser]
@@ -36,7 +36,7 @@
     ;; (println "Defining..." name "@" file-name ;; (alength bytecode)
     ;;          )
     ;; (prn 'loader loader)
-    (.loadClass loader name)
+    (.loadClass @loader name)
     ;; (println "SUCCESFUL LOAD!")
     ;; (.defineClass loader name bytecode 0 (alength bytecode))
     ))
@@ -281,24 +281,26 @@
         nil)
       )))
 
-(defcompiler ^:private compile-if
-  [::&analyser/if ?test ?then ?else]
-  (let [else-label (new Label)
-        end-label (new Label)]
-    ;; (println "PRE")
-    (compile-form (assoc *state* :form ?test))
-    (doto *writer*
-      (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.lang.Boolean") "booleanValue" "()Z")
-      (.visitJumpInsn Opcodes/IFEQ else-label))
-    ;; (prn 'compile-if/?then (:form ?then))
-    (compile-form (assoc *state* :form ?then))
-    ;; (.visitInsn *writer* Opcodes/POP)
-    (doto *writer*
-      (.visitJumpInsn Opcodes/GOTO end-label)
-      (.visitLabel else-label))
-    (compile-form (assoc *state* :form ?else))
-    ;; (.visitInsn *writer* Opcodes/POP)
-    (.visitLabel *writer* end-label)))
+(let [+bool-class+ (->class "java.lang.Boolean")]
+  (defcompiler ^:private compile-if
+    [::&analyser/if ?test ?then ?else]
+    (let [else-label (new Label)
+          end-label (new Label)]
+      ;; (println "PRE")
+      (compile-form (assoc *state* :form ?test))
+      (doto *writer*
+        (.visitTypeInsn Opcodes/CHECKCAST +bool-class+)
+        (.visitMethodInsn Opcodes/INVOKEVIRTUAL +bool-class+ "booleanValue" "()Z")
+        (.visitJumpInsn Opcodes/IFEQ else-label))
+      ;; (prn 'compile-if/?then (:form ?then))
+      (compile-form (assoc *state* :form ?then))
+      ;; (.visitInsn *writer* Opcodes/POP)
+      (doto *writer*
+        (.visitJumpInsn Opcodes/GOTO end-label)
+        (.visitLabel else-label))
+      (compile-form (assoc *state* :form ?else))
+      ;; (.visitInsn *writer* Opcodes/POP)
+      (.visitLabel *writer* end-label))))
 
 (defcompiler ^:private compile-do
   [::&analyser/do ?exprs]
@@ -330,6 +332,11 @@
           (.visitInsn Opcodes/POP)
           (.visitJumpInsn Opcodes/GOTO default-label)))
 
+      [::default [::&analyser/local _ ?idx] $body]
+      (doto writer
+        (.visitVarInsn Opcodes/ASTORE ?idx)
+        (.visitJumpInsn Opcodes/GOTO (get mappings $body)))
+      
       [::store [::&analyser/local _ ?idx] $body]
       (doto writer
         (.visitVarInsn Opcodes/ASTORE ?idx)
@@ -543,10 +550,13 @@
                 (.visitVarInsn Opcodes/ASTORE ?idx)
                 (.visitJumpInsn Opcodes/GOTO (get mappings* ?body)))
               (doto *writer*
-                (.visitInsn Opcodes/POP)
+                ;; (.visitInsn Opcodes/POP)
+                (.visitTypeInsn Opcodes/CHECKCAST (->class +variant-class+))
+                (.visitFieldInsn Opcodes/GETFIELD (->class +variant-class+) "tag" (->type-signature "java.lang.String"))
                 (.visitTypeInsn Opcodes/NEW ex-class)
-                (.visitInsn Opcodes/DUP)
-                (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
+                (.visitInsn Opcodes/DUP_X1)
+                (.visitInsn Opcodes/SWAP)
+                (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" (str "(" (->type-signature "java.lang.String") ")" "V"))
                 (.visitInsn Opcodes/ATHROW)))
             ;; (if default-code
             ;;   ;; (do (prn 'default-code default-code)
@@ -1006,6 +1016,7 @@
 ;; [Interface]
 (defn compile [class-name inputs]
   ;; (prn 'inputs inputs)
+  (reset-loader!)
   (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
                  (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
                          (->class class-name) nil "java/lang/Object" nil))
diff --git a/src/lux/util.clj b/src/lux/util.clj
index 890b73880..5496e8699 100644
--- a/src/lux/util.clj
+++ b/src/lux/util.clj
@@ -160,4 +160,6 @@
 (defn normalize-ident [ident]
   (reduce str "" (map normalize-char ident)))
 
-(defonce loader (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader.))
+(defonce loader (atom nil))
+(defn reset-loader! []
+  (reset! loader (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader.)))
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))