aboutsummaryrefslogtreecommitdiff
path: root/src/lang
diff options
context:
space:
mode:
authorEduardo Julian2014-12-02 01:07:18 -0400
committerEduardo Julian2014-12-02 01:07:18 -0400
commitd95a64fddbee73c6433ba7485959766cb2d4c6f9 (patch)
tree80896e35de559e0166c45179b18ad8288617f2d2 /src/lang
parentce096da3d8a6c28da0983a230e2e9d561618809e (diff)
Added some super-basic type-system.
Diffstat (limited to 'src/lang')
-rw-r--r--src/lang/compiler.clj73
-rw-r--r--src/lang/lexer.clj2
-rw-r--r--src/lang/parser.clj29
-rw-r--r--src/lang/type.clj4
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)
+
+
+