From 99a4eec5bce78ce5262f94a51f2b57ed2507ac46 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 4 May 2015 12:20:32 -0400 Subject: - Added the LuxVar type to properly specify the type of environment bindings. - Implemented "using". - Implemented jvm-program. - Corrected some primitive (un)wrapping errors in lux.compiler.host. - jvm-program is now scoped to enable local variables. - The types of definitions are now stored within the module dictionary. - Added a "main" method that just compiles program.lux. --- src/lux.clj | 7 ++ src/lux/analyser/env.clj | 2 +- src/lux/analyser/host.clj | 24 +++++- src/lux/analyser/lux.clj | 180 +++++++++++++++++++++++--------------------- src/lux/analyser/module.clj | 8 +- src/lux/base.clj | 2 +- src/lux/compiler.clj | 10 +-- src/lux/compiler/host.clj | 23 +++--- src/lux/host.clj | 10 +-- src/lux/type.clj | 54 ++++++++++++- 10 files changed, 203 insertions(+), 117 deletions(-) (limited to 'src') diff --git a/src/lux.clj b/src/lux.clj index 37978aa05..1812bf294 100644 --- a/src/lux.clj +++ b/src/lux.clj @@ -1,8 +1,12 @@ (ns lux + (:gen-class) (:require [lux.base :as &] [lux.compiler :as &compiler] :reload-all)) +(defn -main [& _] + (time (&compiler/compile-all (&/|list "program")))) + (comment ;; TODO: Finish total-locals @@ -13,5 +17,8 @@ (time (&compiler/compile-all (&/|list "lux" "test2"))) ;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2 + ;; jar cvf program.jar output/*.class output/program && java -cp "program.jar" program ;; cd output && jar cvf test2.jar * && java -cp "test2.jar" test2 && cd .. + + ;; cd output && jar cvf program.jar * && java -cp "program.jar" program && cd .. ) diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj index af0052c3d..77fba3ca0 100644 --- a/src/lux/analyser/env.clj +++ b/src/lux/analyser/env.clj @@ -15,7 +15,7 @@ (let [old-mappings (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS)) =return (body (&/update$ &/$ENVS (fn [stack] - (let [bound-unit (&/V "local" (->> (&/|head stack) (&/get$ &/$LOCALS) (&/get$ &/$COUNTER)))] + (let [bound-unit (&/V "lux;Local" (->> (&/|head stack) (&/get$ &/$LOCALS) (&/get$ &/$COUNTER)))] (&/|cons (->> (&/|head stack) (&/update$ &/$LOCALS #(&/update$ &/$COUNTER inc %)) (&/update$ &/$LOCALS #(&/update$ &/$MAPPINGS (fn [m] (&/|put name (&/T bound-unit type) m)) %))) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 1528f2032..3c9e3ce3f 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -18,6 +18,17 @@ [_] (fail "[Analyser Error] Can't extract Symbol."))) +(defn ^:private analyse-1+ [analyse ?token] + (&type/with-var + (fn [$var] + ;; (prn 'analyse-1+ (aget $var 1) (&/show-ast ?token)) + (|do [=expr (&&/analyse-1 analyse $var ?token)] + (matchv ::M/objects [=expr] + [[?item ?type]] + (|do [=type (&type/clean $var ?type)] + (return (&/T ?item =type))) + ))))) + ;; [Resources] (do-template [ ] (let [input-type (&/V "lux;DataT" ) @@ -218,7 +229,7 @@ (do-template [ ] (defn [analyse ?value] - (|do [=value (&&/analyse-1 analyse ?value)] + (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" ) ?value)] (return (&/|list (&/T (&/V =value) (&/V "lux;DataT" )))))) analyse-jvm-d2f "jvm-d2f" "java.lang.Double" "java.lang.Float" @@ -243,7 +254,7 @@ (do-template [ ] (defn [analyse ?value] - (|do [=value (&&/analyse-1 analyse ?value)] + (|do [=value (&&/analyse-1 analyse (&/V "lux;DataT" ) ?value)] (return (&/|list (&/T (&/V =value) (&/V "lux;DataT" )))))) analyse-jvm-iand "jvm-iand" "java.lang.Integer" "java.lang.Integer" @@ -259,6 +270,11 @@ ) (defn analyse-jvm-program [analyse ?args ?body] - (|do [=body (&&env/with-local ?args (&/V "lux;AppT" (&/T &type/List &type/Text)) - (&&/analyse-1 analyse ?body))] + (|do [;; =body (&&env/with-local ?args (&/V "lux;AppT" (&/T &type/List &type/Text)) + ;; (&&/analyse-1 analyse ?body)) + =body (&/with-scope "" + (&&env/with-local "" (&/V "lux;AppT" (&/T &type/List &type/Text)) + (analyse-1+ analyse ?body))) + ;; =body (analyse-1+ analyse ?body) + ] (return (&/|list (&/V "jvm-program" =body))))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 457fd13d6..2a68e0aeb 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -124,82 +124,90 @@ no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not) (->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not)) [inner outer] (&/|split-with no-binding? stack)] - (matchv ::M/objects [outer] - [["lux;Nil" _]] - (&/run-state (|do [[[r-module r-name] $def] (&&module/find-def (if (= "" ?module) module-name ?module) - ?name) - endo-type (matchv ::M/objects [$def] - [["lux;ValueD" ?type]] - (return ?type) - - [["lux;MacroD" _]] - (return &type/Macro) - - [["lux;TypeD" _]] - (return &type/Type)) - ;; :let [_ (println "Got endo-type:" endo-type)] - _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) - (do ;; (println "OH YEAH" (if (= "" ?module) module-name ?module) - ;; ?name) - (return nil)) - (&type/check exo-type endo-type)) - ;; :let [_ (println "Type-checked:" exo-type endo-type)] - ] - (return (&/|list (&/T (&/V "global" (&/T r-module r-name)) - endo-type)))) - state) - - [["lux;Cons" [?genv ["lux;Nil" _]]]] - (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))] - (do ;; (prn 'GOT_GLOBAL local-ident) - (matchv ::M/objects [global] - [[["global" [?module* ?name*]] _]] - (&/run-state (|do [;; :let [_ (prn 'GLOBAL/_1 ?module* ?name*)] - [[r-module r-name] $def] (&&module/find-def ?module* ?name*) - ;; :let [_ (prn 'GLOBAL/_2 r-module r-name)] - ;; :let [_ (println "Found def:" ?module* ?name*)] - endo-type (matchv ::M/objects [$def] - [["lux;ValueD" ?type]] - (return ?type) - - [["lux;MacroD" _]] - (return &type/Macro) - - [["lux;TypeD" _]] - (return &type/Type)) - ;; :let [_ (println "Got endo-type:" endo-type)] - _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) - (do ;; (println "OH YEAH" ?module* ?name*) - (return nil)) - (&type/check exo-type endo-type)) - ;; :let [_ (println "Type-checked:" exo-type endo-type)] - ] - (return (&/|list (&/T (&/V "global" (&/T r-module r-name)) - endo-type)))) - state) - - [_] - (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))) - (fail* "")) - - [["lux;Cons" [top-outer _]]] - (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) - (&/|map #(&/get$ &/$NAME %) outer) - (&/|reverse inner))) - [=local inner*] (&/fold (fn [register+new-inner frame+in-scope] - (|let [[register new-inner] register+new-inner - [frame in-scope] frame+in-scope - [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ident register frame)] - (&/T register* (&/|cons frame* new-inner)))) - (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident)) - (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) - (&/|list)) - (&/zip2 (&/|reverse inner) scopes))] - (&/run-state (|do [btype (&&/expr-type =local) - _ (&type/check exo-type btype)] - (return (&/|list =local))) - (&/set$ &/$ENVS (&/|++ inner* outer) state))) - ))) + (do ;; (when (= "<" ?name) + ;; (prn 'HALLO (&/|length inner) (&/|length outer))) + (matchv ::M/objects [outer] + [["lux;Nil" _]] + (&/run-state (|do [[[r-module r-name] $def] (&&module/find-def (if (= "" ?module) module-name ?module) + ?name) + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro) + + [["lux;TypeD" _]] + (return &type/Type)) + ;; :let [_ (println "Got endo-type:" endo-type)] + _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) + (do ;; (println "OH YEAH" (if (= "" ?module) module-name ?module) + ;; ?name) + (return nil)) + (&type/check exo-type endo-type)) + ;; :let [_ (println "Type-checked:" exo-type endo-type)] + ] + (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + endo-type)))) + state) + + [["lux;Cons" [?genv ["lux;Nil" _]]]] + (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))] + (do (when (= "<" ?name) + (prn 'GOT_GLOBAL local-ident)) + (matchv ::M/objects [global] + [[["lux;Global" [?module* ?name*]] _]] + (&/run-state (|do [;; :let [_ (prn 'GLOBAL/_1 ?module* ?name*)] + ;; :let [_ (when (= "<" ?name) + ;; (println "Pre Found def:" ?module* ?name*))] + [[r-module r-name] $def] (&&module/find-def ?module* ?name*) + ;; :let [_ (prn 'GLOBAL/_2 r-module r-name)] + ;; :let [_ (when (= "<" ?name) + ;; (println "Found def:" r-module r-name))] + endo-type (matchv ::M/objects [$def] + [["lux;ValueD" ?type]] + (return ?type) + + [["lux;MacroD" _]] + (return &type/Macro) + + [["lux;TypeD" _]] + (return &type/Type)) + ;; :let [_ (println "Got endo-type:" endo-type)] + _ (if (and (= &type/Type endo-type) (= &type/Type exo-type)) + (do ;; (println "OH YEAH" ?module* ?name*) + (return nil)) + (&type/check exo-type endo-type)) + ;; :let [_ (println "Type-checked:" exo-type endo-type)] + ;; :let [_ (when (= "<" ?name) + ;; (println "Returnin'"))] + ] + (return (&/|list (&/T (&/V "lux;Global" (&/T r-module r-name)) + endo-type)))) + state) + + [_] + (fail* "[Analyser Error] Can't have anything other than a global def in the global environment."))) + (fail* "")) + + [["lux;Cons" [top-outer _]]] + (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1) + (&/|map #(&/get$ &/$NAME %) outer) + (&/|reverse inner))) + [=local inner*] (&/fold (fn [register+new-inner frame+in-scope] + (|let [[register new-inner] register+new-inner + [frame in-scope] frame+in-scope + [register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ident register frame)] + (&/T register* (&/|cons frame* new-inner)))) + (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident)) + (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident))) + (&/|list)) + (&/zip2 (&/|reverse inner) scopes))] + (&/run-state (|do [btype (&&/expr-type =local) + _ (&type/check exo-type btype)] + (return (&/|list =local))) + (&/set$ &/$ENVS (&/|++ inner* outer) state))) + )))) )) (defn ^:private analyse-apply* [analyse exo-type =fn ?args] @@ -256,18 +264,21 @@ [[=fn-form =fn-type]] (do ;; (prn 'analyse-apply2 (aget =fn-form 0)) (matchv ::M/objects [=fn-form] - [["global" [?module ?name]]] + [["lux;Global" [?module ?name]]] (|do [[[r-module r-name] $def] (&&module/find-def ?module ?name) ;; :let [_ (prn 'apply [?module ?name] (aget $def 0))] ] (matchv ::M/objects [$def] [["lux;MacroD" macro]] (|do [macro-expansion #(-> macro (.apply ?args) (.apply %)) - ;; :let [_ (cond (= ?name "def") - ;; (println (str "def " ?module ";" ?name ": " (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) + ;; :let [_ (cond (= ?name "using") + ;; (println (str "using: " (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) + + ;; ;; (= ?name "def") + ;; ;; (println (str "def " ?module ";" ?name ": " (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) - ;; (= ?name "type`") - ;; (println (str "type`: " (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) + ;; ;; (= ?name "type`") + ;; ;; (println (str "type`: " (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) ;; :else ;; nil)] @@ -375,11 +386,12 @@ (|do [;; :let [_ (prn 'analyse-def/_0)] =value (&/with-scope ?name (analyse-1+ analyse ?value)) + =value-type (&&/expr-type =value) ;; :let [_ (prn 'analyse-def/_1 [?name ?value] (aget =value 0 0))] ] (matchv ::M/objects [=value] - [[["global" [?r-module ?r-name]] _]] - (|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name) + [[["lux;Global" [?r-module ?r-name]] _]] + (|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name =value-type) :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name)) _ (println)]] (return (&/|list))) @@ -393,7 +405,7 @@ :else (&/V "lux;ValueD" =value-type))] - _ (&&module/define module-name ?name def-data)] + _ (&&module/define module-name ?name def-data =value-type)] (return (&/|list (&/V "def" (&/T ?name =value def-data)))))) )))) diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index 83169b17d..de68f48aa 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -10,7 +10,7 @@ (def init-module (&/|table)) -(defn define [module name def-data] +(defn define [module name def-data type] (fn [state] (matchv ::M/objects [(&/get$ &/$ENVS state)] [["lux;Cons" [?env ["lux;Nil" _]]]] @@ -21,7 +21,7 @@ (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] (&/update$ &/$MAPPINGS (fn [mappings] (&/|put (str "" &/+name-separator+ name) - (&/T (&/V "global" (&/T module name)) &type/$Void) + (&/T (&/V "lux;Global" (&/T module name)) type) mappings)) locals)) ?env)))) @@ -30,7 +30,7 @@ [_] (fail* "[Analyser Error] Can't create a new global definition outside of a global environment.")))) -(defn def-alias [a-module a-name r-module r-name] +(defn def-alias [a-module a-name r-module r-name type] (fn [state] ;; (prn 'def-alias [a-module a-name] '=> [r-module r-name]) (matchv ::M/objects [(&/get$ &/$ENVS state)] @@ -42,7 +42,7 @@ (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals] (&/update$ &/$MAPPINGS (fn [mappings] (&/|put (str "" &/+name-separator+ a-name) - (&/T (&/V "global" (&/T r-module r-name)) &type/$Void) + (&/T (&/V "lux;Global" (&/T r-module r-name)) type) mappings)) locals)) ?env)))) diff --git a/src/lux/base.clj b/src/lux/base.clj index d3250670b..70a658d19 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -697,7 +697,7 @@ (str "{" (->> ?elems (|map (fn [elem] (|let [[k v] elem] - (str "#" (show-ast k) " " (show-ast v))))) + (str (show-ast k) " " (show-ast v))))) (|interpose " ") (fold str "")) "}") [["lux;Meta" [_ ["lux;Form" ?elems]]]] diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 14f9863bd..5a9f1b39d 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -55,13 +55,13 @@ [["record" ?elems]] (&&lux/compile-record compile-expression ?type ?elems) - [["local" ?idx]] + [["lux;Local" ?idx]] (&&lux/compile-local compile-expression ?type ?idx) [["captured" [?scope ?captured-id ?source]]] (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source) - [["global" [?owner-class ?name]]] + [["lux;Global" [?owner-class ?name]]] (&&lux/compile-global compile-expression ?type ?owner-class ?name) [["apply" [?fn ?arg]]] @@ -298,9 +298,6 @@ [["jvm-lushr" [?x ?y]]] (&&host/compile-jvm-lushr compile-expression ?type ?x ?y) - - [["jvm-program" ?body]] - (&&host/compile-jvm-program compile-expression ?type ?body) )) )) @@ -312,6 +309,9 @@ [["declare-macro" [?module ?name]]] (&&lux/compile-declare-macro compile-expression ?module ?name) + + [["jvm-program" ?body]] + (&&host/compile-jvm-program compile-expression ?body) [["jvm-interface" [?package ?name ?methods]]] (&&host/compile-jvm-interface compile-expression ?package ?name ?methods) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index ff5d50e23..71d3ced53 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -51,19 +51,19 @@ (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class boolean-class) "valueOf" (str "(Z)" (&host/->type-signature boolean-class))) [["lux;DataT" "byte"]] - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class byte-class) "valueOf" (str "(J)" (&host/->type-signature byte-class))) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class byte-class) "valueOf" (str "(B)" (&host/->type-signature byte-class))) [["lux;DataT" "short"]] - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class short-class) "valueOf" (str "(J)" (&host/->type-signature short-class))) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class short-class) "valueOf" (str "(S)" (&host/->type-signature short-class))) [["lux;DataT" "int"]] - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class int-class) "valueOf" (str "(J)" (&host/->type-signature int-class))) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class int-class) "valueOf" (str "(I)" (&host/->type-signature int-class))) [["lux;DataT" "long"]] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class long-class) "valueOf" (str "(J)" (&host/->type-signature long-class))) [["lux;DataT" "float"]] - (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class float-class) "valueOf" (str "(D)" (&host/->type-signature float-class))) + (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class float-class) "valueOf" (str "(F)" (&host/->type-signature float-class))) [["lux;DataT" "double"]] (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class double-class) "valueOf" (str "(D)" (&host/->type-signature double-class))) @@ -419,6 +419,7 @@ (.visitInsn Opcodes/DUP))] _ (compile ?value) :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST (&host/->class )) (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class ) ) (.visitInsn ) (.visitMethodInsn Opcodes/INVOKESPECIAL (&host/->class ) "" ))]] @@ -451,9 +452,13 @@ (.visitTypeInsn Opcodes/NEW (&host/->class )) (.visitInsn Opcodes/DUP))] _ (compile ?x) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (&host/->class ) )] + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST (&host/->class )) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class ) ))] _ (compile ?y) - :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (&host/->class ) )] + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST (&host/->class )) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host/->class ) ))] :let [_ (doto *writer* (.visitInsn ) (.visitMethodInsn Opcodes/INVOKESPECIAL (&host/->class ) "" ))]] @@ -471,13 +476,13 @@ compile-jvm-lushr Opcodes/LUSHR "longValue" "()J" "java.lang.Long" "intValue" "()I" "java.lang.Integer" "java.lang.Long" "(J)V" ) -(defn compile-jvm-program [compile *type* ?body] +(defn compile-jvm-program [compile ?body] (|do [^ClassWriter *writer* &/get-writer] (&/with-writer (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil) (.visitCode)) - (|do [*writer* &/get-writer + (|do [main-writer &/get-writer _ (compile ?body) - :let [_ (doto ^MethodVisitor *writer* + :let [_ (doto ^MethodVisitor main-writer (.visitInsn Opcodes/POP) (.visitInsn Opcodes/RETURN) (.visitMaxs 0 0) diff --git a/src/lux/host.clj b/src/lux/host.clj index 2d7cbbbdf..80dfd78d5 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -31,7 +31,7 @@ ;; [Resources] (defn full-class [class-name] - (case class + (case class-name "boolean" (return Boolean/TYPE) "byte" (return Byte/TYPE) "short" (return Short/TYPE) @@ -43,7 +43,7 @@ ;; else (try (return (Class/forName class-name)) (catch Exception e - (fail "[Analyser Error] Unknown class."))))) + (fail (str "[Analyser Error] Unknown class: " class-name)))))) (defn full-class-name [class-name] ;; (prn 'full-class-name class-name) @@ -93,12 +93,6 @@ [["lux;Meta" [_ ["lux;Symbol" [_ ?ident]]]]] (full-class-name ?ident) - [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "Array"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?inner]]]] - ["lux;Nil" _]]]]]]]]] - (|do [=inner (full-class-name ?inner)] - (return (str "[L" (->class =inner) ";"))) - [_] (fail (str "[Host] Unknown JVM param: " (pr-str token))))) diff --git a/src/lux/type.clj b/src/lux/type.clj index 7ab585d65..0df628b15 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -135,6 +135,10 @@ (&/T "lux;MacroD" (&/V "lux;BoundT" "")) (&/T "lux;AliasD" Ident))))) +(def LuxVar + (&/V "lux;VariantT" (&/|list (&/T "lux;Local" Int) + (&/T "lux;Global" Ident)))) + (def CompilerState (&/V "lux;AppT" (&/T (fAll "CompilerState" "" (&/V "lux;RecordT" @@ -152,7 +156,7 @@ (&/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))))) + (&/V "lux;TupleT" (&/|list LuxVar Type))))))) (&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type))) (&/T "lux;host" HostState) (&/T "lux;seed" Int)))) @@ -716,6 +720,54 @@ (|do [actual* (apply-type actual $arg)] (check* fixpoints expected actual*)))) + [["lux;DataT" "boolean"] ["lux;DataT" "java.lang.Boolean"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "byte"] ["lux;DataT" "java.lang.Byte"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "short"] ["lux;DataT" "java.lang.Short"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "int"] ["lux;DataT" "java.lang.Integer"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "long"] ["lux;DataT" "java.lang.Long"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "float"] ["lux;DataT" "java.lang.Float"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "double"] ["lux;DataT" "java.lang.Double"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "char"] ["lux;DataT" "java.lang.Character"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "java.lang.Boolean"] ["lux;DataT" "boolean"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "java.lang.Byte"] ["lux;DataT" "byte"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "java.lang.Short"] ["lux;DataT" "short"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "java.lang.Integer"] ["lux;DataT" "int"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "java.lang.Long"] ["lux;DataT" "long"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "java.lang.Float"] ["lux;DataT" "float"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "java.lang.Double"] ["lux;DataT" "double"]] + (return (&/T fixpoints nil)) + + [["lux;DataT" "java.lang.Character"] ["lux;DataT" "char"]] + (return (&/T fixpoints nil)) + [["lux;DataT" e!name] ["lux;DataT" a!name]] (if (or (= e!name a!name) (.isAssignableFrom (Class/forName e!name) (Class/forName a!name))) -- cgit v1.2.3