aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--source/lux.lux2
-rw-r--r--source/lux/host/jvm.lux62
-rw-r--r--source/lux/meta/syntax.lux21
-rw-r--r--src/lux/analyser/host.clj30
-rw-r--r--src/lux/compiler/host.clj6
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"]