From 278675b43905d765da9972f0da03b5fcdc597c41 Mon Sep 17 00:00:00 2001
From: Jeremy Penner <jeremy@sporktania.com>
Date: Fri, 9 Aug 2024 16:24:42 -0400
Subject: [PATCH] start implementing locals

---
 src/main/tock/compiler/specials.cljc | 46 ++++++++++++++++++++++------
 src/main/tock/compiler/util.cljc     |  2 +-
 src/main/tock/compiler/wasm.cljc     |  3 +-
 3 files changed, 39 insertions(+), 12 deletions(-)

diff --git a/src/main/tock/compiler/specials.cljc b/src/main/tock/compiler/specials.cljc
index a8d83f9..dd851a2 100644
--- a/src/main/tock/compiler/specials.cljc
+++ b/src/main/tock/compiler/specials.cljc
@@ -2,6 +2,7 @@
   (:require [meander.epsilon :as m]
             [meander.strategy.epsilon :as r]
             [helins.wasm.bin :as op]
+            [tock.compiler.util :refer [lookup]]
             [tock.compiler.meander :refer [parse-type to-sym label m+]]
             [tock.compiler.wasm :refer [type-to-wasmtype]]))
 
@@ -30,6 +31,27 @@
 (defn comparitor-typecheck [valid?]
   (r/rewrite (_ (m/pred valid? ?l) (m/pred valid? ?r)) [['bool ?l ?l] ['bool ?r ?r]]))
 
+(defn def-special [defsymbol]
+  (let [const? (= defsymbol 'def)]
+    {:desugar (r/rewrite
+               (~defsymbol (m/pred symbol? ?name) ?expr) (~defsymbol {:name ?name & (m/app meta ?name)} ?expr))
+     :typecheck (r/rewrite ({:type (m/some ?t)} _) [[?t ?t]]
+                           (_ ?t) [[?t ?t]])
+     :new-bindings (fn [form ctx]
+                     (let [depth (lookup ctx :fn-scope-depth)
+                           meta (if depth {:fn-scope depth} {})]
+                       (m/match form
+                         (~defsymbol {:name ?symbol} ?expr)
+                         {?symbol (list (if depth 'l/local 'l/global) (merge meta {:name ?symbol :const const?}))})))
+     :mark-bound-subexpressions (r/rewrite 
+                                 (~defsymbol (m/and ?m {:name ?symbol}) ?expr) 
+                                 (~defsymbol ?m (m+ {:binding ?symbol} ?expr)))
+     :emit (fn [form emit]
+             (m/match form 
+               (_ {:fn-scope (m/some) :id ?id} ?expr) (concat (emit ?expr) [[op/local-tee ?id]])
+               ;; TODO: globals
+               ))}))
+
 (def specials
   {'l/if
    {:desugar (r/rewrite
@@ -64,9 +86,13 @@
                                       :params [!names ...]})
                      ('do {} & ?body)))
     :typecheck (r/rewrite ({:type (m/and ?fn-type ['fn . _ ... ?return-type])} _) [[?fn-type ?return-type]])
-    :scope {:local-counter 0 :valid-binding-forms #{'l/local 'l/param}}
-    :new-bindings (fn [form _ctx]
-                    (into {} (map-indexed (fn [index [name type]] [name (list 'l/param {:type type :name name :index index})])
+    :scope (fn [ctx] {:fn-scope-depth (count ctx) :valid-binding-forms #{'l/local 'l/param}})
+    :new-bindings (fn [form ctx]
+                    (into {} (map-indexed (fn [index [name type]] 
+                                            [name (list 'l/param {:type type 
+                                                                  :name name 
+                                                                  :index index 
+                                                                  :fn-scope (lookup ctx :fn-scope-depth)})])
                                           (m/rewrite form
                                                      ('l/fn {:params [!names ...] :type ['fn . !types ... _]} _)
                                                      [[!names !types] ...]))))
@@ -134,11 +160,8 @@
                 (m/match form
                   ('or _ ?l ?r)
                   [[op/if- [:wasm/valtype 'i32] (emit ?l) [[op/i32-const -1]] (emit ?r)]]))}
-   'def {:desugar (r/rewrite
-                   ('def (m/pred symbol? ?name) ?expr) ('def {:name ?name} ?expr))
-         :typecheck (r/rewrite (_ ?t) [[?t ?t]])
-         :new-bindings (fn [form _ctx] (m/match form ('def {:name ?symbol} ?expr) {?symbol (list 'l/global {:name ?symbol})}))
-         :mark-bound-subexpressions (r/rewrite ('def (m/and ?m {:name ?symbol}) ?expr) ('def ?m (m+ {:binding ?symbol} ?expr)))}
+   'def (def-special 'def)
+   'var (def-special 'var)
    'do {:typecheck (r/rewrite (_) [['void]]
                               (_ . !stmt ... ?last) [[?last . (m/app (constantly 'void) !stmt) ... ?last]])
         :scope {}
@@ -146,12 +169,17 @@
                 (m/match form
                   ('do _ . !exprs ...)
                   (mapcat emit !exprs)))}
+   'set! {:typecheck (r/rewrite (_ ?lvalue _) [['void ?lvalue ?lvalue]])
+          }
    'l/lookup {}
    'l/local {}
    'l/param
    {:emit (fn [form _emit]
             (m/match form
-              ('l/param {:index ?id}) [[op/local-get ?id]]))}
+              ('l/param {:index ?id :name ?name :ctx ?ctx :fn-scope ?scope}) 
+              (if (= (lookup ?ctx :fn-scope) ?fn-scope)
+                [[op/local-get ?id]]
+                [[:compile-error form "Can't refer to variable outside function scope" ?name]])))}
    'l/lit
    {:emit (fn [form _emit]
             (m/match form
diff --git a/src/main/tock/compiler/util.cljc b/src/main/tock/compiler/util.cljc
index 4defc73..863e17f 100644
--- a/src/main/tock/compiler/util.cljc
+++ b/src/main/tock/compiler/util.cljc
@@ -2,7 +2,7 @@
 
 ; ctx is a vector of atoms of maps
 (defn new-scope
-  ([ctx base] (conj ctx (atom base)))
+  ([ctx base] (conj ctx (atom (if (map? base) base (base ctx)))))
   ([ctx] (new-scope ctx {})))
 
 (defn lookup [ctx key]
diff --git a/src/main/tock/compiler/wasm.cljc b/src/main/tock/compiler/wasm.cljc
index ec6973c..e3f803f 100644
--- a/src/main/tock/compiler/wasm.cljc
+++ b/src/main/tock/compiler/wasm.cljc
@@ -14,7 +14,6 @@
 ;; replace function definitions with 'l/funcref nodes.
 
 ;; local definitions also need to be hoisted
-;; 'bool is 'i32 internally, but it's simpler to support it directly in the emitter than rewrite it
 
 (def lift-functions
   (r/rewrite
@@ -48,7 +47,7 @@
   (let [subexprs (rest (rest form))
         types (into [] (map #(get-meta % :type) subexprs))
         ops (get opmap types)]
-    (or (concat (mapcat emit subexprs) ops) [[:compile-error form "Unexpected types" types]])))
+    (if ops (concat (mapcat emit subexprs) ops) [[:compile-error form "Unexpected types" types]])))
 
 (defn make-emitter [program]
   (fn emit [form]