diff options
Diffstat (limited to '')
| -rw-r--r-- | src/example/test1.lang | 7 | ||||
| -rw-r--r-- | src/lang/compiler.clj | 23 | ||||
| -rw-r--r-- | src/lang/interpreter.clj | 21 | ||||
| -rw-r--r-- | src/lang/parser.clj | 12 |
4 files changed, 56 insertions, 7 deletions
diff --git a/src/example/test1.lang b/src/example/test1.lang index da3d3fa87..43f3111fa 100644 --- a/src/example/test1.lang +++ b/src/example/test1.lang @@ -7,3 +7,10 @@ (#Cons [val (repeat (-' n 1) val)]))) (repeat 5 5) + +(def (fold f init inputs) + (case inputs + (#Nil []) init + (#Cons [head tail]) (fold f (f init head) tail))) + +(fold * 1 (repeat 5 5)) diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj index 21ef925b5..f189e8d25 100644 --- a/src/lang/compiler.clj +++ b/src/lang/compiler.clj @@ -81,6 +81,28 @@ =else (apply-m compile-form (wrap ?else))] (return `(if ~=test ~=then ~=else)))) +(defcompiler compile-case-branch + [::&parser/case-branch [::&parser/tagged ?tag [::&parser/tuple ?bindings]] ?expr] + (exec [:let [=bindings (map (comp symbol unwrap-ident) ?bindings) + fn-env (into {} (for [a =bindings] [a nil]))] + =expr (apply-m compile-form (wrap* fn-env ?expr))] + (return [?tag =bindings =expr]))) + +(defcompiler compile-case + [::&parser/case ?variant ?branches] + (exec [=variant (apply-m compile-form (wrap ?variant)) + =branches (map-m #(apply-m compile-case-branch (wrap %)) + ?branches) + :let [g!variant (gensym "variant") + =case `(let [~g!variant ~=variant] + (case (:tag ~g!variant) + ~@(apply concat (for [[tag bindings expr] =branches] + [tag `(let [~(vec bindings) (:data ~g!variant)] + ~expr)])))) + ;; _ (prn '=case =case) + ]] + (return =case))) + (defcompiler compile-def [::&parser/def ?form ?body] (match ?form @@ -117,6 +139,7 @@ compile-tuple compile-tagged compile-if + compile-case compile-def compile-defdata compile-fn-call])) diff --git a/src/lang/interpreter.clj b/src/lang/interpreter.clj index 19fe71106..ba370ac2e 100644 --- a/src/lang/interpreter.clj +++ b/src/lang/interpreter.clj @@ -63,7 +63,8 @@ ;; (prn "output#" output#) output#) _# - (fail* (str "Unknown syntax: " (pr-str ~'*token*)))))))) + (do ;; (println "Unknown syntax: " (pr-str ~'*token*)) + (fail* (str "Unknown syntax: " (pr-str ~'*token*))))))))) (defeval eval-ident [::&parser/ident ?ident] @@ -103,8 +104,11 @@ [::&parser/fn-call ?fn ?args] (exec [state &util/get-state =fn (apply-m eval-form (wrap-in state ?fn)) - =args (map-m (fn [arg] (apply-m eval-form (wrap arg))) - ?args)] + ;; :let [_ (prn '=fn ?fn =fn)] + =args (map-m (fn [arg] (apply-m eval-form (wrap-in state arg))) + ?args) + ;; :let [_ (prn '=args =args)] + ] (fn-call =fn =args))) (def eval-form @@ -133,13 +137,14 @@ (comment (let [source-code (slurp "src/example/test1.lang") tokens (&lexer/lex source-code) - _ (prn 'tokens tokens) + ;; _ (prn 'tokens tokens) syntax (&parser/parse tokens) - _ (prn 'syntax syntax)] + ;; _ (prn 'syntax syntax) + ] (eval (update-in +state+ [:forms] concat syntax))) - + ;; (clojure.core/fn [base exp] (fold * 1 (repeat exp base))) @@ -163,5 +168,7 @@ ;; (def (** base exp) ;; (fold * 1 (repeat exp base))) - + ;; Syntax for single-line comments ## + ;; Syntax for multi-line comments #( YOLO )# + ;; Syntax for chars: #"a" ) diff --git a/src/lang/parser.clj b/src/lang/parser.clj index 985a17861..53f60941d 100644 --- a/src/lang/parser.clj +++ b/src/lang/parser.clj @@ -57,6 +57,17 @@ =else (apply-m parse-form (list ?else))] (return [::if =test =then =else]))) +(defparser ^:private parse-case + [::&lexer/list ([[::&lexer/ident "case"] ?variant & cases] :seq)] + (exec [=variant (apply-m parse-form (list ?variant)) + =branches (do (assert (even? (count cases))) + (map-m (fn [[destruct expr]] + (exec [=destruct (apply-m parse-form (list destruct)) + =expr (apply-m parse-form (list expr))] + (return [::case-branch =destruct =expr]))) + (partition 2 cases)))] + (return [::case =variant =branches]))) + (defparser ^:private parse-tagged [::&lexer/list ([[::&lexer/tag ?tag] ?data] :seq)] (exec [=data (apply-m parse-form (list ?data))] @@ -76,6 +87,7 @@ parse-def parse-defdata parse-if + parse-case parse-tagged parse-fn-call])) |