diff --git a/src/main/tock/compiler/bind.cljc b/src/main/tock/compiler/bind.cljc index d661b0e..2a31b5c 100644 --- a/src/main/tock/compiler/bind.cljc +++ b/src/main/tock/compiler/bind.cljc @@ -9,13 +9,14 @@ ctx (if scope (new-scope ctx scope) ctx) new-bindings (:new-bindings special) bindings (if new-bindings (new-bindings form ctx) {}) - new-form (m/rewrite form - ('l/lookup ?m) ('l/lookup {:ctx ~ctx & ?m}) - (m/and ?form ~new-bindings) (m+ {:bindings ~bindings} ?form) - ?form ?form)] + marker (or (:mark-bound-subexpressions special) identity) + form (marker form) + form (if new-bindings (merge-metafield form {:bindings bindings}) form) + add-ctx? (or (= (first form) 'l/lookup) (:binding (second form)) new-bindings) + form (if add-ctx? (merge-metafield form {:ctx ctx}) form)] (doseq [[symbol binding] bindings] (bind! ctx symbol binding)) - ((all-subexpressions (partial decorate-ctx specials ctx)) new-form))) + ((all-subexpressions (partial decorate-ctx specials ctx)) form))) (def perform-lookups (bottom-up diff --git a/src/main/tock/compiler/specials.cljc b/src/main/tock/compiler/specials.cljc index 584214e..2b6a238 100644 --- a/src/main/tock/compiler/specials.cljc +++ b/src/main/tock/compiler/specials.cljc @@ -1,7 +1,7 @@ (ns tock.compiler.specials (:require [meander.epsilon :as m] [meander.strategy.epsilon :as r] - [tock.compiler.meander :refer [parse-type to-sym label] :include-macros true] + [tock.compiler.meander :refer [parse-type to-sym label m+] :include-macros true] [tock.compiler.util :refer [get-meta]])) ;; no namespace - source symbol @@ -84,8 +84,11 @@ :typecheck (comparitor-typecheck logical-type?)} 'or {:desugar (left-binop-desugar 'or) :typecheck (comparitor-typecheck logical-type?)} - 'def {:typecheck (r/rewrite (_ ?t) [[?t ?t]]) - :new-bindings (fn [form _ctx] (m/match form ('def {:name ?symbol} ?expr) {?symbol (list 'l/global {:name ?symbol})}))} + '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)))} 'do {:typecheck (r/rewrite (_) [['void]] (_ . !stmt ... ?last) [[?last . (m/app (constantly 'void) !stmt) ... ?last]]) :scope {}} diff --git a/src/main/tock/compiler/type.cljc b/src/main/tock/compiler/type.cljc index 904fe9e..4b1171a 100644 --- a/src/main/tock/compiler/type.cljc +++ b/src/main/tock/compiler/type.cljc @@ -1,7 +1,7 @@ (ns tock.compiler.type (:require [meander.epsilon :as m] [meander.strategy.epsilon :as r] - [tock.compiler.meander :refer [bottom-up m+] :include-macros true] + [tock.compiler.meander :refer [bottom-up m+ merge-metafield] :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 @@ -45,8 +45,8 @@ ; propogate type back to binding (m/match rewrite - (m+ {:ctx ?ctx :name ?name :type ?type} _) - (update-binding! ?ctx ?name assoc :type ?type) + (_ {:ctx (m/some ?ctx) :binding (m/some ?name) :type (m/some ?type)} . _ ...) + (update-binding! ?ctx ?name merge-metafield {:type ?type}) _ nil)