aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2015-05-06 23:44:24 -0400
committerEduardo Julian2015-05-06 23:44:24 -0400
commit7f39dd6a229b3b5a8e8d4108ecd1f5307b3cbf06 (patch)
treed9655cdb8ea45852791d0f599d294c7fee3a9b5f /src
parentc0bd1c6af6d1691ddc2627710e352a1bbe3eb1c7 (diff)
- Made several optimizations to the compiler.
- Also removed several unused definitions.
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj5
-rw-r--r--src/lux/analyser/base.clj7
-rw-r--r--src/lux/analyser/env.clj6
-rw-r--r--src/lux/analyser/host.clj44
-rw-r--r--src/lux/analyser/lux.clj9
-rw-r--r--src/lux/compiler.clj2
-rw-r--r--src/lux/compiler/case.clj80
-rw-r--r--src/lux/compiler/lambda.clj16
-rw-r--r--src/lux/compiler/lux.clj45
-rw-r--r--src/lux/host.clj21
-rw-r--r--src/lux/lexer.clj4
-rw-r--r--src/lux/parser.clj66
-rw-r--r--src/lux/reader.clj77
-rw-r--r--src/lux/type.clj38
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]]]