refactor: use quasiquoting in STDLIB and go through array in quasiquote (#1135)

core/Array.carp

@@ -9,20 +9,14 @@
                  (cadddr (cdr settings))
                  (if (< step (- step step)) '> '<))
           ]
-      (list
+      `(let [%variable %from]
-       'let (array variable from)
+         (while (%comp %variable %to)
-       (list
+           (do
-        'while (list comp variable to)
+             %(cond
-        (list
+                (= (length body) 0) ()
-         'do
+                (list? body) (car body)
-         (if (= (length body) 0)
+                body)
-           ()
+             (set! %variable (+ %variable %step))))))))
-           (if (list? body)
-             (car body)
-             body))
-         (list
-          'set! variable
-          (list '+ variable step))))))))
 
 (defmodule Array
 
@@ -423,18 +417,18 @@ It will create a copy. If you want to avoid that, consider using [`endo-filter`]
       darr)))
 
 (defmacro doall [f xs]
-  (list 'for ['i 0 (list 'Array.length (list 'ref xs))]
+  `(for [i 0 (Array.length &%xs)]
-        (list f (list 'Array.unsafe-nth (list 'ref xs) 'i))))
+     (%f (Array.unsafe-nth &%xs i))))
 
 (defndynamic foreach-internal [var xs expr]
   (let [xsym (gensym-with 'xs)
         len (gensym-with 'len)
         i (gensym-with 'i)]
-    (list 'let [xsym xs
+    `(let [%xsym %xs
-                len (list 'Array.length xsym)]
+           %len (Array.length %xsym)]
-          (list 'for [i 0 len]
+       (for [%i 0 %len]
-                (list 'let [var (list 'Array.unsafe-nth xsym i)]
+         (let [%var (Array.unsafe-nth %xsym %i)]
-                      expr)))))
+           %expr)))))
 
 (defmacro foreach [binding expr]
   (if (array? binding)

core/Bench.carp

@@ -109,16 +109,16 @@ If your functions takes a large amount of time, experimenting with this might ma
 
 
 (defmacro benchn [n form]
-  (list 'let ['before (Bench.get-time-elapsed)
+  `(let [before (Bench.get-time-elapsed)
-              'times []]
+         times []]
-    (list 'do
+    (do
-      (list 'for ['i 0 n]
+      (for [i 0 %n]
-        (list 'let ['before-once (Bench.get-time-elapsed)]
+        (let [before-once (Bench.get-time-elapsed)]
-          (list 'do
+          (do
-            form
+            %form
-            (list 'set! &times (Array.push-back (Array.copy &times) (Double.- (Bench.get-time-elapsed) before-once))))))
+            (set! &times (Array.push-back (Array.copy &times) (Double.- (Bench.get-time-elapsed) before-once))))))
-      (list 'let ['total (Double.- (Bench.get-time-elapsed) before)
+      (let [total (Double.- (Bench.get-time-elapsed) before)
-                  'per (list 'Double./ 'total (list 'Double.from-int n))]
+            per (Double./ total (Double.from-int %n))]
         (do
           (Bench.print "Total time elapsed: " total)
           (Bench.print "Time elapsed per run (average): " per)

core/Core.carp

@@ -51,7 +51,6 @@
 (load-once "IO.carp")
 (load-once "Pattern.carp")
 (load-once "Debug.carp")
-(load-once "Format.carp")
 (load-once "Random.carp")
 (load-once "Map.carp")
 (load-once "Heap.carp")

core/Debug.carp

@@ -19,37 +19,35 @@ immediately, raising a `SIGABRT` if it fails.")
 
   (doc memory-logged "logs all calls to memory allocation within the form. Requires the flag `--log-memory` to be passed during compilation.")
   (defmacro memory-logged [form]
-    (list 'do
+    `(do
-          '(Debug.log-memory-balance! true)
+       (Debug.log-memory-balance! true)
-          form
+       %form
-          '(Debug.log-memory-balance! false)))
+       (Debug.log-memory-balance! false)))
 
   (doc assert-balanced "raises an error if the memory balance (number of `alloc`s - number of `free`s) isn't `0`. Requires the flag `--log-memory` to be passed durng compilation.")
   (defmacro assert-balanced [form]
-    (list 'let '[balance (Debug.memory-balance)]
+    `(let [balance (Debug.memory-balance)]
-          (list 'do
+       (do
-                (list 'let []
+         (let [] %form)
-                      form)
+         (unless (= balance (Debug.memory-balance))
-                '(if (= balance (Debug.memory-balance))
+           (do
-                   ()
+             (IO.println &(fmt "Invalid memory balance: %d" (Debug.memory-balance)))
-                   (do (IO.println &(fmt "Invalid memory balance: %d" (Debug.memory-balance)))
+             (System.exit 1))))))
-                       (System.exit 1)))
-                ())))
 
   (doc trace "prints the value of an expression to `stdout`, then returns its value.")
   (defmacro trace [x]
     (let [sym (gensym)]
-      (list 'let-do [sym x]
+      `(let-do [%sym %x]
         ; we use eval here to ensure we resolve the symbol before putting it
         ; into file, line, and column
-        (list 'IO.println
+        (IO.println
-          (list 'ref
+          (ref
-            (list 'fmt "%s:%d:%d: %s"
+            (fmt "%s:%d:%d: %s"
-              (eval (list 'file x))
+              %(eval `(file %x))
-              (eval (list 'line x))
+              %(eval `(line %x))
-              (eval (list 'column x))
+              %(eval `(column %x))
-              (list 'ref (list 'str sym)))))
+              &(str %sym))))
-        sym)
+        %sym)
     )
   )
 
@@ -60,8 +58,7 @@ immediately, raising a `SIGABRT` if it fails.")
 
 ;; Crash the program with an error message unless the expression evaluates to 'true'.
 (defmacro assert [expr]
-  (list 'if (list '= true expr)
+  `(unless (= true %expr)
-        ()
+     (do
-        (list 'do
+       (println* (fmt "Assertion '%s' failed at line %d, column %d in file %s" %(str expr) %(line) %(column) %(file)))
-              (list 'println* (list 'fmt "Assertion '%s' failed at line %d, column %d in file %s" (str expr) (line) (column) (file)))
+       (System.abort))))
-              '(System.abort))))

core/Format.carp

@@ -12,10 +12,10 @@
       (if (= len 1)
         (macro-error "error in format string: expected expression after last %")
         (if (= \% (String.char-at s (inc idx))) ; this is an escaped %
-          (list 'ref
+          `(ref
-            (list 'String.append
+            (String.append
-                  "%"
+                "%"
-                  (fmt-internal (String.slice s (+ idx 2) len) args)))
+                %(fmt-internal (String.slice s (+ idx 2) len) args)))
           (if (= 0 (length args)) ; we need to insert something, but have nothing
             (macro-error
               (str "error in format string: not enough arguments to format string (missing argument for '%"
@@ -30,13 +30,13 @@
                     (str "error in format string: too many arguments to format string (missing directive for '"
                          (cadr args)
                          "')"))
-                  (list 'ref (list 'format s (car args))))
+                  `(ref (format %s %(car args))))
                 (let [slice (String.slice s 0 (+ (inc idx) next))]
-                  (list 'ref
+                  `(ref
-                    (list 'String.append
+                     (String.append
-                      (list 'ref (list 'format slice (car args)))
+                       (ref (format %slice %(car args)))
-                      (fmt-internal (String.slice s (+ (inc idx) next) len)
+                       %(fmt-internal (String.slice s (+ (inc idx) next) len)
-                                        (cdr args)))))))))))))
+                                      (cdr args)))))))))))))
 
 (doc fmt "formats a string. It supports all of the string interpolations defined in format of the type that should be interpolated (e.g. %d and %x on integers).")
 (defmacro fmt [s :rest args]

core/IO.carp

@@ -83,7 +83,7 @@
 )
 
 (defmacro println* [:rest forms]
-  (list 'IO.println (build-str* forms)))
+  `(IO.println %(build-str* forms)))
 
 (defmacro print* [:rest forms]
-  (list 'IO.print (build-str* forms)))
+  `(IO.print %(build-str* forms)))

core/Quasiquote.carp

@@ -55,7 +55,9 @@ Example:
                 (list 'cons-last (quasiquote- elem) acc)))
             '()
             arg)))
-        (list 'quote arg)))
+        (if (array? arg)
+          (collect-into (map quasiquote- arg) array)
+          (list 'quote arg))))
 
   (doc quasiquote "is a quotation that may have expressions inside it in the
 form of [`unquote](#unquote) and [`unquote-splicing`](#unquote-splicing).

core/StaticArray.carp

@@ -20,11 +20,11 @@
     (let [xsym (gensym-with 'xs)
           len (gensym-with 'len)
           i (gensym-with 'i)]
-      (list 'let [xsym xs
+      `(let [%xsym %xs
-                  len (list 'StaticArray.length xsym)]
+             %len (StaticArray.length %xsym)]
-            (list 'for [i 0 len]
+         (for [%i 0 %len]
-                  (list 'let [var (list 'StaticArray.unsafe-nth xsym i)]
+           (let [%var (StaticArray.unsafe-nth %xsym %i)]
-                        expr)))))
+             %expr)))))
 
   (defmacro foreach [binding expr]
     (StaticArray.foreach-internal (car binding) (cadr binding) expr))

core/String.carp

@@ -479,10 +479,10 @@
 
 (defndynamic build-str* [forms]
   (if (= (length forms) 0)
-    (list "")
+    '("")
     (if (= (length forms) 1)
-      (list 'ref (list 'str (car forms)))
+      `&(str %(car forms))
-      (list 'ref (list 'String.append (list 'ref (list 'str (car forms))) (build-str* (cdr forms)))))))
+      `&(String.append &(str %(car forms)) %(build-str* (cdr forms))))))
 
 (defmacro str* [:rest forms]
-  (list 'copy (build-str* forms)))
+  `(copy %(build-str* forms)))

core/Test.carp

@@ -137,26 +137,26 @@
 
 (defndynamic with-test-internal [name forms]
   (if (= (length forms) 1)
-    (list (list 'set! name (list 'ref (car forms))))
+    `((set! %name &%(car forms)))
-    (cons (list 'set! name (list 'ref (car forms)))
+    (cons `(set! %name &%(car forms))
           (with-test-internal name (cdr forms)))))
 
 
 (defmacro with-test [name :rest forms]
-  (list 'let (array name '&(Test.State.init 0 0))
+  `(let [%name &(Test.State.init 0 0)]
-    (cons-last
+    %(cons-last
-      (list 'Int.copy (list 'Test.State.failed name))
+      `@(Test.State.failed %name)
       (cons-last
-        (list 'Test.print-test-results name)
+        `(Test.print-test-results %name)
-        (cons 'do (with-test-internal name forms))))
+        `(do %@(with-test-internal name forms))))
     ))
 
 (defmacro deftest [name :rest forms]
   (eval
-    (list 'defn 'main (array)
+    `(defn main []
-      (list 'let (array name '&(Test.State.init 0 0))
+      (let [%name &(Test.State.init 0 0)]
-        (cons-last
+        %(cons-last
-          (list 'Int.copy (list 'Test.State.failed name))
+          `@(Test.State.failed %name)
           (cons-last
-            (list 'Test.print-test-results name)
+            `(Test.print-test-results %name)
-            (cons 'do (with-test-internal name forms))))))))
+            `(do %@(with-test-internal name forms))))))))

core/Tuples.carp

@@ -2,8 +2,8 @@
   (private deftuple-type-)
   (hidden deftuple-type-)
   (defndynamic deftuple-type- [name props]
-    (list 'deftype (cons name props)
+    `(deftype (%name %@props)
-      (collect-into (flatten (map (fn [x] (list x x)) props)) array)))
+      %(collect-into (flatten (map (fn [x] `(%x %x)) props)) array)))
 
   (private deftuple-lt-)
   (hidden deftuple-lt-)
@@ -12,10 +12,10 @@
       'false
       (let [fst (Symbol.prefix name (car props))]
         (if (= (length props) 1)
-          (list '< (list fst 't1) (list fst 't2))
+          `(< (%fst t1) (%fst t2))
-          (list 'if (list '= (list fst 't1) (list fst 't2))
+          `(if (= (%fst t1) (%fst t2))
-            (deftuple-lt- name (cdr props))
+            %(deftuple-lt- name (cdr props))
-            (list '< (list fst 't1) (list fst 't2)))))))
+            (< (%fst t1) (%fst t2)))))))
 
   ; this is basically just a giant template
   (private deftuple-module-)
@@ -23,55 +23,33 @@
   (defndynamic deftuple-module- [name props]
     (let [sname (Symbol.str name)
           module-name (Symbol.concat [name 'Ref])]
-      (list 'do
+      `(do
-        (list 'defmodule module-name
+        (defmodule %module-name
-          (list 'defn '= ['t1 't2]
+          (defn < [t1 t2] %(deftuple-lt- name props))
-            (cons 'and*
+          (implements < %(Symbol.prefix module-name '<))
-              (map (fn [p]
-                    (list '=
-                      (list (Symbol.prefix name p) 't1)
-                      (list (Symbol.prefix name p) 't2)))
-                   props)))
-          (list 'implements '= (Symbol.prefix module-name '=))
 
-          (list 'defn '< ['t1 't2] (deftuple-lt- name props))
+          (defn > [t1 t2] (%(Symbol.prefix module-name '<) t2 t1))
-          (list 'implements '< (Symbol.prefix module-name '<))
+          (implements > %(Symbol.prefix module-name '>)))
 
-          (list 'defn '> ['t1 't2] (list (Symbol.prefix module-name '<) 't2 't1))
+        (defmodule %name
-          (list 'implements '> (Symbol.prefix module-name '>)))
+          (doc init-from-refs
+            %(String.concat ["initializes a `" sname "` from member references."]))
+          %(let [prop-vars (map (fn [x] (Symbol.concat [x '-val])) props)]
+            `(defn init-from-refs %(collect-into prop-vars array)
+              (init %@(map (fn [x] `(copy %x)) prop-vars))))
 
-        (list 'defmodule name
+          (defn < [t1 t2]
-          (list 'doc 'init-from-refs
+            (%(Symbol.prefix module-name '<) &t1 &t2))
-            (String.concat ["initializes a `" sname "` from member references."]))
+          (implements < %(Symbol.prefix name '<))
-          (let [prop-vars (map (fn [x] (Symbol.concat [x '-val])) props)]
-            (list 'defn 'init-from-refs (collect-into prop-vars array)
-              (cons 'init (map (fn [x] (list 'copy x)) prop-vars))))
 
-          (list 'defn '= ['t1 't2]
+          (defn > [t1 t2]
-            (cons 'and*
+            (%(Symbol.prefix module-name '>) &t1 &t2))
-              (map (fn [p] (list '= (list p '(ref t1)) (list p '(ref t2)))) props)))
+          (implements > %(Symbol.prefix name '>))
-          (list 'implements '= (Symbol.prefix name '=))
 
-          (list 'defn '< ['t1 't2]
+          (doc reverse
-            (list (Symbol.prefix module-name '<) '(ref t1) '(ref t2)))
+            %(String.concat ["reverses a `" sname "` by reversing its member positions."]))
-          (list 'implements '< (Symbol.prefix name '<))
+          (defn reverse [t]
-
+            (init %@(map (fn [x] `(copy (%x t))) (reverse props))))))))
-          (list 'defn '> ['t1 't2]
-            (list (Symbol.prefix module-name '>) '(ref t1) '(ref t2)))
-          (list 'implements '> (Symbol.prefix name '>))
-
-          (list 'doc 'reverse
-            (String.concat ["reverses a `" sname "` by reversing its member positions."]))
-          (list 'defn 'reverse ['t]
-            (cons 'init (map (fn [x] (list 'copy (list x 't))) (reverse props))))
-
-          (list 'meta-set! 'zero "doc"
-            (String.concat [
-              "initializes a `" sname
-              "` by calling `zero` for all its members. `zero` must be defined for all member types."]))
-          (list 'defn 'zero [] (cons 'init (map (fn [_] '(zero)) props))))
-          (list 'implements 'zero (Symbol.prefix name 'zero))
-    )))
 
   (doc deftuple "defines a tuple type.
 
@@ -83,6 +61,8 @@ For example:
   (defmacro deftuple [name :rest props]
     (do
       (eval (deftuple-type- name props))
+      (eval `(derive %name zero))
+      (eval `(derive %name =))
       (eval (deftuple-module- name props))
     ))
 )