From ab72e219835d05d7ce76111626a8119a64f5f283 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 15 Dec 2014 22:28:27 -0400
Subject: Added "do" expressions.

---
 src/lang.clj          |  1 -
 src/lang/analyser.clj |  6 ++++++
 src/lang/compiler.clj | 17 +++++++++++++----
 src/lang/parser.clj   |  7 +++++++
 4 files changed, 26 insertions(+), 5 deletions(-)

(limited to 'src')

diff --git a/src/lang.clj b/src/lang.clj
index 0bbd74bf6..e09c06f33 100644
--- a/src/lang.clj
+++ b/src/lang.clj
@@ -12,7 +12,6 @@
 
 (comment
   ;; TODO: Add pattern-matching.
-  ;; TODO: Add "do" expressions.
   ;; TODO: Add all the missing literal types.
   ;; TODO: Allow strings to have escape characters.
   ;; TODO: Fold all closure classes into one.
diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
index d00fb7319..8572cfa53 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -170,6 +170,11 @@
          :let [_ (prn '=else =else)]]
     (return (annotated [::if =test =then =else] ::&type/nothing))))
 
+(defanalyser analyse-do
+  [::&parser/do ?exprs]
+  (exec [=exprs (map-m analyse-form* ?exprs)]
+    (return (annotated [::do =exprs] (-> =exprs last :type)))))
+
 (defanalyser analyse-let
   [::&parser/let ?label ?value ?body]
   (exec [=value (analyse-form* ?value)
@@ -275,6 +280,7 @@
               analyse-dynamic-access
               analyse-fn-call
               analyse-if
+              analyse-do
               analyse-let
               analyse-defclass
               analyse-definterface
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index b7079fecf..83ce18ab1 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -99,14 +99,14 @@
 (defcompiler ^:private compile-local
   [::&analyser/local ?idx]
   (do ;; (prn 'LOCAL ?idx)
-    (doto *writer*
-      (.visitVarInsn Opcodes/ALOAD (int ?idx)))))
+      (doto *writer*
+        (.visitVarInsn Opcodes/ALOAD (int ?idx)))))
 
 (defcompiler ^:private compile-global
   [::&analyser/global ?owner-class ?name]
   (do ;; (prn 'GLOBAL ?owner-class ?name *type*)
-    (doto *writer*
-      (.visitFieldInsn Opcodes/GETSTATIC (->class ?owner-class) ?name (->java-sig *type*)))))
+      (doto *writer*
+        (.visitFieldInsn Opcodes/GETSTATIC (->class ?owner-class) ?name (->java-sig *type*)))))
 
 ;; (defcompiler ^:private compile-call
 ;;   [::&analyser/call ?fn ?args]
@@ -177,6 +177,7 @@
     (doto *writer*
       (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.lang.Boolean") "booleanValue" "()Z")
       (.visitJumpInsn Opcodes/IFEQ else-label))
+    (prn 'compile-if/?then (:form ?then))
     (assert (compile-form (assoc *state* :form ?then)) "CAN't COMPILE THEN")
     (doto *writer*
       (.visitJumpInsn Opcodes/GOTO end-label)
@@ -184,6 +185,13 @@
     (assert (compile-form (assoc *state* :form ?else)) "CAN't COMPILE ELSE")
     (.visitLabel *writer* end-label)))
 
+(defcompiler ^:private compile-do
+  [::&analyser/do ?exprs]
+  (do (doseq [expr (butlast ?exprs)]
+        (compile-form (assoc *state* :form expr))
+        (.visitInsn *writer* Opcodes/POP))
+    (compile-form (assoc *state* :form (last ?exprs)))))
+
 (defcompiler ^:private compile-let
   [::&analyser/let ?idx ?label ?value ?body]
   (let [start-label (new Label)
@@ -442,6 +450,7 @@
                    compile-dynamic-access
                    compile-ann-class
                    compile-if
+                   compile-do
                    compile-let
                    compile-lambda
                    compile-def
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index 2f9a26c66..76f32aba1 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -86,6 +86,12 @@
          =else (apply-m parse-form (list ?else))]
     (return [::if =test =then =else])))
 
+(defparser ^:private parse-do
+  [::&lexer/list ([[::&lexer/ident "do"] & ?exprs] :seq)]
+  (exec [=exprs (map-m #(apply-m parse-form (list %))
+                       ?exprs)]
+    (return [::do =exprs])))
+
 (defparser ^:private parse-case
   [::&lexer/list ([[::&lexer/ident "case"] ?variant & cases] :seq)]
   (exec [=variant (apply-m parse-form (list ?variant))
@@ -201,6 +207,7 @@
               parse-def
               parse-defdata
               parse-if
+              parse-do
               parse-case
               parse-let
               parse-tagged
-- 
cgit v1.2.3