diff options
-rw-r--r-- | src/lux/analyser.clj | 66 | ||||
-rw-r--r-- | src/lux/analyser/base.clj | 2 | ||||
-rw-r--r-- | src/lux/analyser/host.clj | 52 | ||||
-rw-r--r-- | src/lux/compiler.clj | 10 | ||||
-rw-r--r-- | src/lux/compiler/host.clj | 42 | ||||
-rw-r--r-- | src/lux/optimizer.clj | 8 | ||||
-rw-r--r-- | src/lux/repl.clj | 2 |
7 files changed, 83 insertions, 99 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 23cf19061..55f05ce84 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -54,7 +54,7 @@ (fn [state] (fail* (add-loc (&/get$ &/$cursor state) msg)))) -(defn ^:private aba4 [analyse eval! compile-module compile-token exo-type token] +(defn ^:private aba4 [analyse eval! compile-module compile-statement exo-type token] (|case token ;; Classes & interfaces (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_class")] @@ -73,7 +73,7 @@ =anns (&/map% &&a-parser/parse-ann ?anns) =fields (&/map% &&a-parser/parse-field ?fields) =methods (&/map% &&a-parser/parse-method-def ?methods)] - (&&host/analyse-jvm-class analyse compile-token =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods)) + (&&host/analyse-jvm-class analyse compile-statement =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods)) (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_interface")] (&/$Cons ?class-decl @@ -84,7 +84,7 @@ =supers (&/map% &&a-parser/parse-gclass-super ?supers) =anns (&/map% &&a-parser/parse-ann ?anns) =methods (&/map% &&a-parser/parse-method-decl ?methods)] - (&&host/analyse-jvm-interface analyse compile-token =gclass-decl =supers =anns =methods)) + (&&host/analyse-jvm-interface analyse compile-statement =gclass-decl =supers =anns =methods)) (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anon-class")] (&/$Cons ?super-class @@ -96,29 +96,21 @@ =interfaces (&/map% &&a-parser/parse-gclass-super ?interfaces) =ctor-args (&/map% &&a-parser/parse-ctor-arg ?ctor-args) =methods (&/map% &&a-parser/parse-method-def ?methods)] - (&&host/analyse-jvm-anon-class analyse compile-token exo-type =super-class =interfaces =ctor-args =methods)) + (&&host/analyse-jvm-anon-class analyse compile-statement exo-type =super-class =interfaces =ctor-args =methods)) ;; Programs (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_program")] (&/$Cons [_ (&/$SymbolS "" ?args)] (&/$Cons ?body (&/$Nil))))) - (&&host/analyse-jvm-program analyse compile-token ?args ?body) + (&&host/analyse-jvm-program analyse compile-statement ?args ?body) _ (fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token]))))))) -(defn ^:private aba3 [analyse eval! compile-module compile-token exo-type token] +(defn ^:private aba3 [analyse eval! compile-module compile-statement exo-type token] (|case token ;; Objects - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_null")] (&/$Nil))) - (&&host/analyse-jvm-null analyse exo-type) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_null?")] - (&/$Cons ?object - (&/$Nil)))) - (&&host/analyse-jvm-null? analyse exo-type ?object) - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_instanceof")] (&/$Cons [_ (&/$TextS ?class)] (&/$Cons ?object @@ -224,9 +216,9 @@ (&&host/analyse-jvm-monitorexit analyse exo-type ?monitor) _ - (aba4 analyse eval! compile-module compile-token exo-type token))) + (aba4 analyse eval! compile-module compile-statement exo-type token))) -(defn ^:private aba2 [analyse eval! compile-module compile-token exo-type token] +(defn ^:private aba2 [analyse eval! compile-module compile-statement exo-type token] (|case token (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_case")] (&/$Cons ?value ?branches))) @@ -245,12 +237,12 @@ (&/$Cons ?meta (&/$Nil)) )))) - (&&lux/analyse-def analyse eval! compile-token ?name ?value ?meta) + (&&lux/analyse-def analyse eval! compile-statement ?name ?value ?meta) (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_import")] (&/$Cons [_ (&/$TextS ?path)] (&/$Nil)))) - (&&lux/analyse-import analyse compile-module compile-token ?path) + (&&lux/analyse-import analyse compile-module compile-statement ?path) (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_:")] (&/$Cons ?type @@ -268,7 +260,7 @@ (&/$Cons [_ (&/$TextS ?alias)] (&/$Cons [_ (&/$TextS ?module)] (&/$Nil))))) - (&&lux/analyse-alias analyse compile-token ?alias ?module) + (&&lux/analyse-alias analyse compile-statement ?alias ?module) (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_host")] (&/$Cons [_ (&/$TupleS (&/$Cons [_ (&/$TextS ?category)] @@ -279,9 +271,9 @@ (&&host/analyse-host analyse exo-type ?category ?proc ?args) _ - (aba3 analyse eval! compile-module compile-token exo-type token))) + (aba3 analyse eval! compile-module compile-statement exo-type token))) -(defn ^:private aba1 [analyse eval! compile-module compile-token exo-type token] +(defn ^:private aba1 [analyse eval! compile-module compile-statement exo-type token] (|case token ;; Standard special forms (&/$BoolS ?value) @@ -322,14 +314,14 @@ (&&lux/analyse-symbol analyse exo-type ?ident) _ - (aba2 analyse eval! compile-module compile-token exo-type token) + (aba2 analyse eval! compile-module compile-statement exo-type token) )) -(defn ^:private analyse-basic-ast [analyse eval! compile-module compile-token exo-type token] +(defn ^:private analyse-basic-ast [analyse eval! compile-module compile-statement exo-type token] (|case token [meta ?token] (fn [state] - (|case ((aba1 analyse eval! compile-module compile-token exo-type ?token) state) + (|case ((aba1 analyse eval! compile-module compile-statement exo-type ?token) state) (&/$Right state* output) (return* state* output) @@ -358,48 +350,48 @@ (return (&&/|meta =output-type ?output-cursor ?output-term)))) )))) -(defn ^:private analyse-ast [eval! compile-module compile-token exo-type token] +(defn ^:private analyse-ast [eval! compile-module compile-statement exo-type token] (|let [[cursor _] token] (&/with-cursor cursor (&/with-expected-type exo-type (|case token [meta (&/$FormS (&/$Cons [_ (&/$IntS idx)] ?values))] - (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) (&/$Right exo-type) idx nil ?values) + (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-statement) (&/$Right exo-type) idx nil ?values) [meta (&/$FormS (&/$Cons [_ (&/$TagS ?ident)] ?values))] - (analyse-variant+ (partial analyse-ast eval! compile-module compile-token) exo-type ?ident ?values) + (analyse-variant+ (partial analyse-ast eval! compile-module compile-statement) exo-type ?ident ?values) [meta (&/$FormS (&/$Cons ?fn ?args))] (|case ?fn [_ (&/$SymbolS _)] (fn [state] - (|case ((just-analyse (partial analyse-ast eval! compile-module compile-token) ?fn) state) + (|case ((just-analyse (partial analyse-ast eval! compile-module compile-statement) ?fn) state) (&/$Right state* =fn) - ((&&lux/analyse-apply (partial analyse-ast eval! compile-module compile-token) exo-type =fn ?args) state*) + ((&&lux/analyse-apply (partial analyse-ast eval! compile-module compile-statement) exo-type =fn ?args) state*) _ - ((analyse-basic-ast (partial analyse-ast eval! compile-module compile-token) eval! compile-module compile-token exo-type token) state))) + ((analyse-basic-ast (partial analyse-ast eval! compile-module compile-statement) eval! compile-module compile-statement exo-type token) state))) _ - (|do [=fn (just-analyse (partial analyse-ast eval! compile-module compile-token) ?fn)] - (&&lux/analyse-apply (partial analyse-ast eval! compile-module compile-token) exo-type =fn ?args))) + (|do [=fn (just-analyse (partial analyse-ast eval! compile-module compile-statement) ?fn)] + (&&lux/analyse-apply (partial analyse-ast eval! compile-module compile-statement) exo-type =fn ?args))) _ - (analyse-basic-ast (partial analyse-ast eval! compile-module compile-token) eval! compile-module compile-token exo-type token)))))) + (analyse-basic-ast (partial analyse-ast eval! compile-module compile-statement) eval! compile-module compile-statement exo-type token)))))) ;; [Resources] -(defn analyse [eval! compile-module compile-token] +(defn analyse [eval! compile-module compile-statement] (|do [asts &parser/parse] - (&/flat-map% (partial analyse-ast eval! compile-module compile-token &/$VoidT) asts))) + (&/flat-map% (partial analyse-ast eval! compile-module compile-statement &/$VoidT) asts))) (defn clean-output [?var analysis] (|do [:let [[[?output-type ?output-cursor] ?output-term] analysis] =output-type (&type/clean ?var ?output-type)] (return (&&/|meta =output-type ?output-cursor ?output-term)))) -(defn repl-analyse [eval! compile-module compile-token] +(defn repl-analyse [eval! compile-module compile-statement] (|do [asts &parser/parse] (&type/with-var (fn [?var] - (|do [outputs (&/flat-map% (partial analyse-ast eval! compile-module compile-token ?var) asts)] + (|do [outputs (&/flat-map% (partial analyse-ast eval! compile-module compile-statement ?var) asts)] (&/map% (partial clean-output ?var) outputs)))))) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 933af3301..7d20b808d 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -36,8 +36,6 @@ ("jvm-invokevirtual" 1) ("jvm-invokeinterface" 1) ("jvm-invokespecial" 1) - ("jvm-null?" 1) - ("jvm-null" 0) ("jvm-new" 1) ("jvm-class" 1) ("jvm-interface" 1) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 00b3a68c7..2b3dedd4c 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -568,7 +568,7 @@ (return (&/$VariableFieldAnalysis ?name ?privacy-modifier ?state-modifier ?anns ?type)) )) -(defn analyse-jvm-class [analyse compile-token class-decl super-class interfaces =inheritance-modifier =anns ?fields methods] +(defn analyse-jvm-class [analyse compile-statement class-decl super-class interfaces =inheritance-modifier =anns ?fields methods] (&/with-closure (|do [module &/get-module-name :let [[?name ?params] class-decl @@ -580,13 +580,13 @@ _ (&host/use-dummy-class class-decl super-class interfaces &/$None =fields methods) =methods (&/map% (partial analyse-method analyse class-decl* class-env all-supers) methods) _ (check-method-completion all-supers =methods) - _ (compile-token (&&/$jvm-class (&/T [class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None]))) + _ (compile-statement (&&/$jvm-class (&/T [class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None]))) :let [_ (println 'DEF full-name)]] (return &/$Nil)))) -(defn analyse-jvm-interface [analyse compile-token interface-decl supers =anns =methods] +(defn analyse-jvm-interface [analyse compile-statement interface-decl supers =anns =methods] (|do [module &/get-module-name - _ (compile-token (&&/$jvm-interface (&/T [interface-decl supers =anns =methods]))) + _ (compile-statement (&&/$jvm-interface (&/T [interface-decl supers =anns =methods]))) :let [_ (println 'DEF (str module "." (&/|first interface-decl)))]] (return &/$Nil))) @@ -605,7 +605,7 @@ (&/$TupleS &/$Nil)])) captured-slot-class "java.lang.Object" captured-slot-type (&/$GenericClass captured-slot-class &/$Nil)] - (defn analyse-jvm-anon-class [analyse compile-token exo-type super-class interfaces ctor-args methods] + (defn analyse-jvm-anon-class [analyse compile-statement exo-type super-class interfaces ctor-args methods] (&/with-closure (|do [module &/get-module-name scope &/get-scope-name @@ -635,7 +635,7 @@ captured-slot-type))) (&/enumerate =captured))] :let [sources (&/|map captured-source =captured)] - _ (compile-token (&&/$jvm-class (&/T [class-decl super-class interfaces &/$DefaultIM &/$Nil =fields =methods =captured (&/$Some =ctor-args)]))) + _ (compile-statement (&&/$jvm-class (&/T [class-decl super-class interfaces &/$DefaultIM &/$Nil =fields =methods =captured (&/$Some =ctor-args)]))) _cursor &/cursor] (return (&/|list (&&/|meta anon-class-type _cursor (&&/$jvm-new (&/T [anon-class (&/|repeat (&/|length sources) captured-slot-class) sources])) @@ -878,22 +878,6 @@ (&&/$host (&/T ["jvm" "arraylength"]) (&/|list =array)) ))))) -(defn analyse-jvm-null? [analyse exo-type object] - (|do [=object (&&/analyse-1+ analyse object) - _ (ensure-object (&&/expr-type* =object)) - :let [output-type &type/Bool] - _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta output-type _cursor - (&&/$jvm-null? =object)))))) - -(defn analyse-jvm-null [analyse exo-type] - (|do [:let [output-type (&/$DataT &host-type/null-data-tag &/$Nil)] - _ (&type/check exo-type output-type) - _cursor &/cursor] - (return (&/|list (&&/|meta output-type _cursor - &&/$jvm-null))))) - (defn analyse-jvm-throw [analyse exo-type ?ex] (|do [=ex (&&/analyse-1 analyse (&/$DataT "java.lang.Throwable" &/$Nil) ?ex) _cursor &/cursor @@ -913,10 +897,30 @@ analyse-jvm-monitorexit &&/$jvm-monitorexit ) +(defn ^:private analyse-jvm-null? [analyse exo-type ?values] + (|do [:let [(&/$Cons object (&/$Nil)) ?values] + =object (&&/analyse-1+ analyse object) + _ (ensure-object (&&/expr-type* =object)) + :let [output-type &type/Bool] + _ (&type/check exo-type output-type) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$host (&/T ["jvm" "null?"]) (&/|list =object))))))) + +(defn ^:private analyse-jvm-null [analyse exo-type ?values] + (|do [:let [(&/$Nil) ?values] + :let [output-type (&/$DataT &host-type/null-data-tag &/$Nil)] + _ (&type/check exo-type output-type) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$host (&/T ["jvm" "null"]) (&/|list))))))) + (defn analyse-host [analyse exo-type category proc ?values] (case category "jvm" (case proc + "null?" (analyse-jvm-null? analyse exo-type ?values) + "null" (analyse-jvm-null analyse exo-type ?values) "anewarray" (analyse-jvm-anewarray analyse exo-type ?values) "aaload" (analyse-jvm-aaload analyse exo-type ?values) "aastore" (analyse-jvm-aastore analyse exo-type ?values) @@ -1003,9 +1007,9 @@ (let [input-type (&/$AppT &type/List &type/Text) output-type (&/$AppT &type/IO &/$UnitT)] - (defn analyse-jvm-program [analyse compile-token ?args ?body] + (defn analyse-jvm-program [analyse compile-statement ?args ?body] (|do [=body (&/with-scope "" (&&env/with-local ?args input-type (&&/analyse-1 analyse output-type ?body))) - _ (compile-token (&&/$jvm-program =body))] + _ (compile-statement (&&/$jvm-program =body))] (return &/$Nil)))) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 2752d4f42..6ea22dc66 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -95,12 +95,6 @@ (&&host/compile-host compile-expression ?proc-category ?proc-name ?args) ;; JVM - (&o/$jvm-null _) - (&&host/compile-jvm-null compile-expression) - - (&o/$jvm-null? ?object) - (&&host/compile-jvm-null? compile-expression ?object) - (&o/$jvm-new ?class ?classes ?args) (&&host/compile-jvm-new compile-expression ?class ?classes ?args) @@ -148,7 +142,7 @@ )) )) -(defn compile-token [syntax] +(defn compile-statement [syntax] (|case syntax (&o/$def ?name ?body ?meta) (&&lux/compile-def compile-expression ?name ?body ?meta) @@ -207,7 +201,7 @@ :let [file-hash (hash file-content)]] (if (&&cache/cached? name) (&&cache/load source-dirs name file-hash compile-module) - (let [compiler-step (&optimizer/optimize eval! (partial compile-module source-dirs) compile-token)] + (let [compiler-step (&optimizer/optimize eval! (partial compile-module source-dirs) compile-statement)] (|do [module-exists? (&a-module/exists? name)] (if module-exists? (fail "[Compiler Error] Can't redefine a module!") diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 9df678fd0..4caea6112 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -132,25 +132,6 @@ compile-jvm-invokespecial Opcodes/INVOKESPECIAL ) -(defn compile-jvm-null [compile] - (|do [^MethodVisitor *writer* &/get-writer - :let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]] - (return nil))) - -(defn compile-jvm-null? [compile ?object] - (|do [^MethodVisitor *writer* &/get-writer - _ (compile ?object) - :let [$then (new Label) - $end (new Label) - _ (doto *writer* - (.visitJumpInsn Opcodes/IFNULL $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "FALSE" (&host-generics/->type-signature "java.lang.Boolean")) - (.visitJumpInsn Opcodes/GOTO $end) - (.visitLabel $then) - (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean")) - (.visitLabel $end))]] - (return nil))) - (defn compile-jvm-new [compile ?class ?classes ?args] (|do [^MethodVisitor *writer* &/get-writer :let [init-sig (str "(" (&/fold str "" (&/|map &host-generics/->type-signature ?classes)) ")V") @@ -1211,10 +1192,33 @@ &&/wrap-long)]] (return nil))) +(defn ^:private compile-jvm-null [compile ?values] + (|do [:let [(&/$Nil) ?values] + ^MethodVisitor *writer* &/get-writer + :let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]] + (return nil))) + +(defn ^:private compile-jvm-null? [compile ?values] + (|do [:let [(&/$Cons ?object (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?object) + :let [$then (new Label) + $end (new Label) + _ (doto *writer* + (.visitJumpInsn Opcodes/IFNULL $then) + (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "FALSE" (&host-generics/->type-signature "java.lang.Boolean")) + (.visitJumpInsn Opcodes/GOTO $end) + (.visitLabel $then) + (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean")) + (.visitLabel $end))]] + (return nil))) + (defn compile-host [compile proc-category proc-name ?values] (case proc-category "jvm" (case proc-name + "null?" (compile-jvm-null? compile ?values) + "null" (compile-jvm-null compile ?values) "anewarray" (compile-jvm-anewarray compile ?values) "aaload" (compile-jvm-aaload compile ?values) "aastore" (compile-jvm-aastore compile ?values) diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj index 044a89ed6..69ffd25ba 100644 --- a/src/lux/optimizer.clj +++ b/src/lux/optimizer.clj @@ -35,8 +35,6 @@ ("jvm-invokevirtual" 1) ("jvm-invokeinterface" 1) ("jvm-invokespecial" 1) - ("jvm-null?" 1) - ("jvm-null" 1) ("jvm-new" 1) ("jvm-class" 1) ("jvm-interface" 1) @@ -123,12 +121,6 @@ (&-base/$jvm-invokespecial value) (return ($jvm-invokespecial value)) - (&-base/$jvm-null? value) - (return ($jvm-null? value)) - - (&-base/$jvm-null value) - (return ($jvm-null value)) - (&-base/$jvm-new value) (return ($jvm-new value)) diff --git a/src/lux/repl.clj b/src/lux/repl.clj index c101e26d9..134aacafe 100644 --- a/src/lux/repl.clj +++ b/src/lux/repl.clj @@ -51,7 +51,7 @@ state* (&/update$ &/$source (fn [_source] (&/|++ _source line*)) state)] - (|case ((|do [analysed-tokens (&analyser/repl-analyse &compiler/eval! (partial &compiler/compile-module source-dirs) &compiler/compile-token) + (|case ((|do [analysed-tokens (&analyser/repl-analyse &compiler/eval! (partial &compiler/compile-module source-dirs) &compiler/compile-statement) optimized-tokens (->> analysed-tokens (&/|map &a-base/expr-term) (&/map% &optimizer/optimize-token)) |