Modules can now contain definitions of simple interfaces, with only method declarations.

2 files changed, 36 insertions, 13 deletions

diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index 26236da93..f305d8556 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -132,18 +132,31 @@
 
 (defcompiler ^:private compile-defclass
   [::&parser/defclass ?name ?fields]
-  (do (prn 'compile-defclass ?name ?fields)
-    (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
-                   (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
-                           (->class (str *name* "." ?name)) nil "java/lang/Object" nil))]
-      (doseq [[class field] ?fields]
-        (doto (.visitField =class Opcodes/ACC_PUBLIC field (->type-signature class) nil nil)
-          (.visitEnd)))
-      (.visitEnd =class)
-      (let [parent-dir (->class *name*)]
-        (.mkdirs (java.io.File. parent-dir))
-        (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))]
-          (.write stream (.toByteArray =class)))))))
+  (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+                 (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+                         (->class (str *name* "." ?name)) nil "java/lang/Object" nil))]
+    (doseq [[class field] ?fields]
+      (doto (.visitField =class Opcodes/ACC_PUBLIC field (->type-signature class) nil nil)
+        (.visitEnd)))
+    (.visitEnd =class)
+    (let [parent-dir (->class *name*)]
+      (.mkdirs (java.io.File. parent-dir))
+      (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))]
+        (.write stream (.toByteArray =class))))))
+
+(defcompiler ^:private compile-definterface
+  [::&parser/definterface ?name ?members]
+  (let [=interface (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+                     (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT Opcodes/ACC_INTERFACE)
+                             (->class (str *name* "." ?name)) nil "java/lang/Object" nil))]
+    (doseq [[?method [?args ?return]] ?members
+            :let [signature (str "(" (reduce str "" (map ->type-signature ?args)) ")" (->type-signature ?return))]]
+      (.visitMethod =interface (+ Opcodes/ACC_PUBLIC) ?method signature nil nil))
+    (.visitEnd =interface)
+    (let [parent-dir (->class *name*)]
+      (.mkdirs (java.io.File. parent-dir))
+      (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))]
+        (.write stream (.toByteArray =interface))))))
 
 (let [+compilers+ [compile-boolean
                    compile-string
@@ -155,7 +168,8 @@
                    compile-if
                    compile-def
                    compile-module
-                   compile-defclass]]
+                   compile-defclass
+                   compile-definterface]]
   (defn ^:private compile-form [state]
     (prn 'compile-form/state state)
     (some #(% state) +compilers+)))
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index beb14302d..2d104be94 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -115,6 +115,14 @@
                    [?class ?field]))]
     (return [::defclass ?name fields])))
 
+(defparser ^:private parse-definterface
+  [::&lexer/list ([[::&lexer/ident "definterface"] [::&lexer/ident ?name] & ?members] :seq)]
+  (let [members (for [field ?members]
+                  (match field
+                    [::&lexer/list ([[::&lexer/ident ":"] [::&lexer/ident ?member] [::&lexer/list ([[::&lexer/ident "->"] [::&lexer/tuple ?inputs] ?output] :seq)]] :seq)]
+                    [?member [(map ident->string ?inputs) (ident->string ?output)]]))]
+    (return [::definterface ?name members])))
+
 (defparser ^:private parse-tagged
   [::&lexer/list ([[::&lexer/tag ?tag] ?data] :seq)]
   (exec [=data (apply-m parse-form (list ?data))]
@@ -199,6 +207,7 @@
               parse-ann-class
               parse-module
               parse-defclass
+              parse-definterface
               parse-fn-call]))
 
 ;; [Interface]