From 0952d5906d90f305e0604447d6b292204ba53711 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 31 May 2015 00:45:35 -0400 Subject: - Finished _jvm-interface_ & _jvm-class_. - The version of the compiler is now stored as a field in the compiled definitions. --- source/lux.lux | 207 +++++++++++++++++++++++++--------------------- src/lux/analyser.clj | 44 +++++----- src/lux/analyser/host.clj | 172 +++++++++++++++++++++++++++++++------- src/lux/analyser/lux.clj | 10 +-- src/lux/base.clj | 4 +- src/lux/compiler.clj | 29 +++++-- src/lux/compiler/host.clj | 84 ++++++++++++------- src/lux/compiler/lux.clj | 10 ++- src/lux/host.clj | 3 +- 9 files changed, 368 insertions(+), 195 deletions(-) diff --git a/source/lux.lux b/source/lux.lux index bce5c421a..2e5752592 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -7,9 +7,17 @@ ## 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) - apply)) +(_jvm_interface "lux.Function" [] + (apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"])) + +## (_jvm_class "lux.MyFunction" "java.lang.Object" ["lux.Function"] +## [(foo "java.lang.Object" ["public" "static"])] +## ( [] "void" +## ["public"] +## (_jvm_invokespecial java.lang.Object [] this [])) +## (apply [(arg "java.lang.Object")] "java.lang.Object" +## ["public"] +## "YOLO")) ## Basic types (_lux_def Bool (#DataT "java.lang.Boolean")) @@ -577,7 +585,7 @@ _ (fail "Wrong syntax for $'"))) -(def' #export (fold f init xs) +(def' #export (foldL f init xs) (All' [a b] (->' (->' (B' a) (B' b) (B' a)) (B' a) @@ -588,37 +596,50 @@ init (#Cons [x xs']) - (fold f (f init x) xs'))) + (foldL f (f init x) xs'))) + +(def' #export (foldR f init xs) + (All' [a b] + (->' (->' (B' b) (B' a) (B' a)) + (B' a) + ($' List (B' b)) + (B' a))) + (_lux_case xs + #Nil + init + + (#Cons [x xs']) + (f x (foldR f init xs')))) (def' #export (reverse list) (All' [a] (->' ($' List (B' a)) ($' List (B' a)))) - (fold (_lux_: (All' [a] - (->' ($' List (B' a)) (B' a) ($' List (B' a)))) - (lambda' [tail head] - (#Cons [head tail]))) - #Nil - list)) + (foldL (_lux_: (All' [a] + (->' ($' List (B' a)) (B' a) ($' List (B' a)))) + (lambda' [tail head] + (#Cons [head tail]))) + #Nil + list)) (defmacro #export (list xs) (return (_lux_: SyntaxList - (#Cons [(fold (lambda' [tail head] - (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"])) - (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])]))) - #Nil])])))) - (_meta (#TagS ["lux" "Nil"])) - (reverse xs)) + (#Cons [(foldL (lambda' [tail head] + (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"])) + (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])]))) + #Nil])])))) + (_meta (#TagS ["lux" "Nil"])) + (reverse xs)) #Nil])))) (defmacro #export (list& xs) (_lux_case (reverse xs) (#Cons [last init]) (return (_lux_: SyntaxList - (list (fold (lambda' [tail head] - (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) - (_meta (#TupleS (list head tail))))))) - last - init)))) + (list (foldL (lambda' [tail head] + (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) + (_meta (#TupleS (list head tail))))))) + last + init)))) _ (fail "Wrong syntax for list&"))) @@ -642,13 +663,13 @@ (list ($form (list ($symbol ["" "_lux_lambda"]) ($symbol name) harg - (fold (lambda' [body' arg] - ($form (list ($symbol ["" "_lux_lambda"]) - ($symbol ["" ""]) - arg - body'))) - body - (reverse targs)))))))) + (foldL (lambda' [body' arg] + ($form (list ($symbol ["" "_lux_lambda"]) + ($symbol ["" ""]) + arg + body'))) + body + (reverse targs)))))))) _ (fail "Wrong syntax for lambda")))) @@ -714,18 +735,18 @@ (_lux_case tokens (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])]) (return (_lux_: SyntaxList - (list (fold (_lux_: (->' Syntax (#TupleT (list Syntax Syntax)) - Syntax) - (lambda [body binding] - (_lux_case binding - [label value] - (_meta (#FormS (list (_meta (#SymbolS ["lux" "let'"])) label value body)))))) - body - (fold (_lux_: (All' [a] - (->' ($' List (B' a)) (B' a) ($' List (B' a)))) - (lambda [tail head] (#Cons [head tail]))) - #Nil - (as-pairs bindings)))))) + (list (foldL (_lux_: (->' Syntax (#TupleT (list Syntax Syntax)) + Syntax) + (lambda [body binding] + (_lux_case binding + [label value] + (_meta (#FormS (list (_meta (#SymbolS ["lux" "let'"])) label value body)))))) + body + (foldL (_lux_: (All' [a] + (->' ($' List (B' a)) (B' a) ($' List (B' a)))) + (lambda [tail head] (#Cons [head tail]))) + #Nil + (as-pairs bindings)))))) _ (fail "Wrong syntax for let"))) @@ -790,9 +811,9 @@ (_lux_case tokens (#Cons [op (#Cons [init args])]) (return (_lux_: SyntaxList - (list (fold (lambda [a1 a2] ($form (list op a1 a2))) - init - args)))) + (list (foldL (lambda [a1 a2] ($form (list op a1 a2))) + init + args)))) _ (fail "Wrong syntax for $"))) @@ -887,16 +908,16 @@ (_lux_case tokens (#Cons [init apps]) (return (_lux_: SyntaxList - (list (fold (_lux_: (->' Syntax Syntax Syntax) - (lambda [acc app] - (_lux_case app - (#Meta [_ (#FormS parts)]) - ($form (list:++ parts (list acc))) + (list (foldL (_lux_: (->' Syntax Syntax Syntax) + (lambda [acc app] + (_lux_case app + (#Meta [_ (#FormS parts)]) + ($form (list:++ parts (list acc))) - _ - (`' ((~ app) (~ acc)))))) - init - apps)))) + _ + (`' ((~ app) (~ acc)))))) + init + apps)))) _ (fail "Wrong syntax for |>"))) @@ -974,10 +995,10 @@ (_lux_case (reverse tokens) (#Cons [output inputs]) (return (_lux_: SyntaxList - (list (fold (_lux_: (->' Syntax Syntax Syntax) - (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)])))) - output - inputs)))) + (list (foldL (_lux_: (->' Syntax Syntax Syntax) + (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)])))) + output + inputs)))) _ (fail "Wrong syntax for ->"))) @@ -989,20 +1010,20 @@ (defmacro (do tokens) (_lux_case tokens (#Cons [monad (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])]) - (let [body' (fold (_lux_: (-> Syntax (, Syntax Syntax) Syntax) - (lambda [body' binding] - (let [[var value] binding] - (_lux_case var - (#Meta [_ (#TagS ["" "let"])]) - (`' (;let (~ value) (~ body'))) - - _ - (`' (;bind (_lux_lambda (~ ($symbol ["" ""])) - (~ var) - (~ body')) - (~ value))))))) - body - (reverse (as-pairs bindings)))] + (let [body' (foldL (_lux_: (-> Syntax (, Syntax Syntax) Syntax) + (lambda [body' binding] + (let [[var value] binding] + (_lux_case var + (#Meta [_ (#TagS ["" "let"])]) + (`' (;let (~ value) (~ body'))) + + _ + (`' (;bind (_lux_lambda (~ ($symbol ["" ""])) + (~ var) + (~ body')) + (~ value))))))) + body + (reverse (as-pairs bindings)))] (return (_lux_: SyntaxList (list (`' (_lux_case (~ monad) {#;return ;return #;bind ;bind} @@ -1177,7 +1198,7 @@ (def'' #export (length list) (-> List Int) - (fold (lambda [acc _] (int:+ 1 acc)) 0 list)) + (foldL (lambda [acc _] (int:+ 1 acc)) 0 list)) (def'' #export (not x) (-> Bool Bool) @@ -1242,11 +1263,11 @@ (let [replacements (map (_lux_: (-> Text (, Text Syntax)) (lambda [ident] [ident (`' (#;BoundT (~ ($text ident))))])) (list& self-ident idents)) - body' (fold (_lux_: (-> Syntax Text Syntax) - (lambda [body' arg'] - (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')])))) - (replace-syntax replacements body) - (reverse targs))] + body' (foldL (_lux_: (-> Syntax Text Syntax) + (lambda [body' arg'] + (`' (#;AllT [#;None "" (~ ($text arg')) (~ body')])))) + (replace-syntax replacements body) + (reverse targs))] (return (_lux_: SyntaxList (list (`' (#;AllT [(#;Some #;Nil) (~ ($text self-ident)) (~ ($text harg)) (~ body')]))))))) @@ -1318,7 +1339,7 @@ (def'' (list:join xs) (All [a] (-> ($' List ($' List a)) ($' List a))) - (fold list:++ #Nil xs)) + (foldL list:++ #Nil xs)) ## (def'' #export (normalize ident) ## (-> Ident ($' Lux Ident)) @@ -1431,10 +1452,10 @@ (text:++ "#" (ident->text ident)) (#Meta [_ (#TupleS members)]) - ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]") + ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (foldL text:++ "")) "]") (#Meta [_ (#FormS members)]) - ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")") + ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (foldL text:++ "")) ")") (#Meta [_ (#RecordS slots)]) ($ text:++ "{" @@ -1444,7 +1465,7 @@ (let [[k v] slot] ($ text:++ (syntax:show k) " " (syntax:show v)))))) (interpose " ") - (fold text:++ "")) + (foldL text:++ "")) "}") )) @@ -1491,10 +1512,10 @@ ($tuple (map walk-type members)) (#Meta [_ (#FormS (#Cons [type-fn args]))]) - (fold (_lux_: (-> Syntax Syntax Syntax) - (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)])))) - (walk-type type-fn) - (map walk-type args)) + (foldL (_lux_: (-> Syntax Syntax Syntax) + (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)])))) + (walk-type type-fn) + (map walk-type args)) _ type)) @@ -1590,10 +1611,10 @@ (#Cons [value actions]) (let [dummy ($symbol ["" ""])] (return (_lux_: SyntaxList - (list (fold (: (-> Syntax Syntax Syntax) - (lambda [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post))))) - value - actions))))) + (list (foldL (: (-> Syntax Syntax Syntax) + (lambda [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post))))) + value + actions))))) _ (fail "Wrong syntax for exec"))) @@ -1914,10 +1935,10 @@ (case (reverse tokens) (\ (list& last init)) (return (: (List Syntax) - (list (fold (: (-> Syntax Syntax Syntax) - (lambda [post pre] (`
))) - last - init)))) + (list (foldL (: (-> Syntax Syntax Syntax) + (lambda [post pre] (` ))) + last + init)))) _ (fail )))] diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index ba0fe4e66..01a562bfe 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -412,42 +412,44 @@ (matchv ::M/objects [token] ;; Arrays [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new-array"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?length]]] - ["lux;Nil" _]]]]]]]]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?length]]] + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-new-array analyse ?class ?length) [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aastore"]]]] - ["lux;Cons" [?array - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] - ["lux;Cons" [?elem - ["lux;Nil" _]]]]]]]]]]]]] + ["lux;Cons" [?array + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] + ["lux;Cons" [?elem + ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-aastore analyse ?array ?idx ?elem) [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_aaload"]]]] - ["lux;Cons" [?array - ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] - ["lux;Nil" _]]]]]]]]]]] + ["lux;Cons" [?array + ["lux;Cons" [["lux;Meta" [_ ["lux;IntS" ?idx]]] + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-aaload analyse ?array ?idx) ;; Classes & interfaces [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_class"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?name]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?super-class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]] - ["lux;Nil" _]]]]]]]]]]]]] - (&&host/analyse-jvm-class analyse ?name ?super-class ?fields) + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?super-class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?interfaces]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?fields]]] + ?methods]]]]]]]]]]]]]] + (&&host/analyse-jvm-class analyse ?name ?super-class ?interfaces ?fields ?methods) [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_interface"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?name]]]] - ?members]]]]]]]] - (&&host/analyse-jvm-interface analyse ?name ?members) + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?name]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?supers]]] + ?methods]]]]]]]]]] + (&&host/analyse-jvm-interface analyse ?name ?supers ?methods) ;; Programs [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?args]]]] - ["lux;Cons" [?body - ["lux;Nil" _]]]]]]]]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?args]]]] + ["lux;Cons" [?body + ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-program analyse ?args ?body) [_] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 182eb9ebb..1aa683ea6 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -18,6 +18,14 @@ [_] (fail "[Analyser Error] Can't extract Symbol."))) +(defn ^:private extract-text [text] + (matchv ::M/objects [text] + [["lux;Meta" [_ ["lux;TextS" ?text]]]] + (return ?text) + + [_] + (fail "[Analyser Error] Can't extract Text."))) + (defn ^:private analyse-1+ [analyse ?token] (&type/with-var (fn [$var] @@ -112,9 +120,19 @@ analyse-jvm-invokevirtual "jvm-invokevirtual" analyse-jvm-invokeinterface "jvm-invokeinterface" - analyse-jvm-invokespecial "jvm-invokespecial" ) +(defn analyse-jvm-invokespecial [analyse ?class ?method ?classes ?object ?args] + (|do [=classes (&/map% &host/extract-jvm-param ?classes) + =return (if (= "" ?method) + (return &type/$Void) + (&host/lookup-virtual-method ?class ?method =classes)) + =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) + =args (&/map2% (fn [?c ?o] + (&&/analyse-1 analyse (&/V "lux;DataT" ?c) ?o)) + =classes ?args)] + (return (&/|list (&/T (&/V "jvm-invokespecial" (&/T ?class ?method =classes =object =args)) =return))))) + (defn analyse-jvm-null? [analyse ?object] (|do [=object (&&/analyse-1 analyse ?object)] (return (&/|list (&/T (&/V "jvm-null?" =object) (&/V "lux;DataT" "java.lang.Boolean")))))) @@ -139,44 +157,134 @@ =array-type (&&/expr-type =array)] (return (&/|list (&/T (&/V "jvm-aaload" (&/T =array ?idx)) =array-type))))) -(defn analyse-jvm-class [analyse ?name ?super-class ?fields] - (|do [?fields (&/map% (fn [?field] +(defn ^:private analyse-modifiers [modifiers] + (&/fold% (fn [so-far modif] + (matchv ::M/objects [modif] + [["lux;Meta" [_ ["lux;TextS" "public"]]]] + (return (assoc so-far :visibility "public")) + + [["lux;Meta" [_ ["lux;TextS" "private"]]]] + (return (assoc so-far :visibility "private")) + + [["lux;Meta" [_ ["lux;TextS" "protected"]]]] + (return (assoc so-far :visibility "protected")) + + [["lux;Meta" [_ ["lux;TextS" "static"]]]] + (return (assoc so-far :static? true)) + + [["lux;Meta" [_ ["lux;TextS" "final"]]]] + (return (assoc so-far :final? true)) + + [["lux;Meta" [_ ["lux;TextS" "abstract"]]]] + (return (assoc so-far :abstract? true)) + + [["lux;Meta" [_ ["lux;TextS" "synchronized"]]]] + (return (assoc so-far :concurrency "synchronized")) + + [["lux;Meta" [_ ["lux;TextS" "volatile"]]]] + (return (assoc so-far :concurrency "volatile")) + + [_] + (fail (str "[Analyser Error] Unknown modifier: " (&/show-ast modif))))) + {:visibility "default" + :static? false + :final? false + :abstract? false + :concurrency nil} + modifiers)) + +(defn ^:private as-otype [tname] + (case tname + "boolean" "java.lang.Boolean" + "byte" "java.lang.Byte" + "short" "java.lang.Short" + "int" "java.lang.Integer" + "long" "java.lang.Long" + "float" "java.lang.Float" + "double" "java.lang.Double" + "char" "java.lang.Character" + ;; else + tname + )) + +(defn analyse-jvm-class [analyse ?name ?super-class ?interfaces ?fields ?methods] + (|do [=interfaces (&/map% extract-text ?interfaces) + =fields (&/map% (fn [?field] (matchv ::M/objects [?field] - [["lux;Meta" [_ ["lux;TupleS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?class]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?field-name]]] - ["lux;Nil" _]]]]]]]]] - (return [?class ?field-name]) + [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?field-name]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field-type]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?field-modifiers]]] + ["lux;Nil" _]]]]]]]]]]] + (|do [=field-modifiers (analyse-modifiers ?field-modifiers)] + (return {:name ?field-name + :modifiers =field-modifiers + :type ?field-type})) [_] - (fail "[Analyser Error] Fields must be Tuple2 of [Symbol, Symbol]"))) + (fail "[Analyser Error] Wrong syntax for field."))) ?fields) - :let [=fields (into {} (for [[class field] ?fields] - [field {:access :public - :type class}]))] - $module &/get-module-name] - (return (&/|list (&/V "jvm-class" (&/T $module ?name ?super-class =fields {})))))) - -(defn analyse-jvm-interface [analyse ?name ?members] - (|do [=members (&/map% (fn [member] - (matchv ::M/objects [member] - [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ":"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "->"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?inputs]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?output]]]] - ["lux;Nil" _]]]]]]]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?member-name]]]] - ["lux;Nil" _]]]]]]]]]]] - (|do [inputs* (&/map% extract-ident ?inputs)] - (return [?member-name [inputs* ?output]])) + =methods (&/map% (fn [?method] + (matchv ::M/objects [?method] + [[?idx ["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?method-name]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?method-inputs]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method-output]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?method-modifiers]]] + ["lux;Cons" [?method-body + ["lux;Nil" _]]]]]]]]]]]]]]]] + (|do [=method-inputs (&/map% (fn [minput] + (matchv ::M/objects [minput] + [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?input-name]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?input-type]]] + ["lux;Nil" _]]]]]]]]] + (return (&/T (&/ident->text ?input-name) ?input-type)) + + [_] + (fail "[Analyser Error] Wrong syntax for method."))) + ?method-inputs) + =method-modifiers (analyse-modifiers ?method-modifiers) + =method-body (&/with-scope (str ?name "_" ?idx) + (&/fold (fn [body* input*] + (|let [[iname itype] input*] + (&&env/with-local iname (&/V "lux;DataT" (as-otype itype)) + body*))) + (if (= "void" ?method-output) + (analyse-1+ analyse ?method-body) + (&&/analyse-1 analyse (&/V "lux;DataT" (as-otype ?method-output)) ?method-body)) + (&/|reverse (if (:static? =method-modifiers) + =method-inputs + (&/|cons (&/T ";this" ?super-class) + =method-inputs)))))] + (return {:name ?method-name + :modifiers =method-modifiers + :inputs (&/|map &/|second =method-inputs) + :output ?method-output + :body =method-body})) + + [_] + (fail "[Analyser Error] Wrong syntax for method."))) + (&/enumerate ?methods))] + (return (&/|list (&/V "jvm-class" (&/T ?name ?super-class =interfaces =fields =methods)))))) + +(defn analyse-jvm-interface [analyse ?name ?supers ?methods] + (|do [=supers (&/map% extract-text ?supers) + =methods (&/map% (fn [method] + (matchv ::M/objects [method] + [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?method-name]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?inputs]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?output]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?modifiers]]] + ["lux;Nil" _]]]]]]]]]]]]] + (|do [=inputs (&/map% extract-text ?inputs) + =modifiers (analyse-modifiers ?modifiers)] + (return {:name ?method-name + :modifiers =modifiers + :inputs =inputs + :output ?output})) [_] (fail "[Analyser Error] Invalid method signature!"))) - ?members) - :let [=methods (into {} (for [[method [inputs output]] (&/->seq =members)] - [method {:access :public - :type [inputs output]}]))] - $module &/get-module-name] - (return (&/|list (&/V "jvm-interface" (&/T $module ?name =methods)))))) + ?methods)] + (return (&/|list (&/V "jvm-interface" (&/T ?name =supers =methods)))))) (defn analyse-jvm-try [analyse ?body [?catches ?finally]] (|do [=body (&&/analyse-1 analyse ?body) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index dff936fbe..cdecd234f 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -329,14 +329,12 @@ ==type (eval! =type) _ (&type/check exo-type ==type) =value (&&/analyse-1 analyse ==type ?value)] - (matchv ::M/objects [=value] - [[?expr ?expr-type]] - (return (&/|list (&/T ?expr ==type)))))) + (return (&/|list (&/T (&/V "ann" (&/T =value =type)) + ==type))))) (defn analyse-coerce [analyse eval! exo-type ?type ?value] (|do [=type (&&/analyse-1 analyse &type/Type ?type) ==type (eval! =type) =value (&&/analyse-1 analyse ==type ?value)] - (matchv ::M/objects [=value] - [[?expr ?expr-type]] - (return (&/|list (&/T ?expr ==type)))))) + (return (&/|list (&/T (&/V "ann" (&/T =value =type)) + ==type))))) diff --git a/src/lux/base.clj b/src/lux/base.clj index c4aab9ec6..57b25f47e 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -454,7 +454,7 @@ [] (findClass [^String class-name] ;; (prn 'findClass class-name) - (if-let [bytecode (get @store class-name)] + (if-let [^bytes bytecode (get @store class-name)] (.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))])) (throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name)))))))) @@ -652,7 +652,7 @@ [_ _] false)) -(defn enumerate* [idx xs] +(defn ^:private enumerate* [idx xs] (matchv ::M/objects [xs] [["lux;Cons" [x xs*]]] (V "lux;Cons" (T (T idx x) diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj index db2c92c42..a0425cdbe 100644 --- a/src/lux/compiler.clj +++ b/src/lux/compiler.clj @@ -25,6 +25,9 @@ ClassWriter MethodVisitor))) +;; [Constants] +(def ^:private version "0.2") + ;; [Utils/Compilers] (defn ^:private compile-expression [syntax] (matchv ::M/objects [syntax] @@ -72,6 +75,9 @@ [["lambda" [?scope ?env ?body]]] (&&lambda/compile-lambda compile-expression ?scope ?env ?body) + [["ann" [?value-ex ?type-ex]]] + (&&lux/compile-ann compile-expression ?type ?value-ex ?type-ex) + ;; Integer arithmetic [["jvm-iadd" [?x ?y]]] (&&host/compile-jvm-iadd compile-expression ?type ?x ?y) @@ -308,11 +314,11 @@ [["jvm-program" ?body]] (&&host/compile-jvm-program compile-expression ?body) - [["jvm-interface" [?package ?name ?methods]]] - (&&host/compile-jvm-interface compile-expression ?package ?name ?methods) + [["jvm-interface" [?name ?supers ?methods]]] + (&&host/compile-jvm-interface compile-expression ?name ?supers ?methods) - [["jvm-class" [?package ?name ?super-class ?fields ?methods]]] - (&&host/compile-jvm-class compile-expression ?package ?name ?super-class ?fields ?methods))) + [["jvm-class" [?name ?super-class ?interfaces ?fields ?methods]]] + (&&host/compile-jvm-class compile-expression ?name ?super-class ?interfaces ?fields ?methods))) (defn ^:private eval! [expr] (|do [id &/gen-id @@ -353,9 +359,18 @@ file-content (slurp file-name) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - (&host/->class name) nil "java/lang/Object" nil)) - _ (doto (.visitField =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) - .visitEnd)] + (&host/->class name) nil "java/lang/Object" nil) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil (hash file-content)) + .visitEnd) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil version) + .visitEnd) + ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil ...) + ;; .visitEnd) + ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_exports" "Ljava/lang/String;" nil ...) + ;; .visitEnd) + ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_macros" "Ljava/lang/String;" nil ...) + ;; .visitEnd) + )] (matchv ::M/objects [((&/exhaust% compiler-step) (->> state (&/set$ &/$SOURCE (&reader/from file-name file-content)) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 87753dce3..e825ca0ad 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -238,7 +238,7 @@ (defn compile-jvm-new [compile *type* ?class ?classes ?args] (|do [^MethodVisitor *writer* &/get-writer - :let [init-sig (str "(" (reduce str "" (map &host/->type-signature ?classes)) ")V") + :let [init-sig (str "(" (&/fold str "" (&/|map &host/->type-signature ?classes)) ")V") class* (&host/->class ?class) _ (doto *writer* (.visitTypeInsn Opcodes/NEW class*) @@ -247,7 +247,7 @@ (|do [ret (compile arg) :let [_ (prepare-arg! *writer* class-name)]] (return ret))) - (map vector ?classes ?args)) + (&/zip2 ?classes ?args)) :let [_ (doto *writer* (.visitMethodInsn Opcodes/INVOKESPECIAL class* "" init-sig))]] (return nil))) @@ -303,40 +303,62 @@ :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD (&host/->class ?class) ?field (&host/->java-sig *type*))]] (return nil))) -(defn compile-jvm-class [compile ?package ?name ?super-class ?fields ?methods] - (let [parent-dir (&host/->package ?package) - full-name (str parent-dir "/" ?name) +(defn ^:private modifiers->int [mods] + (+ (case (:visibility mods) + "default" 0 + "public" Opcodes/ACC_PUBLIC + "private" Opcodes/ACC_PRIVATE + "protected" Opcodes/ACC_PROTECTED) + (if (:static? mods) Opcodes/ACC_STATIC 0) + (if (:final? mods) Opcodes/ACC_FINAL 0) + (if (:abstract? mods) Opcodes/ACC_ABSTRACT 0) + (case (:concurrency mods) + "synchronized" Opcodes/ACC_SYNCHRONIZED + "volatile" Opcodes/ACC_VOLATILE + ;; else + 0))) + +(defn compile-jvm-class [compile ?name ?super-class ?interfaces ?fields ?methods] + (let [name* (&host/->class ?name) super-class* (&host/->class ?super-class) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) - full-name nil super-class* nil)) - _ (do (doseq [[field props] ?fields] - (doto (.visitField =class Opcodes/ACC_PUBLIC field (&host/->type-signature (:type props)) nil nil) - (.visitEnd))) - (doto (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) - (.visitCode) - (.visitVarInsn Opcodes/ALOAD 0) - (.visitMethodInsn Opcodes/INVOKESPECIAL super-class* "" "()V") - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd)) - (.visitEnd =class) - (.mkdirs (java.io.File. (str "output/" parent-dir))))] - (&&/save-class! full-name (.toByteArray =class)))) - -(defn compile-jvm-interface [compile ?package ?name ?methods] - (let [parent-dir (&host/->package ?package) - full-name (str parent-dir "/" ?name) + name* nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String)))) + _ (&/|map (fn [field] + (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field) + (&host/->type-signature (:type field)) nil nil) + (.visitEnd))) + ?fields)] + (|do [_ (&/map% (fn [method] + (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")" + (&host/->type-signature (:output method)))] + (&/with-writer (.visitMethod =class (modifiers->int (:modifiers method)) + (:name method) + signature nil nil) + (|do [^MethodVisitor =method &/get-writer + :let [_ (.visitCode =method)] + _ (compile (:body method)) + :let [_ (doto =method + (.visitInsn (if (= "void" (:output method)) Opcodes/RETURN Opcodes/ARETURN)) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil))))) + ?methods)] + (&&/save-class! name* (.toByteArray (doto =class .visitEnd)))))) + +(defn compile-jvm-interface [compile ?name ?supers ?methods] + (prn 'compile-jvm-interface (->> ?supers &/->seq pr-str)) + (let [name* (&host/->class ?name) =interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_INTERFACE) - full-name nil "java/lang/Object" nil)) - _ (do (doseq [[?method ?props] ?methods - :let [[?args ?return] (:type ?props) - signature (str "(" (&/fold str "" (&/|map &host/->type-signature ?args)) ")" (&host/->type-signature ?return))]] - (.visitMethod =interface (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) ?method signature nil nil)) - (.visitEnd =interface) - (.mkdirs (java.io.File. (str "output/" parent-dir))))] - (&&/save-class! full-name (.toByteArray =interface)))) + name* nil "java/lang/Object" (->> ?supers (&/|map &host/->class) &/->seq (into-array String)))) + _ (do (&/|map (fn [method] + (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")" + (&host/->type-signature (:output method)))] + (.visitMethod =interface (modifiers->int (:modifiers method)) (:name method) signature nil nil))) + ?methods) + (.visitEnd =interface))] + (&&/save-class! name* (.toByteArray =interface)))) (defn compile-jvm-try [compile *type* ?body ?catches ?finally] (|do [^MethodVisitor *writer* &/get-writer diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index cf4a65f04..d0caff173 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -135,7 +135,12 @@ (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER) current-class nil "java/lang/Object" (into-array ["lux/Function"])) (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_datum" datum-sig nil nil) - (doto (.visitEnd))))] + (doto (.visitEnd))) + ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_mode" datum-sig nil ...) + ;; (doto (.visitEnd))) + ;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_type" datum-sig nil nil) + ;; (doto (.visitEnd))) + )] _ (&/with-writer (.visitMethod =class Opcodes/ACC_PUBLIC "" "()V" nil nil) (|do [^MethodVisitor **writer** &/get-writer :let [_ (.visitCode **writer**)] @@ -150,6 +155,9 @@ _ (&&/save-class! current-class (.toByteArray =class))] (return nil))) +(defn compile-ann [compile *type* ?value-ex ?type-ex] + (compile ?value-ex)) + (defn compile-declare-macro [compile module name] (|do [_ (&a-module/declare-macro module name)] (return nil))) diff --git a/src/lux/host.clj b/src/lux/host.clj index 8817ea338..e2efd92e9 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -25,8 +25,7 @@ ))) (defn ^:private method->type [^Method method] - (|do [=return (class->type (.getReturnType method))] - (return =return))) + (class->type (.getReturnType method))) ;; [Resources] (defn ^String ->class [class] -- cgit v1.2.3