Added some super-basic type-system.

4 files changed, 92 insertions, 16 deletions

diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index 0cb69462e..16b2dfe54 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -6,7 +6,8 @@
                                           repeat-m try-m try-all-m map-m
                                           apply-m]]
                   [parser :as &parser]
-                  [lexer :as &lexer])
+                  [lexer :as &lexer]
+                  [type :as &type])
             :reload)
   (:import (org.objectweb.asm Opcodes
                               ClassWriter
@@ -18,11 +19,25 @@
 (def ^:private +state+
   {:globals {}
    :stack {}
-   :forms '()})
+   :forms '()
+   :classes {}})
+
+(defn define-class [class members]
+  (fn [state]
+    (return* (assoc-in state [:classes class] members) nil)))
+
+(defn find-class [class]
+  (fn [state]
+    (if-let [class-data (get-in state [:classes class])]
+      (return* state class-data)
+      (fail* (str "Unknown class: " class)))))
 
 (defn wrap [x]
   (update-in +state+ [:forms] conj x))
 
+(defn wrap-in [state x]
+  (assoc-in state [:forms] (list x)))
+
 (defn wrap* [env x]
   (-> +state+
       (update-in [:stack] merge env)
@@ -205,29 +220,59 @@
         (.visitLdcInsn ?string))
     (return nil)))
 
+(defn ->java-class [class]
+  (string/replace class #"\." "/"))
+
+(defn ->java-class* [class]
+  (case class
+    "Void" "V"
+    ;; else
+    (str "L" (->java-class class) ";")))
+
+(defn method->signature [method]
+  (match method
+    [::&type/fn ?args ?return]
+    (str "(" (reduce str "" (map ->java-class* ?args)) ")" (->java-class* ?return))))
+
 (defcompiler compile-static-access
   [::&parser/static-access ?class ?member]
-  (let [?class* (string/replace ?class #"\." "/")]
-    (doto *code*
-      (.visitFieldInsn Opcodes/GETSTATIC ?class* ?member "Ljava/io/PrintStream;"))
-    (return nil)))
+  (exec [=class (find-class ?class)
+         :let [member-type (get-in =class [:fields ?member])
+               ?field-class (match member-type
+                              [::&type/object ?field-class _]
+                              ?field-class)]]
+    (do (doto *code*
+          (.visitFieldInsn Opcodes/GETSTATIC (->java-class ?class) ?member (->java-class* ?field-class)))
+      (return member-type))))
 
 (defcompiler compile-dynamic-access
   [::&parser/dynamic-access ?object ?access]
-  (exec [=object (apply-m compile-form (wrap ?object))
-         [=method =args] (match ?access
-                           [::&parser/fn-call [::&parser/ident ?method] ?args]
-                           (exec [=args (map-m #(apply-m compile-form (wrap %))
-                                               ?args)]
-                             (return [?method =args])))]
+  (exec [_state &util/get-state
+         =object (apply-m compile-form (wrap-in _state ?object))
+         :let [?oclass (match =object
+                         [::&type/object ?oclass _]
+                         ?oclass)]
+         =class (find-class ?oclass)
+         [method signature] (match ?access
+                              [::&parser/fn-call [::&parser/ident ?method] ?args]
+                              (exec [=args (map-m #(apply-m compile-form (wrap %))
+                                                  ?args)]
+                                (return [?method (method->signature (get-in =class [:methods ?method]))])))]
     (do (doto *code*
-          (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/io/PrintStream" =method "(Ljava/lang/String;)V"))
+          (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->java-class ?oclass) method signature))
       (return nil))))
 
+(defcompiler compile-ann-class
+  [::&parser/ann-class ?class ?members]
+  (exec [_ (define-class ?class ?members)
+         _state &util/get-state]
+    (return nil)))
+
 (def compile-form
   (try-all-m [compile-string
               compile-static-access
-              compile-dynamic-access]))
+              compile-dynamic-access
+              compile-ann-class]))
 
 (defn compile [inputs]
   (let [cw (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
diff --git a/src/lang/lexer.clj b/src/lang/lexer.clj
index 54e83c078..e2de44d82 100644
--- a/src/lang/lexer.clj
+++ b/src/lang/lexer.clj
@@ -49,7 +49,7 @@
          _ (lex-str "}")]
     (return [::record members])))
 
-(def +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|']*)")
+(def +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':]*)")
 
 (do-template [<name> <tag> <regex>]
   (def <name>
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index 7f1337558..d1bd3dbd8 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -3,7 +3,8 @@
             (lang [util :as &util :refer [exec return* return fail fail*
                                           repeat-m try-m try-all-m map-m
                                           apply-m]]
-                  [lexer :as &lexer])))
+                  [lexer :as &lexer]
+                  [type :as &type])))
 
 (declare parse-form)
 
@@ -26,6 +27,11 @@
   [::&lexer/float ?float]
   (return [::float (Double/parseDouble ?float)]))
 
+(defn ident->string [ident]
+  (match ident
+    [::&lexer/ident ?ident]
+    ?ident))
+
 (defparser ^:private parse-ident
   [::&lexer/ident ?ident]
   (return [::ident ?ident]))
@@ -124,6 +130,26 @@
          =call (apply-m parse-form (list ?call))]
     (return [::dynamic-access =object =call])))
 
+(defparser ^:private parse-ann-class
+  [::&lexer/list ([[::&lexer/ident "ann-class"] [::&lexer/ident ?class] & ?decl] :seq)]
+  (let [[_ class-data] (reduce (fn [[mode data] event]
+                                 (match event
+                                   [::&lexer/ident "methods"]
+                                   [:methods data]
+
+                                   [::&lexer/ident "fields"]
+                                   [:fields data]
+
+                                   [::&lexer/list ([[::&lexer/ident ":"] [::&lexer/ident ?field-name] [::&lexer/ident ?field-class]] :seq)]
+                                   [mode (assoc-in data [mode ?field-name] [::&type/object ?field-class []])]
+                                   
+                                   [::&lexer/list ([[::&lexer/ident ":"] [::&lexer/ident ?method-name] [::&lexer/list ([[::&lexer/ident "->"] [::&lexer/tuple ?args*] [::&lexer/ident ?return]] :seq)]] :seq)]
+                                   [mode (assoc-in data [mode ?method-name] [::&type/fn (map ident->string ?args*) ?return])]
+                                   ))
+                               [nil {}]
+                               ?decl)]
+    (return [::ann-class ?class class-data])))
+
 (defparser ^:private parse-string
   [::&lexer/string ?string]
   (return [::string ?string]))
@@ -153,6 +179,7 @@
               parse-remove
               parse-static-access
               parse-dynamic-access
+              parse-ann-class
               parse-fn-call]))
 
 ;; [Interface]
diff --git a/src/lang/type.clj b/src/lang/type.clj
new file mode 100644
index 000000000..cab0ebeec
--- /dev/null
+++ b/src/lang/type.clj
@@ -0,0 +1,4 @@
+(ns lang.type)
+
+
+