diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lux/analyser.clj | 327 | ||||
| -rw-r--r-- | src/lux/analyser/base.clj | 2 | ||||
| -rw-r--r-- | src/lux/analyser/host.clj | 9 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 17 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 10 | ||||
| -rw-r--r-- | src/lux/compiler/host.clj | 74 | ||||
| -rw-r--r-- | src/lux/compiler/lux.clj | 74 | ||||
| -rw-r--r-- | src/lux/optimizer.clj | 12 |
8 files changed, 256 insertions, 269 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 0cae05eac..f25902a08 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -54,159 +54,160 @@ (fn [state] (fail* (add-loc (&/get$ &/$cursor state) msg)))) -(defn ^:private aba2 [analyse eval! compile-module compile-statement exo-type token] - (|case token - ;; Classes & interfaces - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_class")] - (&/$Cons ?class-decl - (&/$Cons ?super-class - (&/$Cons [_ (&/$TupleS ?interfaces)] - (&/$Cons ?inheritance-modifier - (&/$Cons [_ (&/$TupleS ?anns)] - (&/$Cons [_ (&/$TupleS ?fields)] - (&/$Cons [_ (&/$TupleS ?methods)] - (&/$Nil)))))))))) - (|do [=gclass-decl (&&a-parser/parse-gclass-decl ?class-decl) - =super-class (&&a-parser/parse-gclass-super ?super-class) - =interfaces (&/map% &&a-parser/parse-gclass-super ?interfaces) - =inheritance-modifier (&&a-parser/parse-inheritance-modifier ?inheritance-modifier) - =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-statement =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods)) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_interface")] - (&/$Cons ?class-decl - (&/$Cons [_ (&/$TupleS ?supers)] - (&/$Cons [_ (&/$TupleS ?anns)] - ?methods))))) - (|do [=gclass-decl (&&a-parser/parse-gclass-decl ?class-decl) - =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-statement =gclass-decl =supers =anns =methods)) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anon-class")] - (&/$Cons ?super-class - (&/$Cons [_ (&/$TupleS ?interfaces)] - (&/$Cons [_ (&/$TupleS ?ctor-args)] - (&/$Cons [_ (&/$TupleS ?methods)] - (&/$Nil))))))) - (|do [=super-class (&&a-parser/parse-gclass-super ?super-class) - =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-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-statement ?args ?body) - - _ - (fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token]))))))) - -(defn ^:private aba1 [analyse eval! compile-module compile-statement exo-type token] - (|case token - ;; Standard special forms - (&/$BoolS ?value) - (|do [_ (&type/check exo-type &type/Bool) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor (&&/$bool ?value))))) - - (&/$IntS ?value) - (|do [_ (&type/check exo-type &type/Int) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor (&&/$int ?value))))) - - (&/$RealS ?value) - (|do [_ (&type/check exo-type &type/Real) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor (&&/$real ?value))))) - - (&/$CharS ?value) - (|do [_ (&type/check exo-type &type/Char) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor (&&/$char ?value))))) - - (&/$TextS ?value) - (|do [_ (&type/check exo-type &type/Text) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor (&&/$text ?value))))) - - (&/$TupleS ?elems) - (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems) - - (&/$RecordS ?elems) - (&&lux/analyse-record analyse exo-type ?elems) - - (&/$TagS ?ident) - (analyse-variant+ analyse exo-type ?ident &/$Nil) - - (&/$SymbolS ?ident) - (&&lux/analyse-symbol analyse exo-type ?ident) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_case")] - (&/$Cons ?value ?branches))) - (&&lux/analyse-case analyse exo-type ?value ?branches) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_lambda")] - (&/$Cons [_ (&/$SymbolS "" ?self)] - (&/$Cons [_ (&/$SymbolS "" ?arg)] - (&/$Cons ?body - (&/$Nil)))))) - (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_def")] - (&/$Cons [_ (&/$SymbolS "" ?name)] - (&/$Cons ?value - (&/$Cons ?meta - (&/$Nil)) - )))) - (&&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-statement ?path) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_:")] - (&/$Cons ?type - (&/$Cons ?value - (&/$Nil))))) - (&&lux/analyse-ann analyse eval! exo-type ?type ?value) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_:!")] - (&/$Cons ?type - (&/$Cons ?value - (&/$Nil))))) - (&&lux/analyse-coerce analyse eval! exo-type ?type ?value) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_alias")] - (&/$Cons [_ (&/$TextS ?alias)] - (&/$Cons [_ (&/$TextS ?module)] - (&/$Nil))))) - (&&lux/analyse-alias analyse compile-statement ?alias ?module) - - (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_host")] - (&/$Cons [_ (&/$TupleS (&/$Cons [_ (&/$TextS ?category)] - (&/$Cons [_ (&/$TextS ?proc)] - (&/$Nil))))] - (&/$Cons [_ (&/$TupleS ?args)] - (&/$Nil))))) - (&&host/analyse-host analyse exo-type ?category ?proc ?args) - - _ - (aba2 analyse eval! compile-module compile-statement exo-type token) - )) - -(defn ^:private analyse-basic-ast [analyse eval! compile-module compile-statement exo-type token] +(defn ^:private aba2 [analyse eval! compile-module compilers exo-type token] + (|let [[compile-statement compile-def compile-program] compilers] + (|case token + ;; Classes & interfaces + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_class")] + (&/$Cons ?class-decl + (&/$Cons ?super-class + (&/$Cons [_ (&/$TupleS ?interfaces)] + (&/$Cons ?inheritance-modifier + (&/$Cons [_ (&/$TupleS ?anns)] + (&/$Cons [_ (&/$TupleS ?fields)] + (&/$Cons [_ (&/$TupleS ?methods)] + (&/$Nil)))))))))) + (|do [=gclass-decl (&&a-parser/parse-gclass-decl ?class-decl) + =super-class (&&a-parser/parse-gclass-super ?super-class) + =interfaces (&/map% &&a-parser/parse-gclass-super ?interfaces) + =inheritance-modifier (&&a-parser/parse-inheritance-modifier ?inheritance-modifier) + =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-statement =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods)) + + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_interface")] + (&/$Cons ?class-decl + (&/$Cons [_ (&/$TupleS ?supers)] + (&/$Cons [_ (&/$TupleS ?anns)] + ?methods))))) + (|do [=gclass-decl (&&a-parser/parse-gclass-decl ?class-decl) + =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-statement =gclass-decl =supers =anns =methods)) + + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_anon-class")] + (&/$Cons ?super-class + (&/$Cons [_ (&/$TupleS ?interfaces)] + (&/$Cons [_ (&/$TupleS ?ctor-args)] + (&/$Cons [_ (&/$TupleS ?methods)] + (&/$Nil))))))) + (|do [=super-class (&&a-parser/parse-gclass-super ?super-class) + =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-statement exo-type =super-class =interfaces =ctor-args =methods)) + + _ + (fail-with-loc (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T [(&/T ["" -1 -1]) token])))))))) + +(defn ^:private aba1 [analyse eval! compile-module compilers exo-type token] + (|let [[compile-statement compile-def compile-program] compilers] + (|case token + ;; Standard special forms + (&/$BoolS ?value) + (|do [_ (&type/check exo-type &type/Bool) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor (&&/$bool ?value))))) + + (&/$IntS ?value) + (|do [_ (&type/check exo-type &type/Int) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor (&&/$int ?value))))) + + (&/$RealS ?value) + (|do [_ (&type/check exo-type &type/Real) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor (&&/$real ?value))))) + + (&/$CharS ?value) + (|do [_ (&type/check exo-type &type/Char) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor (&&/$char ?value))))) + + (&/$TextS ?value) + (|do [_ (&type/check exo-type &type/Text) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor (&&/$text ?value))))) + + (&/$TupleS ?elems) + (&&lux/analyse-tuple analyse (&/$Right exo-type) ?elems) + + (&/$RecordS ?elems) + (&&lux/analyse-record analyse exo-type ?elems) + + (&/$TagS ?ident) + (analyse-variant+ analyse exo-type ?ident &/$Nil) + + (&/$SymbolS ?ident) + (&&lux/analyse-symbol analyse exo-type ?ident) + + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_case")] + (&/$Cons ?value ?branches))) + (&&lux/analyse-case analyse exo-type ?value ?branches) + + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_lambda")] + (&/$Cons [_ (&/$SymbolS "" ?self)] + (&/$Cons [_ (&/$SymbolS "" ?arg)] + (&/$Cons ?body + (&/$Nil)))))) + (&&lux/analyse-lambda analyse exo-type ?self ?arg ?body) + + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_def")] + (&/$Cons [_ (&/$SymbolS "" ?name)] + (&/$Cons ?value + (&/$Cons ?meta + (&/$Nil)) + )))) + (&&lux/analyse-def analyse eval! compile-def ?name ?value ?meta) + + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_import")] + (&/$Cons [_ (&/$TextS ?path)] + (&/$Nil)))) + (&&lux/analyse-import analyse compile-module ?path) + + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_:")] + (&/$Cons ?type + (&/$Cons ?value + (&/$Nil))))) + (&&lux/analyse-ann analyse eval! exo-type ?type ?value) + + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_:!")] + (&/$Cons ?type + (&/$Cons ?value + (&/$Nil))))) + (&&lux/analyse-coerce analyse eval! exo-type ?type ?value) + + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_alias")] + (&/$Cons [_ (&/$TextS ?alias)] + (&/$Cons [_ (&/$TextS ?module)] + (&/$Nil))))) + (&&lux/analyse-alias analyse ?alias ?module) + + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_host")] + (&/$Cons [_ (&/$TupleS (&/$Cons [_ (&/$TextS ?category)] + (&/$Cons [_ (&/$TextS ?proc)] + (&/$Nil))))] + (&/$Cons [_ (&/$TupleS ?args)] + (&/$Nil))))) + (&&host/analyse-host analyse exo-type ?category ?proc ?args) + + (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_lux_program")] + (&/$Cons [_ (&/$SymbolS "" ?args)] + (&/$Cons ?body + (&/$Nil))))) + (&&lux/analyse-program analyse compile-program ?args ?body) + + _ + (aba2 analyse eval! compile-module compilers exo-type token) + ))) + +(defn ^:private analyse-basic-ast [analyse eval! compile-module compilers exo-type token] (|case token [meta ?token] (fn [state] - (|case ((aba1 analyse eval! compile-module compile-statement exo-type ?token) state) + (|case ((aba1 analyse eval! compile-module compilers exo-type ?token) state) (&/$Right state* output) (return* state* output) @@ -233,48 +234,48 @@ (return (&&/|meta =output-type ?output-cursor ?output-term)))) )))) -(defn ^:private analyse-ast [eval! compile-module compile-statement exo-type token] +(defn ^:private analyse-ast [eval! compile-module compilers 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-statement) (&/$Right exo-type) idx nil ?values) + (&&lux/analyse-variant (partial analyse-ast eval! compile-module compilers) (&/$Right exo-type) idx nil ?values) [meta (&/$FormS (&/$Cons [_ (&/$TagS ?ident)] ?values))] - (analyse-variant+ (partial analyse-ast eval! compile-module compile-statement) exo-type ?ident ?values) + (analyse-variant+ (partial analyse-ast eval! compile-module compilers) exo-type ?ident ?values) [meta (&/$FormS (&/$Cons ?fn ?args))] (|case ?fn [_ (&/$SymbolS _)] (fn [state] - (|case ((just-analyse (partial analyse-ast eval! compile-module compile-statement) ?fn) state) + (|case ((just-analyse (partial analyse-ast eval! compile-module compilers) ?fn) state) (&/$Right state* =fn) - ((&&lux/analyse-apply (partial analyse-ast eval! compile-module compile-statement) exo-type =fn ?args) state*) + ((&&lux/analyse-apply (partial analyse-ast eval! compile-module compilers) exo-type =fn ?args) state*) _ - ((analyse-basic-ast (partial analyse-ast eval! compile-module compile-statement) eval! compile-module compile-statement exo-type token) state))) + ((analyse-basic-ast (partial analyse-ast eval! compile-module compilers) eval! compile-module compilers exo-type token) state))) _ - (|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))) + (|do [=fn (just-analyse (partial analyse-ast eval! compile-module compilers) ?fn)] + (&&lux/analyse-apply (partial analyse-ast eval! compile-module compilers) exo-type =fn ?args))) _ - (analyse-basic-ast (partial analyse-ast eval! compile-module compile-statement) eval! compile-module compile-statement exo-type token)))))) + (analyse-basic-ast (partial analyse-ast eval! compile-module compilers) eval! compile-module compilers exo-type token)))))) ;; [Resources] -(defn analyse [eval! compile-module compile-statement] +(defn analyse [eval! compile-module compilers] (|do [asts &parser/parse] - (&/flat-map% (partial analyse-ast eval! compile-module compile-statement &/$VoidT) asts))) + (&/flat-map% (partial analyse-ast eval! compile-module compilers &/$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-statement] +(defn repl-analyse [eval! compile-module compilers] (|do [asts &parser/parse] (&type/with-var (fn [?var] - (|do [outputs (&/flat-map% (partial analyse-ast eval! compile-module compile-statement ?var) asts)] + (|do [outputs (&/flat-map% (partial analyse-ast eval! compile-module compilers ?var) asts)] (&/map% (partial clean-output ?var) outputs)))))) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 9faa36939..656b13c44 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -22,14 +22,12 @@ ("case" 2) ("lambda" 3) ("ann" 3) - ("def" 3) ("var" 1) ("captured" 1) ("host" 2) ("jvm-class" 1) ("jvm-interface" 1) - ("jvm-program" 1) ) ;; [Exports] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 8b691ea67..c036c7d0c 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -1031,12 +1031,3 @@ ;; else (fail (str "[Analyser Error] Unknown host procedure: " [category proc])))) - -(let [input-type (&/$AppT &type/List &type/Text) - output-type (&/$AppT &type/IO &/$UnitT)] - (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-statement (&&/$jvm-program =body))] - (return &/$Nil)))) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 9813e5497..065ee643d 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -543,7 +543,7 @@ (|do [output (analyse-lambda** analyse exo-type ?self ?arg ?body)] (return (&/|list output)))) -(defn analyse-def [analyse eval! compile-token ?name ?value ?meta] +(defn analyse-def [analyse eval! compile-def ?name ?value ?meta] (|do [module-name &/get-module-name ? (&&module/defined? module-name ?name)] (if ? @@ -554,11 +554,11 @@ ==meta (eval! =meta) _ (&&module/test-type module-name ?name ==meta (&&/expr-type* =value)) _ (&&module/test-macro module-name ?name ==meta (&&/expr-type* =value)) - _ (compile-token (&&/$def ?name =value ==meta))] + _ (compile-def ?name =value ==meta)] (return &/$Nil)) ))) -(defn analyse-import [analyse compile-module compile-token path] +(defn analyse-import [analyse compile-module path] (|do [module-name &/get-module-name _ (if (= module-name path) (fail (str "[Analyser Error] Module can't import itself: " path)) @@ -573,7 +573,7 @@ (return nil))] (return &/$Nil))))) -(defn analyse-alias [analyse compile-token ex-alias ex-module] +(defn analyse-alias [analyse ex-alias ex-module] (|do [module-name &/get-module-name _ (&&module/alias module-name ex-alias ex-module)] (return &/$Nil))) @@ -601,3 +601,12 @@ _ (&type/check exo-type ==type) =value (&&/analyse-1+ analyse ?value)] (return (&/|list (coerce ==type =value))))) + +(let [input-type (&/$AppT &type/List &type/Text) + output-type (&/$AppT &type/IO &/$UnitT)] + (defn analyse-program [analyse compile-program ?args ?body] + (|do [=body (&/with-scope "" + (&&env/with-local ?args input-type + (&&/analyse-1 analyse output-type ?body))) + _ (compile-program =body)] + (return &/$Nil)))) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index 5d7b03b51..1a0e617c0 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -101,12 +101,6 @@ (defn compile-statement [syntax] (|case syntax - (&o/$def ?name ?body ?meta) - (&&lux/compile-def compile-expression ?name ?body ?meta) - - (&o/$jvm-program ?body) - (&&host/compile-jvm-program compile-expression ?body) - (&o/$jvm-interface ?name ?supers ?anns ?methods) (&&host/compile-jvm-interface compile-expression ?name ?supers ?anns ?methods) @@ -158,7 +152,9 @@ :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-statement)] + (let [compiler-step (&optimizer/optimize eval! (partial compile-module source-dirs) (&/T [compile-statement + (partial &&lux/compile-def compile-expression) + (partial &&lux/compile-program compile-expression)]))] (|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 70218055b..097ebc260 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -1295,77 +1295,3 @@ ;; else (fail (str "[Compiler Error] Unknown host procedure: " [proc-category proc-name])))) - -(defn compile-jvm-program [compile ?body] - (|do [module-name &/get-module-name - ^ClassWriter *writer* &/get-writer] - (&/with-writer (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil) - (.visitCode)) - (|do [^MethodVisitor main-writer &/get-writer - :let [$loop (new Label) - $end (new Label) - _ (doto main-writer - ;; Tail: Begin - (.visitLdcInsn (->> #'&/$Nil meta ::&/idx int)) ;; I - (.visitInsn Opcodes/ACONST_NULL) ;; I? - (.visitLdcInsn &/unit-tag) ;; I?U - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxUtils" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; V - ;; Tail: End - ;; Size: Begin - (.visitVarInsn Opcodes/ALOAD 0) ;; VA - (.visitInsn Opcodes/ARRAYLENGTH) ;; VI - ;; Size: End - ;; Loop: Begin - (.visitLabel $loop) - (.visitLdcInsn (int 1)) ;; VII - (.visitInsn Opcodes/ISUB) ;; VI - (.visitInsn Opcodes/DUP) ;; VII - (.visitJumpInsn Opcodes/IFLT $end) ;; VI - ;; Head: Begin - (.visitInsn Opcodes/DUP) ;; VII - (.visitVarInsn Opcodes/ALOAD 0) ;; VIIA - (.visitInsn Opcodes/SWAP) ;; VIAI - (.visitInsn Opcodes/AALOAD) ;; VIO - (.visitInsn Opcodes/SWAP) ;; VOI - (.visitInsn Opcodes/DUP_X2) ;; IVOI - (.visitInsn Opcodes/POP) ;; IVO - ;; Head: End - ;; Tuple: Begin - (.visitLdcInsn (int 2)) ;; IVOS - (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; IVO2 - (.visitInsn Opcodes/DUP_X1) ;; IV2O2 - (.visitInsn Opcodes/SWAP) ;; IV22O - (.visitLdcInsn (int 0)) ;; IV22OI - (.visitInsn Opcodes/SWAP) ;; IV22IO - (.visitInsn Opcodes/AASTORE) ;; IV2 - (.visitInsn Opcodes/DUP_X1) ;; I2V2 - (.visitInsn Opcodes/SWAP) ;; I22V - (.visitLdcInsn (int 1)) ;; I22VI - (.visitInsn Opcodes/SWAP) ;; I22IV - (.visitInsn Opcodes/AASTORE) ;; I2 - ;; Tuple: End - ;; Cons: Begin - (.visitLdcInsn (->> #'&/$Cons meta ::&/idx int)) ;; I2I - (.visitLdcInsn "") ;; I2I? - (.visitInsn Opcodes/DUP2_X1) ;; II?2I? - (.visitInsn Opcodes/POP2) ;; II?2 - (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxUtils" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; IV - ;; Cons: End - (.visitInsn Opcodes/SWAP) ;; VI - (.visitJumpInsn Opcodes/GOTO $loop) - ;; Loop: End - (.visitLabel $end) ;; VI - (.visitInsn Opcodes/POP) ;; V - (.visitVarInsn Opcodes/ASTORE (int 0)) ;; - ) - ] - _ (compile ?body) - :let [_ (doto main-writer - (.visitInsn Opcodes/ACONST_NULL) - (.visitMethodInsn Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature))] - :let [_ (doto main-writer - (.visitInsn Opcodes/POP) - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))]] - (return nil))))) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index ae6c2cdf5..c45452c7a 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -237,3 +237,77 @@ (defn compile-ann [compile ?value-ex ?type-ex ?value-type] (compile ?value-ex)) + +(defn compile-program [compile ?body] + (|do [module-name &/get-module-name + ^ClassWriter *writer* &/get-writer] + (&/with-writer (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil) + (.visitCode)) + (|do [^MethodVisitor main-writer &/get-writer + :let [$loop (new Label) + $end (new Label) + _ (doto main-writer + ;; Tail: Begin + (.visitLdcInsn (->> #'&/$Nil meta ::&/idx int)) ;; I + (.visitInsn Opcodes/ACONST_NULL) ;; I? + (.visitLdcInsn &/unit-tag) ;; I?U + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxUtils" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; V + ;; Tail: End + ;; Size: Begin + (.visitVarInsn Opcodes/ALOAD 0) ;; VA + (.visitInsn Opcodes/ARRAYLENGTH) ;; VI + ;; Size: End + ;; Loop: Begin + (.visitLabel $loop) + (.visitLdcInsn (int 1)) ;; VII + (.visitInsn Opcodes/ISUB) ;; VI + (.visitInsn Opcodes/DUP) ;; VII + (.visitJumpInsn Opcodes/IFLT $end) ;; VI + ;; Head: Begin + (.visitInsn Opcodes/DUP) ;; VII + (.visitVarInsn Opcodes/ALOAD 0) ;; VIIA + (.visitInsn Opcodes/SWAP) ;; VIAI + (.visitInsn Opcodes/AALOAD) ;; VIO + (.visitInsn Opcodes/SWAP) ;; VOI + (.visitInsn Opcodes/DUP_X2) ;; IVOI + (.visitInsn Opcodes/POP) ;; IVO + ;; Head: End + ;; Tuple: Begin + (.visitLdcInsn (int 2)) ;; IVOS + (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object") ;; IVO2 + (.visitInsn Opcodes/DUP_X1) ;; IV2O2 + (.visitInsn Opcodes/SWAP) ;; IV22O + (.visitLdcInsn (int 0)) ;; IV22OI + (.visitInsn Opcodes/SWAP) ;; IV22IO + (.visitInsn Opcodes/AASTORE) ;; IV2 + (.visitInsn Opcodes/DUP_X1) ;; I2V2 + (.visitInsn Opcodes/SWAP) ;; I22V + (.visitLdcInsn (int 1)) ;; I22VI + (.visitInsn Opcodes/SWAP) ;; I22IV + (.visitInsn Opcodes/AASTORE) ;; I2 + ;; Tuple: End + ;; Cons: Begin + (.visitLdcInsn (->> #'&/$Cons meta ::&/idx int)) ;; I2I + (.visitLdcInsn "") ;; I2I? + (.visitInsn Opcodes/DUP2_X1) ;; II?2I? + (.visitInsn Opcodes/POP2) ;; II?2 + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxUtils" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") ;; IV + ;; Cons: End + (.visitInsn Opcodes/SWAP) ;; VI + (.visitJumpInsn Opcodes/GOTO $loop) + ;; Loop: End + (.visitLabel $end) ;; VI + (.visitInsn Opcodes/POP) ;; V + (.visitVarInsn Opcodes/ASTORE (int 0)) ;; + ) + ] + _ (compile ?body) + :let [_ (doto main-writer + (.visitInsn Opcodes/ACONST_NULL) + (.visitMethodInsn Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature))] + :let [_ (doto main-writer + (.visitInsn Opcodes/POP) + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil))))) diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj index 6fc551cae..ab11fc8a5 100644 --- a/src/lux/optimizer.clj +++ b/src/lux/optimizer.clj @@ -21,14 +21,12 @@ ("case" 1) ("lambda" 1) ("ann" 1) - ("def" 1) ("var" 1) ("captured" 1) ("host" 2) ("jvm-class" 1) ("jvm-interface" 1) - ("jvm-program" 1) ) ;; [Exports] @@ -68,9 +66,6 @@ (&-base/$ann value) (return ($ann value)) - (&-base/$def value) - (return ($def value)) - (&-base/$var value) (return ($var value)) @@ -86,13 +81,10 @@ (&-base/$jvm-interface value) (return ($jvm-interface value)) - (&-base/$jvm-program value) - (return ($jvm-program value)) - _ (assert false (prn-str 'optimize-token (&/adt->text analysis))) )) -(defn optimize [eval! compile-module compile-token] - (|do [analyses (&analyser/analyse eval! compile-module compile-token)] +(defn optimize [eval! compile-module compilers] + (|do [analyses (&analyser/analyse eval! compile-module compilers)] (&/map% optimize-token analyses))) |