diff options
-rw-r--r-- | source/lux.lux | 2 | ||||
-rw-r--r-- | source/lux/host/jvm.lux | 62 | ||||
-rw-r--r-- | source/lux/meta/syntax.lux | 21 | ||||
-rw-r--r-- | src/lux/analyser/host.clj | 30 | ||||
-rw-r--r-- | src/lux/compiler/host.clj | 6 |
5 files changed, 91 insertions, 30 deletions
diff --git a/source/lux.lux b/source/lux.lux index 3ede6d75b..fbdd71904 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -5,7 +5,7 @@ ## First things first, must define functions (_jvm_interface "Function" [] - ("apply" ["java.lang.Object"] "java.lang.Object" ["public" "abstract"])) + ("apply" ["public" "abstract"] [] ["java.lang.Object"] "java.lang.Object")) ## Basic types (_lux_def Bool (10 ["lux" "Bool"] diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 1e903ad1d..4892ba333 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -42,7 +42,8 @@ (deftype MethodDecl (& #method-inputs (List JvmType) - #method-output JvmType)) + #method-output JvmType + #method-exs (List JvmType))) (deftype ArgDecl (& #arg-name Text @@ -51,7 +52,8 @@ (deftype MethodDef (& #method-vars (List ArgDecl) #return-type JvmType - #return-body AST)) + #return-body AST + #throws-exs (List JvmType))) (deftype ExpectedInput (& #opt-input? Bool @@ -88,11 +90,30 @@ (Parser MemberDecl) (&^ (*^ local-tag^) local-symbol^)) +(def throws-decl'^ + (Parser (List JvmType)) + (do Parser/Monad + [_ (tag!^ ["" "throws"])] + (tuple^ (*^ local-symbol^)))) + +(def throws-decl^ + (Parser (List JvmType)) + (do Parser/Monad + [exs? (?^ throws-decl'^)] + (wrap (? (@list) exs?)))) + +(def method-decl'^ + (Parser MethodDecl) + (do Parser/Monad + [inputs (tuple^ (*^ local-symbol^)) + outputs local-symbol^ + exs throws-decl^] + (wrap [inputs outputs exs]))) + (def method-decl^ (Parser (, MemberDecl MethodDecl)) (form^ (&^ member-decl^ - (&^ (tuple^ (*^ local-symbol^)) - local-symbol^)))) + method-decl'^))) (def field-decl^ (Parser (, MemberDecl FieldDecl)) @@ -103,14 +124,19 @@ (Parser ArgDecl) (form^ (&^ local-symbol^ local-symbol^))) +(def method-def'^ + (Parser MethodDef) + (do Parser/Monad + [inputs (tuple^ (*^ arg-decl^)) + output local-symbol^ + exs throws-decl^ + body id^] + (wrap [inputs output body exs]))) + (def method-def^ (Parser (, MemberDecl MethodDef)) - (form^ (do Parser/Monad - [=member-decl member-decl^ - inputs (tuple^ (*^ arg-decl^)) - output local-symbol^ - body id^] - (wrap [=member-decl [inputs output body]])))) + (form^ (&^ member-decl^ + method-def'^))) (def exp-input^ (Parser ExpectedInput) @@ -126,26 +152,32 @@ (wrap [ex? opt? return]))) ## Generators -(def (gen-method-decl [[modifiers name] [inputs output]]) +(def (gen-method-decl [[modifiers name] [inputs output exs]]) (-> (, MemberDecl MethodDecl) AST) - (` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))) + (` ((~ (text$ name)) + [(~@ (map text$ modifiers))] + [(~@ (map text$ exs))] + [(~@ (map text$ inputs))] + (~ (text$ output))))) (def (gen-field-decl [[modifiers name] class]) (-> (, MemberDecl FieldDecl) AST) (` ((~ (text$ name)) + [(~@ (map text$ modifiers))] (~ (text$ class)) - [(~@ (map text$ modifiers))]))) + ))) (def (gen-arg-decl [name type]) (-> ArgDecl AST) (form$ (@list (symbol$ ["" name]) (text$ type)))) -(def (gen-method-def [[modifiers name] [inputs output body]]) +(def (gen-method-def [[modifiers name] [inputs output body exs]]) (-> (, MemberDecl MethodDef) AST) (` ((~ (text$ name)) + [(~@ (map text$ modifiers))] + [(~@ (map text$ exs))] [(~@ (map gen-arg-decl inputs))] (~ (text$ output)) - [(~@ (map text$ modifiers))] (~ body)))) (def (gen-expected-output [ex? opt? output] body) diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux index 3b9149a74..d9f3c6dc3 100644 --- a/source/lux/meta/syntax.lux +++ b/source/lux/meta/syntax.lux @@ -137,6 +137,27 @@ [ tag?^ Ident #;TagS ident:=] ) +(do-template [<name> <type> <tag> <eq>] + [(def #export (<name> v tokens) + (-> <type> (Parser Unit)) + (case tokens + (#;Cons [[_ (<tag> x)] tokens']) + (if (<eq> v x) + (#;Some [tokens' []]) + #;None) + + _ + #;None))] + + [ bool!^ Bool #;BoolS (:: b;Bool/Eq =)] + [ int!^ Int #;IntS i=] + [ real!^ Real #;RealS r=] + [ char!^ Char #;CharS (:: c;Char/Eq =)] + [ text!^ Text #;TextS (:: t;Text/Eq =)] + [symbol!^ Ident #;SymbolS ident:=] + [ tag!^ Ident #;TagS ident:=] + ) + (do-template [<name> <tag>] [(def #export (<name> p tokens) (All [a] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 6c15c8bbc..9d295edda 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -414,8 +414,8 @@ (defn ^:private analyse-field [field] (|case field [_ (&/$FormS (&/$Cons [_ (&/$TextS ?field-name)] - (&/$Cons [_ (&/$TextS ?field-type)] - (&/$Cons [_ (&/$TupleS ?field-modifiers)] + (&/$Cons [_ (&/$TupleS ?field-modifiers)] + (&/$Cons [_ (&/$TextS ?field-type)] (&/$Nil)))))] (|do [=field-modifiers (analyse-modifiers ?field-modifiers)] (return {:name ?field-name @@ -428,12 +428,14 @@ (defn ^:private analyse-method [analyse owner-class method] (|case method [idx [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)] - (&/$Cons [_ (&/$TupleS method-inputs)] - (&/$Cons [_ (&/$TextS method-output)] - (&/$Cons [_ (&/$TupleS method-modifiers)] - (&/$Cons method-body - (&/$Nil)))))))]] + (&/$Cons [_ (&/$TupleS method-modifiers)] + (&/$Cons [_ (&/$TupleS method-exs)] + (&/$Cons [_ (&/$TupleS method-inputs)] + (&/$Cons [_ (&/$TextS method-output)] + (&/$Cons method-body + (&/$Nil))))))))]] (|do [=method-modifiers (analyse-modifiers method-modifiers) + =method-exs (&/map% extract-text method-exs) =method-inputs (&/map% (fn [minput] (|case minput [_ (&/$FormS (&/$Cons [_ (&/$SymbolS "" input-name)] @@ -455,6 +457,7 @@ =method-inputs)))] (return {:name method-name :modifiers =method-modifiers + :exceptions =method-exs :inputs (&/|map &/|second =method-inputs) :output method-output :body =method-body})) @@ -465,14 +468,17 @@ (defn ^:private analyse-method-decl [method] (|case method [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)] - (&/$Cons [_ (&/$TupleS inputs)] - (&/$Cons [_ (&/$TextS output)] - (&/$Cons [_ (&/$TupleS modifiers)] - (&/$Nil))))))] + (&/$Cons [_ (&/$TupleS modifiers)] + (&/$Cons [_ (&/$TupleS method-exs)] + (&/$Cons [_ (&/$TupleS inputs)] + (&/$Cons [_ (&/$TextS output)] + (&/$Nil)))))))] (|do [=inputs (&/map% extract-text inputs) - =modifiers (analyse-modifiers modifiers)] + =modifiers (analyse-modifiers modifiers) + =method-exs (&/map% extract-text method-exs)] (return {:name method-name :modifiers =modifiers + :exceptions =method-exs :inputs =inputs :output output})) diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 89f830561..b4858d789 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -419,7 +419,9 @@ (&host/->type-signature (:output method)))] (&/with-writer (.visitMethod class-writer (&host/modifiers->int (:modifiers method)) (:name method) - signature nil nil) + signature + nil + (->> (:exceptions method) &/->seq (into-array java.lang.String))) (|do [^MethodVisitor =method &/get-writer :let [_ (.visitCode =method)] _ (compile (:body method)) @@ -432,7 +434,7 @@ (defn ^:private compile-method-decl [class-writer method] (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")" (&host/->type-signature (:output method)))] - (.visitMethod class-writer (&host/modifiers->int (:modifiers method)) (:name method) signature nil nil))) + (.visitMethod class-writer (&host/modifiers->int (:modifiers method)) (:name method) signature nil (->> (:exceptions method) &/->seq (into-array java.lang.String))))) (let [clo-field-sig (&host/->type-signature "java.lang.Object") <init>-return "V"] |