aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2014-11-29 02:29:56 -0400
committerEduardo Julian2014-11-29 02:29:56 -0400
commit74f1d02a2f16da9e2ce2fb747dad07979a9db26a (patch)
treed710b3178c804a4fe5d4f8cad0903fc787e60710 /src
parent71b63cbbb858b85dd4850c4aa174cf7ec509b11c (diff)
+ Added simple let expressions. (No destructuring of tuples/records yet)
+ Added records and simple operations on them (get, set & remove).
Diffstat (limited to '')
-rw-r--r--src/example/test1.lang12
-rw-r--r--src/lang/compiler.clj30
-rw-r--r--src/lang/interpreter.clj29
-rw-r--r--src/lang/lexer.clj7
-rw-r--r--src/lang/parser.clj61
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")
- )