start implementing locals
This commit is contained in:
parent
56299b20c3
commit
278675b439
|
@ -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
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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]
|
||||||
|
|
Loading…
Reference in a new issue