The language now supports macros.

6 files changed, 316 insertions, 267 deletions

diff --git a/src/lang.clj b/src/lang.clj
index 5e4316db4..0777812b7 100644
--- a/src/lang.clj
+++ b/src/lang.clj
@@ -16,7 +16,6 @@
   ;; TODO: Adding metadata to global vars.
   ;; TODO: Add records.
   ;; TODO: throw, try, catch, finally
-  ;; TODO: Finish implementing pattern matching.
   ;; TODO: Tuple8 and Tuple8X (for arbitrary-size tuples).
   ;; TODO: Add extra arities (apply2, apply3, ..., apply16)
   ;; TODO: When doing partial application, skip "apply" and just call constructor appropiatedly.
@@ -32,176 +31,24 @@
         ;; _ (prn 'tokens tokens)
         syntax (&parser/parse tokens)
         ;; _ (prn 'syntax syntax)
-        ann-syntax (&analyser/analyse "test2" syntax)
+        ;; ann-syntax (&analyser/analyse "test2" syntax)
         ;; _ (prn 'ann-syntax ann-syntax)
-        class-data (&compiler/compile "test2" ann-syntax)
+        ;; class-data (&compiler/compile "test2" ann-syntax)
+        class-data (&compiler/compile "test2" syntax)
         ;; _ (prn 'class-data class-data)
         ]
-    (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. "test2.class"))]
-      (.write stream class-data)))
-
-  ;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2
-  )
-
-(comment
-  ;; (let [branches '([::&parser/case-branch [::&parser/variant "Cons" ([::&parser/variant "Symbol" ([::&parser/string "~"])] [::&parser/variant "Cons" ([::&parser/ident "unquoted"] [::&parser/variant "Nil" ()])])] [::&parser/variant "Cons" ([::&parser/ident "unquoted"] [::&parser/fn-call [::&parser/ident "template"] ([::&parser/ident "tail"])])]]
-  ;;                    [::&parser/case-branch [::&parser/variant "Cons" ([::&parser/variant "Symbol" ([::&parser/string "~@"])] [::&parser/variant "Cons" ([::&parser/ident "spliced"] [::&parser/variant "Nil" ()])])] [::&parser/variant "Cons" ([::&parser/variant "Symbol" ([::&parser/string "++"])] [::&parser/variant "Cons" ([::&parser/ident "spliced"] [::&parser/fn-call [::&parser/ident "template"] ([::&parser/ident "tail"])])])]]
-  ;;                      [::&parser/case-branch [::&parser/ident "_"] [::&parser/variant "Cons" ([::&parser/ident "head"] [::&parser/fn-call [::&parser/ident "template"] ([::&parser/ident "tail"])])]])
-  ;;       ;; Step 1: Get all vars
-  ;;       get-vars (fn get-vars [pattern]
-  ;;                  (clojure.core.match/match pattern
-  ;;                    [::&parser/ident ?name]
-  ;;                    (list ?name)
-                     
-  ;;                    [::&parser/variant ?tag ?members]
-  ;;                    (mapcat get-vars ?members)
-
-  ;;                    [::&parser/string ?text]
-  ;;                    '()))
-  ;;       vars+body (for [branch branches]
-  ;;                   (clojure.core.match/match branch
-  ;;                     [::&parser/case-branch ?pattern ?body]
-  ;;                     [(get-vars ?pattern) ?body]))
-  ;;       ;; _ (prn 'vars+body vars+body)
-  ;;       max-registers (reduce max 0 (map (comp count first) vars+body))
-  ;;       ;; _ (prn 'max-registers max-registers)
-  ;;       ;; Step 2: Analyse bodies
-  ;;       ;; all-analysis (map (fn [[vars body]]
-  ;;       ;;                     (reduce #(with-local %2 [::&type/object "java.lang.Object" []] %1)
-  ;;       ;;                             (analyse-form* body)
-  ;;       ;;                             (reverse vars)))
-  ;;       ;;                   vars+body)
-  ;;       ;; Step 3: Extract bodies
-  ;;       [_ branch-mappings branches*] (reduce (fn [[$link links branches*] branch]
-  ;;                                               (clojure.core.match/match branch
-  ;;                                                 [::&parser/case-branch ?pattern ?body]
-  ;;                                                 [(inc $link) (assoc links $link ?body) (conj branches* [::&parser/case-branch ?pattern $link])]))
-  ;;                                             [0 {} []]
-  ;;                                             branches)
-  ;;       ;; Step 4: Pattens -> Instructions
-  ;;       ;; ->instructions (fn ->instructions [locals pattern]
-  ;;       ;;                  (clojure.core.match/match pattern
-  ;;       ;;                    [::&parser/variant ?tag ?members]
-  ;;       ;;                    [::pm-variant ?tag (map (partial ->instructions locals) ?members)]
-                           
-  ;;       ;;                    [::&parser/ident ?name]
-  ;;       ;;                    [::pm-local (get locals ?name)]
-                           
-  ;;       ;;                    [::&parser/string ?text]
-  ;;       ;;                    [::pm-text ?text]
-  ;;       ;;                    ))
-  ;;       ;; $scope 0 ;; scope-id
-  ;;       ;; $local 11 ;; next-local-idx
-  ;;       ;; branches** (for [[branch branch-vars] (map vector branches* (map first vars+body))
-  ;;       ;;                  :let [[_ locals] (reduce (fn [[$local =locals] $var]
-  ;;       ;;                                             [(inc $local) (assoc =locals $var [::local $scope $local])])
-  ;;       ;;                                           [$local {}] branch-vars)]]
-  ;;       ;;              (clojure.core.match/match branch
-  ;;       ;;                [::&parser/case-branch ?pattern ?body]
-  ;;       ;;                [(->instructions locals ?pattern) ?body]))
-  ;;       ;; _ (prn branches**)
-  ;;       ;; Step 5: Re-structure branching
-  ;;       ]
-  ;;   ;; [branch-mappings branches**]
-  ;;   branches*)
-
-  
-  
+    ;; (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. "test2.class"))]
+    ;;   (.write stream class-data))
+    )
 
+  (Class/forName "test2.Variant")
   
-  ;; (let [data '([[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~"])]  [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 0]
-  ;;                [[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~@"])] [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 1]
-  ;;                  [[:lang/pm-local [:lang/local 0 11]] 2])
-  ;;       classify-outer (fn [struct [branch $body]]
-  ;;                        (clojure.core.match/match branch
-  ;;                          [::pm-variant ?tag ?members]
-  ;;                          (update-in struct [:cases ?tag] conj {:members ?members
-  ;;                                                                :body $body})
-                           
-  ;;                          [::pm-text ?text]
-  ;;                          (update-in struct [:tests] conj {:test [::text ?text]
-  ;;                                                           :body $body})
-
-  ;;                          [::pm-local ?binding]
-  ;;                          (assoc struct :default {:storage ?binding
-  ;;                                                  :body $body})))
-  ;;       outer-classification (reduce classify-outer
-  ;;                                    {:cases {}
-  ;;                                     :tests '()
-  ;;                                     :default nil}
-  ;;                                    data)
-  ;;       full-classifier (fn full-classifier [global]
-  ;;                         (prn 'full-classifier global)
-  ;;                         (let [subcases (:cases global)]
-  ;;                           (if (empty? subcases)
-  ;;                             global
-  ;;                             (let [crossed (sort (fn [x1 x2] (> (-> x1 second :cases count) (-> x2 second :cases count)))
-  ;;                                                 (for [[tag subs] subcases
-  ;;                                                       :let [_ (prn 'subcases tag subs)]
-  ;;                                                       :let [parts (for [cross (apply map list (map :members subs))
-  ;;                                                                         :let [_ (prn 'cross tag cross)]
-  ;;                                                                         ;; :let [_ (prn '(map :body subs) (map :body subs))]
-  ;;                                                                         ;; :let [_ (prn (class cross)            (count cross)
-  ;;                                                                         ;;              (class (map :body subs)) (count (map :body subs)))]
-  ;;                                                                         :let [cross+ (map vector cross (map :body subs))]
-  ;;                                                                         ;; :let [_ (prn 'cross+ tag (class cross+) (count cross+))]
-  ;;                                                                         ;; :let [_ (prn 'cross+ tag cross+)]
-  ;;                                                                         :let [cross++ (reduce classify-outer
-  ;;                                                                                               {:cases {}
-  ;;                                                                                                :tests '()
-  ;;                                                                                                :default nil}
-  ;;                                                                                               cross+)]
-  ;;                                                                         ;; :let [_ (prn 'cross++ tag cross++)]
-  ;;                                                                         ]
-  ;;                                                                     cross++)]
-  ;;                                                       :let [_ (prn 'parts parts)]]
-  ;;                                                   [tag parts]))
-                                    
-  ;;                                   ]
-  ;;                               (assoc global :cases (reduce (fn [tree [tag subcases]]
-  ;;                                                              (update-in tree [tag] #(conj (or % []) (full-classifier subcases))))
-  ;;                                                            {}
-  ;;                                                            crossed))))))]
-  ;;   (full-classifier outer-classification))
+  ;; jar cvf test2.jar *.class test2 && java -cp "test2.jar" test2
   )
 
-(comment
-  [{2 [:lang.parser/variant "Cons" ([:lang.parser/ident "head"] [:lang.parser/fn-call [:lang.parser/ident "template"] ([:lang.parser/ident "tail"])])],
-    1 [:lang.parser/variant "Cons" ([:lang.parser/variant "Symbol" ([:lang.parser/string "++"])] [:lang.parser/variant "Cons" ([:lang.parser/ident "spliced"] [:lang.parser/fn-call [:lang.parser/ident "template"] ([:lang.parser/ident "tail"])])])],
-    0 [:lang.parser/variant "Cons" ([:lang.parser/ident "unquoted"] [:lang.parser/fn-call [:lang.parser/ident "template"] ([:lang.parser/ident "tail"])])]}
-   {:type :lang/adt*,
-    :patterns {"Cons" ({:type :lang/adt*,
-                        :patterns {"Symbol" ({:type :lang/text-tests,
-                                              :patterns {"~@" #{1},
-                                                         "~" #{0}},
-                                              :defaults [],
-                                              :branches #{0 1}})},
-                        :default nil,
-                        :branches #{0 1}}
-                       {:type :lang/adt*,
-                        :patterns {"Cons" ({:type :lang/defaults,
-                                            :stores {[:lang/local 0 11] #{0 1}},
-                                            :branches #{0 1}}
-                                           {:type :lang/adt*,
-                                            :patterns {"Nil" ()},
-                                            :default nil,
-                                            :branches #{0 1}})},
-                        :default nil,
-                        :branches #{0 1}})},
-    :default [:lang/default [:lang/local 0 11] 2],
-    :branches #{0 1 2}}]
-  
-  (let [data '([[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~"])]  [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 0]
-                 [[:lang/pm-variant "Cons" ([:lang/pm-variant "Symbol" ([:lang/pm-text "~@"])] [:lang/pm-variant "Cons" ([:lang/pm-local [:lang/local 0 11]] [:lang/pm-variant "Nil" ()])])] 1]
-                   [[:lang/pm-local [:lang/local 0 11]] 2])
-        ]
-    (generate-branches data))
-
-  ;; (def (workday? d)
-  ;;   (case d
-  ;;     (or [#Monday #Tuesday #Wednesday #Thursday #Friday]
-  ;;         true)
-  ;;     (or [#Saturday #Sunday]
-  ;;         false)))
-  
-  )
+;; (def (workday? d)
+;;   (case d
+;;     (or [#Monday #Tuesday #Wednesday #Thursday #Friday]
+;;         true)
+;;     (or [#Saturday #Sunday]
+;;         false)))
diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
index 21117a7b7..1e2c684bb 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -5,18 +5,22 @@
             [clojure.core.match :refer [match]]
             (lang [util :as &util :refer [exec return* return fail fail*
                                           repeat-m try-m try-all-m map-m reduce-m
-                                          apply-m within]]
+                                          apply-m within
+                                          normalize-ident
+                                          loader]]
                   [parser :as &parser]
                   [type :as &type])))
 
-(declare analyse-form)
+(declare analyse-form
+         ->tokens
+         tokens->clojure)
 
 ;; [Util]
 (defn ^:private annotated [form type]
   {:form form
    :type type})
 
-(defn ^:private fresh-env [id]
+(defn fresh-env [id]
   {:id id
    :counter 0
    :mappings {}
@@ -33,6 +37,13 @@
                      (assoc-in [:defs-env name] (annotated [::global (:name state) name] (:type desc))))
                  nil]]))
 
+(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))
+    [::&util/ok [state (= (get-in state [:defs (:name state) (nth name 1) :mode]) ::macro)]]))
+
 (def ^:private next-local-idx
   (fn [state]
     [::&util/ok [state (-> state :env first :counter)]]))
@@ -45,7 +56,21 @@
   (fn [state]
     [::&util/ok [state (-> state :env first)]]))
 
-(defn ^:private with-scope [scope body]
+(defn ^:private in-scope? [scope]
+  (fn [state]
+    (match scope
+      [::&parser/ident ?macro-name]
+      (do ;; (prn 'in-scope?
+          ;;      ?macro-name
+          ;;      (get-in state [:lambda-scope 0])
+          ;;      (some (partial = ?macro-name) (get-in state [:lambda-scope 0])))
+        [::&util/ok [state (some (partial = ?macro-name) (get-in state [:lambda-scope 0]))]])
+
+      _
+      [::&util/ok [state false]])
+    ))
+
+(defn with-scope [scope body]
   (fn [state]
     (let [=return (body (-> state
                             (update-in [:lambda-scope 0] conj scope)
@@ -237,8 +262,9 @@
         [::&util/ok [?state ?value]]
         [::&util/ok [(assoc ?state :forms old-forms) ?value]]
         
-        _
-        =return))))
+        [::&util/failure ?message]
+        (do (prn 'analyse-form* ?message)
+          [::&util/failure ?message])))))
 
 (do-template [<name> <tag> <class>]
   (defanalyser <name>
@@ -380,15 +406,118 @@
                          ]
                     (return (annotated [::dynamic-method =target =owner ?method =method =args] (&type/return-type =method))))]))))
 
+(defn ->token [x]
+  (prn '->token x)
+  (let [variant (.newInstance (.loadClass loader "test2.Variant"))]
+    (match x
+      [::&parser/string ?text]
+      (doto variant
+        (-> .-tag (set! "Text"))
+        (-> .-value (set! (doto (.newInstance (.loadClass loader "test2.Tuple1"))
+                            (-> .-_0 (set! ?text))))))
+      [::&parser/ident ?ident]
+      (doto variant
+        (-> .-tag (set! "Ident"))
+        (-> .-value (set! (doto (.newInstance (.loadClass loader "test2.Tuple1"))
+                            (-> .-_0 (set! ?ident))))))
+      [::&parser/fn-call ?fn ?args]
+      (doto variant
+        (-> .-tag (set! "Form"))
+        (-> .-value (set! (doto (.newInstance (.loadClass loader "test2.Tuple1"))
+                            (-> .-_0 (set! (->tokens (cons ?fn ?args))))))
+            ))
+      )))
+
+(defn ->tokens [xs]
+  (let [variant (.loadClass loader "test2.Variant")
+        tuple2 (.loadClass loader "test2.Tuple2")]
+    (reduce (fn [tail x]
+              ;; (prn 'tail (.-tag tail) 'x x)
+              (doto (.newInstance variant)
+                (-> .-tag (set! "Cons"))
+                (-> .-value (set! (doto (.newInstance tuple2)
+                                    (-> .-_0 (set! (->token x)))
+                                    (-> .-_1 (set! tail))
+                                    ;; (-> prn)
+                                    )))
+                ;; (-> prn)
+                ))
+            (doto (.newInstance variant)
+              (-> .-tag (set! "Nil"))
+              (-> .-value (set! (.newInstance (.loadClass loader "test2.Tuple0")))))
+            (reverse xs))))
+
+(defn ->clojure-token [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)))]
+    "Form" (let [[?fn & ?args] (-> x .-value .-_0 tokens->clojure)]
+             [::&parser/fn-call ?fn ?args])
+    "Quote" [::&parser/quote (-> x .-value .-_0 ->clojure-token)]))
+
+(defn tokens->clojure [xs]
+  (prn 'tokens->clojure xs (.-tag xs))
+  (case (.-tag xs)
+    "Nil" '()
+    "Cons" (let [tuple2 (.-value xs)]
+             (cons (->clojure-token (.-_0 tuple2))
+                   (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)]
+         macro? (is-macro? ?fn)
+         scoped? (in-scope? ?fn)
+         :let [;; _ (prn 'macro? ?fn macro?)
+               ;; _ (prn 'scoped? scoped?)
+               ]
          =fn (analyse-form* ?fn)
          ;; :let [_ (prn '=fn =fn)]
-         =args (map-m analyse-form* ?args)
          ;; :let [_ (prn '=args =args)]
          ]
-    (return (annotated [::call =fn =args] [::&type/object "java.lang.Object" []]))))
+    (if (and macro? (not scoped?))
+      (do ;; (prn "MACRO CALL!" ?fn ?args =fn)
+          (let [macro (match (:form =fn)
+                        [::global ?module ?name]
+                        (.newInstance (.loadClass loader (str ?module "$" (normalize-ident ?name)))))
+                output (->clojure-token (.apply macro (->tokens ?args)))]
+            (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" []]))))
+    ))
 
 (defanalyser analyse-if
   [::&parser/if ?test ?then ?else]
@@ -630,6 +759,20 @@
         (return (annotated [::def [?name args] =value] ::&type/nothing))))
     ))
 
+(defanalyser analyse-defmacro
+  [::&parser/defmacro [::&parser/fn-call [::&parser/ident ?name] ([[::&parser/ident ?tokens]] :seq)] ?value]
+  (exec [[=function =tokens =return] (within :types (&type/fresh-function 1))
+         =value (with-scope ?name
+                  (with-scoped-name ?name =function
+                    (with-local ?tokens =tokens
+                      (analyse-form* ?value))))
+         =function (within :types (exec [_ (&type/solve =return (:type =value))]
+                                    (&type/clean =function)))
+         _ (define ?name {:mode   ::macro
+                          :access ::public
+                          :type   =function})]
+    (return (annotated [::def [?name (list ?tokens)] =value] ::&type/nothing))))
+
 (defanalyser analyse-lambda
   [::&parser/lambda ?args ?body]
   (exec [;; :let [_ (prn 'analyse-lambda ?args ?body)]
@@ -661,7 +804,11 @@
     (exec [_ (require-module module-name ?alias)]
       (return (annotated [::require ?file ?alias] ::&type/nothing)))))
 
-(def ^:private analyse-form
+(defanalyser analyse-quote
+  [::&parser/quote ?quoted]
+  (return (annotated [::quote ?quoted] ::&type/nothing)))
+
+(def analyse-form
   (try-all-m [analyse-boolean
               analyse-int
               analyse-float
@@ -680,8 +827,10 @@
               analyse-defclass
               analyse-definterface
               analyse-def
+              analyse-defmacro
               analyse-import
-              analyse-require]))
+              analyse-require
+              analyse-quote]))
 
 ;; [Interface]
 (defn analyse [module-name tokens]
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index 2ead6daec..113cb2fed 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -3,7 +3,12 @@
   (:require [clojure.string :as string]
             [clojure.set :as set]
             [clojure.core.match :refer [match]]
-            (lang [type :as &type]
+            (lang [util :as &util :refer [exec return* return fail fail*
+                                          repeat-m try-m try-all-m map-m reduce-m
+                                          apply-m within
+                                          normalize-ident
+                                          loader]]
+                  [type :as &type]
                   [lexer :as &lexer]
                   [parser :as &parser]
                   [analyser :as &analyser])
@@ -18,30 +23,22 @@
 
 ;; [Utils/General]
 (defn ^:private write-file [file data]
+  (println 'write-file file (alength data))
   (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))]
-    (.write stream data)))
-
-(defn ^:private normalize-char [char]
-  (case char
-    \* "_ASTER_"
-    \+ "_PLUS_"
-    \- "_DASH_"
-    \/ "_SLASH_"
-    \_ "_UNDERS_"
-    \% "_PERCENT_"
-    \$ "_DOLLAR_"
-    \! "_BANG_"
-    \' "_QUOTE_"
-    \` "_BQUOTE_"
-    \@ "_AT_"
-    \^ "_CARET_"
-    \& "_AMPERS_"
-    \= "_EQ_"
-    ;; default
-    char))
-
-(defn ^:private normalize-ident [ident]
-  (reduce str "" (map normalize-char ident)))
+    (.write stream data))
+  ;; (Thread/sleep 2000)
+  )
+
+(let [;; loader (proxy [ClassLoader] [])
+      ]
+  (defn load-class! [name file-name]
+    (println "Defining..." name "@" file-name ;; (alength bytecode)
+             )
+    ;; (prn 'loader loader)
+    (.loadClass loader name)
+    (println "SUCCESFUL LOAD!")
+    ;; (.defineClass loader name bytecode 0 (alength bytecode))
+    ))
 
 (def ^:private +variant-class+ "test2.Variant")
 
@@ -290,7 +287,7 @@
       +tuple-field-sig+ (->type-signature "java.lang.Object")
       equals-sig (str "(" (->type-signature "java.lang.Object") ")Z")]
   (defn compile-decision-tree [writer mappings cleanup-level next-label default-label decision-tree]
-    (prn 'compile-decision-tree cleanup-level decision-tree)
+    ;; (prn 'compile-decision-tree cleanup-level decision-tree)
     (match decision-tree
       [::test-text ?text $body]
       (let [$else (new Label)]
@@ -326,7 +323,8 @@
               (.visitInsn Opcodes/POP) ;; variant
               (do (let [arity (-> ?subcases first (nth 2) count)
                         tuple-class (str "test2/Tuple" arity)
-                        _ (prn ?tag arity tuple-class)]
+                        ;; _ (prn ?tag arity tuple-class)
+                        ]
                     (when (> arity 0)
                       (doto writer
                         (.visitInsn Opcodes/DUP) ;; variant, variant
@@ -355,48 +353,15 @@
               ;; variant, tag ->
               (.visitLabel tag-else-label))
             (->> (doseq [[?tag ?subcases] ?cases
-                         :let [_ (.print System/out (prn-str 'COMPILE-PATTERN ?tag ?subcases))]
+                         ;; :let [_ (.print System/out (prn-str 'COMPILE-PATTERN ?tag ?subcases))]
                          :let [tag-else-label (new Label)]])))
         (-> (doto (.visitInsn Opcodes/POP))
             (->> (dotimes [_ (+ cleanup-level 2)])))
         (.visitJumpInsn Opcodes/GOTO default-label)))
     ))
 
-;; ([:lang.compiler/subcase 0 ([:lang.compiler/test-adt #{0} {"Symbol" ()}]
-;;                             [:lang.compiler/test-adt #{0} {"Nil" ([:lang.compiler/subcase 0 ()])}])]
-;;  [:lang.compiler/subcase 0 ([:lang.compiler/test-adt #{0} {"Symbol" ()}]
-;;                             [:lang.compiler/store [:lang.analyser/local 0 2] 1])]
-;;  [:lang.compiler/subcase 0 ([:lang.compiler/store [:lang.analyser/local 0 1] 0]
-;;                             [:lang.compiler/test-adt #{0} {"Nil" ([:lang.compiler/subcase 0 ()])}])]
-;;  [:lang.compiler/subcase 0 ([:lang.compiler/store [:lang.analyser/local 0 1] 0]
-;;                             [:lang.compiler/store [:lang.analyser/local 0 2] 1])]
-;;  [:lang.compiler/subcase 1 ([:lang.compiler/test-adt #{1} {"Symbol" ([:lang.compiler/subcase 1 ([:lang.compiler/store [:lang.analyser/local 0 1] 1])])}]
-;;                             [:lang.compiler/test-adt #{1} {"Nil" ()}])]
-;;  [:lang.compiler/subcase 1 ([:lang.compiler/test-adt #{1} {"Symbol" ([:lang.compiler/subcase 1 ([:lang.compiler/store [:lang.analyser/local 0 1] 1])])}]
-;;                             [:lang.compiler/store [:lang.analyser/local 0 2] 1])]
-;;  [:lang.compiler/subcase 1 ([:lang.compiler/store [:lang.analyser/local 0 1] 0]
-;;                             [:lang.compiler/test-adt #{0} {"Nil" ([:lang.compiler/subcase 0 ()])}])]
-;;  [:lang.compiler/subcase 1 ([:lang.compiler/store [:lang.analyser/local 0 1] 0]
-;;                             [:lang.compiler/store [:lang.analyser/local 0 2] 1])])
-
-;; ({:type :lang.analyser/adt*,
-;;   :patterns {"Cons" {:parts ({:type :lang.analyser/adt*,
-;;                               :patterns {"Symbol" {:parts ({:type :lang.analyser/defaults,
-;;                                                             :stores {[:lang.analyser/local 0 1] #{1}},
-;;                                                             :branches #{1}}),
-;;                                                    :branches #{1}}},
-;;                               :default [:lang.analyser/default [:lang.analyser/local 0 1] 0],
-;;                               :branches #{0 1}}
-;;                              {:type :lang.analyser/adt*,
-;;                               :patterns {"Nil" {:parts (), :branches #{0}}},
-;;                               :default [:lang.analyser/default [:lang.analyser/local 0 2] 1],
-;;                               :branches #{0 1}}),
-;;                      :branches #{0 1}}},
-;;   :default nil,
-;;   :branches #{0 1}})
-
 (defn sequence-parts [branches parts]
-  (.print System/out (prn-str 'sequence-parts branches parts))
+  ;; (.print System/out (prn-str 'sequence-parts branches parts))
   (if (empty? parts)
     '(())
     (let [[head & tail] parts
@@ -422,14 +387,14 @@
                      (do ;; (prn '(:default head) (:default head))
                          ;; (assert (nil? (:default head)))
                          (concat (let [patterns (into {} (for [[?tag ?struct] (:patterns head)
-                                                               :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))]
+                                                               ;; :let [_ (.print System/out (prn-str 'PATTERN ?tag ?struct))]
                                                                :let [?parts (:parts ?struct)
                                                                      num-parts (count ?parts)
                                                                      ?supports (:branches ?struct)
                                                                      subcases (for [?body (set/intersection branches ?supports)
                                                                                     subseq (sequence-parts #{?body} ?parts)
-                                                                                    :let [_ (when (= "Symbol" ?tag)
-                                                                                              (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))]
+                                                                                    ;; :let [_ (when (= "Symbol" ?tag)
+                                                                                    ;;           (.print System/out (prn-str 'counting ?tag num-parts (count subseq) subseq)))]
                                                                                     :when (= num-parts (count subseq))]
                                                                                 [::subcase ?body subseq])]
                                                                :when (not (empty? subcases))]
@@ -593,8 +558,10 @@
                       (.visitInsn Opcodes/ARETURN)
                       (.visitMaxs 0 0)
                       (.visitEnd)))
-          _ (.visitEnd =class)]
-      (write-file (str current-class ".class") (.toByteArray =class)))
+          _ (.visitEnd =class)
+          bytecode (.toByteArray =class)]
+      (write-file (str current-class ".class") bytecode)
+      (load-class! (string/replace current-class #"/" ".") (str current-class ".class")))
     ))
 
 (defn compile-field [writer class-name ?name body state]
@@ -614,8 +581,10 @@
                          (.visitInsn Opcodes/RETURN)
                          (.visitMaxs 0 0)
                          (.visitEnd)))
-                   (.visitEnd))]
-      (write-file (str current-class ".class") (.toByteArray =class)))
+                   (.visitEnd))
+          bytecode (.toByteArray =class)]
+      (write-file (str current-class ".class") bytecode)
+      (load-class! (string/replace current-class #"/" ".") (str current-class ".class")))
     ))
 
 (defcompiler ^:private compile-def
@@ -757,8 +726,10 @@
                 (.visitInsn Opcodes/ARETURN)
                 (.visitMaxs 0 0)
                 (.visitEnd))
-        _ (.visitEnd =class)]
-    (write-file (str current-class ".class") (.toByteArray =class))
+        _ (.visitEnd =class)
+        bytecode (.toByteArray =class)]
+    (write-file (str current-class ".class") bytecode)
+    (load-class! (string/replace current-class #"/" ".") (str current-class ".class"))
     ;; (apply prn 'LAMBDA ?scope ?args (->> (:mappings ?frame)
     ;;                                      (map second)
     ;;                                      (map :form)
@@ -797,8 +768,8 @@
       (.visitEnd))
     (.visitEnd =class)
     (.mkdirs (java.io.File. parent-dir))
-    (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))]
-      (.write stream (.toByteArray =class)))))
+    (write-file (str parent-dir "/" ?name ".class") (.toByteArray =class))
+    (load-class! (string/replace (str parent-dir "/" ?name) #"/" ".") (str parent-dir "/" ?name ".class"))))
 
 (defcompiler ^:private compile-definterface
   [::&analyser/definterface [?package ?name] ?members]
@@ -813,8 +784,8 @@
       (.visitMethod =interface (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) ?method signature nil nil))
     (.visitEnd =interface)
     (.mkdirs (java.io.File. parent-dir))
-    (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str parent-dir "/" ?name ".class")))]
-      (.write stream (.toByteArray =interface)))))
+    (write-file (str parent-dir "/" ?name ".class") (.toByteArray =interface))
+    (load-class! (string/replace (str parent-dir "/" ?name) #"/" ".") (str parent-dir "/" ?name ".class"))))
 
 (defcompiler ^:private compile-variant
   [::&analyser/variant ?tag ?members]
@@ -856,12 +827,40 @@
         ;; _ (prn 'tokens tokens)
         syntax (&parser/parse tokens)
         ;; _ (prn 'syntax syntax)
-        ann-syntax (&analyser/analyse module-name syntax)
+        ;; ann-syntax (&analyser/analyse module-name syntax)
         ;; _ (prn 'ann-syntax ann-syntax)
-        class-data (compile module-name ann-syntax)]
-    (write-file (str module-name ".class") class-data)
+        bytecode (compile module-name syntax)]
+    ;; (write-file (str module-name ".class") bytecode)
+    ;; (load-class! (string/replace module-name #"/" ".") (str module-name ".class"))
     nil))
 
+(defn quoted->token [quoted]
+  (prn 'quoted->token quoted)
+  (match quoted
+    [::&parser/string ?text]
+    {:form [::&analyser/variant "Text" (list {:form [::&analyser/literal ?text]
+                                              :type [::&type/object "java.lang.String" []]})]
+     :type [::&type/variant "Text" (list [::&type/object "java.lang.String" []])]}
+    
+    [::&parser/fn-call ?fn ?args]
+    (let [members* (quoted->token (cons ?fn ?args))]
+      {:form [::&analyser/variant "Form" (list members*)]
+       :type [::&type/variant "Form" (list (:type members*))]})
+
+    ([] :seq)
+    {:form [::&analyser/variant "Nil" '()]
+     :type [::&type/variant "Nil" '()]}
+    
+    ([head & tail] :seq)
+    (let [head* (quoted->token head)
+          tail* (quoted->token tail)]
+      {:form [::&analyser/variant "Cons" (list head* tail*)]
+       :type [::&type/variant "Nil" (list (:type head*) (:type tail*))]})))
+
+(defcompiler compile-quote
+  [::&analyser/quote ?quoted]
+  (compile-form (assoc *state* :form (quoted->token ?quoted))))
+
 (let [+compilers+ [compile-literal
                    compile-variant
                    compile-tuple
@@ -882,7 +881,8 @@
                    compile-defclass
                    compile-definterface
                    compile-import
-                   compile-require]]
+                   compile-require
+                   compile-quote]]
   (defn ^:private compile-form [state]
     ;; (prn 'compile-form/state state)
     (or (some #(% state) +compilers+)
@@ -894,18 +894,39 @@
   (let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
                  (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
                          (->class class-name) nil "java/lang/Object" nil))
-        state {:class-name class-name
-               :writer =class
-               :form nil
-               :parent nil}]
-    (doseq [input inputs]
-      (when (not (compile-form (assoc state :form input)))
-        (assert false input)))
+        compiler-state {:class-name class-name
+                        :writer =class
+                        :form nil
+                        :parent nil}]
+    (match ((repeat-m
+             (&analyser/with-scope class-name
+               (exec [ann-input &analyser/analyse-form
+                      :let [_ (when (not (compile-form (assoc compiler-state :form ann-input)))
+                                (assert false ann-input))]]
+                 (return ann-input))))
+            {:name class-name
+             :forms inputs
+             :deps {}
+             :imports {}
+             :defs {}
+             :defs-env {}
+             :lambda-scope [[] 0]
+             :env (list (&analyser/fresh-env 0))
+             :types &type/+init+})
+      [::&util/ok [?state ?forms]]
+      (if (empty? (:forms ?state))
+        ?forms
+        (assert false (str "Unconsumed input: " (pr-str (:forms ?state)))))
+      
+      [::&util/failure ?message]
+      (assert false ?message))
+    ;;;
     (.visitEnd =class)
-    (let [=array (.toByteArray =class)]
-      ;; (prn 'compile class-name =array)
-      =array))
-
+    (let [bytecode (.toByteArray =class)]
+      (write-file (str class-name ".class") bytecode)
+      (load-class! (string/replace class-name #"/" ".") (str class-name ".class"))
+      bytecode)
+    )
   ;; (comment
   ;;   (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2"))
   ;;   (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader. (.loadClass "test2.Function"))
diff --git a/src/lang/lexer.clj b/src/lang/lexer.clj
index 870209503..9fa533dc5 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 [<name> <tag> <regex>]
   (def <name>
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index 48f624ba4..34f3e70b4 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -71,6 +71,12 @@
          =body (apply-m parse-form (list ?body))]
     (return [::def =name =body])))
 
+(defparser ^:private parse-defmacro
+  [::&lexer/list ([[::&lexer/ident "defmacro"] ?name ?body] :seq)]
+  (exec [=name (apply-m parse-form (list ?name))
+         =body (apply-m parse-form (list ?body))]
+    (return [::defmacro =name =body])))
+
 (defparser ^:private parse-defdata
   [::&lexer/list ([[::&lexer/ident "defdata"] ?type & ?cases] :seq)]
   (exec [=type (apply-m parse-form (list ?type))
@@ -195,6 +201,7 @@
               parse-record
               parse-lambda
               parse-def
+              parse-defmacro
               parse-defdata
               parse-if
               parse-do
diff --git a/src/lang/util.clj b/src/lang/util.clj
index e2edfb550..7eb431033 100644
--- a/src/lang/util.clj
+++ b/src/lang/util.clj
@@ -132,3 +132,28 @@
         [::ok [(assoc state slot ?state) ?value]]
         _
         =return))))
+
+(defn ^:private normalize-char [char]
+  (case char
+    \* "_ASTER_"
+    \+ "_PLUS_"
+    \- "_DASH_"
+    \/ "_SLASH_"
+    \_ "_UNDERS_"
+    \% "_PERCENT_"
+    \$ "_DOLLAR_"
+    \! "_BANG_"
+    \' "_QUOTE_"
+    \` "_BQUOTE_"
+    \@ "_AT_"
+    \^ "_CARET_"
+    \& "_AMPERS_"
+    \= "_EQ_"
+    ;; default
+    char))
+
+(defn normalize-ident [ident]
+  (reduce str "" (map normalize-char ident)))
+
+(defonce loader (doto (-> (java.io.File. "./") .toURL vector into-array java.net.URLClassLoader.)
+                  (->> (prn 'loader))))