diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser.clj | 26 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 57 | ||||
| -rw-r--r-- | src/lux/util.clj | 4 | ||||
| -rw-r--r-- | test2.lux | 144 |
4 files changed, 142 insertions, 89 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 6b823b3ee..1aa2d587b 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -477,39 +477,39 @@ ;; (prn '->token x) (match x [::&parser/bool ?bool] - (doto (.newInstance (.loadClass loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "test2.Variant1")) (-> .-tag (set! "Bool")) (-> .-_1 (set! ?bool))) [::&parser/int ?int] - (doto (.newInstance (.loadClass loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "test2.Variant1")) (-> .-tag (set! "Int")) (-> .-_1 (set! ?int))) [::&parser/real ?real] - (doto (.newInstance (.loadClass loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "test2.Variant1")) (-> .-tag (set! "Real")) (-> .-_1 (set! ?real))) [::&parser/char ?elem] - (doto (.newInstance (.loadClass loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "test2.Variant1")) (-> .-tag (set! "Char")) (-> .-_1 (set! ?elem))) [::&parser/text ?text] - (doto (.newInstance (.loadClass loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "test2.Variant1")) (-> .-tag (set! "Text")) (-> .-_1 (set! ?text))) [::&parser/tag ?tag] - (doto (.newInstance (.loadClass loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "test2.Variant1")) (-> .-tag (set! "Tag")) (-> .-_1 (set! ?tag))) [::&parser/ident ?ident] - (doto (.newInstance (.loadClass loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "test2.Variant1")) (-> .-tag (set! "Ident")) (-> .-_1 (set! ?ident))) [::&parser/tuple ?elems] - (doto (.newInstance (.loadClass loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "test2.Variant1")) (-> .-tag (set! "Tuple")) (-> .-_1 (set! (->tokens ?elems)))) [::&parser/form ?elems] - (doto (.newInstance (.loadClass loader "test2.Variant1")) + (doto (.newInstance (.loadClass @loader "test2.Variant1")) (-> .-tag (set! "Form")) (-> .-_1 (set! (->tokens ?elems)))) )) @@ -517,11 +517,11 @@ (defn ->tokens [xs] (reduce (fn [tail x] ;; (prn 'tail (.-tag tail) 'x x) - (doto (.newInstance (.loadClass loader "test2.Variant2")) + (doto (.newInstance (.loadClass @loader "test2.Variant2")) (-> .-tag (set! "Cons")) (-> .-_1 (set! (->token x))) (-> .-_2 (set! tail)))) - (doto (.newInstance (.loadClass loader "test2.Variant0")) + (doto (.newInstance (.loadClass @loader "test2.Variant0")) (-> .-tag (set! "Nil"))) (reverse xs))) @@ -557,12 +557,12 @@ :let [_ (prn 'analyse-call [:global-fn ?module ?name] macro? scoped?)]] (if (and macro? (not scoped?)) (let [macro-class (str ?module "$" (normalize-ident ?name)) - transformed (-> (.loadClass loader macro-class) + transformed (-> (.loadClass @loader macro-class) .newInstance (.apply (->tokens ?args)) ->clojure-token) _ (prn 'analyse-call/transformed transformed)] - (-> (.loadClass loader macro-class) + (-> (.loadClass @loader macro-class) .newInstance (.apply (->tokens ?args)) ->clojure-token diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index aea9ea1e2..31b440b88 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -8,7 +8,7 @@ repeat-m try-m try-all-m map-m reduce-m apply-m within normalize-ident - loader]] + loader reset-loader!]] [type :as &type] [lexer :as &lexer] [parser :as &parser] @@ -36,7 +36,7 @@ ;; (println "Defining..." name "@" file-name ;; (alength bytecode) ;; ) ;; (prn 'loader loader) - (.loadClass loader name) + (.loadClass @loader name) ;; (println "SUCCESFUL LOAD!") ;; (.defineClass loader name bytecode 0 (alength bytecode)) )) @@ -281,24 +281,26 @@ nil) ))) -(defcompiler ^:private compile-if - [::&analyser/if ?test ?then ?else] - (let [else-label (new Label) - end-label (new Label)] - ;; (println "PRE") - (compile-form (assoc *state* :form ?test)) - (doto *writer* - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.lang.Boolean") "booleanValue" "()Z") - (.visitJumpInsn Opcodes/IFEQ else-label)) - ;; (prn 'compile-if/?then (:form ?then)) - (compile-form (assoc *state* :form ?then)) - ;; (.visitInsn *writer* Opcodes/POP) - (doto *writer* - (.visitJumpInsn Opcodes/GOTO end-label) - (.visitLabel else-label)) - (compile-form (assoc *state* :form ?else)) - ;; (.visitInsn *writer* Opcodes/POP) - (.visitLabel *writer* end-label))) +(let [+bool-class+ (->class "java.lang.Boolean")] + (defcompiler ^:private compile-if + [::&analyser/if ?test ?then ?else] + (let [else-label (new Label) + end-label (new Label)] + ;; (println "PRE") + (compile-form (assoc *state* :form ?test)) + (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST +bool-class+) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL +bool-class+ "booleanValue" "()Z") + (.visitJumpInsn Opcodes/IFEQ else-label)) + ;; (prn 'compile-if/?then (:form ?then)) + (compile-form (assoc *state* :form ?then)) + ;; (.visitInsn *writer* Opcodes/POP) + (doto *writer* + (.visitJumpInsn Opcodes/GOTO end-label) + (.visitLabel else-label)) + (compile-form (assoc *state* :form ?else)) + ;; (.visitInsn *writer* Opcodes/POP) + (.visitLabel *writer* end-label)))) (defcompiler ^:private compile-do [::&analyser/do ?exprs] @@ -330,6 +332,11 @@ (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO default-label))) + [::default [::&analyser/local _ ?idx] $body] + (doto writer + (.visitVarInsn Opcodes/ASTORE ?idx) + (.visitJumpInsn Opcodes/GOTO (get mappings $body))) + [::store [::&analyser/local _ ?idx] $body] (doto writer (.visitVarInsn Opcodes/ASTORE ?idx) @@ -543,10 +550,13 @@ (.visitVarInsn Opcodes/ASTORE ?idx) (.visitJumpInsn Opcodes/GOTO (get mappings* ?body))) (doto *writer* - (.visitInsn Opcodes/POP) + ;; (.visitInsn Opcodes/POP) + (.visitTypeInsn Opcodes/CHECKCAST (->class +variant-class+)) + (.visitFieldInsn Opcodes/GETFIELD (->class +variant-class+) "tag" (->type-signature "java.lang.String")) (.visitTypeInsn Opcodes/NEW ex-class) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V") + (.visitInsn Opcodes/DUP_X1) + (.visitInsn Opcodes/SWAP) + (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" (str "(" (->type-signature "java.lang.String") ")" "V")) (.visitInsn Opcodes/ATHROW))) ;; (if default-code ;; ;; (do (prn 'default-code default-code) @@ -1006,6 +1016,7 @@ ;; [Interface] (defn compile [class-name inputs] ;; (prn 'inputs inputs) + (reset-loader!) (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)) diff --git a/src/lux/util.clj b/src/lux/util.clj index 890b73880..5496e8699 100644 --- a/src/lux/util.clj +++ b/src/lux/util.clj @@ -160,4 +160,6 @@ (defn normalize-ident [ident] (reduce str "" (map normalize-char ident))) -(defonce loader (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader.)) +(defonce loader (atom nil)) +(defn reset-loader! [] + (reset! loader (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader.))) @@ -75,30 +75,21 @@ (jvm/invokevirtual java.io.PrintStream "println" [Object] (jvm/getstatic System out) [x])) -(def (++ xs ys) +(defmacro (list xs) (case xs #Nil - ys + (#Tag "Nil") (#Cons x xs*) - (#Cons x (++ xs* ys)))) + (#Form (#Cons (#Tag "Cons") (#Cons x (#Cons (list xs*) #Nil)))))) -(def (template elems) - (case elems +(def (++ xs ys) + (case xs #Nil - elems - - (#Cons head tail) - (case head - (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil))) - (#Cons unquoted (template tail)) - - (#Form (#Cons (#Ident "~@") (#Cons spliced #Nil))) - (#Cons (#Ident "++") (#Cons spliced (template tail))) + ys - _ - (#Cons head (template tail)) - ))) + (#Cons x xs*) + (#Cons x (++ xs* ys)))) (def (map f xs) (case xs @@ -108,42 +99,51 @@ (#Cons x xs*) (#Cons (f x) (map f xs*)))) -(def (convert-list f xs) - (case xs +(def (untemplate-list untemplate tokens) + (case tokens #Nil (#Tag "Nil") - (#Cons x xs*) - (#Form (#Cons (#Tag "Cons") (#Cons (f x) (#Cons (convert-list f xs*) #Nil)))))) + (#Cons token tokens') + (#Form (list (#Tag "Cons") (untemplate token) (untemplate-list untemplate tokens'))))) -(def (convert token) +(def (untemplate token) (case token - (#Tag tag) - (#Form (#Cons (#Tag "Tag") (#Cons (#Text tag) #Nil))) + (#Bool elem) + (#Form (list (#Tag "Bool") (#Bool elem))) + + (#Int elem) + (#Form (list (#Tag "Int") (#Int elem))) + + (#Real elem) + (#Form (list (#Tag "Real") (#Real elem))) + + (#Char elem) + (#Form (list (#Tag "Char") (#Char elem))) + + (#Text elem) + (#Form (list (#Tag "Text") (#Text elem))) + + (#Tag elem) + (#Form (list (#Tag "Tag") (#Text elem))) - (#Text text) - (#Form (#Cons (#Tag "Text") (#Cons (#Text text) #Nil))) + (#Ident elem) + (#Form (list (#Tag "Ident") (#Text elem))) - (#Ident ident) - (#Form (#Cons (#Tag "Ident") (#Cons (#Text ident) #Nil))) + (#Form (#Cons (#Ident "~") (#Cons unquoted #Nil))) + unquoted (#Tuple elems) - (#Form (#Cons (#Tag "Tuple") (#Cons (convert-list convert elems) #Nil))) + (#Form (list (#Tag "Tuple") (untemplate-list untemplate elems))) (#Form elems) - (#Form (#Cons (#Tag "Form") (#Cons (convert-list convert elems) #Nil))) + (#Form (list (#Tag "Form") (untemplate-list untemplate elems))) )) (defmacro (' form) (case form - (#Cons form* #Nil) - (case form* - (#Form elems) - (convert (#Form (template elems))) - - _ - (convert form) - ))) + (#Cons token #Nil) + (untemplate token))) ## Utils (def (fail* message) @@ -170,12 +170,6 @@ _ inputs)))) -## Ideally, this is what I want... -## (exec [yolo lol -## #let [foo (bar 1 2 3)] -## #when true] -## (meme yolo foo)) - (def (+ x y) (jvm/i+ x y)) @@ -208,13 +202,10 @@ _ #Nil)) -(defmacro (list xs) - (case xs - #Nil - (#Tag "Nil") - - (#Cons x xs*) - (#Form (#Cons (#Tag "Cons") (#Cons x (#Cons (list xs*) #Nil)))))) +## Ideally, this is what I want... +## (exec [yolo lol +## #let [foo (bar 1 2 3)]] +## (meme yolo foo)) (defmacro (exec tokens) (case tokens @@ -229,6 +220,55 @@ (as-pairs steps)) (#Text "Oh no!")))) +(def (try-m monad) + (lambda [state] + (case (monad state) + (#Ok [?state ?datum]) + (return* ?state (#Just ?datum)) + + (#Failure _) + (return* state #Nothing)))) + +(def (repeat-m monad) + (lambda [state] + (case (monad state) + (#Ok [?state ?head]) + (case ((repeat-m monad) ?state) + (#Ok [?state* ?tail]) + (return* ?state* (#Cons ?head ?tail))) + + (#Failure ?message) + (return* state #Nil)))) + +(def (try-all-m monads) + (lambda [state] + (case monads + #Nil + (fail* "No alternative worked!") + (#Cons monad monads') + (let output (monad state) + (case output + (#Ok _) + output + + (#Failure _) + (case monads' + #Nil + output + (#Cons _ _) + ((try-all-m monads') state)) + )) + ))) + +(def (map-m f inputs) + (case inputs + #Nil + (return #Nil) + (#Cons input inputs') + (exec [output (f input) + outputs (map-m f inputs')] + (return (#Cons output outputs))))) + (def (cons tail head) (#Cons head tail)) @@ -257,7 +297,7 @@ ## Program (def (main args) (case (' ((~ "Oh yeah..."))) - (#Form (#Cons (#Text text) #Nil)) + (#Form (#Cons text #Nil)) (do (println text) (println (+ 10 20)) (println (inc 10)) |