diff options
| -rw-r--r-- | src/lang.clj | 14 | ||||
| -rw-r--r-- | src/lang/asm.clj | 48 | ||||
| -rw-r--r-- | src/lang/compiler.clj | 409 | ||||
| -rw-r--r-- | src/lang/interpreter.clj | 224 | ||||
| -rw-r--r-- | test2.lang | 10 |
5 files changed, 127 insertions, 578 deletions
diff --git a/src/lang.clj b/src/lang.clj index d5c166529..77235dcf0 100644 --- a/src/lang.clj +++ b/src/lang.clj @@ -8,20 +8,18 @@ (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))] (.write stream data))) -(def ^:private +state+ - {:globals {} - :stack {} - :forms '() - :classes {}}) - (comment (let [source-code (slurp "test2.lang") tokens (&lexer/lex source-code) _ (prn 'tokens tokens) syntax (&parser/parse tokens) _ (prn 'syntax syntax) - class-data (&compiler/compile (update-in +state+ [:forms] concat syntax))] + class-data (&compiler/compile syntax)] (write-file "output.class" class-data)) - + (->> (slurp "test2.lang") + &lexer/lex + &parser/parse + &compiler/compile + (write-file "output.class")) ) diff --git a/src/lang/asm.clj b/src/lang/asm.clj deleted file mode 100644 index 9f8e542c4..000000000 --- a/src/lang/asm.clj +++ /dev/null @@ -1,48 +0,0 @@ -(ns lang.asm - (:import (org.objectweb.asm Opcodes - ClassWriter - MethodVisitor))) - -(defn write-file [file data] - (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))] - (.write stream data))) - -(comment - (let [class-data (let [cw (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - "hello_world" nil "java/lang/Object" nil))] - (doto (.visitMethod cw Opcodes/ACC_PUBLIC "<init>" "()V" nil nil) - (.visitCode) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V") - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd)) - (doto (.visitMethod cw (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil) - (.visitCode) - (.visitFieldInsn Opcodes/GETSTATIC "java/lang/System" "out" "Ljava/io/PrintStream;") - (.visitLdcInsn "Hello, World!") - (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/io/PrintStream" "println" "(Ljava/lang/String;)V") - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd)) - (.visitEnd cw) - (.toByteArray cw))] - (write-file "hello_world.class" class-data)) - - - ) - -;; package asm; -;; public class HelloWorld { -;; public static void main(String[] args) { -;; System.out.println("Hello, World!"); -;; } -;; } - - - - - - - diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj index d3265b5e4..1c3f634cc 100644 --- a/src/lang/compiler.clj +++ b/src/lang/compiler.clj @@ -2,12 +2,7 @@ (:refer-clojure :exclude [compile]) (:require [clojure.string :as string] [clojure.core.match :refer [match]] - (lang [util :as &util :refer [exec return* return fail fail* - repeat-m try-m try-all-m map-m - apply-m]] - [parser :as &parser] - [lexer :as &lexer] - [type :as &type]) + [lang.parser :as &parser] :reload) (:import (org.objectweb.asm Opcodes Label @@ -16,320 +11,146 @@ (declare compile-form) -;; [Utils] -(def ^:private +state+ - {:globals {} - :stack {} - :forms '() - :classes {}}) - -(defn define-class [class members] - (fn [state] - (return* (assoc-in state [:classes class] members) nil))) - -(defn find-class [class] - (fn [state] - (if-let [class-data (get-in state [:classes class])] - (return* state class-data) - (fail* (str "Unknown class: " class))))) - -(defn wrap [x] - (update-in +state+ [:forms] conj x)) - -(defn wrap-in [state x] - (assoc-in state [:forms] (list x))) - -(defn wrap* [env x] - (-> +state+ - (update-in [:stack] merge env) - (update-in [:forms] conj x))) - -(defmacro ^:private defcompiler [name match return] - `(def ~name - (fn [state#] - (let [~'*token* (first (:forms state#))] - ;; (prn '~name ~'*token*) - (match ~'*token* - ~match - (let [output# (~return (update-in state# [:forms] rest))] - ;; (prn "output#" output#) - output#) - _# - (fail* (str "Unknown syntax: " (pr-str ~'*token*)))))))) - -(defn unwrap-ident [ident] +;; [Utils/General] +(defmacro ^:private defcompiler [name match body] + `(defn ~name [~'*writer* ~'*form*] + (match ~'*form* + ~match + (do ~body + true) + _# + false))) + +(defn ^:private unwrap-ident [ident] (match ident [::&parser/ident ?label] ?label)) -(defn unwrap-tagged [ident] +(defn ^:private unwrap-tagged [ident] (match ident [::&parser/tagged ?tag ?data] [?tag ?data])) -(defcompiler compile-int - [::&parser/int ?int] - (return ?int)) - -(defcompiler compile-float - [::&parser/float ?float] - (return ?float)) - -(defcompiler compile-ident - [::&parser/ident ?name] - (return (symbol ?name))) - -(defcompiler compile-tuple - [::&parser/tuple ?elems] - (exec [=elems (map-m (fn [elem] (apply-m compile-form (wrap elem))) - ?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))] - (return {:tag ?tag :data =data}))) - -(defcompiler compile-fn-call - [::&parser/fn-call ?fn ?args] - (exec [=fn (apply-m compile-form (wrap ?fn)) - =args (map-m (fn [arg] (apply-m compile-form (wrap arg))) - ?args)] - (return (reduce (fn [f a] `(~f ~a)) - =fn =args)))) - -(defcompiler compile-if - [::&parser/if ?test ?then ?else] - (exec [=test (apply-m compile-form (wrap ?test)) - =then (apply-m compile-form (wrap ?then)) - =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-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)) - =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-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 - [::&parser/fn-call [::&parser/ident ?name] ?args] - (exec [:let [=name (symbol ?name) - =args (map (comp symbol unwrap-ident) ?args) - fn-env (into {} (for [a =args] [a nil]))] - =body (apply-m compile-form (wrap* fn-env ?body)) - :let [curled-body (reduce (fn [inner arg] `(fn [~arg] ~inner)) - =body (reverse =args)) - ;; _ (prn 'curled-body curled-body) - fn-def (let [[_ ?arg ?body] curled-body] - `(fn ~=name ~?arg ~?body)) - ;; _ (prn 'fn-def fn-def) - ]] - (return fn-def)) - - [::&parser/ident ?name] - (apply-m compile-form (wrap ?body)))) - -(defcompiler compile-defdata - [::&parser/defdata ?form ?cases] - (match ?form - [::&parser/fn-call ?name ?args] - (let [=name (unwrap-ident ?name) - ;; _ (prn '=name =name) - =args (map unwrap-ident ?args) - ;; _ (prn '=args =args) - =cases (map unwrap-tagged ?cases) - ;; _ (prn '=cases =cases) - ] - (return `(fn ~(symbol =name) ~(mapv symbol =args)))))) - -;; (def compile-form -;; (try-all-m [compile-int -;; compile-float -;; compile-ident -;; compile-tuple -;; compile-record -;; compile-tagged -;; compile-if -;; compile-case -;; compile-let -;; compile-def -;; compile-defdata -;; compile-fn-call])) - -;; (defn compile [inputs] -;; (assert false) -;; (match ((repeat-m compile-form) inputs) -;; [::&util/ok [?state ?forms]] -;; (if (empty? (:forms ?state)) -;; ?forms -;; (assert false (str "Unconsumed input: " ?state))) - -;; [::&util/failure ?message] -;; (assert false ?message))) +(defn ^:private ->class [class] + (string/replace class #"\." "/")) -(def ^:dynamic *code*) +(defn ^:private ->type-signature [class] + (case class + "Void" "V" + ;; else + (str "L" (->class class) ";"))) -(defcompiler compile-boolean +;; [Utils/Compilers] +(defcompiler ^:private compile-boolean [::&parser/boolean ?boolean] - (do (if ?boolean - (.visitLdcInsn *code* (int 1)) - (.visitLdcInsn *code* (int 0))) - (return nil))) + (if ?boolean + (.visitLdcInsn *writer* (int 1)) + (.visitLdcInsn *writer* (int 0)))) -(defcompiler compile-string +(defcompiler ^:private compile-string [::&parser/string ?string] - (do (doto *code* - (.visitLdcInsn ?string)) - (return nil))) + (.visitLdcInsn *writer* ?string)) -(defn ->java-class [class] - (string/replace class #"\." "/")) - -(defn ->java-class* [class] - (case class - "Void" "V" - ;; else - (str "L" (->java-class class) ";"))) +(defcompiler ^:private compile-ident + [::&parser/ident ?name] + (doto *writer* + (.visitVarInsn Opcodes/ALOAD (int 0)))) -(defn method->signature [method] - (match method - [::&type/fn ?args ?return] - (str "(" (reduce str "" (map ->java-class* ?args)) ")" (->java-class* ?return)))) +(defcompiler ^:private compile-fn-call + [::&parser/fn-call [::&parser/ident ?fn] ?args] + (do (doseq [arg ?args] + (compile-form *writer* arg)) + (doto *writer* + (.visitMethodInsn Opcodes/INVOKESTATIC "output" ?fn "(Ljava/lang/Object;)Ljava/lang/Object;")))) -(defcompiler compile-static-access +(defcompiler ^:private compile-static-access [::&parser/static-access ?class ?member] - (exec [=class (find-class ?class) - :let [member-type (get-in =class [:fields ?member]) - ?field-class (match member-type - [::&type/object ?field-class _] - ?field-class)]] - (do (doto *code* - (.visitFieldInsn Opcodes/GETSTATIC (->java-class ?class) ?member (->java-class* ?field-class))) - (return member-type)))) + (doto *writer* + (.visitFieldInsn Opcodes/GETSTATIC (->class ?class) ?member (->type-signature "java.io.PrintStream")))) -(defcompiler compile-dynamic-access +(defcompiler ^:private compile-dynamic-access [::&parser/dynamic-access ?object ?access] - (exec [_state &util/get-state - =object (apply-m compile-form (wrap-in _state ?object)) - :let [?oclass (match =object - [::&type/object ?oclass _] - ?oclass)] - =class (find-class ?oclass) - [method signature] (match ?access - [::&parser/fn-call [::&parser/ident ?method] ?args] - (exec [=args (map-m #(apply-m compile-form (wrap %)) - ?args)] - (return [?method (method->signature (get-in =class [:methods ?method]))])))] - (do (doto *code* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->java-class ?oclass) method signature)) - (return nil)))) - -(defcompiler compile-ann-class + (let [=object (compile-form *writer* ?object) + method (match ?access + [::&parser/fn-call [::&parser/ident ?method] ?args] + (do (doseq [arg ?args] + (compile-form *writer* arg)) + ?method))] + (doto *writer* + (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") method "(Ljava/lang/String;)V")))) + +(defcompiler ^:private compile-ann-class [::&parser/ann-class ?class ?members] - (exec [_ (define-class ?class ?members) - _state &util/get-state] - (return nil))) + nil) -(defcompiler compile-if +(defcompiler ^:private 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-boolean - compile-string - compile-static-access - compile-dynamic-access - compile-ann-class - compile-if])) - + (let [else-label (new Label) + end-label (new Label)] + (compile-form *writer* ?test) + (.visitJumpInsn *writer* Opcodes/IFEQ else-label) + (compile-form *writer* ?then) + (doto *writer* + (.visitJumpInsn Opcodes/GOTO end-label) + (.visitLabel else-label)) + (compile-form *writer* ?else) + (.visitLabel *writer* end-label))) + +(defcompiler ^:private compile-def + [::&parser/def ?form ?body] + (match ?form + [::&parser/fn-call [::&parser/ident ?name] ?args] + (if (= "main" ?name) + (let [=method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name "([Ljava/lang/String;)V" nil nil) + (.visitCode))] + (compile-form =method ?body) + (doto =method + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd))) + (let [=method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name "(Ljava/lang/Object;)Ljava/lang/Object;" nil nil) + (.visitCode))] + ;; (doto =method + ;; (.visitFieldInsn Opcodes/GETSTATIC (->class "java.lang.System") "out" (->type-signature "java.io.PrintStream")) + ;; (.visitLdcInsn "IN") + ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") "println" "(Ljava/lang/String;)V")) + (compile-form =method ?body) + ;; (doto =method + ;; (.visitFieldInsn Opcodes/GETSTATIC (->class "java.lang.System") "out" (->type-signature "java.io.PrintStream")) + ;; (.visitLdcInsn "OUT") + ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") "println" "(Ljava/lang/String;)V")) + (doto =method + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd)))) + )) + +(let [+compilers+ [compile-boolean + compile-string + compile-ident + compile-fn-call + compile-static-access + compile-dynamic-access + compile-ann-class + compile-if + compile-def]] + (defn ^:private compile-form [writer form] + (prn 'compile-form/form form) + (some #(% writer form) +compilers+))) + +;; [Interface] (defn compile [inputs] - (let [cw (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - "output" nil "java/lang/Object" nil))] - (doto (.visitMethod cw Opcodes/ACC_PUBLIC "<init>" "()V" nil nil) + (prn 'inputs inputs) + (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + "output" nil "java/lang/Object" nil))] + (doto (.visitMethod =class Opcodes/ACC_PUBLIC "<init>" "()V" nil nil) (.visitCode) (.visitVarInsn Opcodes/ALOAD 0) (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V") (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) (.visitEnd)) - (let [_main_ (doto (.visitMethod cw (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil) - (.visitCode) - ;; (.visitFieldInsn Opcodes/GETSTATIC "java/lang/System" "out" "Ljava/io/PrintStream;") - ;; (.visitLdcInsn "Hello, World!") - ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/io/PrintStream" "println" "(Ljava/lang/String;)V") - )] - (binding [*code* _main_] - (match ((repeat-m compile-form) inputs) - [::&util/ok [?state ?forms]] - (if (empty? (:forms ?state)) - ?forms - (assert false (str "Unconsumed input: " ?state))) - - [::&util/failure ?message] - (assert false ?message))) - (doto _main_ - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))) - (.visitEnd cw) - (.toByteArray cw))) + (doall (map (partial compile-form =class) inputs)) + (.visitEnd =class) + (.toByteArray =class))) diff --git a/src/lang/interpreter.clj b/src/lang/interpreter.clj deleted file mode 100644 index 2c3f5af35..000000000 --- a/src/lang/interpreter.clj +++ /dev/null @@ -1,224 +0,0 @@ -(ns lang.interpreter - (:refer-clojure :exclude [eval resolve -' *']) - (:require [clojure.core.match :refer [match]] - (lang [util :as &util :refer [exec return* return fail fail* - repeat-m try-m try-all-m map-m - apply-m]] - [parser :as &parser] - [lexer :as &lexer] - [compiler :as &compiler]) - :reload) - ) - -(declare eval-form) - -;; (defonce _init_ -;; (do (alter-var-root #'clojure.core/prn -;; (constantly #(.println System/out (apply pr-str %&)))))) - -(defprotocol Function - (apply [f x])) - -(defrecord Tagged [tag data]) - -;; (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+ - {:globals {"*" (reify Function - (apply [f x] - (reify Function - (apply [f y] - (* x y))))) - "-" (reify Function - (apply [f x] - (reify Function - (apply [f y] - (- x y))))) - "+" (reify Function - (apply [f x] - (reify Function - (apply [f y] - (+ x y))))) - "<=" (reify Function - (apply [f x] - (reify Function - (apply [f y] - (<= x y)))))} - :stack {} - :forms '()}) - -;; (def ^:private +state+ -;; {:globals {"*" (fn [x] (fn [y] (* x y)))} -;; :stack {} -;; :forms '()}) - -(defn wrap [x] - (update-in +state+ [:forms] conj x)) - -(defn wrap-in [state x] - (assoc state :forms (list x))) - -(defn resolve [ident] - (fn [state] - ;; (prn 'resolve ident (get-in state [:globals ident]) (get-in state [:globals])) - (if-let [value (get-in state [:globals ident])] - (return* state value) - (fail* (str "Unrecognized identifier: " ident))))) - -(defn define [name value] - (fn [state] - ;; (prn 'define name value (assoc-in state [:globals name] value)) - (return* (assoc-in state [:globals name] value) nil))) - -(defn fn-call [f args] - ;; (prn 'fn-call/call f args (first args) (second args)) - ;; (prn 'fn-call/output* (f (first args))) - ;; (prn 'fn-call/output* ((f (first args)) (second args))) - (let [output (reduce #(%1 %2) f args)] - ;; (prn 'fn-call/output output) - (return output))) - -(defmacro ^:private defeval [name match return] - `(def ~name - (fn [state#] - (let [~'*token* (first (:forms state#))] - ;; (prn '~name ~'*token*) - ;; (prn '~name state#) - (match ~'*token* - ~match - (let [output# (~return (update-in state# [:forms] rest))] - ;; (prn "output#" output#) - output#) - _# - (do ;; (println "Unknown syntax: " (pr-str ~'*token*)) - (fail* (str "Unknown syntax: " (pr-str ~'*token*))))))))) - -(defeval eval-ident - [::&parser/ident ?ident] - (resolve ?ident)) - -(defeval eval-int - [::&parser/int ?int] - (return ?int)) - -(defeval eval-float - [::&parser/float ?float] - (return ?float)) - -(defeval eval-def - [::&parser/def ?form ?body] - (exec [;; :let [_ (prn 'eval-defdata ?form ?cases)] - =value (apply-m &compiler/compile-form (wrap *token*)) - ;; :let [_ (prn 'eval-def 'DONE =value)] - :let [=name (match ?form - [::&parser/fn-call [::&parser/ident ?name] ?args] - ?name - - [::&parser/ident ?name] - ?name) - =value* (clojure.core/eval =value) - ;; _ (prn '=value* =value*) - ] - ] - (define =name =value*))) - -(defeval eval-defdata - [::&parser/defdata ?form & ?cases] - (exec [;; :let [_ (prn 'eval-defdata ?form ?cases)] - _ (apply-m &compiler/compile-form (wrap `[::&parser/defdata ~?form ~@?cases])) - ;; :let [_ (prn 'eval-defdata 'DONE)] - ] - (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 - =fn (apply-m eval-form (wrap-in state ?fn)) - ;; :let [_ (prn '=fn ?fn =fn)] - =args (map-m (fn [arg] (apply-m eval-form (wrap-in state arg))) - ?args) - ;; :let [_ (prn '=args =args)] - ] - (return (reduce #(%1 %2) =fn =args)) - ;; (fn-call =fn =args) - )) - -(def eval-form - (try-all-m [eval-int - eval-float - eval-ident - eval-def - eval-defdata - eval-get - eval-set - eval-remove - eval-fn-call])) - -(defn eval [text] - (match ((repeat-m eval-form) text) - [::&util/ok [?state ?forms]] - (if (empty? (:forms ?state)) - ?forms - (assert false (str "Unconsumed input: " ?state))) - - [::&util/failure ?message] - (assert false ?message))) - -(comment - (let [source-code (slurp "src/example/test1.lang") - tokens (&lexer/lex source-code) - ;; _ (prn 'tokens tokens) - syntax (&parser/parse tokens) - ;; _ (prn 'syntax syntax) - ] - (eval (update-in +state+ [:forms] concat syntax))) - - ;; TODO: Add meta-data to top-level vars/fns. - ;; TODO: - ;; TODO: - - ;; (defdata (List x) - ;; (#Nil []) - ;; (#Cons [x] (List x))) - - ;; (def (** base exp) - ;; (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) - - ;; (class (BiFunctor bf) - ;; (: bimap (All [a b c d] - ;; (-> [(-> [a] b) (-> [c] d) (bf a c)] (bf b d))))) - - ;; (instance (BiFunctor Either) - ;; (def (bimap f1 f2 either) - ;; (case either - ;; (#Left l) (#Left (f1 l)) - ;; (#Right r) (#Right (f2 r))))) - ) diff --git a/test2.lang b/test2.lang index df0fe3aac..feb3adc3f 100644 --- a/test2.lang +++ b/test2.lang @@ -9,8 +9,10 @@ fields (: out java.io.PrintStream)) -(_. (_.. java.lang.System out) (println "MEME")) +(def (id x) + x) -(if true - (_. (_.. java.lang.System out) (println "TRUE")) - (_. (_.. java.lang.System out) (println "FALSE"))) +(def (main args) + (if true + (_. (_.. java.lang.System out) (println "TRUE")) + (_. (_.. java.lang.System out) (println "FALSE")))) |