Added Java class imports.

4 files changed, 91 insertions, 22 deletions

diff --git a/src/lang.clj b/src/lang.clj
index d8b65afe6..5d5dd0c66 100644
--- a/src/lang.clj
+++ b/src/lang.clj
@@ -46,16 +46,61 @@
         syntax (&parser/parse tokens)
         ;; _ (prn 'syntax syntax)
         ann-syntax (&analyser/analyse "test2" syntax)
-        _ (prn 'ann-syntax ann-syntax)
+        ;; _ (prn 'ann-syntax ann-syntax)
         class-data (&compiler/compile "test2" ann-syntax)]
     (write-file "test2.class" class-data))
 
-  ;; TODO: Define functions as classes inheriting Function.
-  ;; TODO: Allow importing Java classes.
+  (let y ...
+       (lambda x (* x y)))
+
+  (let y ...
+       (proxy Function1
+         (apply1 [_ x] (* x y))))
+
+  (def (foo w x y z)
+    ($ * w x y z))
+  =>
+  (let f1 (proxy Function1 [w x y]
+                 (apply1 [_ z]
+                   (STATIC-METHOD w x y z)))
+       (let f2 (proxy Function2 [w x]
+                      (apply1 [_ y]
+                        f1)
+                      (apply2 [_ y z]
+                        (STATIC-METHOD w x y z)))
+            (proxy Function4
+              (apply1 [_ w x]
+                      (proxy Function3 [w]
+                             (apply1 [_ x]
+                               f2)
+                             (apply2 [_ x y]
+                               f1)
+                             (apply3 [_ x y z]
+                               (STATIC-METHOD w x y z))))
+              (apply2 [_ w x]
+                f2)
+              (apply3 [_ w x y]
+                f1)
+              (apply4 [_ w x y z]
+                (STATIC-METHOD w x y z)))))
+
+  <OR AS...>
+  (proxy Function []
+         (apply [_ w]
+           (proxy Function [w]
+                  (apply [_ x]
+                    (proxy Function [w x]
+                           (apply [_ y]
+                             (proxy Function [w x y]
+                                    (apply [_ z]
+                                      (STATIC-METHOD w x y z)))))))))
+  
+
   ;; TODO: Allow using other modules.
+  ;; TODO: Define functions as classes inheriting Function.
   ;; TODO: Add tuples.
-  ;; TODO: Add thunks.
   ;; TODO: Add pattern-matching.
+  ;; TODO: Add thunks.
   ;; TODO: Add Java-interop.
   ;; TODO: Do tail-call optimization.
   ;; TODO: Add macros.
diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
index c40fccffb..abf8fa638 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -1,6 +1,7 @@
 (ns lang.analyser
   (:refer-clojure :exclude [resolve])
   (:require [clojure.core.match :refer [match]]
+            [clojure.string :as string]
             (lang [util :as &util :refer [exec return* return fail fail*
                                           repeat-m try-m try-all-m map-m
                                           apply-m within]]
@@ -40,6 +41,13 @@
         _
         =return))))
 
+(defn ^:private import-class [long-name short-name]
+  (fn [state]
+    (let [=class (annotated [::class long-name] ::&type/nothing)]
+      [::&util/ok [(update-in state [:env :mappings] merge {long-name =class,
+                                                            short-name =class})
+                   nil]])))
+
 (defn ^:private resolve [ident]
   (fn [state]
     (if-let [resolved (get-in state [:env :mappings ident])]
@@ -88,8 +96,12 @@
   (return (annotated [::ann-class ?class ?members] ::&type/nothing)))
 
 (defanalyser analyse-static-access
-  [::&parser/static-access ?class ?member]
-  (return (annotated [::static-access ?class ?member] ::&type/nothing)))
+  [::&parser/static-access ?target ?member]
+  (exec [=target (resolve ?target)
+         :let [_ (prn '=target ?target (:form =target))]]
+    (match (:form =target)
+      [::class ?class]
+      (return (annotated [::static-access ?class ?member] ::&type/nothing)))))
 
 (defanalyser analyse-dynamic-access
   [::&parser/dynamic-access ?object ?member]
@@ -173,6 +185,11 @@
         (return (annotated [::def [?name args] =value] ::&type/nothing))))
     ))
 
+(defanalyser analyse-import
+  [::&parser/import ?class]
+  (exec [_ (import-class ?class (last (string/split ?class #"\.")))]
+    (return (annotated [::import ?class] ::&type/nothing))))
+
 (def ^:private analyse-form
   (try-all-m [analyse-boolean
               analyse-string
@@ -186,7 +203,8 @@
               analyse-let
               analyse-defclass
               analyse-definterface
-              analyse-def]))
+              analyse-def
+              analyse-import]))
 
 ;; [Interface]
 (defn analyse [module-name tokens]
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index a8d38842a..d6a6f5125 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -74,19 +74,19 @@
 
 (defcompiler ^:private compile-local
   [::&analyser/local ?idx]
-  (do (prn 'LOCAL ?idx)
+  (do ;; (prn 'LOCAL ?idx)
     (doto *writer*
       (.visitVarInsn Opcodes/ALOAD (int ?idx)))))
 
 (defcompiler ^:private compile-global
   [::&analyser/global ?owner-class ?name]
-  (do (prn 'GLOBAL ?owner-class ?name *type*)
+  (do ;; (prn 'GLOBAL ?owner-class ?name *type*)
     (doto *writer*
       (.visitFieldInsn Opcodes/GETSTATIC (->class ?owner-class) ?name (->java-sig *type*)))))
 
 (defcompiler ^:private compile-call
   [::&analyser/call ?fn ?args]
-  (do (prn 'compile-call ?fn)
+  (do ;; (prn 'compile-call ?fn)
     (doseq [arg ?args]
       (compile-form (assoc *state* :form arg)))
     (match (:form ?fn)
@@ -115,7 +115,7 @@
   [::&analyser/if ?test ?then ?else]
   (let [else-label (new Label)
         end-label (new Label)]
-    (println "PRE")
+    ;; (println "PRE")
     (assert (compile-form (assoc *state* :form ?test)) "CAN't COMPILE TEST")
     (doto *writer*
       (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.lang.Boolean") "booleanValue" "()Z")
@@ -145,7 +145,8 @@
   (match ?form
     (?name :guard string?)
     (let [=type (:type ?body)
-          _ (prn '?body ?body)]
+          ;; _ (prn '?body ?body)
+          ]
       (doto (.visitField *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name (->java-sig =type) nil nil)
         (.visitEnd)))
 
@@ -153,7 +154,7 @@
     (if (= "main" ?name)
       (let [=method (doto (.visitMethod *writer* (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) ?name "([Ljava/lang/String;)V" nil nil)
                       (.visitCode))]
-        (prn 'FN/?body ?body)
+        ;; (prn 'FN/?body ?body)
         (assert (compile-form (assoc *state* :writer =method :form ?body)) (str "Body couldn't compile: " (pr-str ?body)))
         (doto =method
           (.visitInsn Opcodes/RETURN)
@@ -207,7 +208,7 @@
 (defcompiler ^:private compile-variant
   [::&analyser/variant ?tag ?value]
   (let [variant-class* (->class +variant-class+)]
-    (prn 'compile-variant ?tag ?value)
+    ;; (prn 'compile-variant ?tag ?value)
     (doto *writer*
       (.visitTypeInsn Opcodes/NEW variant-class*)
       (.visitInsn Opcodes/DUP)
@@ -221,7 +222,12 @@
       (.visitFieldInsn Opcodes/PUTFIELD variant-class* "value" "Ljava/lang/Object;"))
     ))
 
+(defcompiler compile-import
+  [::&analyser/import ?class]
+  nil)
+
 (let [+compilers+ [compile-literal
+                   compile-variant
                    compile-local
                    compile-global
                    compile-call
@@ -233,15 +239,15 @@
                    compile-def
                    compile-defclass
                    compile-definterface
-                   compile-variant]]
+                   compile-import]]
   (defn ^:private compile-form [state]
-    (prn 'compile-form/state state)
+    ;; (prn 'compile-form/state state)
     (or (some #(% state) +compilers+)
         (assert false (str "Can't compile: " (pr-str (:form state)))))))
 
 ;; [Interface]
 (defn compile [class-name inputs]
-  (prn 'inputs inputs)
+  ;; (prn 'inputs inputs)
   (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
                  (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
                          (->class class-name) nil "java/lang/Object" nil))
@@ -261,7 +267,7 @@
       (when (not (compile-form (assoc state :form input)))
         (assert false input)))
     ;; (doall (map #(compile-form (assoc state :form %)) inputs))
-    (prn 'inputs inputs)
+    ;; (prn 'inputs inputs)
     (when-let [constants (seq (for [input inputs
                                     :let [payload (match (:form input)
                                                     [::&analyser/def (?name :guard string?) ?body]
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index fd50a04fb..f756a8b14 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -98,9 +98,9 @@
          =body (apply-m parse-form (list ?body))]
     (return [::let ?label =value =body])))
 
-(defparser ^:private parse-module
-  [::&lexer/list ([[::&lexer/ident "module"]] :seq)]
-  (return [::module]))
+(defparser ^:private parse-import
+  [::&lexer/list ([[::&lexer/ident "import"] [::&lexer/ident ?class]] :seq)]
+  (return [::import ?class]))
 
 (defparser ^:private parse-defclass
   [::&lexer/list ([[::&lexer/ident "defclass"] [::&lexer/ident ?name] [::&lexer/tuple ?fields]] :seq)]
@@ -200,7 +200,7 @@
               parse-static-access
               parse-dynamic-access
               parse-ann-class
-              parse-module
+              parse-import
               parse-defclass
               parse-definterface
               parse-fn-call]))