aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2014-12-09 02:09:11 -0400
committerEduardo Julian2014-12-09 02:09:11 -0400
commit58bfb46ba16fc1db07e501be6fcc0c940ec7a350 (patch)
tree8e8c6f9ad9f3cc9c2bcf4046017e3e9225670786 /src
parentbad2695169969e6ee7551d2a2c23d9c4e1b656fb (diff)
Now compiling tagged values.
Diffstat (limited to 'src')
-rw-r--r--src/lang.clj5
-rw-r--r--src/lang/compiler.clj32
2 files changed, 34 insertions, 3 deletions
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]