mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-17 16:38:14 +03:00
refactor: use quasiquoting in STDLIB and go through array in quasiquote (#1135)
This commit is contained in:
parent
2584518d1c
commit
bdaf96550f
@ -9,20 +9,14 @@
|
||||
(cadddr (cdr settings))
|
||||
(if (< step (- step step)) '> '<))
|
||||
]
|
||||
(list
|
||||
'let (array variable from)
|
||||
(list
|
||||
'while (list comp variable to)
|
||||
(list
|
||||
'do
|
||||
(if (= (length body) 0)
|
||||
()
|
||||
(if (list? body)
|
||||
(car body)
|
||||
body))
|
||||
(list
|
||||
'set! variable
|
||||
(list '+ variable step))))))))
|
||||
`(let [%variable %from]
|
||||
(while (%comp %variable %to)
|
||||
(do
|
||||
%(cond
|
||||
(= (length body) 0) ()
|
||||
(list? body) (car body)
|
||||
body)
|
||||
(set! %variable (+ %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))]
|
||||
(list f (list 'Array.unsafe-nth (list 'ref xs) 'i))))
|
||||
`(for [i 0 (Array.length &%xs)]
|
||||
(%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
|
||||
len (list 'Array.length xsym)]
|
||||
(list 'for [i 0 len]
|
||||
(list 'let [var (list 'Array.unsafe-nth xsym i)]
|
||||
expr)))))
|
||||
`(let [%xsym %xs
|
||||
%len (Array.length %xsym)]
|
||||
(for [%i 0 %len]
|
||||
(let [%var (Array.unsafe-nth %xsym %i)]
|
||||
%expr)))))
|
||||
|
||||
(defmacro foreach [binding expr]
|
||||
(if (array? binding)
|
||||
|
@ -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)
|
||||
'times []]
|
||||
(list 'do
|
||||
(list 'for ['i 0 n]
|
||||
(list 'let ['before-once (Bench.get-time-elapsed)]
|
||||
(list 'do
|
||||
form
|
||||
(list 'set! × (Array.push-back (Array.copy ×) (Double.- (Bench.get-time-elapsed) before-once))))))
|
||||
(list 'let ['total (Double.- (Bench.get-time-elapsed) before)
|
||||
'per (list 'Double./ 'total (list 'Double.from-int n))]
|
||||
`(let [before (Bench.get-time-elapsed)
|
||||
times []]
|
||||
(do
|
||||
(for [i 0 %n]
|
||||
(let [before-once (Bench.get-time-elapsed)]
|
||||
(do
|
||||
%form
|
||||
(set! × (Array.push-back (Array.copy ×) (Double.- (Bench.get-time-elapsed) before-once))))))
|
||||
(let [total (Double.- (Bench.get-time-elapsed) before)
|
||||
per (Double./ total (Double.from-int %n))]
|
||||
(do
|
||||
(Bench.print "Total time elapsed: " total)
|
||||
(Bench.print "Time elapsed per run (average): " per)
|
||||
|
@ -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")
|
||||
|
@ -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
|
||||
'(Debug.log-memory-balance! true)
|
||||
form
|
||||
'(Debug.log-memory-balance! false)))
|
||||
`(do
|
||||
(Debug.log-memory-balance! true)
|
||||
%form
|
||||
(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)]
|
||||
(list 'do
|
||||
(list 'let []
|
||||
form)
|
||||
'(if (= balance (Debug.memory-balance))
|
||||
()
|
||||
(do (IO.println &(fmt "Invalid memory balance: %d" (Debug.memory-balance)))
|
||||
(System.exit 1)))
|
||||
())))
|
||||
`(let [balance (Debug.memory-balance)]
|
||||
(do
|
||||
(let [] %form)
|
||||
(unless (= balance (Debug.memory-balance))
|
||||
(do
|
||||
(IO.println &(fmt "Invalid memory balance: %d" (Debug.memory-balance)))
|
||||
(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
|
||||
(list 'ref
|
||||
(list 'fmt "%s:%d:%d: %s"
|
||||
(eval (list 'file x))
|
||||
(eval (list 'line x))
|
||||
(eval (list 'column x))
|
||||
(list 'ref (list 'str sym)))))
|
||||
sym)
|
||||
(IO.println
|
||||
(ref
|
||||
(fmt "%s:%d:%d: %s"
|
||||
%(eval `(file %x))
|
||||
%(eval `(line %x))
|
||||
%(eval `(column %x))
|
||||
&(str %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)
|
||||
()
|
||||
(list 'do
|
||||
(list 'println* (list 'fmt "Assertion '%s' failed at line %d, column %d in file %s" (str expr) (line) (column) (file)))
|
||||
'(System.abort))))
|
||||
`(unless (= true %expr)
|
||||
(do
|
||||
(println* (fmt "Assertion '%s' failed at line %d, column %d in file %s" %(str expr) %(line) %(column) %(file)))
|
||||
(System.abort))))
|
||||
|
@ -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
|
||||
(list 'String.append
|
||||
`(ref
|
||||
(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,12 +30,12 @@
|
||||
(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
|
||||
(list 'String.append
|
||||
(list 'ref (list 'format slice (car args)))
|
||||
(fmt-internal (String.slice s (+ (inc idx) next) len)
|
||||
`(ref
|
||||
(String.append
|
||||
(ref (format %slice %(car args)))
|
||||
%(fmt-internal (String.slice s (+ (inc idx) next) len)
|
||||
(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).")
|
||||
|
@ -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)))
|
||||
|
@ -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).
|
||||
|
@ -20,11 +20,11 @@
|
||||
(let [xsym (gensym-with 'xs)
|
||||
len (gensym-with 'len)
|
||||
i (gensym-with 'i)]
|
||||
(list 'let [xsym xs
|
||||
len (list 'StaticArray.length xsym)]
|
||||
(list 'for [i 0 len]
|
||||
(list 'let [var (list 'StaticArray.unsafe-nth xsym i)]
|
||||
expr)))))
|
||||
`(let [%xsym %xs
|
||||
%len (StaticArray.length %xsym)]
|
||||
(for [%i 0 %len]
|
||||
(let [%var (StaticArray.unsafe-nth %xsym %i)]
|
||||
%expr)))))
|
||||
|
||||
(defmacro foreach [binding expr]
|
||||
(StaticArray.foreach-internal (car binding) (cadr binding) expr))
|
||||
|
@ -479,10 +479,10 @@
|
||||
|
||||
(defndynamic build-str* [forms]
|
||||
(if (= (length forms) 0)
|
||||
(list "")
|
||||
'("")
|
||||
(if (= (length forms) 1)
|
||||
(list 'ref (list 'str (car forms)))
|
||||
(list 'ref (list 'String.append (list 'ref (list 'str (car forms))) (build-str* (cdr forms)))))))
|
||||
`&(str %(car forms))
|
||||
`&(String.append &(str %(car forms)) %(build-str* (cdr forms))))))
|
||||
|
||||
(defmacro str* [:rest forms]
|
||||
(list 'copy (build-str* forms)))
|
||||
`(copy %(build-str* forms)))
|
||||
|
@ -137,26 +137,26 @@
|
||||
|
||||
(defndynamic with-test-internal [name forms]
|
||||
(if (= (length forms) 1)
|
||||
(list (list 'set! name (list 'ref (car forms))))
|
||||
(cons (list 'set! name (list 'ref (car forms)))
|
||||
`((set! %name &%(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
|
||||
`@(Test.State.failed %name)
|
||||
(cons-last
|
||||
(list 'Int.copy (list 'Test.State.failed name))
|
||||
(cons-last
|
||||
(list 'Test.print-test-results name)
|
||||
(cons 'do (with-test-internal name forms))))
|
||||
`(Test.print-test-results %name)
|
||||
`(do %@(with-test-internal name forms))))
|
||||
))
|
||||
|
||||
(defmacro deftest [name :rest forms]
|
||||
(eval
|
||||
(list 'defn 'main (array)
|
||||
(list 'let (array name '&(Test.State.init 0 0))
|
||||
`(defn main []
|
||||
(let [%name &(Test.State.init 0 0)]
|
||||
%(cons-last
|
||||
`@(Test.State.failed %name)
|
||||
(cons-last
|
||||
(list 'Int.copy (list 'Test.State.failed name))
|
||||
(cons-last
|
||||
(list 'Test.print-test-results name)
|
||||
(cons 'do (with-test-internal name forms))))))))
|
||||
`(Test.print-test-results %name)
|
||||
`(do %@(with-test-internal name forms))))))))
|
||||
|
@ -2,8 +2,8 @@
|
||||
(private deftuple-type-)
|
||||
(hidden deftuple-type-)
|
||||
(defndynamic deftuple-type- [name props]
|
||||
(list 'deftype (cons name props)
|
||||
(collect-into (flatten (map (fn [x] (list x x)) props)) array)))
|
||||
`(deftype (%name %@props)
|
||||
%(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))
|
||||
(list 'if (list '= (list fst 't1) (list fst 't2))
|
||||
(deftuple-lt- name (cdr props))
|
||||
(list '< (list fst 't1) (list fst 't2)))))))
|
||||
`(< (%fst t1) (%fst t2))
|
||||
`(if (= (%fst t1) (%fst t2))
|
||||
%(deftuple-lt- name (cdr props))
|
||||
(< (%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
|
||||
(list 'defmodule module-name
|
||||
(list 'defn '= ['t1 't2]
|
||||
(cons 'and*
|
||||
(map (fn [p]
|
||||
(list '=
|
||||
(list (Symbol.prefix name p) 't1)
|
||||
(list (Symbol.prefix name p) 't2)))
|
||||
props)))
|
||||
(list 'implements '= (Symbol.prefix module-name '=))
|
||||
`(do
|
||||
(defmodule %module-name
|
||||
(defn < [t1 t2] %(deftuple-lt- name props))
|
||||
(implements < %(Symbol.prefix module-name '<))
|
||||
|
||||
(list 'defn '< ['t1 't2] (deftuple-lt- name props))
|
||||
(list 'implements '< (Symbol.prefix module-name '<))
|
||||
(defn > [t1 t2] (%(Symbol.prefix module-name '<) t2 t1))
|
||||
(implements > %(Symbol.prefix module-name '>)))
|
||||
|
||||
(list 'defn '> ['t1 't2] (list (Symbol.prefix module-name '<) 't2 't1))
|
||||
(list 'implements '> (Symbol.prefix module-name '>)))
|
||||
(defmodule %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
|
||||
(list 'doc 'init-from-refs
|
||||
(String.concat ["initializes a `" sname "` from member references."]))
|
||||
(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))))
|
||||
(defn < [t1 t2]
|
||||
(%(Symbol.prefix module-name '<) &t1 &t2))
|
||||
(implements < %(Symbol.prefix name '<))
|
||||
|
||||
(list 'defn '= ['t1 't2]
|
||||
(cons 'and*
|
||||
(map (fn [p] (list '= (list p '(ref t1)) (list p '(ref t2)))) props)))
|
||||
(list 'implements '= (Symbol.prefix name '=))
|
||||
(defn > [t1 t2]
|
||||
(%(Symbol.prefix module-name '>) &t1 &t2))
|
||||
(implements > %(Symbol.prefix name '>))
|
||||
|
||||
(list 'defn '< ['t1 't2]
|
||||
(list (Symbol.prefix module-name '<) '(ref t1) '(ref t2)))
|
||||
(list 'implements '< (Symbol.prefix name '<))
|
||||
|
||||
(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 reverse
|
||||
%(String.concat ["reverses a `" sname "` by reversing its member positions."]))
|
||||
(defn reverse [t]
|
||||
(init %@(map (fn [x] `(copy (%x t))) (reverse props))))))))
|
||||
|
||||
(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))
|
||||
))
|
||||
)
|
||||
|
Loading…
Reference in New Issue
Block a user