diff --git a/src/main/tock/compiler/desugar.cljc b/src/main/tock/compiler/desugar.cljc index cc58b98..bbf78fd 100644 --- a/src/main/tock/compiler/desugar.cljc +++ b/src/main/tock/compiler/desugar.cljc @@ -9,16 +9,17 @@ (preserving-meta (r/attempt (r/rewrite - (m/pred symbol? ?sym) (m/app #(symbol (name %)) ?sym) - (m/pred number? ?num) ('l/lit ?num) - (m/pred boolean? ?b) (typed ('l/lit ?b) 'bool)))))) + (m/pred symbol? ?sym) (m/app #(symbol (name %)) ?sym) + (m/pred integer? ?num) (typed (l/lit ?num) 'i64) + (m/pred double? ?num) (typed (l/lit ?num) 'f64) + (m/pred boolean? ?b) (typed (l/lit ?b) 'bool)))))) (def type-cleanup-pass (r/bottom-up (r/attempt (r/rewrite (meta-split {:tag (m/some ?symbol)} ?form) - (typed ?form ?symbol) + (typed ?form (m/app #(symbol (name %)) ?symbol)) (meta-split {:fn [!type ... '-> ?return-type]} ?form) (typed ?form ['fn . !type ... ?return-type]) @@ -32,30 +33,29 @@ (preserving-meta (apply r/pipe (mapcat (fn [[_ {:keys [desugar]}]] (if desugar [(r/attempt desugar)] [])) specials)))))) -(defn make-lookup-pass [specials] - (r/rewrite - (meta-split ?meta (m/pred symbol? ?sym)) - (meta-split ?meta ('l/read ?sym)) - - (meta-split ?meta - ((m/pred #(and (symbol? %) (get-in specials [% :leaf])) ?special) . !args ...)) - (meta-split ?meta (?special . !args ...)) - - (meta-split ?meta - ((m/pred #(and (symbol? %) (contains? specials %)) ?special) . (m/cata !args) ...)) - (meta-split ?meta (?special . !args ...)) - - (meta-split ?meta - ((m/pred #(or (not (symbol? %)) (not (contains? specials %))) (m/cata ?head)) . (m/cata !args) ...)) - (meta-split ?meta ('l/call (label ?head "function") . (label !args "argument") ...)))) +(defn make-structure-pass [specials] + (let [special? (fn [key] (and (symbol? key) (contains? specials key)))] + (r/rewrite + (meta-split ?meta (m/pred symbol? ?sym)) + (m/app merge ?meta {:special 'l/read :name ?sym}) + + (meta-split ?meta ('l/lit ?val)) + (m/app merge ?meta {:special 'l/lit :val ?val}) + + (meta-split ?meta ((m/pred special? ?special) . (m/cata !args) ...)) + (m/app merge ?meta {:special ?special :args [!args ...]}) + + (meta-split ?meta ((m/pred #(not (special? %)) (m/cata ?func)) . (m/cata !args) ...)) + (m/app merge ?meta {:special 'l/call :args [(label ?func "function") . (label !args "argument") ...]})))) (defn desugar ([form] (desugar form specials)) ([form specials] (let [desugar-pass (make-desugar-pass specials) - lookup-pass (make-lookup-pass specials)] + structure-pass (make-structure-pass specials)] (-> form leaf-pass type-cleanup-pass desugar-pass - lookup-pass)))) + structure-pass + )))) diff --git a/src/main/tock/compiler/specials.cljc b/src/main/tock/compiler/specials.cljc index 53f84fa..300abf4 100644 --- a/src/main/tock/compiler/specials.cljc +++ b/src/main/tock/compiler/specials.cljc @@ -36,14 +36,14 @@ ('fn [!names ...] & ?body) (i/fn [!names ... 'void] & ?body) ('i/fn [(typed !names !types) ... ?return-type] & ?body) - (meta-split {:type ['fn !types ... ?return-type] + (meta-split {:type ['fn . !types ... ?return-type] :params [!names ...]} ('l/fn ('do & ?body))))} '+ {:desugar (left-binop-desugar '+)} '- {:desugar (r/choice - (r/rewrite ('- ?v) ('- ('l/lit 0) ?v)) - (left-associative '-))} + (r/rewrite ('- ?v) ('- 0 ?v)) + (left-associative '-))} '* {:desugar (left-binop-desugar '*)} '/ {:desugar (left-binop-desugar '/)} '= {} @@ -56,6 +56,5 @@ 'or {:desugar (left-binop-desugar 'or)} 'def {} 'do {} - 'l/lit {:leaf true} - 'l/read {:leaf true} + 'l/lit {} 'l/call {}}) diff --git a/src/main/tock/experiment.cljs b/src/main/tock/experiment.cljs index 9c6c15c..73ab560 100644 --- a/src/main/tock/experiment.cljs +++ b/src/main/tock/experiment.cljs @@ -27,7 +27,7 @@ #_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]} (defn main [] - (js/console.log (desugar `(if true (thing bloop) false (blarp poop))))) + (js/console.log (desugar `(fn add [^f64 left ^f64 right -> f64] (+ left right))))) ;; (js/console.log test-wasm) ;; (-> (instantiate-wasm test-wasm #js {}) ;; (.then #(js/console.log (-> % (.-instance) (.-exports) (.add-double 2 3)))))