X-Git-Url: https://git.distorted.org.uk/~mdw/fringe/blobdiff_plain/a72b6978928e45212ef174643d4408f3f7cbfe51..d87584d71b1c587112f039ab69a5af8b083b18be:/cl-fringe.lisp

diff --git a/cl-fringe.lisp b/cl-fringe.lisp
index 7386c38..5af3cc7 100644
--- a/cl-fringe.lisp
+++ b/cl-fringe.lisp
@@ -10,14 +10,27 @@
 ;; new iterator function to produce the remaining items; if there are no more
 ;; items, then it returns NIL twice.
 
+(defun reduce-iterator (func init iter)
+  "Invoke FUNC on the elements of ITER.
+
+   We maintain a STATE whose value initially is INIT; for each ITEM, we
+   update the state with the value of (funcall FUNC ITEM STATE); the end
+   result is the final state."
+  (let ((state init) item)
+    (loop
+      (setf (values item iter) (funcall iter))
+      (unless iter (return state))
+      (setf state (funcall func item state)))))
+
 (defun list-iterator (iter)
   "Collect the items from ITER into a list and return it."
-  (labels ((recur (iter list)
-	     (multiple-value-bind (data iter) (funcall iter)
-	       (if iter
-		   (recur iter (cons data list))
-		   (nreverse list)))))
-    (recur iter nil)))
+  (nreverse (reduce-iterator #'cons nil iter)))
+
+(defun iterate-list (list)
+  "Return an iterator for LIST, according to our iteration protocol."
+  (if (endp list)
+      (lambda () (values nil nil))
+      (lambda () (values (car list) (iterate-list (cdr list))))))
 
 (defun same-iterators-p (iter-a iter-b &key (test #'eql))
   "Return whether ITER-A and ITER-B produce the same items."
@@ -63,9 +76,7 @@
 
   (let ((len (length string)))
     (labels ((parse (i)
-	       (cond ((>= i len)
-		      (values nil i))
-		     ((char= (char string i) #\()
+	       (cond ((and (< i len) (char= (char string i) #\())
 		      (multiple-value-bind (left i) (parse (1+ i))
 			(unless (< i len) (error "no data"))
 			(let ((data (char string i)))
@@ -95,17 +106,21 @@
 				       (iterate-fringe (parse-tree b))))))))
 
 #+cl-launch
-(defun launch ()
-  (flet ((bail (format args)
-	   (format *error-output* "~A: ~?~%"
-		   (cl-launch:getenv "CL_LAUNCH_FILE") format args)
-	   (cl-launch:quit 1)))
-    (handler-case
-	(main cl-launch:*arguments*)
-      (simple-error (err)
-	(bail (simple-condition-format-control err)
-	      (simple-condition-format-arguments err)))
-      (error (err)
-	(bail "~A" err)))))
+(progn
+  (defparameter *program-name*
+    (pathname-name (or (cl-launch:getenv "CL_LAUNCH_FILE")
+		       (namestring *load-pathname*)
+		       "<unknown>")))
+  (defun launch ()
+    (flet ((bail (format args)
+	     (format *error-output* "~A: ~?~%" *program-name* format args)
+	     (cl-launch:quit 1)))
+      (handler-case
+	  (main cl-launch:*arguments*)
+	(simple-error (err)
+	  (bail (simple-condition-format-control err)
+		(simple-condition-format-arguments err)))
+	(error (err)
+	  (bail "~A" err))))))
 
 ;;;----- That's all, folks --------------------------------------------------