SpindleyQ/tock
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Add typechecking pass

Browse source
This commit is contained in:
Jeremy Penner 2024-07-28 16:26:02 -04:00
parent f19d274ea3
commit 21ced785bd
5 changed files with 78 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
src/main/tock/compiler.cljc
View file

@ -2,7 +2,7 @@
(:require [tock.compiler.desugar :refer [desugar]]
[tock.compiler.bind :refer [bind]]
[tock.compiler.specials :refer [specials]]
;; [tock.compiler.type :refer [typecheck-expr]]
[tock.compiler.type :refer [typecheck]]
;; [tock.compiler.wasm :refer [ctx-to-wasm]]
[meander.epsilon :as m]))
@ -57,4 +57,5 @@
(let [ctx (new-ctx)]
(-> form
(desugar specials)
(bind specials ctx))))
(bind specials ctx)
(typecheck specials))))

2
src/main/tock/compiler/bind.cljc
View file

@ -1,7 +1,7 @@
(ns tock.compiler.bind
(:require [meander.epsilon :as m]
[tock.compiler.util :refer [get-special new-scope bind! lookup]]
[tock.compiler.meander :refer [bottom-up all-subexpressions m+ merge-metafield]]))
[tock.compiler.meander :refer [bottom-up all-subexpressions m+ merge-metafield] :include-macros true]))
(defn decorate-ctx [specials ctx form]
(let [special (get-special specials form)

5
src/main/tock/compiler/meander.cljc
View file

@ -9,7 +9,8 @@
(list? form) (apply list (first form) (merge (second form) m) (rest (rest form)))
:else (do (print "m+ " form meta "\n") form)))
(m/defsyntax m+ [meta-pattern pattern]
(m/defsyntax m+
[meta-pattern pattern]
(case (::r.syntax/phase &env)
:meander/substitute `(m/app merge-metafield ~pattern ~meta-pattern)
:meander/match `(m/and (_ ~meta-pattern . _ ...) ~pattern)
@ -48,4 +49,4 @@
(defn bottom-up [s]
(fn rec [t]
((r/pipe s (all-subexpressions rec)) t)))
((r/pipe (all-subexpressions rec) s) t)))

10
src/main/tock/compiler/specials.cljc
View file

@ -57,7 +57,7 @@
('l/fn (m/app merge ?m {:type ['fn . !types ... 'void]
:params [!names ...]})
('do {} & ?body)))
:typecheck (r/rewrite ({:type ['fn . _ ... ?return-type]} _) [[?return-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}}
:new-bindings (fn [form _ctx]
(into {} (map-indexed (fn [index [name type]] [name (list 'l/param {:type type :name name :index index})])
@ -89,10 +89,10 @@
'do {:typecheck (r/rewrite (_) [['void]]
(_ . !stmt ... ?last) [[?last . (m/app (constantly 'void) !stmt) ... ?last]])
:scope {}}
'l/lookup {:typecheck (r/rewrite ({:type ?type}) [[?type]])}
'l/local {:typecheck (r/rewrite ({:type ?type}) [[?type]])}
'l/param {:typecheck (r/rewrite ({:type ?type}) [[?type]])}
'l/lit {:typecheck (r/rewrite ({:type ?type}) [[?type]])}
'l/lookup {}
'l/local {}
'l/param {}
'l/lit {}
'l/call
{:typecheck (r/rewrite (_ (m/and ['fn . !param-types ... ?return-type] ?fn-type) . _ ...)
[[?return-type ?fn-type . !param-types ...]])}

112
src/main/tock/compiler/type.cljc
View file

@ -1,39 +1,59 @@
(ns tock.compiler.type
(:require [meander.epsilon :as m]
[tock.compiler.util :refer [bind! compile-error lookup new-scope] :as u]))
; once we've hit the typechecking stage, nodes in our expression tree are maps, where each node has at least :special
; and :args keys. :special is a symbol corresponding to a record in the `specials` map; :args is an ordered list of
; subexpressions. a node may optionally contain a :type field as well.
[meander.strategy.epsilon :as r]
[tock.compiler.meander :refer [bottom-up m+] :include-macros true]
[tock.compiler.util :refer [lookup get-meta get-special lookup update-binding!]]))
; typechecking happens bottom-up. by the time a node is called to be typechecked, the system has verified that all of the children
; under :args will have a :type field.
; there are two type syntaxes:
; desugared type syntax is either a bare symbol (ie. 'void, 'i64), or for parameterized types, a dynamic variant stored as a vector
; (ie ['fn arg-type arg-type return-type]).
; 1. internal syntax - always stored in a form's metadata under the :type key. fetched with `expr-type`, added by
; `decorate-type`. generally is either a bare symbol, or for parameterized types, a dynamic
; variant stored as a vector, like ['fn type type type].
; each special has an associated typechecking function, under the :typecheck key. This function is passed a list, where the first
; element is the metadata map for the special, and the following elements are the types of the subexpression. It must return a
; vector of possible valid typings for the expression. A typing is a vector where the first element is the type of the parent
; expression, and each subsequent element corresponds to a type that the corresponding subexpression should be coerced to.
; 2. input syntax - stored in metadata with ^{} prefix syntax. converted to tock's internal syntax with `syntax-type`.
; generally, type names are stored as {:tag 'name}, and parameterized types like ['enum ...] are
; written in the input as ^{enum [...]}. (if there is only one parameter, the vector is skipped).
; The desugaring process handles this conversion.
; if no :typecheck key is specified, it is assumed that there are no subexpressions and the type should already be present in
; the metadata, or that the form is a binding lookup and the type can be read from context
(def default-typechecker
(r/rewrite
({:ctx ?ctx :name ?name}) [[(m/app #(get-meta (lookup %1 %2) :type) ?ctx ?name)]]
({:type ?type}) [[?type]]))
;; built-in types
(defn coerce [expr to-type]
(m/rewrite [(get-meta expr :type) to-type]
[?t ?t] ~expr
[_ 'void] ('l/cast {:type 'void} ~expr)
_ (m+ {:type-mismatch ~to-type} ~expr)))
;; (defn make-type [symbol] (fn [expr] (assoc-type expr symbol)))
;; (def void (make-type 'void))
;; (def f64 (make-type 'f64))
;; (def bool (make-type 'bool))
(defn coerce-form [form typing]
(m/rewrite [form typing]
[(?special ?m . !subexprs ...) [?result-type . !types ...]]
(?special {:type ?result-type & ?m} . (m/app coerce !subexprs !types) ...)))
;; typechecking helpers
(defn coerce [expr typesym error]
(let [ltype (expr-type expr)]
(cond (= ltype typesym) expr
(= typesym 'void) (void `(u/cast-void ~expr))
:else (throw error))))
(defn typecheck-expr [form specials]
(let [special (get-special specials form)
typechecker (or (:typecheck special) default-typechecker)
input (m/rewrite form (_ ?m . (m/and (_ {:type !subtype} . _ ...) _) ...) (?m . !subtype ...))
_ (print (first form) input)
typings (typechecker input)
rewrites (map #(coerce-form form %) typings)
valid-rewrites (filter #(nil? (get-meta % :type-mismatch)) rewrites)
rewrite (or (first valid-rewrites) (first rewrites))]
; propogate type back to binding
(m/match rewrite
(m+ {:ctx ?ctx :name ?name :type ?type} _)
(update-binding! ?ctx ?name assoc :type ?type)
_ nil)
rewrite))
(defn typecheck [form specials]
((bottom-up #(typecheck-expr % specials)) form))
;; The typechecker itself!
;; This is currently doing several jobs at once:
@ -52,28 +72,28 @@
;; External syntax uses simple namespaceless 'symbols, internal syntax uses `u/symbols
; todo: actually validate types
(defn validate-type [type] type)
;; (defn validate-type [type] type)
; (fn [^type name ^type name -> return-type] body)
(defn alloc-local [ctx]
(swap! (lookup ctx ::u/lastlocal) inc))
;; ; (fn [^type name ^type name -> return-type] body)
;; (defn alloc-local [ctx]
;; (swap! (lookup ctx ::u/lastlocal) inc))
; todo: must store function metadata globally
(defn alloc-func [ctx func-type func-body]
(let [funcs (swap! (lookup ctx ::u/module-funcs)
(fn [funcs]
(conj funcs {:type func-type :body func-body})))]
(- (count funcs) 1)))
;; ; todo: must store function metadata globally
;; (defn alloc-func [ctx func-type func-body]
;; (let [funcs (swap! (lookup ctx ::u/module-funcs)
;; (fn [funcs]
;; (conj funcs {:type func-type :body func-body})))]
;; (- (count funcs) 1)))
(defn bind-params! [params ctx]
(let [bind-param! (fn [name type]
(bind! ctx name {:local (alloc-local ctx)
:type (validate-type type)}))
bind-all! (fn [names return-type]
(doseq [name names] (bind-param! name (syntax-type (meta name) ctx (compile-error name "Expected explicit type"))))
(apply vector (concat ['fn]
(map #(syntax-type (meta %) ctx nil) names)
[(syntax-type return-type ctx (compile-error return-type "Invalid return type"))])))]
(m/match params
[!name ... '-> ?return-type] (bind-all! !name ?return-type)
[!name ...] (bind-all! !name 'void))))
;; (defn bind-params! [params ctx]
;; (let [bind-param! (fn [name type]
;; (bind! ctx name {:local (alloc-local ctx)
;; :type (validate-type type)}))
;; bind-all! (fn [names return-type]
;; (doseq [name names] (bind-param! name (syntax-type (meta name) ctx (compile-error name "Expected explicit type"))))
;; (apply vector (concat ['fn]
;; (map #(syntax-type (meta %) ctx nil) names)
;; [(syntax-type return-type ctx (compile-error return-type "Invalid return type"))])))]
;; (m/match params
;; [!name ... '-> ?return-type] (bind-all! !name ?return-type)
;; [!name ...] (bind-all! !name 'void))))