diff options
Diffstat (limited to '')
| -rw-r--r-- | src/lux/analyser.clj | 15 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 5 | ||||
| -rw-r--r-- | src/lux/compiler/cache.clj | 174 | ||||
| -rw-r--r-- | src/lux/type/host.clj | 98 |
4 files changed, 161 insertions, 131 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 29043e868..704e4d4c2 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -68,6 +68,12 @@ (&&lux/analyse-variant analyser (&/V &/$Right exo-type) idx values) ))) +(defn ^:private add-loc [meta ^String msg] + (if (.startsWith msg "@") + msg + (|let [[file line col] meta] + (str "@ " file "," line "," col "\n" msg)))) + (defn ^:private aba10 [analyse eval! compile-module compile-token exo-type token] (|case token ;; Arrays @@ -117,7 +123,8 @@ (&&host/analyse-jvm-laload analyse exo-type ?array ?idx) _ - (assert false (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T (&/T "" -1 -1) token))))))) + #(fail* (add-loc (&/get$ &/$cursor %) + (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T (&/T "" -1 -1) token)))))))) (defn ^:private aba9 [analyse eval! compile-module compile-token exo-type token] (|case token @@ -648,12 +655,6 @@ (aba2 analyse eval! compile-module compile-token exo-type token) )) -(defn ^:private add-loc [meta ^String msg] - (if (.startsWith msg "@") - msg - (|let [[file line col] meta] - (str "@ " file "," line "," col "\n" msg)))) - (defn ^:private analyse-basic-ast [analyse eval! compile-module compile-token exo-type token] (|case token [meta ?token] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index ab3cbf14e..46f4b1f1c 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -298,7 +298,8 @@ =object (&&/analyse-1+ analyse object) [sub-class sub-params] (ensure-object (&&/expr-type* =object)) (&/$DataT super-class* super-params*) (&host-type/->super-type &type/existential class-loader class sub-class sub-params) - :let [gtype-env (&/fold2 (fn [m g t] (&/Cons$ (&/T g t) m)) + :let [_ (prn '<name> sub-class '-> super-class* (&/|length parent-gvars) (&/|length super-params*)) + gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/Cons$ (&/T (.getName g) t) m)) (&/|table) parent-gvars super-params*)] @@ -318,7 +319,7 @@ [gret exceptions parent-gvars gvars gargs] (&host/lookup-static-method class-loader class method classes) _ (ensure-catching exceptions) =args (&/map2% (fn [_class _arg] - (&&/analyse-1 analyse (&type/Data$ _class &/Nil$) _arg)) + (&&/analyse-1 analyse (&host-type/class-name->type _class) _arg)) classes args) :let [output-type (&host-type/class->type (cast Class gret))] diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj index a35225acf..b2cc65203 100644 --- a/src/lux/compiler/cache.clj +++ b/src/lux/compiler/cache.clj @@ -63,87 +63,93 @@ (clean-file f)) nil)) -(defn load [module module-hash compile-module] - "(-> Text Int (-> Text (Lux (,))) (Lux Bool))" - (|do [loader &/loader - !classes &/classes - already-loaded? (&a-module/exists? module) - _modules &/modules - :let [redo-cache (|do [_ (delete module) - _ (compile-module module)] - (return false))]] - (if already-loaded? - (return true) - (if (cached? module) - (let [module* (&host/->class-name module) - module-path (str &&/output-dir module) - class-name (str module* "._") - ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) - (&&/load-class! loader class-name))] - (if (and (= module-hash (get-field &/hash-field module-meta)) - (= &&/version (get-field &/compiler-field module-meta))) - (let [imports (string/split (get-field &/imports-field module-meta) (re-pattern (java.util.regex.Pattern/quote &&/import-separator)))] - (|do [loads (&/map% (fn [_import] - (|do [content (&&io/read-file (str _import ".lux")) - _ (load _import (hash content) compile-module)] - (&/cached-module? _import))) - (if (= [""] imports) - &/Nil$ - (&/->list imports)))] - (if (->> loads &/->seq (every? true?)) - (do (doseq [^File file (seq (.listFiles (File. module-path))) - :when (not (.isDirectory file)) - :let [file-name (.getName file)] - :when (not= "_.class" file-name)] - (let [real-name (second (re-find #"^(.*)\.class$" file-name)) - bytecode (read-file file)] - (swap! !classes assoc (str module* "." real-name) bytecode))) - (let [defs (string/split (get-field &/defs-field module-meta) (re-pattern (java.util.regex.Pattern/quote &&/def-separator))) - tag-groups (let [all-tags (get-field &/tags-field module-meta)] - (if (= "" all-tags) - &/Nil$ - (-> all-tags - (string/split (re-pattern (java.util.regex.Pattern/quote &&/tag-group-separator))) - (->> (map (fn [_group] - (let [[_type _tags] (string/split _group (re-pattern (java.util.regex.Pattern/quote &&/type-separator)))] - (&/T _type (&/->list (string/split _tags (re-pattern (java.util.regex.Pattern/quote &&/tag-separator))))))))) - &/->list)))] - (|do [_ (&a-module/enter-module module) - _ (&/flag-cached-module module) - _ (&a-module/set-imports imports) - _ (&/map% (fn [_def] - (let [[_exported? _name _ann] (string/split _def #" ")] - (|do [_ (case _ann - "T" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name))) - def-value (get-field &/datum-field def-class)] - (&a-module/define module _name (&/V &/$TypeD def-value) &type/Type)) - "M" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name))) - def-value (get-field &/datum-field def-class)] - (|do [_ (&a-module/define module _name (&/V &/$ValueD (&/T &type/Macro def-value)) &type/Macro)] - (&a-module/declare-macro module _name))) - "V" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name))) - def-meta (get-field &/meta-field def-class)] - (|case def-meta - (&/$ValueD def-type _) - (&a-module/define module _name def-meta def-type))) - ;; else - (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] - (|do [__type (&a-module/def-type __module __name)] - (&a-module/def-alias module _name __module __name __type))))] - (if (= &&/exported-true _exported?) - (&a-module/export module _name) - (return nil))) - )) - (if (= [""] defs) - &/Nil$ - (&/->list defs))) - _ (&/map% (fn [group] - (|let [[_type _tags] group] - (|do [=type (&a-module/type-def module _type)] - (&a-module/declare-tags module _tags =type)))) - tag-groups)] - (return true)))) - redo-cache))) - redo-cache) - ) - redo-cache)))) +(let [->regex (fn [text] (re-pattern (java.util.regex.Pattern/quote text))) + import-separator-re (->regex &&/import-separator) + type-separator-re (->regex &&/type-separator) + tag-separator-re (->regex &&/tag-separator) + def-separator-re (->regex &&/def-separator) + tag-group-separator-re (->regex &&/tag-group-separator)] + (defn load [module module-hash compile-module] + "(-> Text Int (-> Text (Lux (,))) (Lux Bool))" + (|do [loader &/loader + !classes &/classes + already-loaded? (&a-module/exists? module) + _modules &/modules + :let [redo-cache (|do [_ (delete module) + _ (compile-module module)] + (return false))]] + (if already-loaded? + (return true) + (if (cached? module) + (let [module* (&host/->class-name module) + module-path (str &&/output-dir module) + class-name (str module* "._") + ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) + (&&/load-class! loader class-name))] + (if (and (= module-hash (get-field &/hash-field module-meta)) + (= &&/version (get-field &/compiler-field module-meta))) + (let [imports (string/split (get-field &/imports-field module-meta) import-separator-re)] + (|do [loads (&/map% (fn [_import] + (|do [content (&&io/read-file (str _import ".lux")) + _ (load _import (hash content) compile-module)] + (&/cached-module? _import))) + (if (= [""] imports) + &/Nil$ + (&/->list imports)))] + (if (->> loads &/->seq (every? true?)) + (do (doseq [^File file (seq (.listFiles (File. module-path))) + :when (not (.isDirectory file)) + :let [file-name (.getName file)] + :when (not= "_.class" file-name)] + (let [real-name (second (re-find #"^(.*)\.class$" file-name)) + bytecode (read-file file)] + (swap! !classes assoc (str module* "." real-name) bytecode))) + (let [defs (string/split (get-field &/defs-field module-meta) def-separator-re) + tag-groups (let [all-tags (get-field &/tags-field module-meta)] + (if (= "" all-tags) + &/Nil$ + (-> all-tags + (string/split tag-group-separator-re) + (->> (map (fn [_group] + (let [[_type _tags] (string/split _group type-separator-re)] + (&/T _type (&/->list (string/split (or _tags "") tag-separator-re))))))) + &/->list)))] + (|do [_ (&a-module/enter-module module) + _ (&/flag-cached-module module) + _ (&a-module/set-imports imports) + _ (&/map% (fn [_def] + (let [[_exported? _name _ann] (string/split _def #" ")] + (|do [_ (case _ann + "T" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name))) + def-value (get-field &/datum-field def-class)] + (&a-module/define module _name (&/V &/$TypeD def-value) &type/Type)) + "M" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name))) + def-value (get-field &/datum-field def-class)] + (|do [_ (&a-module/define module _name (&/V &/$ValueD (&/T &type/Macro def-value)) &type/Macro)] + (&a-module/declare-macro module _name))) + "V" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name))) + def-meta (get-field &/meta-field def-class)] + (|case def-meta + (&/$ValueD def-type _) + (&a-module/define module _name def-meta def-type))) + ;; else + (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] + (|do [__type (&a-module/def-type __module __name)] + (&a-module/def-alias module _name __module __name __type))))] + (if (= &&/exported-true _exported?) + (&a-module/export module _name) + (return nil))) + )) + (if (= [""] defs) + &/Nil$ + (&/->list defs))) + _ (&/map% (fn [group] + (|let [[_type _tags] group] + (|do [=type (&a-module/type-def module _type)] + (&a-module/declare-tags module _tags =type)))) + tag-groups)] + (return true)))) + redo-cache))) + redo-cache) + ) + redo-cache))))) diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj index 9d83e0b58..ac045eebe 100644 --- a/src/lux/type/host.clj +++ b/src/lux/type/host.clj @@ -87,12 +87,8 @@ (range (count (or arr-obrackets arr-pbrackets ""))))) )))) -;; (-> String (.getMethod "getBytes" (into-array Class [])) .getReturnType) -;; (-> String (.getMethod "getBytes" (into-array Class [])) ^Class (.getGenericReturnType) -;; .getName (->> (re-find #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+)|(\[+)([ZBSIJFDC]))"))) - (defn instance-param [existential matchings refl-type] - "(-> (List (, Text Type)) (^ java.lang.reflect.Type) (Lux Type))" + "(-> (Lux Type) (List (, Text Type)) (^ java.lang.reflect.Type) (Lux Type))" (cond (instance? Class refl-type) (return (class->type refl-type)) @@ -113,7 +109,9 @@ (let [gvar (.getName ^TypeVariable refl-type)] (if-let [m-type (&/|get gvar matchings)] (return m-type) - (fail (str "[Type Error] Unknown generic type variable: " gvar)))) + (fail (str "[Type Error] Unknown generic type variable: " gvar " -- " (->> matchings + (&/|map &/|first) + &/->seq))))) (instance? WildcardType refl-type) (if-let [bound (->> ^WildcardType refl-type .getUpperBounds seq first)] @@ -191,38 +189,41 @@ (defn check-host-types [check check-error fixpoints existential class-loader invariant?? expected actual] (|let [[e!name e!params] expected [a!name a!params] actual] - (cond (= "java.lang.Object" e!name) - (return (&/T fixpoints nil)) - - (= null-data-tag a!name) - (if (not (primitive-type? e!name)) - (return (&/T fixpoints nil)) - (fail (check-error (&/V &/$DataT expected) (&/V &/$DataT actual)))) - - (= null-data-tag e!name) - (if (= null-data-tag a!name) - (return (&/T fixpoints nil)) - (fail (check-error (&/V &/$DataT expected) (&/V &/$DataT actual)))) - - (and (= array-data-tag e!name) - (not= array-data-tag a!name)) - (fail (check-error (&/V &/$DataT expected) (&/V &/$DataT actual))) - - :else - (let [e!name (as-obj e!name) - a!name (as-obj a!name)] - (cond (.equals ^Object e!name a!name) - (if (= (&/|length e!params) (&/|length a!params)) - (|do [_ (&/map2% check e!params a!params)] - (return (&/T fixpoints nil))) - (fail (str "[Type Error] Amounts of generic parameters don't match: " e!name "(" (&/|length e!params) ")" " vs " a!name "(" (&/|length a!params) ")"))) - - (not invariant??) - (|do [actual* (->super-type existential class-loader e!name a!name a!params)] - (check (&/V &/$DataT expected) actual*)) - - :else - (fail (str "[Type Error] Names don't match: " e!name " =/= " a!name))))))) + (try (cond (= "java.lang.Object" e!name) + (return (&/T fixpoints nil)) + + (= null-data-tag a!name) + (if (not (primitive-type? e!name)) + (return (&/T fixpoints nil)) + (fail (check-error (&/V &/$DataT expected) (&/V &/$DataT actual)))) + + (= null-data-tag e!name) + (if (= null-data-tag a!name) + (return (&/T fixpoints nil)) + (fail (check-error (&/V &/$DataT expected) (&/V &/$DataT actual)))) + + (and (= array-data-tag e!name) + (not= array-data-tag a!name)) + (fail (check-error (&/V &/$DataT expected) (&/V &/$DataT actual))) + + :else + (let [e!name (as-obj e!name) + a!name (as-obj a!name)] + (cond (.equals ^Object e!name a!name) + (if (= (&/|length e!params) (&/|length a!params)) + (|do [_ (&/map2% check e!params a!params)] + (return (&/T fixpoints nil))) + (fail (str "[Type Error] Amounts of generic parameters don't match: " e!name "(" (&/|length e!params) ")" " vs " a!name "(" (&/|length a!params) ")"))) + + (not invariant??) + (|do [actual* (->super-type existential class-loader e!name a!name a!params)] + (check (&/V &/$DataT expected) actual*)) + + :else + (fail (str "[Type Error] Names don't match: " e!name " =/= " a!name))))) + (catch Exception e + (prn 'check-host-types e [e!name a!name]) + (throw e))))) (let [Void$ (&/V &/$VariantT (&/|list)) gen-type (constantly Void$)] @@ -233,3 +234,24 @@ (return (&/V &/$DataT (&/T class params)))) (catch Exception e (fail (str "[Type Error] Unknown type: " class))))))) + +(defn class-name->type [class-name] + (case class-name + "[Z" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Boolean" (&/|list)))))) + "[B" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Byte" (&/|list)))))) + "[S" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Short" (&/|list)))))) + "[I" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Integer" (&/|list)))))) + "[J" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Long" (&/|list)))))) + "[F" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Float" (&/|list)))))) + "[D" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Double" (&/|list)))))) + "[C" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "java.lang.Character" (&/|list)))))) + ;; "[Z" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "boolean" (&/|list)))))) + ;; "[B" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "byte" (&/|list)))))) + ;; "[S" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "short" (&/|list)))))) + ;; "[I" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "int" (&/|list)))))) + ;; "[J" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "long" (&/|list)))))) + ;; "[F" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "float" (&/|list)))))) + ;; "[D" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "double" (&/|list)))))) + ;; "[C" (&/V &/$DataT (&/T array-data-tag (&/|list (&/V &/$DataT (&/T "char" (&/|list)))))) + ;; else + (&/V &/$DataT (&/T class-name (&/|list))))) |