From e6c8e86823f61dddb00d5768acc1982bac173083 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 8 Feb 2016 15:52:35 -0400
Subject: - Added the ability to define native methods.

---
 src/lux/analyser/host.clj   |  6 ++++++
 src/lux/analyser/parser.clj | 21 +++++++++++++++++++++
 src/lux/base.clj            |  6 ++++--
 src/lux/compiler/host.clj   | 14 ++++++++++++++
 src/lux/host.clj            | 10 ++++++++++
 5 files changed, 55 insertions(+), 2 deletions(-)

(limited to 'src')

diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index f8d6060d4..24b70e353 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -645,6 +645,9 @@
 
       (&/$AbstractMethodSyntax ?name ?anns ?gvars ?exceptions ?inputs ?output)
       (return (&/$AbstractMethodAnalysis (&/T [?name ?anns ?gvars ?exceptions ?inputs ?output])))
+
+      (&/$NativeMethodSyntax ?name ?anns ?gvars ?exceptions ?inputs ?output)
+      (return (&/$NativeMethodAnalysis (&/T [?name ?anns ?gvars ?exceptions ?inputs ?output])))
       )))
 
 (defn ^:private mandatory-methods [supers]
@@ -670,6 +673,9 @@
 
                                       (&/$AbstractMethodSyntax _)
                                       mmap
+
+                                      (&/$NativeMethodSyntax _)
+                                      mmap
                                       ))
                                   {}
                                   methods)
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index 85aae913a..f6b76d343 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -304,12 +304,33 @@
     _
     (fail "")))
 
+(defn ^:private parse-method-native-def [ast]
+  (|case ast
+    [_ (&/$FormS (&/$Cons [_ (&/$TextS "native")]
+                          (&/$Cons [_ (&/$TextS ?name)]
+                                   (&/$Cons [_ (&/$TupleS anns)]
+                                            (&/$Cons [_ (&/$TupleS gvars)]
+                                                     (&/$Cons [_ (&/$TupleS exceptions)]
+                                                              (&/$Cons [_ (&/$TupleS inputs)]
+                                                                       (&/$Cons output
+                                                                                (&/$Nil)))))))))]
+    (|do [=anns (&/map% parse-ann anns)
+          =gvars (&/map% parse-text gvars)
+          =exceptions (&/map% parse-gclass exceptions)
+          =inputs (&/map% parse-arg-decl inputs)
+          =output (parse-gclass output)]
+      (return (&/$NativeMethodSyntax (&/T [?name =anns =gvars =exceptions =inputs =output]))))
+
+    _
+    (fail "")))
+
 (defn parse-method-def [ast]
   (&/try-all% (&/|list #((parse-method-init-def ast) %)
                        #((parse-method-virtual-def ast) %)
                        #((parse-method-override-def ast) %)
                        #((parse-method-static-def ast) %)
                        #((parse-method-abstract-def ast) %)
+                       #((parse-method-native-def ast) %)
                        (fn [state]
                          (fail* (str "[Analyser Error] Invalid method definition: " (&/show-ast ast)))))))
 
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 1c7c894b3..d653a11b1 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -182,14 +182,16 @@
   ("VirtualMethodSyntax" 1)
   ("OverridenMethodSyntax" 1)
   ("StaticMethodSyntax" 1)
-  ("AbstractMethodSyntax" 1))
+  ("AbstractMethodSyntax" 1)
+  ("NativeMethodSyntax" 1))
 
 (defvariant
   ("ConstructorMethodAnalysis" 1)
   ("VirtualMethodAnalysis" 1)
   ("OverridenMethodAnalysis" 1)
   ("StaticMethodAnalysis" 1)
-  ("AbstractMethodAnalysis" 1))
+  ("AbstractMethodAnalysis" 1)
+  ("NativeMethodAnalysis" 1))
 
 ;; Meta-data
 (defvariant
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index bddb25f67..de6e6484d 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -612,6 +612,20 @@
               :let [_ (&/|map (partial compile-annotation =method) ?anns)
                     _ (.visitEnd =method)]]
           (return nil))))
+
+    (&/$NativeMethodSyntax ?name ?anns ?gvars ?exceptions ?inputs ?output)
+    (|let [=method-decl (&/T [?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output])
+           [simple-signature generic-signature] (&host-generics/method-signatures =method-decl)]
+      (&/with-writer (.visitMethod class-writer
+                                   (+ Opcodes/ACC_PUBLIC Opcodes/ACC_NATIVE)
+                                   ?name
+                                   simple-signature
+                                   generic-signature
+                                   (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+        (|do [^MethodVisitor =method &/get-writer
+              :let [_ (&/|map (partial compile-annotation =method) ?anns)
+                    _ (.visitEnd =method)]]
+          (return nil))))
     ))
 
 (defn ^:private compile-method-decl [^ClassWriter class-writer =method-decl]
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 6bbf752f2..d1b884280 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -337,6 +337,16 @@
                           (->> =exceptions (&/|map &host-generics/gclass->bytecode-class-name) &/->seq (into-array java.lang.String)))
         (.visitEnd)))
 
+    (&/$NativeMethodSyntax =name =anns =gvars =exceptions =inputs =output)
+    (|let [method-decl [=name =anns =gvars =exceptions (&/|map &/|second =inputs) =output]
+           [simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
+      (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_NATIVE)
+                          =name
+                          simple-signature
+                          generic-signature
+                          (->> =exceptions (&/|map &host-generics/gclass->bytecode-class-name) &/->seq (into-array java.lang.String)))
+        (.visitEnd)))
+
     _
     (assert false (println-str 'compile-dummy-method (&/adt->text method-def)))
     ))
-- 
cgit v1.2.3