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. --- project.clj | 7 +- source/lux.lux | 152 +++++++++++++++++++++++++++++++++---- source/program.lux | 6 ++ 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 ++++++++++++- 13 files changed, 351 insertions(+), 134 deletions(-) diff --git a/project.clj b/project.clj index 78893a05b..9f647fcd4 100644 --- a/project.clj +++ b/project.clj @@ -1,9 +1,10 @@ -(defproject lang "0.1.0-SNAPSHOT" - :description "FIXME: write description" +(defproject lux-jvm "0.1.0" + :description "The JVM compiler for the Lux programming language." :url "http://example.com/FIXME" :license {:name "Eclipse Public License" :url "http://www.eclipse.org/legal/epl-v10.html"} :dependencies [[org.clojure/clojure "1.6.0"] [org.clojure/core.match "0.2.1"] [org.ow2.asm/asm-all "5.0.3"]] - :warn-on-reflection true) + :warn-on-reflection true + :main lux) diff --git a/source/lux.lux b/source/lux.lux index b967dc0b3..acd913a3c 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -1,3 +1,11 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## The use and distribution terms for this software are covered by the +## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +## which can be found in the file epl-v10.html at the root of this distribution. +## By using this software in any fashion, you are agreeing to be bound by +## the terms of this license. +## You must not remove this notice, or any other, from this software. + ## First things first, must define functions (jvm-interface Function (:' (-> [java.lang.Object] java.lang.Object) @@ -219,11 +227,20 @@ (#Cons [["lux;AliasD" Ident] #Nil])])])]))])) +## (deftype LuxVar +## (| (#Local Int) +## (#Global Ident))) +(def' LuxVar + (#VariantT (#Cons [["lux;Local" Int] + (#Cons [["lux;Global" Ident] + #Nil])]))) +(export' LuxVar) + ## (deftype #rec CompilerState ## (& #source (Maybe Reader) ## #modules (List (, Text (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE CompilerState (List Syntax))))))))) ## #module-aliases (List Void) -## #envs (List (Env Text Void)) +## #envs (List (Env Text (, LuxVar Type))) ## #types (Bindings Int Type) ## #host HostState)) (def' CompilerState @@ -239,7 +256,8 @@ #Nil])]))]) #Nil])]))])] (#Cons [["lux;module-aliases" (#AppT [List Void])] - (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) Void])])] + (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) + (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])] (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])] (#Cons [["lux;host" HostState] (#Cons [["lux;seed" Int] @@ -1173,7 +1191,7 @@ (-> Bool Bool) (if x false true)) -(def__ (text:++ x y) +(def__ #export (text:++ x y) (-> Text Text Text) (jvm-invokevirtual java.lang.String concat [java.lang.String] x [y])) @@ -1367,7 +1385,7 @@ (as-pairs tokens))] (;return (:' SyntaxList (list (`' (#;RecordT (;list (~@ pairs)))))))))) -(def__ (->text x) +(def__ #export (->text x) (-> (^ java.lang.Object) Text) (jvm-invokevirtual java.lang.Object toString [] x [])) @@ -1415,12 +1433,12 @@ ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")") (#Meta [_ (#Record slots)]) - ($ text:++ "(" (|> slots + ($ text:++ "{" (|> slots (map (:' (-> (, Syntax Syntax) Text) (lambda [slot] (let [[k v] slot] ($ text:++ (syntax:show k) " " (syntax:show v)))))) - (interpose " ") (fold text:++ "")) ")") + (interpose " ") (fold text:++ "")) "}") )) (def__ #export (macro-expand syntax) @@ -1614,7 +1632,10 @@ #None body'))] - (return (: (List Syntax) (list (`' (def' (~ name) (~ body''))))))) + (return (: (List Syntax) (list& (`' (def' (~ name) (~ body''))) + (if export? + (list (`' (export' (~ name)))) + #Nil))))) #None (fail "Wrong syntax for def")))) @@ -1935,14 +1956,117 @@ (#Left "Uh, oh... The universe is not working properly...")) )) -## (def #export (print x) -## (-> Text (IO (,))) -## (io (jvm-invokevirtual java.io.PrintStream print [java.lang.Object] -## (jvm-getstatic java.lang.System out) [x]))) +(def #export (print x) + (-> Text (,)) + (jvm-invokevirtual java.io.PrintStream print [java.lang.Object] + (jvm-getstatic java.lang.System out) [x])) + +(def #export (println x) + (-> Text (,)) + (print (text:++ x "\n"))) + +(def #export (some f xs) + (All [a b] + (-> (-> a (Maybe b)) (List a) (Maybe b))) + (case xs + #Nil + #None + + (#Cons [x xs']) + (case (f x) + #None + (some f xs') + + (#Some y) + (#Some y)))) + + +(def (index-of part text) + (-> Text Text Int) + (jvm-i2l (jvm-invokevirtual java.lang.String indexOf [java.lang.String] + text [part]))) + +(def (substring1 idx text) + (-> Int Text Text) + (jvm-invokevirtual java.lang.String substring [int] + text [(jvm-l2i idx)])) + +(def (substring2 idx1 idx2 text) + (-> Int Int Text Text) + (jvm-invokevirtual java.lang.String substring [int int] + text [(jvm-l2i idx1) (jvm-l2i idx2)])) + +(def (split-slot slot) + (-> Text (, Text Text)) + (let [idx (index-of ";" slot) + module (substring2 0 idx slot) + name (substring1 (inc idx) slot)] + [module name])) -## (def #export (println x) -## (-> Text (IO (,))) -## (print (text:++ x "\n"))) +(def (resolve-struct-type type) + (-> Type (Maybe Type)) + (case type + (#RecordT slots) + (#Some type) + + (#AppT [fun arg]) + (resolve-struct-type fun) + + (#AllT [_ _ _ body]) + (resolve-struct-type body) + + _ + #None)) + +(defmacro #export (using tokens state) + (case tokens + (\ (list struct body)) + (case struct + (#Meta [_ (#Symbol vname)]) + (let [vname' (ident->text vname)] + (case state + {#source source #modules modules #module-aliases module-aliases + #envs envs #types types #host host + #seed seed} + (let [?struct-type (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type)) + (lambda [env] + (case env + {#name _ #inner-closures _ #locals {#counter _ #mappings mappings} #closure _} + (some (: (-> (, Text (, LuxVar Type)) (Maybe Type)) + (lambda [binding] + (let [[bname [_ type]] binding] + (if (text:= vname' bname) + (#Some type) + #None)))) + mappings)))) + envs)] + (case ?struct-type + #None + (#Left ($ text:++ "Unknown structure: " vname')) + + (#Some struct-type) + (case (resolve-struct-type struct-type) + (#Some (#RecordT slots)) + (let [pattern ($record (map (: (-> (, Text Type) (, Syntax Syntax)) + (lambda [slot] + (let [[sname stype] slot + [module name] (split-slot sname)] + [($tag [module name]) ($symbol ["" name])]))) + slots)) + _ (println (text:++ "Using pattern: " (syntax:show pattern)))] + (#Right [state (list (` (case' (~ struct) (~ pattern) (~ body))))])) + + _ + (#Left "Can only \"use\" records.")))))) + + _ + (let [dummy ($symbol ["" ""])] + (#Right [state (list (` (case' (~ struct) + (~ dummy) + (using (~ dummy) (~ body)))))]))) + + _ + (#Left "Wrong syntax for defsig"))) ## (defmacro (loop tokens) ## (case' tokens diff --git a/source/program.lux b/source/program.lux index 6ec9db79e..22bbad2d5 100644 --- a/source/program.lux +++ b/source/program.lux @@ -10,3 +10,9 @@ (if (p x) (list& x (filter p xs')) (filter p xs')))) + +(jvm-program _ + (exec (println "Hello, world!") + (println ($ text:++ "2 + 2 = " (->text (int:+ 2 2)))) + (println (->text (using Int:Ord + (< 5 10)))))) 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