aboutsummaryrefslogtreecommitdiff
path: root/src/lang
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lang.clj26
-rw-r--r--src/lang/compiler.clj118
-rw-r--r--src/lang/lexer.clj12
-rw-r--r--src/lang/parser.clj19
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)))