From 58bfb46ba16fc1db07e501be6fcc0c940ec7a350 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 9 Dec 2014 02:09:11 -0400
Subject: Now compiling tagged values.

---
 src/lang.clj          |  5 ++++-
 src/lang/compiler.clj | 32 ++++++++++++++++++++++++++++++--
 2 files changed, 34 insertions(+), 3 deletions(-)

(limited to 'src')

diff --git a/src/lang.clj b/src/lang.clj
index 97465a7a8..eb26b9cc8 100644
--- a/src/lang.clj
+++ b/src/lang.clj
@@ -27,7 +27,6 @@
   ;; TODO: Add tuples.
   ;; TODO: Add let.
   ;; TODO: Add pattern-matching.
-  ;; TODO: Add tagged values.
   ;; TODO: Do tail-call optimization.
   ;; TODO: Add macros.
   ;; TODO: Add type-level computations.
@@ -39,4 +38,8 @@
   ;; TODO: Allow using other modules.
   ;; TODO: 
   ;; TODO: 
+  
+  ;; jar cvf test2.jar test2 test2.class
+  ;; java -cp "test2.jar" test2
+  ;; jar cvf test2.jar test2 test2.class && java -cp "test2.jar" test2
   )
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index d2b24eb02..dbc088668 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -141,6 +141,13 @@
     (doseq [[class field] ?fields]
       (doto (.visitField =class Opcodes/ACC_PUBLIC field (->type-signature class) nil nil)
         (.visitEnd)))
+    (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" "()V" nil nil)
+      (.visitCode)
+      (.visitVarInsn Opcodes/ALOAD 0)
+      (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V")
+      (.visitInsn Opcodes/RETURN)
+      (.visitMaxs 0 0)
+      (.visitEnd))
     (.visitEnd =class)
     (let [parent-dir (->class *name*)]
       (.mkdirs (java.io.File. parent-dir))
@@ -161,6 +168,23 @@
       (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))]
         (.write stream (.toByteArray =interface))))))
 
+(let [+tagged+ "test2/Tagged"]
+  (defcompiler ^:private compile-tagged
+    [::&parser/tagged ?tag ?value]
+    (do (prn 'compile-tagged ?tag ?value)
+      (doto *writer*
+        (.visitTypeInsn Opcodes/NEW +tagged+)
+        (.visitInsn Opcodes/DUP)
+        (.visitMethodInsn Opcodes/INVOKESPECIAL +tagged+ "<init>" "()V")
+        (.visitInsn Opcodes/DUP)
+        (.visitLdcInsn ?tag)
+        (.visitFieldInsn Opcodes/PUTFIELD +tagged+ "tag" "Ljava/lang/String;")
+        (.visitInsn Opcodes/DUP))
+      (compile-form (assoc *state* :form ?value))
+      (doto *writer*
+        (.visitFieldInsn Opcodes/PUTFIELD +tagged+ "value" "Ljava/lang/Object;"))
+      )))
+
 (let [+compilers+ [compile-boolean
                    compile-string
                    compile-ident
@@ -172,7 +196,8 @@
                    compile-def
                    compile-module
                    compile-defclass
-                   compile-definterface]]
+                   compile-definterface
+                   compile-tagged]]
   (defn ^:private compile-form [state]
     (prn 'compile-form/state state)
     (some #(% state) +compilers+)))
@@ -194,7 +219,10 @@
     ;;   (.visitInsn Opcodes/RETURN)
     ;;   (.visitMaxs 0 0)
     ;;   (.visitEnd))
-    (doall (map #(compile-form (assoc state :form %)) inputs))
+    (doseq [input inputs]
+      (when (not (compile-form (assoc state :form input)))
+        (assert false input)))
+    ;; (doall (map #(compile-form (assoc state :form %)) inputs))
     (when-let [constants (seq (for [input inputs
                                     :let [payload (match input
                                                     [::&parser/def [::&parser/ident ?name] ?body]
-- 
cgit v1.2.3