X-Git-Url: https://git.distorted.org.uk/~mdw/fringe/blobdiff_plain/23416a991adb0a708812ab87e9554f7e7fcc3374..HEAD:/cl-fringe.lisp

diff --git a/cl-fringe.lisp b/cl-fringe.lisp
index 0a41838..161240b 100644
--- a/cl-fringe.lisp
+++ b/cl-fringe.lisp
@@ -64,7 +64,7 @@
 		   (t (values nil nil)))))
     (lambda () (recur node nil))))
 
-(defun parse-tree (string)
+(defun parse-tree (string &key (start 0) (end (length string)))
   "Parse STRING, and return the tree described.
 
    The syntax is simple:
@@ -74,23 +74,22 @@
    The ambiguity is resolved by always treating `(' as a tree when a tree is
    expected."
 
-  (let ((len (length string)))
-    (labels ((parse (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)))
-			  (multiple-value-bind (right i) (parse (1+ i))
-			    (unless (and (< i len)
-					 (char= (char string i) #\)))
-			      (error "missing )"))
-			    (values
-			     (make-node :left left :data data :right right)
-			     (1+ i))))))
-		     (t (values nil i)))))
-      (multiple-value-bind (tree i) (parse 0)
-	(unless (= i len) (error "trailing junk"))
-	tree))))
+  (labels ((parse (i)
+	     (cond ((and (< i end) (char= (char string i) #\())
+		    (multiple-value-bind (left i) (parse (1+ i))
+		      (unless (< i end) (error "no data"))
+		      (let ((data (char string i)))
+			(multiple-value-bind (right i) (parse (1+ i))
+			  (unless (and (< i end)
+				       (char= (char string i) #\)))
+			    (error "missing )"))
+			  (values
+			   (make-node :left left :data data :right right)
+			   (1+ i))))))
+		   (t (values nil i)))))
+    (multiple-value-bind (tree i) (parse start)
+      (unless (= i end) (error "trailing junk"))
+      tree)))
 
 ;;;--------------------------------------------------------------------------
 ;;; Main program.
@@ -120,11 +119,10 @@
     0))
 
 #+cl-launch
-(defun launch ()
-  (cl-launch:quit (main (or (cl-launch:getenv "CL_LAUNCH_FILE")
-			    (namestring *load-pathname*)
-			    "<unknown>")
-			cl-launch:*arguments*)))
+(cl-launch:quit (main (pathname-name (or (cl-launch:getenv "CL_LAUNCH_FILE")
+					 *load-pathname*
+					 "<unknown>"))
+		      cl-launch:*arguments*))
 
 #+(and (not cl-launch) ecl)
 (ext:quit (main (ext:argv 0)