desugar specials into maps

src/main/tock/compiler/desugar.cljc

@@ -10,15 +10,16 @@
     (r/attempt
      (r/rewrite
       (m/pred symbol? ?sym)  (m/app #(symbol (name %)) ?sym)
-      (m/pred number? ?num) ('l/lit ?num)
+      (m/pred integer? ?num) (typed (l/lit ?num) 'i64)
-      (m/pred boolean? ?b) (typed ('l/lit ?b) 'bool))))))
+      (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] 
+(defn make-structure-pass [specials]
+  (let [special? (fn [key] (and (symbol? key) (contains? specials key)))]
     (r/rewrite
      (meta-split ?meta (m/pred symbol? ?sym))
-   (meta-split ?meta ('l/read ?sym))
+     (m/app merge ?meta {:special 'l/read :name ?sym})
     
-   (meta-split ?meta
+     (meta-split ?meta ('l/lit ?val))
-               ((m/pred #(and (symbol? %) (get-in specials [% :leaf])) ?special) . !args ...))
+     (m/app merge ?meta {:special 'l/lit :val ?val})
-   (meta-split ?meta (?special . !args ...))
     
-   (meta-split ?meta
+     (meta-split ?meta ((m/pred special? ?special) . (m/cata !args) ...))
-               ((m/pred #(and (symbol? %) (contains? specials %)) ?special) . (m/cata !args) ...))
+     (m/app merge ?meta {:special ?special :args [!args ...]})
-   (meta-split ?meta (?special . !args ...))
     
-   (meta-split ?meta
+     (meta-split ?meta ((m/pred #(not (special? %)) (m/cata ?func)) . (m/cata !args) ...))
-               ((m/pred #(or (not (symbol? %)) (not (contains? specials %))) (m/cata ?head)) . (m/cata !args) ...))
+     (m/app merge ?meta {:special 'l/call :args [(label ?func "function") . (label !args "argument") ...]}))))
-   (meta-split ?meta ('l/call (label ?head "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
+         ))))

src/main/tock/compiler/specials.cljc

@@ -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/lit {}
-   'l/read {:leaf true}
    'l/call {}})

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