Doing some basic compilation.

4 files changed, 147 insertions, 28 deletions

diff --git a/src/lang.clj b/src/lang.clj
new file mode 100644
index 000000000..45c6013d4
--- /dev/null
+++ b/src/lang.clj
@@ -0,0 +1,26 @@
+(ns lang
+  (:require (lang [lexer :as &lexer]
+                  [parser :as &parser]
+                  [compiler :as &compiler])
+            :reload))
+
+(defn write-file [file data]
+  (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))]
+    (.write stream data)))
+
+(def ^:private +state+
+  {:globals {}
+   :stack {}
+   :forms '()})
+
+(comment
+  (let [source-code (slurp "test2.lang")
+        tokens (&lexer/lex source-code)
+        _ (prn 'tokens tokens)
+        syntax (&parser/parse tokens)
+        _ (prn 'syntax syntax)
+        class-data (&compiler/compile (update-in +state+ [:forms] concat syntax))]
+    (write-file "output.class" class-data))
+
+  
+  )
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index 6e37213a8..0cb69462e 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -1,12 +1,16 @@
 (ns lang.compiler
   (:refer-clojure :exclude [compile])
-  (:require [clojure.core.match :refer [match]]
+  (:require [clojure.string :as string]
+            [clojure.core.match :refer [match]]
             (lang [util :as &util :refer [exec return* return fail fail*
                                           repeat-m try-m try-all-m map-m
                                           apply-m]]
                   [parser :as &parser]
                   [lexer :as &lexer])
-            :reload))
+            :reload)
+  (:import (org.objectweb.asm Opcodes
+                              ClassWriter
+                              MethodVisitor)))
 
 (declare compile-form)
 
@@ -168,30 +172,92 @@
           ]
       (return `(fn ~(symbol =name) ~(mapv symbol =args))))))
 
+;; (def compile-form
+;;   (try-all-m [compile-int
+;;               compile-float
+;;               compile-ident
+;;               compile-tuple
+;;               compile-record
+;;               compile-tagged
+;;               compile-if
+;;               compile-case
+;;               compile-let
+;;               compile-def
+;;               compile-defdata
+;;               compile-fn-call]))
+
+;; (defn compile [inputs]
+;;   (assert false)
+;;   (match ((repeat-m compile-form) inputs)
+;;     [::&util/ok [?state ?forms]]
+;;     (if (empty? (:forms ?state))
+;;       ?forms
+;;       (assert false (str "Unconsumed input: " ?state)))
+
+;;     [::&util/failure ?message]
+;;     (assert false ?message)))
+
+(def ^:dynamic *code*)
+
+(defcompiler compile-string
+  [::&parser/string ?string]
+  (do (doto *code*
+        (.visitLdcInsn ?string))
+    (return nil)))
+
+(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)))
+
+(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])))]
+    (do (doto *code*
+          (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/io/PrintStream" =method "(Ljava/lang/String;)V"))
+      (return nil))))
+
 (def compile-form
-  (try-all-m [compile-int
-              compile-float
-              compile-ident
-              compile-tuple
-              compile-record
-              compile-tagged
-              compile-if
-              compile-case
-              compile-let
-              compile-def
-              compile-defdata
-              compile-fn-call]))
+  (try-all-m [compile-string
+              compile-static-access
+              compile-dynamic-access]))
 
 (defn compile [inputs]
-  (match ((repeat-m compile-form) inputs)
-    [::&util/ok [?state ?forms]]
-    (if (empty? (:forms ?state))
-      ?forms
-      (assert false (str "Unconsumed input: " ?state)))
-    
-    [::&util/failure ?message]
-    (assert false ?message)))
-
-(comment
-  
-  )
+  (let [cw (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+             (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+                     "output" nil "java/lang/Object" nil))]
+    (doto (.visitMethod cw Opcodes/ACC_PUBLIC "<init>" "()V" nil nil)
+      (.visitCode)
+      (.visitVarInsn Opcodes/ALOAD 0)
+      (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V")
+      (.visitInsn Opcodes/RETURN)
+      (.visitMaxs 0 0)
+      (.visitEnd))
+    (let [_main_ (doto (.visitMethod cw (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "main" "([Ljava/lang/String;)V" nil nil)
+                   (.visitCode)
+                   ;; (.visitFieldInsn Opcodes/GETSTATIC "java/lang/System" "out" "Ljava/io/PrintStream;")
+                   ;; (.visitLdcInsn "Hello, World!")
+                   ;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/io/PrintStream" "println" "(Ljava/lang/String;)V")
+                   )]
+      (binding [*code* _main_]
+        (match ((repeat-m compile-form) inputs)
+          [::&util/ok [?state ?forms]]
+          (if (empty? (:forms ?state))
+            ?forms
+            (assert false (str "Unconsumed input: " ?state)))
+          
+          [::&util/failure ?message]
+          (assert false ?message)))
+      (doto _main_
+        (.visitInsn Opcodes/RETURN)
+        (.visitMaxs 0 0)
+        (.visitEnd)))
+    (.visitEnd cw)
+    (.toByteArray cw)))
diff --git a/src/lang/lexer.clj b/src/lang/lexer.clj
index 5bd57f7de..54e83c078 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\-\+\_\=!@$%^&*<>\.,/\\\|'][a-zA-Z0-9\-\+\_\=!@$%^&*<>\.,/\\\|']*)")
+(def +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|'][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|']*)")
 
 (do-template [<name> <tag> <regex>]
   (def <name>
@@ -60,6 +60,15 @@
   ^:private lex-int   ::int    #"^(0|[1-9][0-9]*)"
   ^:private lex-ident ::ident  +ident-re+)
 
+(def lex-string
+  (exec [_ (lex-str "\"")
+         token (lex-regex #"^(.+?(?=\"))")
+         _ (lex-str "\"")
+         ]
+    (return [::string token])))
+
+;; (lex "(_. (_.. java.lang.System out) (println \"YOLO\"))")
+
 (def ^:private lex-single-line-comment
   (exec [_ (lex-str "##")
          comment (lex-regex #"^([^\n]*)")
@@ -105,6 +114,7 @@
   (exec [_ (try-m lex-white-space)
          form (try-all-m [lex-float
                           lex-int
+                          lex-string
                           lex-ident
                           lex-tag
                           lex-list
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index 2abb75cf5..7f1337558 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -114,6 +114,20 @@
          =record (apply-m parse-form (list ?record))]
     (return [::set ?tag =value =record])))
 
+(defparser ^:private parse-static-access
+  [::&lexer/list ([[::&lexer/ident "_.."] [::&lexer/ident ?class] [::&lexer/ident ?member]] :seq)]
+  (return [::static-access ?class ?member]))
+
+(defparser ^:private parse-dynamic-access
+  [::&lexer/list ([[::&lexer/ident "_."] ?object ?call] :seq)]
+  (exec [=object (apply-m parse-form (list ?object))
+         =call (apply-m parse-form (list ?call))]
+    (return [::dynamic-access =object =call])))
+
+(defparser ^:private parse-string
+  [::&lexer/string ?string]
+  (return [::string ?string]))
+
 (defparser ^:private parse-fn-call
   [::&lexer/list ([?f & ?args] :seq)]
   (exec [=f (apply-m parse-form (list ?f))
@@ -124,6 +138,7 @@
 (def ^:private parse-form
   (try-all-m [parse-int
               parse-float
+              parse-string
               parse-ident
               parse-tuple
               parse-record
@@ -136,6 +151,8 @@
               parse-get
               parse-set
               parse-remove
+              parse-static-access
+              parse-dynamic-access
               parse-fn-call]))
 
 ;; [Interface]
@@ -144,7 +161,7 @@
     [::&util/ok [?state ?forms]]
     (if (empty? ?state)
       ?forms
-      (assert false (str "Unconsumed input: " ?state)))
+      (assert false (str "Unconsumed input: " (pr-str ?state))))
     
     [::&util/failure ?message]
     (assert false ?message)))