aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lang.clj3
-rw-r--r--src/lang/analyser.clj83
-rw-r--r--src/lang/compiler.clj116
-rw-r--r--src/lang/lexer.clj11
4 files changed, 140 insertions, 73 deletions
diff --git a/src/lang.clj b/src/lang.clj
index 0aaba1b81..f12ffc8d5 100644
--- a/src/lang.clj
+++ b/src/lang.clj
@@ -11,7 +11,6 @@
(.write stream data)))
(comment
- ;; TODO: Add pattern-matching.
;; TODO: Fold all closure classes into one.
;; TODO: When doing partial application, skip "apply" and just call constructor appropiatedly.
;; TODO: Add extra arities (apply2, apply3, ..., apply16)
@@ -28,7 +27,7 @@
;; TODO: Adding metadata to global vars.
;; TODO: Add records.
;; TODO: throw, try, catch, finally
- ;; TODO:
+ ;; TODO: Finish implementing pattern matching.
;; TODO:
(let [source-code (slurp "test2.lang")
diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
index 0cab85f66..bc48a0c81 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -55,7 +55,7 @@
_
true)]
[k v]))]
- (prn 'ms ms 'ms* ms*)
+ ;; (prn 'ms ms 'ms* ms*)
ms*))))))]
(match =return
[::&util/ok [?state ?value]]
@@ -80,7 +80,7 @@
(fn [state]
(if-let [[_ ?alias ?binding] (re-find #"^(.*)/(.*)$" ident)]
(let [?module (get-in state [:deps ?alias])]
- (prn 'resolve ?module ?alias ?binding)
+ ;; (prn 'resolve ?module ?alias ?binding)
[::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]])
(if-let [resolved (get-in state [:env :mappings ident])]
[::&util/ok [state resolved]]
@@ -96,10 +96,12 @@
(fail* (str "Unmatched token: " token#))))))
(defn analyse-form* [form]
- (prn 'analyse-form* form)
+ ;; (prn 'analyse-form* form)
(fn [state]
(let [old-forms (:forms state)
- =return (analyse-form (assoc state :forms (list form)))]
+ =return (analyse-form (assoc state :forms (list form)))
+ ;; _ (prn 'analyse-form*/=return =return)
+ ]
(match =return
[::&util/ok [?state ?value]]
[::&util/ok [(assoc ?state :forms old-forms) ?value]]
@@ -121,7 +123,10 @@
(defanalyser analyse-variant
[::&parser/tagged ?tag ?value]
- (exec [=value (analyse-form* ?value)]
+ (exec [;; :let [_ (prn 'analyse-variant [?tag ?value])]
+ =value (analyse-form* ?value)
+ ;; :let [_ (prn '=value =value)]
+ ]
(return (annotated [::variant ?tag =value] [::&type/variant ?tag (:type =value)]))))
(defanalyser analyse-tuple
@@ -132,7 +137,8 @@
(defanalyser analyse-ident
[::&parser/ident ?ident]
(exec [_env (fn [state] [::&util/ok [state (:env state)]])
- :let [_ (prn 'analyse-ident ?ident _env)]]
+ ;; :let [_ (prn 'analyse-ident ?ident _env)]
+ ]
(resolve ?ident)))
(defanalyser analyse-ann-class
@@ -142,7 +148,8 @@
(defanalyser analyse-static-access
[::&parser/static-access ?target ?member]
(exec [=target (resolve ?target)
- :let [_ (prn '=target ?target (:form =target))]]
+ ;; :let [_ (prn '=target ?target (:form =target))]
+ ]
(match (:form =target)
[::class ?class]
(return (annotated [::static-access ?class ?member] ::&type/nothing)))))
@@ -157,22 +164,24 @@
(defanalyser analyse-fn-call
[::&parser/fn-call ?fn ?args]
- (exec [:let [_ (prn 'PRE '?fn ?fn)]
+ (exec [;; :let [_ (prn 'PRE '?fn ?fn)]
=fn (analyse-form* ?fn)
- :let [_ (prn '=fn =fn)]
+ ;; :let [_ (prn '=fn =fn)]
=args (map-m analyse-form* ?args)
- :let [_ (prn '=args =args)]]
+ ;; :let [_ (prn '=args =args)]
+ ]
(return (annotated [::call =fn =args] [::&type/object "java.lang.Object" []]))))
(defanalyser analyse-if
[::&parser/if ?test ?then ?else]
(exec [=test (analyse-form* ?test)
- :let [_ (prn '=test =test)]
- :let [_ (prn 'PRE '?then ?then)]
+ ;; :let [_ (prn '=test =test)]
+ ;; :let [_ (prn 'PRE '?then ?then)]
=then (analyse-form* ?then)
- :let [_ (prn '=then =then)]
+ ;; :let [_ (prn '=then =then)]
=else (analyse-form* ?else)
- :let [_ (prn '=else =else)]]
+ ;; :let [_ (prn '=else =else)]
+ ]
(return (annotated [::if =test =then =else] ::&type/nothing))))
(defanalyser analyse-do
@@ -180,6 +189,27 @@
(exec [=exprs (map-m analyse-form* ?exprs)]
(return (annotated [::do =exprs] (-> =exprs last :type)))))
+(defanalyser analyse-case
+ [::&parser/case ?variant ?branches]
+ (exec [;; :let [_ (prn '?variant ?variant)]
+ =variant (analyse-form* ?variant)
+ ;; :let [_ (prn '=variant =variant)]
+ =branches (map-m (fn [branch]
+ ;; (prn 'branch branch)
+ (match branch
+ [::&parser/case-branch [::&parser/tagged ?tag [::&parser/ident ?label]] ?body]
+ (exec [;; :let [_ (prn ?tag ?label '?body ?body)]
+ idx next-local-idx
+ =body (with-local ?label [::&type/object "java.lang.Object" []]
+ (analyse-form* ?body))
+ ;; :let [_ (prn ?tag ?label '=body =body)]
+ ]
+ (return [?tag ?label idx =body]))))
+ ?branches)
+ ;; :let [_ (prn '=branches =branches)]
+ ]
+ (return (annotated [::case =variant =branches] ::&type/nothing))))
+
(defanalyser analyse-let
[::&parser/let ?label ?value ?body]
(exec [=value (analyse-form* ?value)
@@ -222,7 +252,7 @@
[::&parser/ident ?ident]
?ident))]
(exec [[=function =args =return] (within :types (&type/fresh-function (count args)))
- :let [_ (prn '[=function =args =return] [=function =args =return])]
+ ;; :let [_ (prn '[=function =args =return] [=function =args =return])]
;; :let [env (-> {}
;; (assoc ?name =function)
;; (into (map vector args =args)))
@@ -231,10 +261,10 @@
(with-local label type inner))
(analyse-form* ?value)
(reverse (map vector args =args)))
- :let [_ (prn '=value =value)]
+ ;; :let [_ (prn '=value =value)]
=function (within :types (exec [_ (&type/solve =return (:type =value))]
(&type/clean =function)))
- :let [_ (prn '=function =function)]
+ ;; :let [_ (prn '=function =function)]
_ (define ?name {:mode ::function
:access ::public
:type =function})]
@@ -243,21 +273,22 @@
(defanalyser analyse-lambda
[::&parser/lambda ?args ?body]
- (exec [:let [_ (prn 'analyse-lambda ?args ?body)]
+ (exec [;; :let [_ (prn 'analyse-lambda ?args ?body)]
[=function =args =return] (within :types (&type/fresh-function (count ?args)))
- :let [_ (prn '[=function =args =return] [=function =args =return])]
- :let [_ (prn 'PRE/?body ?body)]
+ ;; :let [_ (prn '[=function =args =return] [=function =args =return])]
+ ;; :let [_ (prn 'PRE/?body ?body)]
_env (fn [state] [::&util/ok [state (:env state)]])
- :let [_ (prn 'analyse-lambda _env)]
+ ;; :let [_ (prn 'analyse-lambda _env)]
=body (with-fresh-env
(reduce (fn [inner [label type]]
(with-local label type inner))
(analyse-form* ?body)
(reverse (map vector ?args =args))))
- :let [_ (prn '=body =body)]
+ ;; :let [_ (prn '=body =body)]
=function (within :types (exec [_ (&type/solve =return (:type =body))]
(&type/clean =function)))
- :let [_ (prn '=function =function)]]
+ ;; :let [_ (prn '=function =function)]
+ ]
(return (annotated [::lambda ?args =body] =function))))
(defanalyser analyse-import
@@ -267,9 +298,10 @@
(defanalyser analyse-require
[::&parser/require ?file ?alias]
- (let [_ (prn `[require ~?file ~?alias])
+ (let [;; _ (prn `[require ~?file ~?alias])
module-name (re-find #"[^/]+$" ?file)
- _ (prn 'module-name module-name)]
+ ;; _ (prn 'module-name module-name)
+ ]
(exec [_ (require-module module-name ?alias)]
(return (annotated [::require ?file ?alias] ::&type/nothing)))))
@@ -289,6 +321,7 @@
analyse-fn-call
analyse-if
analyse-do
+ analyse-case
analyse-let
analyse-defclass
analyse-definterface
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index b29bc38d1..48cbe3999 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -142,7 +142,7 @@
(defcompiler ^:private compile-call
[::&analyser/call ?fn ?args]
- (do (prn 'compile-call (:form ?fn) ?fn ?args)
+ (do ;; (prn 'compile-call (:form ?fn) ?fn ?args)
(match (:form ?fn)
[::&analyser/local _]
(do (compile-form (assoc *state* :form ?fn))
@@ -198,7 +198,7 @@
(doto *writer*
(.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.lang.Boolean") "booleanValue" "()Z")
(.visitJumpInsn Opcodes/IFEQ else-label))
- (prn 'compile-if/?then (:form ?then))
+ ;; (prn 'compile-if/?then (:form ?then))
(assert (compile-form (assoc *state* :form ?then)) "CAN't COMPILE THEN")
(doto *writer*
(.visitJumpInsn Opcodes/GOTO end-label)
@@ -213,12 +213,45 @@
(.visitInsn *writer* Opcodes/POP))
(compile-form (assoc *state* :form (last ?exprs)))))
+(let [oclass (->class "java.lang.Object")
+ equals-sig (str "(" (->type-signature "java.lang.Object") ")Z")]
+ (defcompiler ^:private compile-case
+ [::&analyser/case ?variant ?branches]
+ (do (compile-form (assoc *state* :form ?variant))
+ (let [end-label (new Label)]
+ (doseq [[?tag ?label ?idx ?body] ?branches]
+ ;; (prn '[?tag ?label ?idx ?body] [?tag ?label ?idx ?body])
+ (let [else-label (new Label)]
+ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitFieldInsn Opcodes/GETFIELD (->class +variant-class+) "tag" "Ljava/lang/String;")
+ (.visitLdcInsn ?tag)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig)
+ (.visitJumpInsn Opcodes/IFEQ else-label))
+ (let [start-label (new Label)
+ end-label (new Label)]
+ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitFieldInsn Opcodes/GETFIELD (->class +variant-class+) "value" (->type-signature "java.lang.Object")))
+ (.visitLocalVariable *writer* ?label (->type-signature "java.lang.Object") nil start-label end-label ?idx)
+ (doto *writer*
+ (.visitVarInsn Opcodes/ASTORE ?idx)
+ (.visitLabel start-label)
+ (.visitInsn Opcodes/POP))
+ (compile-form (assoc *state* :form ?body))
+ (.visitLabel *writer* end-label))
+ (doto *writer*
+ (.visitJumpInsn Opcodes/GOTO end-label)
+ (.visitLabel else-label))))
+ (.visitLabel *writer* end-label))
+ )))
+
(defcompiler ^:private compile-let
[::&analyser/let ?idx ?label ?value ?body]
(let [start-label (new Label)
end-label (new Label)
?idx (int ?idx)]
- (prn '(:type ?value) (:type ?value) (->java-sig (:type ?value)))
+ ;; (prn '(:type ?value) (:type ?value) (->java-sig (:type ?value)))
(.visitLocalVariable *writer* ?label (->java-sig (:type ?value)) nil start-label end-label ?idx)
(assert (compile-form (assoc *state* :form ?value)) "CAN't COMPILE LET-VALUE")
(doto *writer*
@@ -282,38 +315,38 @@
(defcompiler ^:private compile-def
[::&analyser/def ?form ?body]
- (do (prn 'compile-def ?form)
- (match ?form
- (?name :guard string?)
- (let [=type (:type ?body)
- ;; _ (prn '?body ?body)
- ]
- (doto (.visitField *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name (->java-sig =type) nil nil)
- (.visitEnd)))
-
- [?name ?args]
- (do (prn 'compile-def `(~'def (~(symbol ?name) ~@(map symbol ?args))))
- (if (= "main" ?name)
- (let [signature "([Ljava/lang/String;)V"
- =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil)
- (.visitCode))]
- ;; (prn 'FN/?body ?body)
- (assert (compile-form (assoc *state* :parent *writer* :writer =method :form ?body)) (str "Body couldn't compile: " (pr-str ?body)))
- (doto =method
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd)))
- (let [signature (str "(" (apply str (repeat (count ?args) "Ljava/lang/Object;")) ")" "Ljava/lang/Object;")
- _ (prn 'signature signature)
- =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil)
- (.visitCode))]
- (compile-form (assoc *state* :parent *writer* :writer =method :form ?body))
- (doto =method
- (.visitInsn Opcodes/ARETURN)
- (.visitMaxs 0 0)
- (.visitEnd))
- (compile-method-function *writer* *class-name* ?name (count ?args)))))
- )))
+ (do ;; (prn 'compile-def ?form)
+ (match ?form
+ (?name :guard string?)
+ (let [=type (:type ?body)
+ ;; _ (prn '?body ?body)
+ ]
+ (doto (.visitField *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name (->java-sig =type) nil nil)
+ (.visitEnd)))
+
+ [?name ?args]
+ (do ;; (prn 'compile-def `(~'def (~(symbol ?name) ~@(map symbol ?args))))
+ (if (= "main" ?name)
+ (let [signature "([Ljava/lang/String;)V"
+ =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil)
+ (.visitCode))]
+ ;; (prn 'FN/?body ?body)
+ (assert (compile-form (assoc *state* :parent *writer* :writer =method :form ?body)) (str "Body couldn't compile: " (pr-str ?body)))
+ (doto =method
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ (let [signature (str "(" (apply str (repeat (count ?args) "Ljava/lang/Object;")) ")" "Ljava/lang/Object;")
+ ;; _ (prn 'signature signature)
+ =method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name signature nil nil)
+ (.visitCode))]
+ (compile-form (assoc *state* :parent *writer* :writer =method :form ?body))
+ (doto =method
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
+ (compile-method-function *writer* *class-name* ?name (count ?args)))))
+ )))
(defcompiler ^:private compile-lambda
[::&analyser/lambda ?args ?body]
@@ -371,7 +404,7 @@
(write-file (str current-class ".class") (.toByteArray =class))))
(let [=method (doto (.visitMethod *parent* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "lambda_impl" real-signature nil nil)
(.visitCode))]
- (prn '(:form ?body) (:form ?body))
+ ;; (prn '(:form ?body) (:form ?body))
(compile-form (assoc *state* :parent *parent* :writer =method :form ?body))
(doto =method
(.visitInsn Opcodes/ARETURN)
@@ -448,15 +481,15 @@
(defcompiler compile-require
[::&analyser/require ?file ?alias]
(let [module-name (re-find #"[^/]+$" ?file)
- _ (prn 'module-name module-name)
+ ;; _ (prn 'module-name module-name)
source-code (slurp (str module-name ".lang"))
- _ (prn 'source-code source-code)
+ ;; _ (prn 'source-code source-code)
tokens (&lexer/lex source-code)
- _ (prn 'tokens tokens)
+ ;; _ (prn 'tokens tokens)
syntax (&parser/parse tokens)
- _ (prn 'syntax syntax)
+ ;; _ (prn 'syntax syntax)
ann-syntax (&analyser/analyse module-name syntax)
- _ (prn 'ann-syntax ann-syntax)
+ ;; _ (prn 'ann-syntax ann-syntax)
class-data (compile module-name ann-syntax)]
(write-file (str module-name ".class") class-data)
nil))
@@ -472,6 +505,7 @@
compile-ann-class
compile-if
compile-do
+ compile-case
compile-let
compile-lambda
compile-def
diff --git a/src/lang/lexer.clj b/src/lang/lexer.clj
index 93bdf51aa..870209503 100644
--- a/src/lang/lexer.clj
+++ b/src/lang/lexer.clj
@@ -74,12 +74,13 @@
(def ^:private lex-string
(exec [_ (lex-str "\"")
- state &util/get-state
- :let [_ (prn 'PRE state)]
+ ;; state &util/get-state
+ ;; :let [_ (prn 'PRE state)]
token lex-string-body
_ (lex-str "\"")
- state &util/get-state
- :let [_ (prn 'POST state)]]
+ ;; state &util/get-state
+ ;; :let [_ (prn 'POST state)]
+ ]
(return [::string token])))
(def ^:private lex-single-line-comment
@@ -106,7 +107,7 @@
;; :let [_ (prn 'COMMENT comment)]
_ (lex-str ")#")
;; :let [_ (prn 'CLOSE)]
- :let [_ (prn 'multi-comment comment)]
+ ;; :let [_ (prn 'multi-comment comment)]
]
(return [::comment comment])))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 06:48:18 +0000