From ce096da3d8a6c28da0983a230e2e9d561618809e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 1 Dec 2014 01:05:17 -0400 Subject: Doing some basic compilation. --- src/lang.clj | 26 +++++++++++ src/lang/compiler.clj | 118 +++++++++++++++++++++++++++++++++++++++----------- src/lang/lexer.clj | 12 ++++- src/lang/parser.clj | 19 +++++++- 4 files changed, 147 insertions(+), 28 deletions(-) create mode 100644 src/lang.clj (limited to 'src') 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 "" "()V" nil nil) + (.visitCode) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "" "()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 [ ] (def @@ -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))) -- cgit v1.2.3