diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser.clj | 5 | ||||
| -rw-r--r-- | src/lux/analyser/base.clj | 7 | ||||
| -rw-r--r-- | src/lux/analyser/env.clj | 6 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 44 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 9 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 2 | ||||
| -rw-r--r-- | src/lux/compiler/case.clj | 80 | ||||
| -rw-r--r-- | src/lux/compiler/lambda.clj | 16 | ||||
| -rw-r--r-- | src/lux/compiler/lux.clj | 45 | ||||
| -rw-r--r-- | src/lux/host.clj | 21 | ||||
| -rw-r--r-- | src/lux/lexer.clj | 4 | ||||
| -rw-r--r-- | src/lux/parser.clj | 66 | ||||
| -rw-r--r-- | src/lux/reader.clj | 77 | ||||
| -rw-r--r-- | src/lux/type.clj | 38 |
14 files changed, 177 insertions, 243 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index eefb5b41c..8fad07dfa 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -26,9 +26,6 @@ ["lux;Nil" _]]]]]]]]] (&/T catch+ ?finally-body))) -(defn ^:private _meta [token] - (&/V "lux;Meta" (&/T (&/T "" -1 -1) token))) - (defn ^:private aba1 [analyse eval! exo-type token] (matchv ::M/objects [token] ;; Standard special forms @@ -59,7 +56,7 @@ (&&lux/analyse-record analyse exo-type ?elems) [["lux;Meta" [meta ["lux;Tag" ?ident]]]] - (&&lux/analyse-variant analyse exo-type ?ident (_meta (&/V "lux;Tuple" (|list)))) + (&&lux/analyse-variant analyse exo-type ?ident (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;Tuple" (|list))))) [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]] (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null")))) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index b16025349..a4c96c350 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -25,10 +25,3 @@ &/get-module-name (return ?module))] (return (&/ident->text (&/T module* ?name)))))) - -(defn resolved-ident* [ident] - (|let [[?module ?name] ident] - (|do [module* (if (= "" ?module) - &/get-module-name - (return ?module))] - (return (&/T module* ?name))))) diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj index 77fba3ca0..fa7b9aa1a 100644 --- a/src/lux/analyser/env.clj +++ b/src/lux/analyser/env.clj @@ -34,12 +34,6 @@ [_] =return)))) -(defn with-locals [locals monad] - (reduce (fn [inner [label elem]] - (with-local label elem inner)) - monad - (reverse locals))) - (def captured-vars (fn [state] (return* state (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS))))) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 0d9fb1333..3631bddb2 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -75,46 +75,40 @@ ) (defn analyse-jvm-getstatic [analyse ?class ?field] - (|do [=class (&host/full-class-name ?class) - =type (&host/lookup-static-field =class ?field)] - (return (&/|list (&/T (&/V "jvm-getstatic" (&/T =class ?field)) =type))))) + (|do [=type (&host/lookup-static-field ?class ?field)] + (return (&/|list (&/T (&/V "jvm-getstatic" (&/T ?class ?field)) =type))))) (defn analyse-jvm-getfield [analyse ?class ?field ?object] - (|do [=class (&host/full-class-name ?class) - =type (&host/lookup-static-field =class ?field) + (|do [=type (&host/lookup-static-field ?class ?field) =object (&&/analyse-1 analyse ?object)] - (return (&/|list (&/T (&/V "jvm-getfield" (&/T =class ?field =object)) =type))))) + (return (&/|list (&/T (&/V "jvm-getfield" (&/T ?class ?field =object)) =type))))) (defn analyse-jvm-putstatic [analyse ?class ?field ?value] - (|do [=class (&host/full-class-name ?class) - =type (&host/lookup-static-field =class ?field) + (|do [=type (&host/lookup-static-field ?class ?field) =value (&&/analyse-1 analyse ?value)] - (return (&/|list (&/T (&/V "jvm-putstatic" (&/T =class ?field =value)) =type))))) + (return (&/|list (&/T (&/V "jvm-putstatic" (&/T ?class ?field =value)) =type))))) (defn analyse-jvm-putfield [analyse ?class ?field ?object ?value] - (|do [=class (&host/full-class-name ?class) - =type (&host/lookup-static-field =class ?field) + (|do [=type (&host/lookup-static-field ?class ?field) =object (&&/analyse-1 analyse ?object) =value (&&/analyse-1 analyse ?value)] - (return (&/|list (&/T (&/V "jvm-putfield" (&/T =class ?field =object =value)) =type))))) + (return (&/|list (&/T (&/V "jvm-putfield" (&/T ?class ?field =object =value)) =type))))) (defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] - (|do [=class (&host/full-class-name ?class) - =classes (&/map% &host/extract-jvm-param ?classes) - =return (&host/lookup-static-method =class ?method =classes) + (|do [=classes (&/map% &host/extract-jvm-param ?classes) + =return (&host/lookup-static-method ?class ?method =classes) =args (&/flat-map% analyse ?args)] - (return (&/|list (&/T (&/V "jvm-invokestatic" (&/T =class ?method =classes =args)) =return))))) + (return (&/|list (&/T (&/V "jvm-invokestatic" (&/T ?class ?method =classes =args)) =return))))) (do-template [<name> <tag>] (defn <name> [analyse ?class ?method ?classes ?object ?args] - (|do [=class (&host/full-class-name ?class) - =classes (&/map% &host/extract-jvm-param ?classes) - =return (&host/lookup-virtual-method =class ?method =classes) + (|do [=classes (&/map% &host/extract-jvm-param ?classes) + =return (&host/lookup-virtual-method ?class ?method =classes) =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) =args (&/map2% (fn [?c ?o] (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)) =classes ?args)] - (return (&/|list (&/T (&/V <tag> (&/T =class ?method =classes =object =args)) =return))))) + (return (&/|list (&/T (&/V <tag> (&/T ?class ?method =classes =object =args)) =return))))) analyse-jvm-invokevirtual "jvm-invokevirtual" analyse-jvm-invokeinterface "jvm-invokeinterface" @@ -126,15 +120,13 @@ (return (&/|list (&/T (&/V "jvm-null?" =object) (&/V "lux;DataT" "java.lang.Boolean")))))) (defn analyse-jvm-new [analyse ?class ?classes ?args] - (|do [=class (&host/full-class-name ?class) - =classes (&/map% &host/extract-jvm-param ?classes) + (|do [=classes (&/map% &host/extract-jvm-param ?classes) =args (&/flat-map% analyse ?args)] - (return (&/|list (&/T (&/V "jvm-new" (&/T =class =classes =args)) (&/V "lux;DataT" =class)))))) + (return (&/|list (&/T (&/V "jvm-new" (&/T ?class =classes =args)) (&/V "lux;DataT" ?class)))))) (defn analyse-jvm-new-array [analyse ?class ?length] - (|do [=class (&host/full-class-name ?class)] - (return (&/|list (&/T (&/V "jvm-new-array" (&/T =class ?length)) (&/V "array" (&/T (&/V "lux;DataT" =class) - (&/V "lux;Nil" nil)))))))) + (return (&/|list (&/T (&/V "jvm-new-array" (&/T ?class ?length)) (&/V "array" (&/T (&/V "lux;DataT" ?class) + (&/V "lux;Nil" nil))))))) (defn analyse-jvm-aastore [analyse ?array ?idx ?elem] (|do [=array (&&/analyse-1 analyse &type/$Void ?array) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 26376ad60..df87a08b6 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -45,8 +45,7 @@ (defn analyse-variant [analyse exo-type ident ?value] (|do [exo-type* (matchv ::M/objects [exo-type] [["lux;VarT" ?id]] - (&/try-all% (&/|list (|do [exo-type* (&/try-all% (&/|list (&type/deref ?id) - (fail "##8##")))] + (&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)] (&type/actual-type exo-type*)) (|do [_ (&type/set-var ?id &type/Type)] (&type/actual-type &type/Type)))) @@ -74,8 +73,7 @@ (defn analyse-record [analyse exo-type ?elems] (|do [exo-type* (matchv ::M/objects [exo-type] [["lux;VarT" ?id]] - (|do [exo-type* (&/try-all% (&/|list (&type/deref ?id) - (fail "##7##")))] + (|do [exo-type* (&type/deref ?id)] (&type/actual-type exo-type*)) [_] @@ -265,8 +263,7 @@ [["lux;VarT" ?id]] (|do [? (&type/bound? ?id)] (if ? - (|do [dtype (&/try-all% (&/|list (&type/deref ?id) - (fail "##6##")))] + (|do [dtype (&type/deref ?id)] (matchv ::M/objects [dtype] [["lux;ExT" _]] (return (&/T _expr exo-type)) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index f970540c9..209e29626 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -353,7 +353,7 @@ (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) (&host/->class name) nil "java/lang/Object" nil))] (matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (->> state - (&/set$ &/$SOURCE (&/V "lux;Some" (&reader/from (str "source/" name ".lux")))) + (&/set$ &/$SOURCE (&reader/from (str "source/" name ".lux"))) (&/set$ &/$ENVS (&/|list (&/env name))) (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %)) (&/update$ &/$MODULES #(&/|put name &a-module/init-module %))))] diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj index 37847f553..1a0a9c6bc 100644 --- a/src/lux/compiler/case.clj +++ b/src/lux/compiler/case.clj @@ -16,10 +16,7 @@ MethodVisitor))) ;; [Utils] -(let [+tag-sig+ (&host/->type-signature "java.lang.String") - +oclass+ (&host/->class "java.lang.Object") - +equals-sig+ (str "(" (&host/->type-signature "java.lang.Object") ")Z") - compare-kv #(.compareTo ^String (aget ^objects %1 0) ^String (aget ^objects %2 0))] +(let [compare-kv #(.compareTo ^String (aget ^objects %1 0) ^String (aget ^objects %2 0))] (defn ^:private compile-match [^MethodVisitor writer ?match $target $else] (matchv ::M/objects [?match] [["StoreTestAC" ?idx]] @@ -29,9 +26,9 @@ [["BoolTestAC" ?value]] (doto writer - (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Boolean")) + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Boolean") (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Boolean") "booleanValue" "()Z") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Boolean" "booleanValue" "()Z") (.visitLdcInsn ?value) (.visitJumpInsn Opcodes/IF_ICMPNE $else) (.visitInsn Opcodes/POP) @@ -39,9 +36,9 @@ [["IntTestAC" ?value]] (doto writer - (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Long")) + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Long") (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Long") "longValue" "()J") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Long" "longValue" "()J") (.visitLdcInsn ?value) (.visitInsn Opcodes/LCMP) (.visitJumpInsn Opcodes/IFNE $else) @@ -50,9 +47,9 @@ [["RealTestAC" ?value]] (doto writer - (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Double")) + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Double") (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Double") "doubleValue" "()D") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Double" "doubleValue" "()D") (.visitLdcInsn ?value) (.visitInsn Opcodes/DCMPL) (.visitJumpInsn Opcodes/IFNE $else) @@ -61,9 +58,9 @@ [["CharTestAC" ?value]] (doto writer - (.visitTypeInsn Opcodes/CHECKCAST (&host/->class "java.lang.Character")) + (.visitTypeInsn Opcodes/CHECKCAST "java/lang/Character") (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Character") "charValue" "()C") + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Character" "charValue" "()C") (.visitLdcInsn ?value) (.visitJumpInsn Opcodes/IF_ICMPNE $else) (.visitInsn Opcodes/POP) @@ -73,7 +70,7 @@ (doto writer (.visitInsn Opcodes/DUP) (.visitLdcInsn ?value) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class "java.lang.Object") "equals" (str "(" (&host/->type-signature "java.lang.Object") ")Z")) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z") (.visitJumpInsn Opcodes/IFEQ $else) (.visitInsn Opcodes/POP) (.visitJumpInsn Opcodes/GOTO $target)) @@ -126,7 +123,7 @@ (.visitLdcInsn (int 0)) (.visitInsn Opcodes/AALOAD) (.visitLdcInsn ?tag) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL +oclass+ "equals" +equals-sig+) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z") (.visitJumpInsn Opcodes/IFEQ $else) (.visitInsn Opcodes/DUP) (.visitLdcInsn (int 1)) @@ -151,34 +148,33 @@ patterns)] (&/T mappings (&/|reverse patterns*)))) -(let [ex-class (&host/->class "java.lang.IllegalStateException")] - (defn ^:private compile-pattern-matching [^MethodVisitor writer compile mappings patterns $end] - (let [entries (&/|map (fn [?branch+?body] - (|let [[?branch ?body] ?branch+?body - label (new Label)] - (&/T (&/T ?branch label) - (&/T label ?body)))) - mappings) - mappings* (&/|map &/|first entries)] - (doto writer - (-> (doto (compile-match ?match (&/|get ?body mappings*) $else) - (.visitLabel $else)) - (->> (|let [[?body ?match] ?body+?match]) - (doseq [?body+?match (&/->seq patterns) - :let [$else (new Label)]]))) - (.visitInsn Opcodes/POP) - (.visitTypeInsn Opcodes/NEW ex-class) - (.visitInsn Opcodes/DUP) - (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V") - (.visitInsn Opcodes/ATHROW)) - (&/map% (fn [?label+?body] - (|let [[?label ?body] ?label+?body] - (|do [:let [_ (.visitLabel writer ?label)] - ret (compile ?body) - :let [_ (.visitJumpInsn writer Opcodes/GOTO $end)]] - (return ret)))) - (&/|map &/|second entries)) - ))) +(defn ^:private compile-pattern-matching [^MethodVisitor writer compile mappings patterns $end] + (let [entries (&/|map (fn [?branch+?body] + (|let [[?branch ?body] ?branch+?body + label (new Label)] + (&/T (&/T ?branch label) + (&/T label ?body)))) + mappings) + mappings* (&/|map &/|first entries)] + (doto writer + (-> (doto (compile-match ?match (&/|get ?body mappings*) $else) + (.visitLabel $else)) + (->> (|let [[?body ?match] ?body+?match]) + (doseq [?body+?match (&/->seq patterns) + :let [$else (new Label)]]))) + (.visitInsn Opcodes/POP) + (.visitTypeInsn Opcodes/NEW "java/lang/IllegalStateException") + (.visitInsn Opcodes/DUP) + (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/IllegalStateException" "<init>" "()V") + (.visitInsn Opcodes/ATHROW)) + (&/map% (fn [?label+?body] + (|let [[?label ?body] ?label+?body] + (|do [:let [_ (.visitLabel writer ?label)] + ret (compile ?body) + :let [_ (.visitJumpInsn writer Opcodes/GOTO $end)]] + (return ret)))) + (&/|map &/|second entries)) + )) ;; [Resources] (defn compile-case [compile *type* ?value ?matches] diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj index 3ba6e52f1..65c7e58aa 100644 --- a/src/lux/compiler/lambda.clj +++ b/src/lux/compiler/lambda.clj @@ -79,17 +79,11 @@ :let [_ (doto *writer* (.visitTypeInsn Opcodes/NEW lambda-class) (.visitInsn Opcodes/DUP))] - _ (->> closed-over - &/->seq - (sort #(matchv ::M/objects [(&/|second %1) (&/|second %2)] - [[["captured" [_ ?cid1 _]] _] - [["captured" [_ ?cid2 _]] _]] - (< ?cid1 ?cid2))) - &/->list - (&/map% (fn [?name+?captured] - (matchv ::M/objects [?name+?captured] - [[?name [["captured" [_ _ ?source]] _]]] - (compile ?source))))) + _ (&/map% (fn [?name+?captured] + (matchv ::M/objects [?name+?captured] + [[?name [["captured" [_ _ ?source]] _]]] + (compile ?source))) + closed-over) :let [_ (.visitMethodInsn *writer* Opcodes/INVOKESPECIAL lambda-class "<init>" init-signature)]] (return nil))) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 491cf62fb..cf4a65f04 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -20,27 +20,24 @@ MethodVisitor))) ;; [Exports] -(let [+class+ (&host/->class "java.lang.Boolean") - +sig+ (&host/->type-signature "java.lang.Boolean")] - (defn compile-bool [compile *type* ?value] - (|do [^MethodVisitor *writer* &/get-writer - :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") (if ?value "TRUE" "FALSE") (&host/->type-signature "java.lang.Boolean"))]] - (return nil)))) +(defn compile-bool [compile *type* ?value] + (|do [^MethodVisitor *writer* &/get-writer + :let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC "java/lang/Boolean" (if ?value "TRUE" "FALSE") "Ljava/lang/Boolean;")]] + (return nil))) (do-template [<name> <class> <sig> <caster>] - (let [+class+ (&host/->class <class>)] - (defn <name> [compile *type* value] - (|do [^MethodVisitor *writer* &/get-writer - :let [_ (doto *writer* - (.visitTypeInsn Opcodes/NEW +class+) - (.visitInsn Opcodes/DUP) - (.visitLdcInsn (<caster> value)) - (.visitMethodInsn Opcodes/INVOKESPECIAL +class+ "<init>" <sig>))]] - (return nil)))) + (defn <name> [compile *type* value] + (|do [^MethodVisitor *writer* &/get-writer + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/NEW <class>) + (.visitInsn Opcodes/DUP) + (.visitLdcInsn (<caster> value)) + (.visitMethodInsn Opcodes/INVOKESPECIAL <class> "<init>" <sig>))]] + (return nil))) - compile-int "java.lang.Long" "(J)V" long - compile-real "java.lang.Double" "(D)V" double - compile-char "java.lang.Character" "(C)V" char + compile-int "java/lang/Long" "(J)V" long + compile-real "java/lang/Double" "(D)V" double + compile-char "java/lang/Character" "(C)V" char ) (defn compile-text [compile *type* ?value] @@ -53,7 +50,7 @@ :let [num-elems (&/|length ?elems) _ (doto *writer* (.visitLdcInsn (int num-elems)) - (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object"))] _ (&/map2% (fn [idx elem] (|do [:let [_ (doto *writer* (.visitInsn Opcodes/DUP) @@ -73,7 +70,7 @@ num-elems (&/|length elems*) _ (doto *writer* (.visitLdcInsn (int num-elems)) - (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")))] + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object"))] _ (&/map2% (fn [idx kv] (|let [[k v] kv] (|do [:let [_ (doto *writer* @@ -89,7 +86,7 @@ (|do [^MethodVisitor *writer* &/get-writer :let [_ (doto *writer* (.visitLdcInsn (int 2)) - (.visitTypeInsn Opcodes/ANEWARRAY (&host/->class "java.lang.Object")) + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") (.visitInsn Opcodes/DUP) (.visitLdcInsn (int 0)) (.visitLdcInsn ?tag) @@ -124,19 +121,19 @@ (|do [^MethodVisitor *writer* &/get-writer _ (compile ?fn) _ (compile ?arg) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE (&host/->class &host/function-class) "apply" &&/apply-signature)]] + :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]] (return nil))) (defn compile-def [compile ?name ?body ?def-data] (|do [^ClassWriter *writer* &/get-writer module-name &/get-module-name :let [outer-class (&host/->class module-name) - datum-sig (&host/->type-signature "java.lang.Object") + datum-sig "Ljava/lang/Object;" current-class (&host/location (&/|list outer-class ?name)) _ (.visitInnerClass *writer* current-class outer-class nil (+ Opcodes/ACC_STATIC Opcodes/ACC_SYNTHETIC)) =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 [(&host/->class &host/function-class)])) + current-class nil "java/lang/Object" (into-array ["lux/Function"])) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) (doto (.visitEnd))))] _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "<clinit>" "()V" nil nil) diff --git a/src/lux/host.clj b/src/lux/host.clj index 55a772fcc..d159d2608 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -29,25 +29,6 @@ (return =return))) ;; [Resources] -(defn full-class [class-name] - (case class-name - "boolean" (return Boolean/TYPE) - "byte" (return Byte/TYPE) - "short" (return Short/TYPE) - "int" (return Integer/TYPE) - "long" (return Long/TYPE) - "float" (return Float/TYPE) - "double" (return Double/TYPE) - "char" (return Character/TYPE) - ;; else - (try (return (Class/forName class-name)) - (catch Exception e - (fail (str "[Analyser Error] Unknown class: " class-name)))))) - -(defn full-class-name [class-name] - (|do [^Class =class (full-class class-name)] - (return (.getName =class)))) - (defn ^String ->class [class] (string/replace class #"\." "/")) @@ -89,7 +70,7 @@ (defn extract-jvm-param [token] (matchv ::M/objects [token] [["lux;Meta" [_ ["lux;Symbol" [_ ?ident]]]]] - (full-class-name ?ident) + (return ?ident) [_] (fail (str "[Host] Unknown JVM param: " (pr-str token))))) diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index eb4e7af7c..f94a3d058 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -25,7 +25,9 @@ (|do [[_ [_ body]] (&reader/read-regex #"(?s)^([^\"\\]*)")] (return body))))) -(def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]*)") +(def ^:private +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'`:\~\?]*)" + ;; #"^([^0-9\[\]\(\)\{\};#\s\"][^\[\]\(\)\{\};#\s\"]*)" + ) ;; [Lexers] (def ^:private lex-white-space diff --git a/src/lux/parser.clj b/src/lux/parser.clj index d8817fc05..6b392ea96 100644 --- a/src/lux/parser.clj +++ b/src/lux/parser.clj @@ -38,45 +38,47 @@ (def parse (|do [token &lexer/lex] (matchv ::M/objects [token] - [["lux;Meta" [meta ["White_Space" _]]]] - (return (&/|list)) + [["lux;Meta" [meta token*]]] + (matchv ::M/objects [token*] + [["White_Space" _]] + (return (&/|list)) - [["lux;Meta" [meta ["Comment" _]]]] - (return (&/|list)) - - [["lux;Meta" [meta ["Bool" ?value]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Bool" (Boolean/parseBoolean ?value)))))) + [["Comment" _]] + (return (&/|list)) + + [["Bool" ?value]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Bool" (Boolean/parseBoolean ?value)))))) - [["lux;Meta" [meta ["Int" ?value]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Int" (Integer/parseInt ?value)))))) + [["Int" ?value]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Int" (Integer/parseInt ?value)))))) - [["lux;Meta" [meta ["Real" ?value]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Real" (Float/parseFloat ?value)))))) + [["Real" ?value]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Real" (Float/parseFloat ?value)))))) - [["lux;Meta" [meta ["Char" ^String ?value]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Char" (.charAt ?value 0)))))) + [["Char" ^String ?value]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Char" (.charAt ?value 0)))))) - [["lux;Meta" [meta ["Text" ?value]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Text" ?value))))) + [["Text" ?value]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Text" ?value))))) - [["lux;Meta" [meta ["Symbol" ?ident]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Symbol" ?ident))))) + [["Symbol" ?ident]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Symbol" ?ident))))) - [["lux;Meta" [meta ["Tag" ?ident]]]] - (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Tag" ?ident))))) + [["Tag" ?ident]] + (return (&/|list (&/V "lux;Meta" (&/T meta (&/V "lux;Tag" ?ident))))) - [["lux;Meta" [meta ["Open_Paren" _]]]] - (|do [syntax (parse-form parse)] - (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) - - [["lux;Meta" [meta ["Open_Bracket" _]]]] - (|do [syntax (parse-tuple parse)] - (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) + [["Open_Paren" _]] + (|do [syntax (parse-form parse)] + (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) + + [["Open_Bracket" _]] + (|do [syntax (parse-tuple parse)] + (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) - [["lux;Meta" [meta ["Open_Brace" _]]]] - (|do [syntax (parse-record parse)] - (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) + [["Open_Brace" _]] + (|do [syntax (parse-record parse)] + (return (&/|list (&/V "lux;Meta" (&/T meta syntax))))) - [_] - (fail "[Parser Error] Unknown lexer token.") - ))) + [_] + (fail "[Parser Error] Unknown lexer token.") + )))) diff --git a/src/lux/reader.clj b/src/lux/reader.clj index 3c5f0066d..6a954d5ff 100644 --- a/src/lux/reader.clj +++ b/src/lux/reader.clj @@ -8,50 +8,59 @@ (defn ^:private with-line [body] (fn [state] (matchv ::M/objects [(&/get$ &/$SOURCE state)] - [["lux;None" _]] - (fail* "[Reader Error] No source code.") - - [["lux;Some" ["lux;Nil" _]]] + [["lux;Nil" _]] (fail* "[Reader Error] EOF") - [["lux;Some" ["lux;Cons" [["lux;Meta" [[file-name line-num column-num] line]] - more]]]] + [["lux;Cons" [["lux;Meta" [[file-name line-num column-num] line]] + more]]] (matchv ::M/objects [(body file-name line-num column-num line)] [["No" msg]] (fail* msg) - [["Yes" [meta ["lux;None" _]]]] - (return* (&/set$ &/$SOURCE (&/V "lux;Some" more) state) - meta) + [["Done" output]] + (return* (&/set$ &/$SOURCE more state) + output) - [["Yes" [meta ["lux;Some" line-meta]]]] - (return* (&/set$ &/$SOURCE (&/V "lux;Some" (&/|cons line-meta more)) state) - meta)) + [["Yes" [output line*]]] + (return* (&/set$ &/$SOURCE (&/|cons line* more) state) + output)) ))) ;; [Exports] +(defn ^:private re-find! [regex line] + (let [matcher (.matcher regex line)] + (when (.find matcher) + (.group matcher 0)))) + +(defn ^:private re-find3! [regex line] + (let [matcher (.matcher regex line)] + (when (.find matcher) + (list (.group matcher 0) + (.group matcher 1) + (.group matcher 2))))) + (defn read-regex [regex] (with-line (fn [file-name line-num column-num ^String line] - (if-let [[^String match] (re-find regex line)] + (if-let [^String match (re-find! regex line)] (let [match-length (.length match) line* (.substring line match-length)] - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match)) - (if (empty? line*) - (&/V "lux;None" nil) - (&/V "lux;Some" (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*))))))) + (if (empty? line*) + (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match))) + (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) match)) + (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) (&/V "No" (str "[Reader Error] Pattern failed: " regex)))))) (defn read-regex2 [regex] (with-line (fn [file-name line-num column-num ^String line] - (if-let [[^String match tok1 tok2] (re-find regex line)] + (if-let [[^String match tok1 tok2] (re-find3! regex line)] (let [match-length (.length match) line* (.substring line match-length)] - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))) - (if (empty? line*) - (&/V "lux;None" nil) - (&/V "lux;Some" (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*))))))) + (if (empty? line*) + (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))) + (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))) + (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) (&/V "No" (str "[Reader Error] Pattern failed: " regex)))))) (defn read-text [^String text] @@ -60,10 +69,10 @@ (if (.startsWith line text) (let [match-length (.length text) line* (.substring line match-length)] - (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text)) - (if (empty? line*) - (&/V "lux;None" nil) - (&/V "lux;Some" (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*))))))) + (if (empty? line*) + (&/V "Done" (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text))) + (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) text)) + (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))) (&/V "No" (str "[Reader Error] Text failed: " text)))))) (defn from [file-name] @@ -74,19 +83,5 @@ line)))) (&/|filter (fn [line+line-num] (|let [[line-num line] line+line-num] - (not (empty? line)))) + (not= "" line))) (&/enumerate lines))))) - -(def current-line - (fn [state] - (matchv ::M/objects [(&/get$ &/$SOURCE state)] - [["lux;None" _]] - (fail* "[Reader Error] No source code.") - - [["lux;Some" ["lux;Nil" _]]] - (fail* "[Reader Error] EOF") - - [["lux;Some" ["lux;Cons" [["lux;Meta" [_ line]] - more]]]] - (return* state line) - ))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 57c2d4624..2e9e85092 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -142,7 +142,7 @@ (def CompilerState (&/V "lux;AppT" (&/T (fAll "CompilerState" "" (&/V "lux;RecordT" - (&/|list (&/T "lux;source" (&/V "lux;AppT" (&/T Maybe Reader))) + (&/|list (&/T "lux;source" Reader) (&/T "lux;modules" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Text (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" @@ -180,15 +180,14 @@ (defn deref [id] (fn [state] - (let [mappings (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS))] - (if-let [type* (->> mappings (&/|get id))] - (matchv ::M/objects [type*] - [["lux;Some" type]] - (return* state type) - - [["lux;None" _]] - (fail* (str "[Type Error] Unbound type-var: " id))) - (fail* (str "[Type Error] <deref> Unknown type-var: " id)))))) + (if-let [type* (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))] + (matchv ::M/objects [type*] + [["lux;Some" type]] + (return* state type) + + [["lux;None" _]] + (fail* (str "[Type Error] Unbound type-var: " id))) + (fail* (str "[Type Error] <deref> Unknown type-var: " id))))) (defn set-var [id type] (fn [state] @@ -210,8 +209,8 @@ (fn [state] (let [id (->> state (&/get$ &/$TYPES) (&/get$ &/$COUNTER))] (return* (&/update$ &/$TYPES #(->> % - (&/update$ &/$COUNTER inc) - (&/update$ &/$MAPPINGS (fn [ms] (&/|put id (&/V "lux;None" nil) ms)))) + (&/update$ &/$COUNTER inc) + (&/update$ &/$MAPPINGS (fn [ms] (&/|put id (&/V "lux;None" nil) ms)))) state) id)))) @@ -271,8 +270,7 @@ (matchv ::M/objects [type] [["lux;VarT" ?id]] (if (= ?tid ?id) - (&/try-all% (&/|list (deref ?id) - (fail "##5##"))) + (deref ?id) (return type)) [["lux;LambdaT" [?arg ?return]]] @@ -554,12 +552,10 @@ [["lux;VarT" ?eid] ["lux;VarT" ?aid]] (if (= ?eid ?aid) (return (&/T fixpoints nil)) - (|do [ebound (&/try-all% (&/|list (|do [ebound (&/try-all% (&/|list (deref ?eid) - (fail "##4##")))] + (|do [ebound (&/try-all% (&/|list (|do [ebound (deref ?eid)] (return (&/V "lux;Some" ebound))) (return (&/V "lux;None" nil)))) - abound (&/try-all% (&/|list (|do [abound (&/try-all% (&/|list (deref ?aid) - (fail "##3##")))] + abound (&/try-all% (&/|list (|do [abound (deref ?aid)] (return (&/V "lux;Some" abound))) (return (&/V "lux;None" nil))))] (matchv ::M/objects [ebound abound] @@ -579,15 +575,13 @@ [["lux;VarT" ?id] _] (&/try-all% (&/|list (|do [_ (set-var ?id actual)] (return (&/T fixpoints nil))) - (|do [bound (&/try-all% (&/|list (deref ?id) - (fail "##1##")))] + (|do [bound (deref ?id)] (check* fixpoints bound actual)))) [_ ["lux;VarT" ?id]] (&/try-all% (&/|list (|do [_ (set-var ?id expected)] (return (&/T fixpoints nil))) - (|do [bound (&/try-all% (&/|list (deref ?id) - (fail "##2##")))] + (|do [bound (deref ?id)] (check* fixpoints expected bound)))) [["lux;AppT" [["lux;VarT" ?eid] A1]] ["lux;AppT" [["lux;VarT" ?aid] A2]]] |