aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux207
-rw-r--r--src/lux/analyser.clj44
-rw-r--r--src/lux/analyser/host.clj172
-rw-r--r--src/lux/analyser/lux.clj10
-rw-r--r--src/lux/base.clj4
-rw-r--r--src/lux/compiler.clj29
-rw-r--r--src/lux/compiler/host.clj84
-rw-r--r--src/lux/compiler/lux.clj10
-rw-r--r--src/lux/host.clj3
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"])]
+## (<init> [] "void"
+## ["public"]
+## (_jvm_invokespecial java.lang.Object <init> [] 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] (` <form>)))
- last
- init))))
+ (list (foldL (: (-> Syntax Syntax Syntax)
+ (lambda [post pre] (` <form>)))
+ last
+ init))))
_
(fail <message>)))]
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 (= "<init>" ?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>" 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 "<init>" "()V" nil nil)
- (.visitCode)
- (.visitVarInsn Opcodes/ALOAD 0)
- (.visitMethodInsn Opcodes/INVOKESPECIAL super-class* "<init>" "()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 "<clinit>" "()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]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 15:48:43 +0000