From 0bccd6a2313dc5eadb635d1fbf02dbb0a5ff2cfe Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 4 Dec 2014 00:28:48 -0400
Subject: Now compiles booleans and ifs.

---
 src/lang/compiler.clj | 31 +++++++++++++++++++++++++++++--
 src/lang/lexer.clj    | 10 ++++++----
 src/lang/parser.clj   |  7 ++++++-
 3 files changed, 41 insertions(+), 7 deletions(-)

(limited to 'src/lang')

diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index 16b2dfe54..d3265b5e4 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -10,6 +10,7 @@
                   [type :as &type])
             :reload)
   (:import (org.objectweb.asm Opcodes
+                              Label
                               ClassWriter
                               MethodVisitor)))
 
@@ -214,6 +215,13 @@
 
 (def ^:dynamic *code*)
 
+(defcompiler compile-boolean
+  [::&parser/boolean ?boolean]
+  (do (if ?boolean
+        (.visitLdcInsn *code* (int 1))
+        (.visitLdcInsn *code* (int 0)))
+    (return nil)))
+
 (defcompiler compile-string
   [::&parser/string ?string]
   (do (doto *code*
@@ -268,11 +276,30 @@
          _state &util/get-state]
     (return nil)))
 
+(defcompiler compile-if
+  [::&parser/if ?test ?then ?else]
+  (exec [_state &util/get-state
+         =test (apply-m compile-form (wrap-in _state ?test))
+         :let [else-label (new Label)
+               end-label (new Label)]
+         =then (do (doto *code*
+                     (.visitJumpInsn Opcodes/IFEQ else-label))
+                 (apply-m compile-form (wrap-in _state ?then)))
+         :let [_ (doto *code*
+                   (.visitJumpInsn Opcodes/GOTO end-label)
+                   (.visitLabel else-label))]
+         =else (apply-m compile-form (wrap-in _state ?else))]
+    (do (doto *code*
+          (.visitLabel end-label))
+      (return nil))))
+
 (def compile-form
-  (try-all-m [compile-string
+  (try-all-m [compile-boolean
+              compile-string
               compile-static-access
               compile-dynamic-access
-              compile-ann-class]))
+              compile-ann-class
+              compile-if]))
 
 (defn compile [inputs]
   (let [cw (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
diff --git a/src/lang/lexer.clj b/src/lang/lexer.clj
index e2de44d82..65e57114b 100644
--- a/src/lang/lexer.clj
+++ b/src/lang/lexer.clj
@@ -56,9 +56,10 @@
     (exec [token (lex-regex <regex>)]
       (return [<tag> token])))
 
-  ^:private lex-float ::float  #"^(0|[1-9][0-9]*)\.[0-9]+"
-  ^:private lex-int   ::int    #"^(0|[1-9][0-9]*)"
-  ^:private lex-ident ::ident  +ident-re+)
+  ^:private lex-boolean ::boolean #"^(true|false)"
+  ^:private lex-float   ::float   #"^(0|[1-9][0-9]*)\.[0-9]+"
+  ^:private lex-int     ::int     #"^(0|[1-9][0-9]*)"
+  ^:private lex-ident   ::ident   +ident-re+)
 
 (def lex-string
   (exec [_ (lex-str "\"")
@@ -112,7 +113,8 @@
 
 (def ^:private lex-form
   (exec [_ (try-m lex-white-space)
-         form (try-all-m [lex-float
+         form (try-all-m [lex-boolean
+                          lex-float
                           lex-int
                           lex-string
                           lex-ident
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index d1bd3dbd8..f09d87145 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -19,6 +19,10 @@
          (fail* (str "Unmatched token: " token#))))))
 
 ;; [Parsers]
+(defparser ^:private parse-boolean
+  [::&lexer/boolean ?boolean]
+  (return [::boolean (Boolean/parseBoolean ?boolean)]))
+
 (defparser ^:private parse-int
   [::&lexer/int ?int]
   (return [::int (Long/parseLong ?int)]))
@@ -162,7 +166,8 @@
     (return [::fn-call =f =args])))
 
 (def ^:private parse-form
-  (try-all-m [parse-int
+  (try-all-m [parse-boolean
+              parse-int
               parse-float
               parse-string
               parse-ident
-- 
cgit v1.2.3