start implementing locals

This commit is contained in:
Jeremy Penner 2024-08-09 16:24:42 -04:00
parent 56299b20c3
commit 278675b439
3 changed files with 39 additions and 12 deletions

View file

@ -2,6 +2,7 @@
(:require [meander.epsilon :as m] (:require [meander.epsilon :as m]
[meander.strategy.epsilon :as r] [meander.strategy.epsilon :as r]
[helins.wasm.bin :as op] [helins.wasm.bin :as op]
[tock.compiler.util :refer [lookup]]
[tock.compiler.meander :refer [parse-type to-sym label m+]] [tock.compiler.meander :refer [parse-type to-sym label m+]]
[tock.compiler.wasm :refer [type-to-wasmtype]])) [tock.compiler.wasm :refer [type-to-wasmtype]]))
@ -30,6 +31,27 @@
(defn comparitor-typecheck [valid?] (defn comparitor-typecheck [valid?]
(r/rewrite (_ (m/pred valid? ?l) (m/pred valid? ?r)) [['bool ?l ?l] ['bool ?r ?r]])) (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 (def specials
{'l/if {'l/if
{:desugar (r/rewrite {:desugar (r/rewrite
@ -64,9 +86,13 @@
:params [!names ...]}) :params [!names ...]})
('do {} & ?body))) ('do {} & ?body)))
:typecheck (r/rewrite ({:type (m/and ?fn-type ['fn . _ ... ?return-type])} _) [[?fn-type ?return-type]]) :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}} :scope (fn [ctx] {:fn-scope-depth (count ctx) :valid-binding-forms #{'l/local 'l/param}})
:new-bindings (fn [form _ctx] :new-bindings (fn [form ctx]
(into {} (map-indexed (fn [index [name type]] [name (list 'l/param {:type type :name name :index index})]) (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 (m/rewrite form
('l/fn {:params [!names ...] :type ['fn . !types ... _]} _) ('l/fn {:params [!names ...] :type ['fn . !types ... _]} _)
[[!names !types] ...])))) [[!names !types] ...]))))
@ -134,11 +160,8 @@
(m/match form (m/match form
('or _ ?l ?r) ('or _ ?l ?r)
[[op/if- [:wasm/valtype 'i32] (emit ?l) [[op/i32-const -1]] (emit ?r)]]))} [[op/if- [:wasm/valtype 'i32] (emit ?l) [[op/i32-const -1]] (emit ?r)]]))}
'def {:desugar (r/rewrite 'def (def-special 'def)
('def (m/pred symbol? ?name) ?expr) ('def {:name ?name} ?expr)) 'var (def-special 'var)
: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)))}
'do {:typecheck (r/rewrite (_) [['void]] 'do {:typecheck (r/rewrite (_) [['void]]
(_ . !stmt ... ?last) [[?last . (m/app (constantly 'void) !stmt) ... ?last]]) (_ . !stmt ... ?last) [[?last . (m/app (constantly 'void) !stmt) ... ?last]])
:scope {} :scope {}
@ -146,12 +169,17 @@
(m/match form (m/match form
('do _ . !exprs ...) ('do _ . !exprs ...)
(mapcat emit !exprs)))} (mapcat emit !exprs)))}
'set! {:typecheck (r/rewrite (_ ?lvalue _) [['void ?lvalue ?lvalue]])
}
'l/lookup {} 'l/lookup {}
'l/local {} 'l/local {}
'l/param 'l/param
{:emit (fn [form _emit] {:emit (fn [form _emit]
(m/match form (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 'l/lit
{:emit (fn [form _emit] {:emit (fn [form _emit]
(m/match form (m/match form

View file

@ -2,7 +2,7 @@
; ctx is a vector of atoms of maps ; ctx is a vector of atoms of maps
(defn new-scope (defn new-scope
([ctx base] (conj ctx (atom base))) ([ctx base] (conj ctx (atom (if (map? base) base (base ctx)))))
([ctx] (new-scope ctx {}))) ([ctx] (new-scope ctx {})))
(defn lookup [ctx key] (defn lookup [ctx key]

View file

@ -14,7 +14,6 @@
;; replace function definitions with 'l/funcref nodes. ;; replace function definitions with 'l/funcref nodes.
;; local definitions also need to be hoisted ;; 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 (def lift-functions
(r/rewrite (r/rewrite
@ -48,7 +47,7 @@
(let [subexprs (rest (rest form)) (let [subexprs (rest (rest form))
types (into [] (map #(get-meta % :type) subexprs)) types (into [] (map #(get-meta % :type) subexprs))
ops (get opmap types)] 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] (defn make-emitter [program]
(fn emit [form] (fn emit [form]