From 74f1d02a2f16da9e2ce2fb747dad07979a9db26a Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 29 Nov 2014 02:29:56 -0400
Subject: + Added simple let expressions. (No destructuring of tuples/records
 yet) + Added records and simple operations on them (get, set & remove).

---
 src/example/test1.lang   | 12 ++++++++++
 src/lang/compiler.clj    | 30 ++++++++++++++++++++++++
 src/lang/interpreter.clj | 29 ++++++++++++++++++++++-
 src/lang/lexer.clj       |  7 ++++++
 src/lang/parser.clj      | 61 +++++++++++++++++++++++++++++++++---------------
 5 files changed, 119 insertions(+), 20 deletions(-)

diff --git a/src/example/test1.lang b/src/example/test1.lang
index c5d797beb..8e740eabd 100644
--- a/src/example/test1.lang
+++ b/src/example/test1.lang
@@ -24,3 +24,15 @@
 (def pi 3.14)
 
 pi
+
+(def (foo x)
+  (let [y (*' 2 x)]
+    (+' x y)))
+
+(foo 10)
+
+(def bar {#x 10 #y 20})
+bar
+(get@ #x bar)
+(set@ #z 30 bar)
+(remove@ #y bar)
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index 74e0ba46e..6e37213a8 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -65,6 +65,14 @@
                        ?elems)]
     (return (vec =elems))))
 
+(defcompiler compile-record
+  [::&parser/record ?kvs]
+  (exec [=kvs (map-m (fn [[?label ?value]]
+                       (exec [=value (apply-m compile-form (wrap ?value))]
+                         (return [?label =value])))
+                     ?kvs)]
+    (return (into {} =kvs))))
+
 (defcompiler compile-tagged
   [::&parser/tagged ?tag ?data]
   (exec [=data (apply-m compile-form (wrap ?data))]
@@ -92,6 +100,11 @@
          =expr (apply-m compile-form (wrap* fn-env ?expr))]
     (return [?tag =bindings =expr])))
 
+(defcompiler compile-let-binding
+  [::&parser/let-binding [::&parser/ident ?name] ?expr]
+  (exec [=expr (apply-m compile-form (wrap ?expr))]
+    (return [(symbol ?name) =expr])))
+
 (defcompiler compile-case
   [::&parser/case ?variant ?branches]
   (exec [=variant (apply-m compile-form (wrap ?variant))
@@ -107,6 +120,21 @@
                ]]
     (return =case)))
 
+(defcompiler compile-let
+  [::&parser/let ?bindings ?expr]
+  (exec [=expr (apply-m compile-form (wrap ?expr))
+         =bindings (map-m #(apply-m compile-let-binding (wrap %))
+                          ?bindings)
+         :let [;; _ (prn '=bindings =bindings)
+               =let (reduce (fn [inner [?name ?expr]]
+                              `(let [~?name ~?expr]
+                                 ~inner))
+                            =expr
+                            =bindings)
+               ;; _ (prn '=let =let)
+               ]]
+    (return =let)))
+
 (defcompiler compile-def
   [::&parser/def ?form ?body]
   (match ?form
@@ -145,9 +173,11 @@
               compile-float
               compile-ident
               compile-tuple
+              compile-record
               compile-tagged
               compile-if
               compile-case
+              compile-let
               compile-def
               compile-defdata
               compile-fn-call]))
diff --git a/src/lang/interpreter.clj b/src/lang/interpreter.clj
index 73148831e..85be602da 100644
--- a/src/lang/interpreter.clj
+++ b/src/lang/interpreter.clj
@@ -18,6 +18,8 @@
 
 (def <=' (fn [x] (fn [y] (<= x y))))
 (def -' (fn [x] (fn [y] (- x y))))
+(def +' (fn [x] (fn [y] (+ x y))))
+(def *' (fn [x] (fn [y] (* x y))))
 
 ;; [Utils]
 (def ^:private +state+
@@ -64,7 +66,7 @@
              output#)
            _#
            (do ;; (println "Unknown syntax: " (pr-str ~'*token*))
-             (fail* (str "Unknown syntax: " (pr-str ~'*token*)))))))))
+               (fail* (str "Unknown syntax: " (pr-str ~'*token*)))))))))
 
 (defeval eval-ident
   [::&parser/ident ?ident]
@@ -103,6 +105,23 @@
          ]
     (return nil)))
 
+(defeval eval-get
+  [::&parser/get ?tag [::&parser/ident ?record]]
+  (exec [=record (resolve ?record)]
+    (return (get =record ?tag))))
+
+(defeval eval-set
+  [::&parser/set ?tag ?value [::&parser/ident ?record]]
+  (exec [state &util/get-state
+         =value (apply-m eval-form (wrap-in state ?value))
+         =record (resolve ?record)]
+    (return (assoc =record ?tag =value))))
+
+(defeval eval-remove
+  [::&parser/remove ?tag [::&parser/ident ?record]]
+  (exec [=record (resolve ?record)]
+    (return (dissoc =record ?tag))))
+
 (defeval eval-fn-call
   [::&parser/fn-call ?fn ?args]
   (exec [state &util/get-state
@@ -120,6 +139,9 @@
               eval-ident
               eval-def
               eval-defdata
+              eval-get
+              eval-set
+              eval-remove
               eval-fn-call]))
 
 (defn eval [text]
@@ -150,4 +172,9 @@
   ;;   (fold * 1 (repeat exp base)))
 
   ;; Syntax for chars: #"a"
+
+
+  ;; (set@ {#z 30} bar) (set@ {#z 30 #w "YOLO"} bar)
+  ;; (remove@ [#x #y] bar)
+  ;; (get@ [#x #y] bar)
   )
diff --git a/src/lang/lexer.clj b/src/lang/lexer.clj
index 927453aeb..5bd57f7de 100644
--- a/src/lang/lexer.clj
+++ b/src/lang/lexer.clj
@@ -43,6 +43,12 @@
          _ (lex-str "]")]
     (return [::tuple members])))
 
+(def ^:private lex-record
+  (exec [_ (lex-str "{")
+         members lex-forms
+         _ (lex-str "}")]
+    (return [::record members])))
+
 (def +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'][a-zA-Z0-9\-\+\_\=!@$%^&*<>\.,/\\\|']*)")
 
 (do-template [<name> <tag> <regex>]
@@ -103,6 +109,7 @@
                           lex-tag
                           lex-list
                           lex-tuple
+                          lex-record
                           lex-single-line-comment
                           lex-multi-line-comment])
          _ (try-m lex-white-space)]
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index b3cb5cbc0..2abb75cf5 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -36,6 +36,16 @@
                        ?parts)]
     (return [::tuple =parts])))
 
+(defparser ^:private parse-record
+  [::&lexer/record ?parts]
+  (exec [=kvs (do (assert (even? (count ?parts)))
+                (map-m #(match %
+                          ([[::&lexer/tag ?label] ?value] :seq)
+                          (exec [=value (apply-m parse-form (list ?value))]
+                            (return [?label =value])))
+                       (partition 2 ?parts)))]
+    (return [::record =kvs])))
+
 (defparser ^:private parse-def
   [::&lexer/list ([[::&lexer/ident "def"] ?name ?body] :seq)]
   (exec [=name (apply-m parse-form (list ?name))
@@ -72,11 +82,38 @@
                             (partition 2 cases)))]
     (return [::case =variant =branches])))
 
+(defparser ^:private parse-let
+  [::&lexer/list ([[::&lexer/ident "let"] [::&lexer/tuple ?bindings] ?expr] :seq)]
+  (exec [=expr (apply-m parse-form (list ?expr))
+         =bindings (do (assert (even? (count ?bindings)))
+                     (map-m (fn [[destruct expr]]
+                              (exec [=destruct (apply-m parse-form (list destruct))
+                                     =expr (apply-m parse-form (list expr))]
+                                (return [::let-binding =destruct =expr])))
+                            (partition 2 ?bindings)))]
+    (return [::let =bindings =expr])))
+
 (defparser ^:private parse-tagged
   [::&lexer/list ([[::&lexer/tag ?tag] ?data] :seq)]
   (exec [=data (apply-m parse-form (list ?data))]
     (return [::tagged ?tag =data])))
 
+(defparser ^:private parse-get
+  [::&lexer/list ([[::&lexer/ident "get@"] [::&lexer/tag ?tag] ?record] :seq)]
+  (exec [=record (apply-m parse-form (list ?record))]
+    (return [::get ?tag =record])))
+
+(defparser ^:private parse-remove
+  [::&lexer/list ([[::&lexer/ident "remove@"] [::&lexer/tag ?tag] ?record] :seq)]
+  (exec [=record (apply-m parse-form (list ?record))]
+    (return [::remove ?tag =record])))
+
+(defparser ^:private parse-set
+  [::&lexer/list ([[::&lexer/ident "set@"] [::&lexer/tag ?tag] ?value ?record] :seq)]
+  (exec [=value (apply-m parse-form (list ?value))
+         =record (apply-m parse-form (list ?record))]
+    (return [::set ?tag =value =record])))
+
 (defparser ^:private parse-fn-call
   [::&lexer/list ([?f & ?args] :seq)]
   (exec [=f (apply-m parse-form (list ?f))
@@ -89,11 +126,16 @@
               parse-float
               parse-ident
               parse-tuple
+              parse-record
               parse-def
               parse-defdata
               parse-if
               parse-case
+              parse-let
               parse-tagged
+              parse-get
+              parse-set
+              parse-remove
               parse-fn-call]))
 
 ;; [Interface]
@@ -106,22 +148,3 @@
     
     [::&util/failure ?message]
     (assert false ?message)))
-
-(comment
-  ((comp parse list &lexer/lex) (slurp "src/example/test1.lang"))
-  
-  (&lexer/lex (slurp "src/example/test1.lang"))
-  "\n(def (** base exp)\n  (reduce * 1 (repeat exp base)))\n"
-  
-  [::list ([::ident "def"]
-             [::list ([::ident "**"] [::ident "base"] [::ident "exp"])]
-               [::list ([::ident "reduce"]
-                          [::ident "*"]
-                            [::int "1"]
-                              [::list ([::ident "repeat"]
-                                         [::ident "exp"]
-                                           [::ident "base"])])])]
-
-  (re-find #"^([a-zA-Z!@$%^&*<>\.,/\\\|][a-zA-Z0-9!@$%^&*<>\.,/\\\|]*)" "a9")
-  (re-find #"^([1-9][0-9]*)" "9")
-  )
-- 
cgit v1.2.3