From d95a64fddbee73c6433ba7485959766cb2d4c6f9 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 2 Dec 2014 01:07:18 -0400
Subject: Added some super-basic type-system.

---
 src/lang/compiler.clj | 73 +++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 59 insertions(+), 14 deletions(-)

(limited to 'src/lang/compiler.clj')

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)
-- 
cgit v1.2.3