aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lang/analyser.clj30
-rw-r--r--src/lang/compiler.clj81
-rw-r--r--src/lang/parser.clj21
-rw-r--r--test2.lang10
4 files changed, 27 insertions, 115 deletions
diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
index 1e1be1d7b..4b1b95836 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -55,14 +55,14 @@
(defn ^:private with-lambda-scope [body]
(fn [state]
- (let [_ (prn 'with-lambda-scope (get-in state [:lambda-scope 0]) (get-in state [:lambda-scope 1]))
+ (let [;; _ (prn 'with-lambda-scope (get-in state [:lambda-scope 0]) (get-in state [:lambda-scope 1]))
=return (body (-> state
(update-in [:lambda-scope 0] conj (get-in state [:lambda-scope 1]))
(assoc-in [:lambda-scope 1] 0)))]
(match =return
[::&util/ok [?state ?value]]
- [::&util/ok [(do (prn [:lambda-scope 0] (get-in ?state [:lambda-scope 0]))
- (prn [:lambda-scope 1] (get-in ?state [:lambda-scope 1]))
+ [::&util/ok [(do ;; (prn [:lambda-scope 0] (get-in ?state [:lambda-scope 0]))
+ ;; (prn [:lambda-scope 1] (get-in ?state [:lambda-scope 1]))
(-> ?state
(update-in [:lambda-scope 0] pop)
(assoc-in [:lambda-scope 1] (inc (get-in state [:lambda-scope 1])))))
@@ -118,8 +118,8 @@
]
(match =return
[::&util/ok [?state ?value]]
- (do (prn 'PRE-LAMBDA (:env state))
- (prn 'POST-LAMBDA (:env ?state) ?value)
+ (do ;; (prn 'PRE-LAMBDA (:env state))
+ ;; (prn 'POST-LAMBDA (:env ?state) ?value)
[::&util/ok [(-> ?state
(update-in [:env] rest)
;; (update-in [:lambda-scope 1] inc)
@@ -154,17 +154,18 @@
(let [?module (get-in state [:deps ?alias])]
;; (prn 'resolve ?module ?alias ?binding)
[::&util/ok [state (annotated [::global ?module ?binding] ::&type/nothing)]])
- (let [_ (prn 'resolve/_1 ident)
+ (let [;; _ (prn 'resolve/_1 ident)
[inner outer] (split-with #(nil? (get-in % [:mappings ident])) (:env state))
;; _ (prn ident '[inner outer] [inner outer])
- _ (prn 'resolve/_2 '[inner outer] [inner outer])]
+ ;; _ (prn 'resolve/_2 '[inner outer] [inner outer])
+ ]
(cond (empty? inner)
[::&util/ok [state (-> state :env first :mappings (get ident))]]
(empty? outer)
(if-let [global|import (or (get-in state [:defs-env ident])
(get-in state [:imports ident]))]
- (do (prn 'resolve/_3 'global|import global|import)
+ (do ;; (prn 'resolve/_3 'global|import global|import)
[::&util/ok [state global|import]])
[::&util/failure (str "Unresolved identifier: " ident)])
@@ -179,7 +180,8 @@
(iterate pop)
(take (count inner))
reverse)))
- _ (prn 'resolve/_4 '[=local inner*] =local inner*)]
+ ;; _ (prn 'resolve/_4 '[=local inner*] =local inner*)
+ ]
[::&util/ok [(assoc state :env (concat inner* outer)) =local]])))
)))
@@ -239,14 +241,11 @@
;; (resolve ?ident))
(exec [=ident (resolve ?ident)
;; :let [_ (prn 'analyse-ident ?ident =ident)]
- state &util/get-state
- :let [_ (prn 'analyse-ident ?ident (:form =ident) (:env state))]]
+ ;; state &util/get-state
+ ;; :let [_ (prn 'analyse-ident ?ident (:form =ident) (:env state))]
+ ]
(return =ident)))
-(defanalyser analyse-ann-class
- [::&parser/ann-class ?class ?members]
- (return (annotated [::ann-class ?class ?members] ::&type/nothing)))
-
(defanalyser analyse-static-access
[::&parser/static-access ?target ?member]
(exec [=target (resolve ?target)
@@ -416,7 +415,6 @@
analyse-tuple
analyse-lambda
analyse-ident
- analyse-ann-class
analyse-static-access
analyse-dynamic-access
analyse-fn-call
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index bd64563e8..83aa14252 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -125,7 +125,7 @@
(defcompiler ^:private compile-captured
[::&analyser/captured ?scope ?captured-id ?source]
- (do (prn 'CAPTURED [?scope ?captured-id])
+ (do ;; (prn 'CAPTURED [?scope ?captured-id])
(doto *writer*
(.visitVarInsn Opcodes/ALOAD 0)
(.visitFieldInsn Opcodes/GETFIELD (apply str (interpose "$" ?scope)) (str "__" ?captured-id) "Ljava/lang/Object;"))))
@@ -170,11 +170,7 @@
(->> (when (> (count ?args) 1))))
(.visitMethodInsn Opcodes/INVOKESPECIAL call-class "<init>" signature)
(do (compile-form (assoc *state* :form (last ?args))))
- (.visitMethodInsn Opcodes/INVOKEINTERFACE "test2/Function" "apply" apply-signature))
- ;; (doseq [arg ?args]
- ;; (compile-form (assoc *state* :form arg))
- ;; (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "test2/Function" "apply" apply-signature))
- )
+ (.visitMethodInsn Opcodes/INVOKEINTERFACE "test2/Function" "apply" apply-signature)))
_
(do (compile-form (assoc *state* :form ?fn))
@@ -198,10 +194,6 @@
(.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") ?method "(Ljava/lang/Object;)V")
(.visitInsn Opcodes/ACONST_NULL))))
-(defcompiler ^:private compile-ann-class
- [::&analyser/ann-class ?class ?members]
- nil)
-
(defcompiler ^:private compile-if
[::&analyser/if ?test ?then ?else]
(let [else-label (new Label)
@@ -301,19 +293,8 @@
(.visitCode)
(.visitVarInsn Opcodes/ALOAD 0)
(.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V")
- (-> (doto ;; (.visitFieldInsn Opcodes/GETSTATIC (->class "java.lang.System") "out" (->type-signature "java.io.PrintStream"))
- ;; (.visitTypeInsn Opcodes/NEW (->class "java.lang.Integer"))
- ;; (.visitInsn Opcodes/DUP)
- ;; (.visitVarInsn Opcodes/ALOAD 1)
- ;; ;; (.visitVarInsn Opcodes/ALOAD 0)
- ;; ;; (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig)
- ;; (.visitMethodInsn Opcodes/INVOKESPECIAL (->class "java.lang.Integer") "<init>" "(I)V")
- ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") "println" "(Ljava/lang/Object;)V")
-
- (.visitVarInsn Opcodes/ALOAD 0)
+ (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
(.visitVarInsn Opcodes/ILOAD 1)
- ;; (.visitInsn Opcodes/ICONST_0)
-
(.visitFieldInsn Opcodes/PUTFIELD current-class "_counter" counter-sig)
(-> (doto (.visitVarInsn Opcodes/ALOAD 0)
(.visitVarInsn Opcodes/ALOAD (+ clo_idx 2))
@@ -328,20 +309,10 @@
(.visitEnd))
=method (let [default-label (new Label)
branch-labels (for [_ (range num-captured)]
- (new Label))
- ;; _ (prn 'branch-labels (count branch-labels) branch-labels)
- ;; end-label (new Label)
- ]
+ (new Label))]
(doto (.visitMethod =class Opcodes/ACC_PUBLIC "apply" apply-signature nil nil)
(.visitCode)
- (-> (doto ;; (.visitFieldInsn Opcodes/GETSTATIC (->class "java.lang.System") "out" (->type-signature "java.io.PrintStream"))
- ;; (.visitTypeInsn Opcodes/NEW (->class "java.lang.Integer"))
- ;; (.visitInsn Opcodes/DUP)
- ;; (.visitVarInsn Opcodes/ALOAD 0)
- ;; (.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig)
- ;; (.visitMethodInsn Opcodes/INVOKESPECIAL (->class "java.lang.Integer") "<init>" "(I)V")
- ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") "println" "(Ljava/lang/Object;)V")
- (.visitVarInsn Opcodes/ALOAD 0)
+ (-> (doto (.visitVarInsn Opcodes/ALOAD 0)
(.visitFieldInsn Opcodes/GETFIELD current-class "_counter" counter-sig)
(.visitTableSwitchInsn 0 (dec num-captured) default-label (into-array Label branch-labels))
(-> (doto (.visitLabel branch-label)
@@ -401,16 +372,6 @@
(.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) ?body))
(compile-method-function *writer* *class-name* ?name (count ?args) ?body *state*)))
)))
@@ -423,7 +384,7 @@
(defcompiler ^:private compile-lambda
[::&analyser/lambda ?scope ?frame ?args ?body]
- (let [_ (prn '[?scope ?frame] ?scope ?frame)
+ (let [;; _ (prn '[?scope ?frame] ?scope ?frame)
num-args (count ?args)
outer-class (->class *class-name*)
clo-field-sig (->type-signature "java.lang.Object")
@@ -441,8 +402,8 @@
(apply str counter-sig (repeat num-captured clo-field-sig)))
")"
"V")
- _ (prn current-class 'init-signature init-signature)
- _ (prn current-class 'real-signature real-signature)
+ ;; _ (prn current-class 'init-signature init-signature)
+ ;; _ (prn current-class 'real-signature real-signature)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
current-class nil "java/lang/Object" (into-array ["test2/Function"]))
@@ -509,7 +470,6 @@
(-> (.visitInsn Opcodes/ACONST_NULL)
(->> (dotimes [clo_idx (- (dec num-captured) current-captured)])))
(.visitMethodInsn Opcodes/INVOKESPECIAL current-class "<init>" init-signature)
- ;; (.visitJumpInsn Opcodes/GOTO end-label)
(.visitInsn Opcodes/ARETURN))
(->> (doseq [[branch-label current-captured] (map vector branch-labels (range (count branch-labels)))
;; :let [_ (prn '[branch-label current-captured] [branch-label current-captured])]
@@ -521,13 +481,11 @@
(->> (when (not= 0 num-captured))))
(.visitVarInsn Opcodes/ALOAD 1)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL current-class "impl" real-signature)
- ;; (.visitLabel end-label)
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd)))
;; _ (prn 'LAMBDA/?body ?body)
- =impl (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC ;; Opcodes/ACC_STATIC
- ) "impl" real-signature nil nil)
+ =impl (doto (.visitMethod =class Opcodes/ACC_PUBLIC "impl" real-signature nil nil)
(.visitCode)
(->> (assoc *state* :form ?body :writer)
compile-form)
@@ -536,10 +494,10 @@
(.visitEnd))
_ (.visitEnd =class)]
(write-file (str current-class ".class") (.toByteArray =class))
- (apply prn 'LAMBDA ?scope ?args (->> (:mappings ?frame)
- (map second)
- (map :form)
- (filter captured?)))
+ ;; (apply prn 'LAMBDA ?scope ?args (->> (:mappings ?frame)
+ ;; (map second)
+ ;; (map :form)
+ ;; (filter captured?)))
(doto *writer*
(.visitTypeInsn Opcodes/NEW current-class)
(.visitInsn Opcodes/DUP)
@@ -639,7 +597,6 @@
compile-call
compile-static-access
compile-dynamic-access
- compile-ann-class
compile-if
compile-do
compile-case
@@ -661,25 +618,13 @@
(let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
(->class class-name) nil "java/lang/Object" nil))
- ;; (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- ;; (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
- ;; "output" nil "java/lang/Object" nil))
state {:class-name class-name
:writer =class
:form nil
:parent 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))
(doseq [input inputs]
(when (not (compile-form (assoc state :form input)))
(assert false input)))
- ;; (doall (map #(compile-form (assoc state :form %)) inputs))
- ;; (prn 'inputs inputs)
(when-let [constants (seq (for [input inputs
:let [payload (match (:form input)
[::&analyser/def (?name :guard string?) ?body]
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index 90db91172..ea3f518f5 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -168,26 +168,6 @@
=call (apply-m parse-form (list ?call))]
(return [::dynamic-access =object =call])))
-(defparser ^:private parse-ann-class
- [::&lexer/list ([[::&lexer/ident "ann-class"] [::&lexer/ident ?class] & ?decl] :seq)]
- (let [[_ class-data] (reduce (fn [[mode data] event]
- (match event
- [::&lexer/ident "methods"]
- [:methods data]
-
- [::&lexer/ident "fields"]
- [:fields data]
-
- [::&lexer/list ([[::&lexer/ident ":"] [::&lexer/ident ?field-name] [::&lexer/ident ?field-class]] :seq)]
- [mode (assoc-in data [mode ?field-name] [::&type/object ?field-class []])]
-
- [::&lexer/list ([[::&lexer/ident ":"] [::&lexer/ident ?method-name] [::&lexer/list ([[::&lexer/ident "->"] [::&lexer/tuple ?args*] [::&lexer/ident ?return]] :seq)]] :seq)]
- [mode (assoc-in data [mode ?method-name] [::&type/fn (map ident->string ?args*) ?return])]
- ))
- [nil {}]
- ?decl)]
- (return [::ann-class ?class class-data])))
-
(defparser ^:private parse-string
[::&lexer/string ?string]
(return [::string ?string]))
@@ -221,7 +201,6 @@
parse-remove
parse-static-access
parse-dynamic-access
- parse-ann-class
parse-defclass
parse-definterface
parse-import
diff --git a/test2.lang b/test2.lang
index 8f9b7c817..758f01720 100644
--- a/test2.lang
+++ b/test2.lang
@@ -1,16 +1,6 @@
(import java.lang.System)
(require "./another" as another)
-(ann-class java.lang.String)
-
-(ann-class java.io.PrintStream
- methods
- (: println (-> [java.lang.String] Void)))
-
-(ann-class java.lang.System
- fields
- (: out java.io.PrintStream))
-
(defclass Tagged [[java.lang.String tag] [java.lang.Object value]])
(definterface Function
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 07:05:24 +0000