diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lang/compiler.clj | 30 | ||||
| -rw-r--r-- | src/lang/interpreter.clj | 29 | ||||
| -rw-r--r-- | src/lang/lexer.clj | 7 | ||||
| -rw-r--r-- | src/lang/parser.clj | 61 |
4 files changed, 107 insertions, 20 deletions
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") - ) |