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

desugar specials into maps

Browse source
This commit is contained in:
Jeremy Penner 2024-07-14 22:45:34 -04:00
parent 58d756cd56
commit a362729acc
3 changed files with 27 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
src/main/tock/compiler/desugar.cljc
View file

@ -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))
(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
((m/pred #(and (symbol? %) (get-in specials [% :leaf])) ?special) . !args ...))
(meta-split ?meta (?special . !args ...))
(meta-split ?meta ('l/lit ?val))
(m/app merge ?meta {:special 'l/lit :val ?val})
(meta-split ?meta
((m/pred #(and (symbol? %) (contains? specials %)) ?special) . (m/cata !args) ...))
(meta-split ?meta (?special . !args ...))
(meta-split ?meta ((m/pred special? ?special) . (m/cata !args) ...))
(m/app merge ?meta {:special ?special :args [!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") ...))))
(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
))))

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

@ -36,13 +36,13 @@
('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))
(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 {}})

2
src/main/tock/experiment.cljs
View file

@ -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)))))