diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux/analyser.clj | 15 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 11 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 44 | ||||
| -rw-r--r-- | src/lux/analyser/module.clj | 32 | ||||
| -rw-r--r-- | src/lux/compiler/lux.clj | 13 | ||||
| -rw-r--r-- | src/lux/host.clj | 1 | ||||
| -rw-r--r-- | src/lux/type.clj | 108 |
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))) |