diff --git a/lib/arc.arc b/lib/arc.arc index c738647..883c0bd 100644 --- a/lib/arc.arc +++ b/lib/arc.arc @@ -8,7 +8,7 @@ ; add sigs of ops defined in ac.scm ; get hold of error types within arc ; does macex have to be defined in scheme instead of using def below? -; write disp, read, write in arc +; write pr, read, write in arc ; could I get all of macros up into arc.arc? ; warn when shadow a global name ; some simple regexp/parsing plan @@ -63,11 +63,6 @@ (cons (f (car xs) (cadr xs)) (pair (cddr xs) f)))) -(assign mac (annotate 'mac - (fn (name parms . body) - `(do (sref sig ',parms ',name) - (safeset ,name (annotate 'mac (fn ,parms ,@body))))))) - (mac and args (if args (if (cdr args) @@ -182,12 +177,6 @@ (mac unless (test . body) `(if (no ,test) (do ,@body))) -(mac while (test . body) - (w/uniq (gf gp) - `((rfn ,gf (,gp) - (when ,gp ,@body (,gf ,test))) - ,test))) - (def empty (seq) (or (no seq) (and (or (is (type seq) 'string) (is (type seq) 'table)) @@ -292,9 +281,9 @@ (and (acons x) (is (car x) val))) (def warn (msg . args) - (disp (+ "Warning: " msg ". ")) - (map [do (write _) (disp " ")] args) - (disp #\newline)) + (pr "Warning: " msg ". ") + (map [do (pr _) (pr " ")] args) + (prn ")) (mac atomic body `(atomic-invoke (fn () ,@body))) @@ -308,125 +297,6 @@ (mac atwiths args `(atomic (withs ,@args))) - -; setforms returns (vars get set) for a place based on car of an expr -; vars is a list of gensyms alternating with expressions whose vals they -; should be bound to, suitable for use as first arg to withs -; get is an expression returning the current value in the place -; set is an expression representing a function of one argument -; that stores a new value in the place - -; A bit gross that it works based on the *name* in the car, but maybe -; wrong to worry. Macros live in expression land. - -; seems meaningful to e.g. (push 1 (pop x)) if (car x) is a cons. -; can't in cl though. could I define a setter for push or pop? - -(assign setter (table)) - -(mac defset (name parms . body) - (w/uniq gexpr - `(sref setter - (fn (,gexpr) - (let ,parms (cdr ,gexpr) - ,@body)) - ',name))) - -(defset car (x) - (w/uniq g - (list (list g x) - `(car ,g) - `(fn (val) (scar ,g val))))) - -(defset cdr (x) - (w/uniq g - (list (list g x) - `(cdr ,g) - `(fn (val) (scdr ,g val))))) - -(defset caar (x) - (w/uniq g - (list (list g x) - `(caar ,g) - `(fn (val) (scar (car ,g) val))))) - -(defset cadr (x) - (w/uniq g - (list (list g x) - `(cadr ,g) - `(fn (val) (scar (cdr ,g) val))))) - -(defset cddr (x) - (w/uniq g - (list (list g x) - `(cddr ,g) - `(fn (val) (scdr (cdr ,g) val))))) - -; Note: if expr0 macroexpands into any expression whose car doesn't -; have a setter, setforms assumes it's a data structure in functional -; position. Such bugs will be seen only when the code is executed, when -; sref complains it can't set a reference to a function. - -(def setforms (expr0) - (let expr (macex expr0) - (if (isa expr 'sym) - (if (ssyntax expr) - (setforms (ssexpand expr)) - (w/uniq (g h) - (list (list g expr) - g - `(fn (,h) (assign ,expr ,h))))) - ; make it also work for uncompressed calls to compose - (and (acons expr) (metafn (car expr))) - (setforms (expand-metafn-call (ssexpand (car expr)) (cdr expr))) - (and (acons expr) (acons (car expr)) (is (caar expr) 'get)) - (setforms (list (cadr expr) (cadr (car expr)))) - (let f (setter (car expr)) - (if f - (f expr) - ; assumed to be data structure in fn position - (do (when (caris (car expr) 'fn) - (warn "Inverting what looks like a function call" - expr0 expr)) - (w/uniq (g h) - (let argsyms (map [uniq] (cdr expr)) - (list (+ (list g (car expr)) - (mappend list argsyms (cdr expr))) - `(,g ,@argsyms) - `(fn (,h) (sref ,g ,h ,(car argsyms)))))))))))) - -(def metafn (x) - (or (ssyntax x) - (and (acons x) (in (car x) 'compose 'complement)))) - -(def expand-metafn-call (f args) - (if (is (car f) 'compose) - ((afn (fs) - (if (caris (car fs) 'compose) ; nested compose - (self (join (cdr (car fs)) (cdr fs))) - (cdr fs) - (list (car fs) (self (cdr fs))) - (cons (car fs) args))) - (cdr f)) - (is (car f) 'no) - (err "Can't invert " (cons f args)) - (cons f args))) - -(def expand= (place val) - (if (and (isa place 'sym) (~ssyntax place)) - `(assign ,place ,val) - (let (vars prev setter) (setforms place) - (w/uniq g - `(atwith ,(+ vars (list g val)) - (,setter ,g)))))) - -(def expand=list (terms) - `(do ,@(map (fn ((p v)) (expand= p v)) ; [apply expand= _] - (pair terms)))) - -(mac = args - (expand=list args)) - (mac loop (start test update . body) (w/uniq (gfn gparm) `(do ,start @@ -488,9 +358,9 @@ ,test))) (def last (xs) - (if (cdr xs) - (last (cdr xs)) - (car xs))) + (if (= (cdr xs) nil) + (car xs) + (last (cdr xs)))) (def rem (test seq) (let f (testify test) @@ -635,12 +505,8 @@ ; as lists of chars annotated with 'string, and modify car and cdr to get ; the rep of these. That would also require hacking the reader. -(def pr args - (map1 disp args) - (car args)) - (def prt args - (map1 [if _ (disp _)] args) + (map1 [if _ (pr _)] args) (car args)) (def prn args