aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj15
-rw-r--r--src/lux/analyser/host.clj11
-rw-r--r--src/lux/analyser/lux.clj44
-rw-r--r--src/lux/analyser/module.clj32
-rw-r--r--src/lux/compiler/lux.clj13
-rw-r--r--src/lux/host.clj1
-rw-r--r--src/lux/type.clj108
7 files changed, 157 insertions, 67 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index e4511fdeb..938f6df2f 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -90,6 +90,11 @@
;; (prn "if" (&/show-ast ?value)))
(&&lux/analyse-def analyse ?name ?value))
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "declare-macro'"]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?name]]]]
+ ["lux;Nil" _]]]]]]]]]
+ (&&lux/analyse-declare-macro analyse ?name)
+
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "import'"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?path]]]
["lux;Nil" _]]]]]]]]]
@@ -256,7 +261,7 @@
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokestatic"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]]
["lux;Nil" _]]]]]]]]]]]]]]]
@@ -264,7 +269,7 @@
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokevirtual"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
["lux;Cons" [?object
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]]
@@ -272,8 +277,8 @@
(&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args)
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokeinterface"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
["lux;Cons" [?object
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]]
@@ -282,7 +287,7 @@
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokespecial"]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?method]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
["lux;Cons" [?object
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 7d9aaae2f..466058f4e 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -2,7 +2,7 @@
(:require (clojure [template :refer [do-template]])
[clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
- (lux [base :as & :refer [|do return fail]]
+ (lux [base :as & :refer [|let |do return fail]]
[parser :as &parser]
[type :as &type]
[host :as &host])
@@ -102,16 +102,19 @@
(do-template [<name> <tag>]
(defn <name> [analyse ?class ?method ?classes ?object ?args]
- ;; (prn '<name> ?class ?method)
+ (prn '<name> ?class ?method)
(|do [=class (&host/full-class-name ?class)
;; :let [_ (prn 'analyse-jvm-invokevirtual/=class =class)]
=classes (&/map% &host/extract-jvm-param ?classes)
;; :let [_ (prn 'analyse-jvm-invokevirtual/=classes =classes)]
=return (&host/lookup-virtual-method =class ?method =classes)
;; :let [_ (prn 'analyse-jvm-invokevirtual/=return =return)]
- =object (&&/analyse-1 analyse ?object)
+ =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object)
;; :let [_ (prn 'analyse-jvm-invokevirtual/=object =object)]
- =args (&/flat-map% analyse ?args)
+ =args (&/map% (fn [c+o]
+ (|let [[?c ?o] c+o]
+ (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)))
+ (&/zip2 =classes ?args))
;; :let [_ (prn 'analyse-jvm-invokevirtual/=args =args)]
]
(return (&/|list (&/V "Expression" (&/T (&/V <tag> (&/T =class ?method =classes =object =args)) =return))))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index b9a3ffbf2..7c9b9b5f0 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -38,6 +38,12 @@
(return (&/|list (&/V "Expression" (&/T (&/V "tuple" =elems)
exo-type)))))
+ [["lux;AllT" _]]
+ (&type/with-var
+ (fn [$var]
+ (|do [exo-type** (&type/apply-type exo-type* $var)]
+ (analyse-tuple analyse exo-type** ?elems))))
+
[_]
(fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*))))))
@@ -315,13 +321,39 @@
(if ?
(|do [dtype (&type/deref ?id)]
(fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))
- (return output)))))))
+ (matchv ::M/objects [output]
+ [["Expression" [_expr _]]]
+ ;; (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _arg))]
+ ;; (return (&/V "Expression" (&/T _expr exo-type))))
+ (return (&/V "Expression" (&/T _expr exo-type)))
+ )))))))
[_]
(|do [exo-type* (&type/actual-type exo-type)]
(analyse-lambda* analyse exo-type* ?self ?arg ?body))
))
+;; (defn analyse-lambda** [analyse exo-type ?self ?arg ?body]
+;; ;; (prn 'analyse-lambda**/&& (aget exo-type 0))
+;; (matchv ::M/objects [exo-type]
+;; [["lux;AllT" [_env _self _arg _body]]]
+;; (&type/with-var
+;; (fn [$var]
+;; (|do [exo-type* (&type/apply-type exo-type $var)
+;; output (analyse-lambda** analyse exo-type* ?self ?arg ?body)]
+;; (matchv ::M/objects [$var]
+;; [["lux;VarT" ?id]]
+;; (|do [? (&type/bound? ?id)]
+;; (if ?
+;; (|do [dtype (&type/deref ?id)]
+;; (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))
+;; (return output)))))))
+
+;; [_]
+;; (|do [exo-type* (&type/actual-type exo-type)]
+;; (analyse-lambda* analyse exo-type* ?self ?arg ?body))
+;; ))
+
(defn analyse-lambda [analyse exo-type ?self ?arg ?body]
(|do [output (analyse-lambda** analyse exo-type ?self ?arg ?body)]
(return (&/|list output))))
@@ -341,10 +373,7 @@
:let [_ (prn 'analyse-def/TYPE ?name ;; (&type/show-type =value-type)
)
_ (println)
- def-data (cond (&type/type= &type/Macro =value-type)
- (&/V "lux;MacroD" (&/V "lux;None" nil))
-
- (&type/type= &type/Type =value-type)
+ def-data (cond (&type/type= &type/Type =value-type)
(&/V "lux;TypeD" nil)
:else
@@ -354,6 +383,11 @@
]
(return (&/|list (&/V "Statement" (&/V "def" (&/T ?name =value def-data)))))))))
+(defn analyse-declare-macro [analyse ?name]
+ (|do [module-name &/get-module-name
+ _ (&&module/declare-macro module-name ?name)]
+ (return (&/|list))))
+
(defn analyse-import [analyse exo-type ?path]
(return (&/|list)))
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index ac5968026..6f82d9b6f 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -2,7 +2,8 @@
(:require [clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
(lux [base :as & :refer [|do return return* fail fail*]]
- [type :as &type])
+ [type :as &type]
+ [host :as &host])
[lux.analyser.base :as &&]))
;; [Exports]
@@ -54,6 +55,35 @@
(return true))
(return false))))
+(defn declare-macro [module name]
+ (fn [state]
+ (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
+ (if-let [$def (&/|get name $module)]
+ (matchv ::M/objects [$def]
+ [["lux;ValueD" ?type]]
+ (do ;; (prn 'declare-macro/?type (aget ?type 0))
+ (&/run-state (|do [_ (&type/check &type/Macro ?type)
+ loader &/loader
+ :let [macro (-> (.loadClass loader (&host/location (&/|list module name)))
+ (.getField "_datum")
+ (.get nil))]]
+ (fn [state*]
+ (return* (&/update$ &/$MODULES
+ (fn [$modules]
+ (&/|put module (&/|put name (&/V "lux;MacroD" (&/V "lux;Some" macro)) $module)
+ $modules))
+ state*)
+ nil)))
+ state))
+
+ [["lux;MacroD" _]]
+ (fail* (str "[Analyser Error] Can't re-declare a macro: " (str module &/+name-separator+ name)))
+
+ [["lux;TypeD" _]]
+ (fail* (str "[Analyser Error] Definition doesn't have macro type: " module ";" name)))
+ (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name))))
+ (fail* (str "[Analyser Error] Module doesn't exist: " module)))))
+
(defn install-macro [module name macro]
(fn [state]
(if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 5ceeca1bc..1553d3975 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -163,16 +163,5 @@
;; :let [_ (prn 'compile-def/_1 ?name current-class)]
_ (&&/save-class! current-class (.toByteArray =class))
;; :let [_ (prn 'compile-def/_2 ?name)]
- loader &/loader
- :let [full-macro-name (&host/location (&/|list module-name ?name))]
- _ (if-let [macro (matchv ::M/objects [?def-data]
- [["lux;MacroD" ["lux;None" _]]]
- (-> (.loadClass loader full-macro-name)
- (.getField "_datum")
- (.get nil))
-
- [_]
- nil)]
- (&a-module/install-macro module-name ?name macro)
- (return nil))]
+ ]
(return nil)))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 5b02c8192..26a270199 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -4,7 +4,6 @@
[clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
(lux [base :as & :refer [|do return* return fail fail* |let]]
- [parser :as &parser]
[type :as &type])))
;; [Constants]
diff --git a/src/lux/type.clj b/src/lux/type.clj
index e5c96d7bd..217a167a4 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -76,28 +76,6 @@
(&/V "lux;VariantT" (&/|list (&/T "lux;Meta" (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "m")
(&/V "lux;BoundT" "v")))))))))
-(def Reader
- (&/V "lux;AppT" (&/T List
- (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Meta Cursor))
- Text)))))
-
-(def HostState
- (&/V "lux;RecordT"
- (&/|list (&/T "lux;writer" (&/V "lux;DataT" "org.objectweb.asm.ClassWriter"))
- (&/T "lux;loader" (&/V "lux;DataT" "java.lang.ClassLoader"))
- (&/T "lux;eval-ctor" Int))))
-
-(def CompilerState
- (&/V "lux;RecordT"
- (&/|list (&/T "lux;source" (&/V "lux;AppT" (&/T Maybe Reader)))
- (&/T "lux;modules" (&/V "lux;AppT" (&/T List $Void)))
- (&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List $Void)))
- (&/T "lux;envs" (&/V "lux;AppT" (&/T List
- (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text))
- $Void)))))
- (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type)))
- (&/T "lux;host" HostState))))
-
(def Syntax*
(let [Syntax* (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "w")
(&/V "lux;AppT" (&/T (&/V "lux;BoundT" "Syntax'")
@@ -121,20 +99,64 @@
(let [w (&/V "lux;AppT" (&/T Meta Cursor))]
(&/V "lux;AppT" (&/T w (&/V "lux;AppT" (&/T Syntax* w))))))
+(def ^:private SyntaxList (&/V "lux;AppT" (&/T List Syntax)))
+
(def Either
(fAll "_" "l"
(fAll "" "r"
(&/V "lux;VariantT" (&/|list (&/T "lux;Left" (&/V "lux;BoundT" "l"))
(&/T "lux;Right" (&/V "lux;BoundT" "r")))))))
+(def StateE
+ (fAll "StateE" "s"
+ (fAll "" "a"
+ (&/V "lux;LambdaT" (&/T (&/V "lux;BoundT" "s")
+ (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Either Text))
+ (&/V "lux;TupleT" (&/|list (&/V "lux;BoundT" "s")
+ (&/V "lux;BoundT" "a"))))))))))
+
+(def Reader
+ (&/V "lux;AppT" (&/T List
+ (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Meta Cursor))
+ Text)))))
+
+(def HostState
+ (&/V "lux;RecordT"
+ (&/|list (&/T "lux;writer" (&/V "lux;DataT" "org.objectweb.asm.ClassWriter"))
+ (&/T "lux;loader" (&/V "lux;DataT" "java.lang.ClassLoader"))
+ (&/T "lux;eval-ctor" Int))))
+
+(def DefData*
+ (fAll "DefData'" ""
+ (&/V "lux;VariantT" (&/|list (&/T "lux;TypeD" Unit)
+ (&/T "lux;ValueD" Type)
+ (&/T "lux;MacroD" (&/V "lux;BoundT" ""))))))
+
+(def CompilerState
+ (&/V "lux;AppT" (&/T (fAll "CompilerState" ""
+ (&/V "lux;RecordT"
+ (&/|list (&/T "lux;source" (&/V "lux;AppT" (&/T Maybe Reader)))
+ (&/T "lux;modules" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT"
+ (&/|list Text
+ (&/V "lux;AppT" (&/T List (&/V "lux;TupleT"
+ (&/|list Text
+ (&/V "lux;AppT" (&/T DefData*
+ (&/V "lux;LambdaT" (&/T SyntaxList
+ (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "CompilerState")
+ (&/V "lux;BoundT" "")))))
+ SyntaxList)))))))))))))))
+ (&/T "lux;module-aliases" (&/V "lux;AppT" (&/T List $Void)))
+ (&/T "lux;envs" (&/V "lux;AppT" (&/T List
+ (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text))
+ $Void)))))
+ (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type)))
+ (&/T "lux;host" HostState))))
+ $Void)))
+
(def Macro
- (let [SyntaxList (&/V "lux;AppT" (&/T List Syntax))]
- (&/V "lux;LambdaT" (&/T SyntaxList
- (&/V "lux;LambdaT" (&/T CompilerState
- (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Either Text))
- (&/V "lux;TupleT" (&/|list CompilerState
- SyntaxList))))))))
- ))
+ (&/V "lux;LambdaT" (&/T SyntaxList
+ (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE CompilerState))
+ SyntaxList)))))
(defn bound? [id]
(fn [state]
@@ -145,7 +167,7 @@
[["lux;None" _]]
(return* state false))
- (fail* (str "[Type Error] Unknown type-var: " id)))))
+ (fail* (str "[Type Error] <bound?> Unknown type-var: " id)))))
(defn deref [id]
(fn [state]
@@ -159,7 +181,7 @@
[["lux;None" _]]
(fail* (str "[Type Error] Unbound type-var: " id))))
- (fail* (str "[Type Error] Unknown type-var: " id)))))))
+ (fail* (str "[Type Error] <deref> Unknown type-var: " id)))))))
(defn set-var [id type]
(fn [state]
@@ -175,7 +197,7 @@
ts))
state)
nil))))
- (fail* (str "[Type Error] Unknown type-var: " id)))))
+ (fail* (str "[Type Error] <set-var> Unknown type-var: " id " | " (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) &/|length))))))
;; [Exports]
;; Type vars
@@ -196,20 +218,23 @@
(if (= id ?id)
(return binding)
(matchv ::M/objects [?type]
+ [["lux;None" _]]
+ (return binding)
+
[["lux;Some" ?type*]]
(matchv ::M/objects [?type*]
[["lux;VarT" ?id*]]
(if (= id ?id*)
(return (&/T ?id (&/V "lux;None" nil)))
- (|do [?type** (clean* id ?type*)]
- (return (&/T ?id (&/V "lux;Some" ?type**)))))
+ (return binding)
+ ;; (|do [?type** (clean* id ?type*)]
+ ;; (return (&/T ?id (&/V "lux;Some" ?type**))))
+ )
[_]
(|do [?type** (clean* id ?type*)]
(return (&/T ?id (&/V "lux;Some" ?type**)))))
-
- [["lux;None" _]]
- (return binding)))))
+ ))))
(->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))]
(fn [state]
(return* (&/update$ &/$TYPES #(->> %
@@ -237,6 +262,7 @@
(if (= ?tid ?id)
(&/try-all% (&/|list (deref ?id)
(return type)))
+ ;; (deref ?id)
(return type))
[["lux;LambdaT" [?arg ?return]]]
@@ -349,6 +375,9 @@
[_]
[args body*]))]
(str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")"))
+
+ [_]
+ (assert false (prn-str 'show-type (aget type 0) (class (aget type 1))))
))
(defn type= [x y]
@@ -604,7 +633,7 @@
[["lux;AppT" [F A]] _]
(let [fp-pair (&/T expected actual)
;; _ (prn 'LEFT_APP (&/|length fixpoints))
- _ (when (> (&/|length fixpoints) 20)
+ _ (when (> (&/|length fixpoints) 40)
(println 'FIXPOINTS (->> (&/|keys fixpoints)
(&/|map (fn [pair]
(|let [[e a] pair]
@@ -660,7 +689,8 @@
(check* fixpoints expected actual*))))
[["lux;DataT" e!name] ["lux;DataT" a!name]]
- (if (= e!name a!name)
+ (if (or (= e!name a!name)
+ (.isAssignableFrom (Class/forName e!name) (Class/forName a!name)))
(return (&/T fixpoints nil))
(fail (str "[Type Error] Names don't match: " e!name " & " a!name)))