lib: remove extra stuff from arc.arc

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