From 212dd66966a873e3d7183b071f719ef58e4d88fe Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 3 Jan 2015 02:31:14 -0400 Subject: - Beginning to implement compiler in the language itself. - The language can now handle more symbols on identifiers. --- src/lang/analyser.clj | 44 +++++++------------------------------------- src/lang/compiler.clj | 12 ++++++------ src/lang/lexer.clj | 2 +- src/lang/util.clj | 11 ++++++++++- test2.lang | 47 ++++++++++++++++++++++++++++++++++++++++++++++- 5 files changed, 70 insertions(+), 46 deletions(-) diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj index 1e2c684bb..30592c817 100644 --- a/src/lang/analyser.clj +++ b/src/lang/analyser.clj @@ -39,9 +39,9 @@ (defn ^:private is-macro? [name] (fn [state] - (prn 'is-macro? (nth name 1) - (get-in state [:defs (:name state) (nth name 1) :mode]) - (= (get-in state [:defs (:name state) (nth name 1) :mode]) ::macro)) + ;; (prn 'is-macro? (nth name 1) + ;; (get-in state [:defs (:name state) (nth name 1) :mode]) + ;; (= (get-in state [:defs (:name state) (nth name 1) :mode]) ::macro)) [::&util/ok [state (= (get-in state [:defs (:name state) (nth name 1) :mode]) ::macro)]])) (def ^:private next-local-idx @@ -407,7 +407,7 @@ (return (annotated [::dynamic-method =target =owner ?method =method =args] (&type/return-type =method))))])))) (defn ->token [x] - (prn '->token x) + ;; (prn '->token x) (let [variant (.newInstance (.loadClass loader "test2.Variant"))] (match x [::&parser/string ?text] @@ -448,7 +448,7 @@ (reverse xs)))) (defn ->clojure-token [x] - (prn '->clojure-token x (.-tag x)) + ;; (prn '->clojure-token x (.-tag x)) (case (.-tag x) "Text" [::&parser/string (-> x .-value .-_0 (doto (-> string? assert)))] "Ident" [::&parser/ident (-> x .-value .-_0 (doto (-> string? assert)))] @@ -457,7 +457,7 @@ "Quote" [::&parser/quote (-> x .-value .-_0 ->clojure-token)])) (defn tokens->clojure [xs] - (prn 'tokens->clojure xs (.-tag xs)) + ;; (prn 'tokens->clojure xs (.-tag xs)) (case (.-tag xs) "Nil" '() "Cons" (let [tuple2 (.-value xs)] @@ -465,36 +465,6 @@ (tokens->clojure (.-_1 tuple2)))) )) -;; (defn ->clojure-tokens [xs] -;; (case (.-tag xs) -;; "Cons" (let [tuple2 (.-value xs)] -;; (cons (->clojure-token (.-_0 tuple2)) (->clojure-tokens (.-_1 tuple2)))) -;; "Nil" '())) - -(comment - (-> (->token [::&parser/string "YOLO"]) - .-value - .-_0) - - (-> (->tokens (list [::&parser/string "YOLO"])) - ;; .-tag - .-value - .-_1 - .-tag - ) - - (let [_ (prn 'loader loader) - macro (-> loader (.loadClass "test2$_QUOTE_") .newInstance) - tokens (->tokens (list [::&parser/string "YOLO"]))] - (prn macro) - (prn tokens) - (prn (.apply macro tokens)) - (prn (->clojure-token (.apply macro tokens))) - ) - - - ) - (defanalyser analyse-fn-call [::&parser/fn-call ?fn ?args] (exec [;; :let [_ (prn 'PRE '?fn ?fn)] @@ -513,7 +483,7 @@ [::global ?module ?name] (.newInstance (.loadClass loader (str ?module "$" (normalize-ident ?name))))) output (->clojure-token (.apply macro (->tokens ?args)))] - (prn "MACRO CALL!" macro output) + ;; (prn "MACRO CALL!" macro output) (analyse-form* output))) (exec [=args (map-m analyse-form* ?args)] (return (annotated [::call =fn =args] [::&type/object "java.lang.Object" []])))) diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj index 113cb2fed..27652c1ad 100644 --- a/src/lang/compiler.clj +++ b/src/lang/compiler.clj @@ -23,7 +23,7 @@ ;; [Utils/General] (defn ^:private write-file [file data] - (println 'write-file file (alength data)) + ;; (println 'write-file file (alength data)) (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))] (.write stream data)) ;; (Thread/sleep 2000) @@ -32,11 +32,11 @@ (let [;; loader (proxy [ClassLoader] []) ] (defn load-class! [name file-name] - (println "Defining..." name "@" file-name ;; (alength bytecode) - ) + ;; (println "Defining..." name "@" file-name ;; (alength bytecode) + ;; ) ;; (prn 'loader loader) (.loadClass loader name) - (println "SUCCESFUL LOAD!") + ;; (println "SUCCESFUL LOAD!") ;; (.defineClass loader name bytecode 0 (alength bytecode)) )) @@ -304,7 +304,7 @@ (->> (dotimes [_ (inc cleanup-level)]))) (.visitJumpInsn Opcodes/GOTO default-label))) - [::store [::&analyser/local 0 ?idx] $body] + [::store [::&analyser/local _ ?idx] $body] (doto writer (.visitVarInsn Opcodes/ASTORE ?idx) (-> (.visitJumpInsn Opcodes/GOTO (get mappings $body)) @@ -835,7 +835,7 @@ nil)) (defn quoted->token [quoted] - (prn 'quoted->token quoted) + ;; (prn 'quoted->token quoted) (match quoted [::&parser/string ?text] {:form [::&analyser/variant "Text" (list {:form [::&analyser/literal ?text] diff --git a/src/lang/lexer.clj b/src/lang/lexer.clj index 9fa533dc5..7b23c5947 100644 --- a/src/lang/lexer.clj +++ b/src/lang/lexer.clj @@ -52,7 +52,7 @@ ;; [Lexers] (def ^:private lex-white-space (lex-regex #"^(\s+)")) -(def +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':\~][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':\~]*)") +(def +ident-re+ #"^([a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':\~\?][0-9a-zA-Z\-\+\_\=!@$%^&*<>\.,/\\\|':\~\?]*)") (do-template [ ] (def diff --git a/src/lang/util.clj b/src/lang/util.clj index 7eb431033..063dfa061 100644 --- a/src/lang/util.clj +++ b/src/lang/util.clj @@ -139,16 +139,25 @@ \+ "_PLUS_" \- "_DASH_" \/ "_SLASH_" + \\ "_BSLASH_" \_ "_UNDERS_" \% "_PERCENT_" \$ "_DOLLAR_" - \! "_BANG_" \' "_QUOTE_" \` "_BQUOTE_" \@ "_AT_" \^ "_CARET_" \& "_AMPERS_" \= "_EQ_" + \! "_BANG_" + \? "_QM_" + \: "_COLON_" + \; "_SCOLON_" + \. "_PERIOD_" + \, "_COMMA_" + \< "_LT_" + \> "_GT_" + \~ "_TILDE_" ;; default char)) diff --git a/test2.lang b/test2.lang index 243ab902a..13fabc59a 100644 --- a/test2.lang +++ b/test2.lang @@ -1,5 +1,5 @@ (import java.lang.System) -## (require "./another" as another) +(require "./another" as another) (definterface Function (: apply (-> [java.lang.Object] java.lang.Object))) @@ -46,6 +46,51 @@ (#Quote form*) ))) +## Utils +(def (fail* message) + (#Failure message)) + +(def (return* state value) + (#Ok state value)) + +(def (fail message) + (lambda [state] + (#Failure message))) + +(def (return value) + (lambda [state] + (#Ok state value))) + +(def (bind m-value step) + (lambda [state] + (let inputs (m-value state) + (case inputs + (#Ok ?state ?datum) + (step ?datum ?state) + + _ + inputs)))) + +## Ideally, this is what I want... +## (exec [yolo lol +## #let [foo bar] +## #when foo] +## (meme yolo foo)) + +(defmacro (exec tokens) + (case tokens + (#Cons (#Tuple steps) (#Cons return #Nil)) + (if (= 0 (mod (length steps) 2)) + (fold (lambda [inner pair] + (case pair + [label computation] + (` (bind (~ computation) + (lambda [(~ label)] (~ inner)))))) + return + (as-pairs steps)) + (#Text "Oh no!")))) + +## Program (def (main args) (case (' ((~ "TROLOLOL"))) (#Form (#Cons (#Text text) #Nil)) -- cgit v1.2.3