Hacked the system to use the new LET-OPT optional argument machinery,

LET-OPTIONAL, LET-OPTIONAL*, and :OPTIONAL. The new macros are
faster and easier to read than the old PARSE-OPTIONALS and OPTIONAL-ARG
procedures.

scsh/filesys.scm

@@ -82,7 +82,7 @@
   (create-file-thing new-fname
 		     (lambda (new-fname)
 		       (create-hard-link/errno old-fname new-fname))
-		     (optional-arg maybe-override? #f)
+		     (:optional maybe-override? #f)
 		     "create-hard-link"
 		     create-hard-link))
 
@@ -90,7 +90,7 @@
   (create-file-thing new-fname
 		     (lambda (symlink)
 		       (create-symlink/errno old-fname symlink))
-		     (optional-arg maybe-override? #f)
+		     (:optional maybe-override? #f)
 		     "create-symlink"
 		     create-symlink))
 
@@ -103,7 +103,7 @@
 ;;; us not to. That's life in the food chain.
 
 (define (rename-file old-fname new-fname . maybe-override?)
-  (let ((override? (optional-arg maybe-override? #f)))
+  (let ((override? (:optional maybe-override? #f)))
     (if (or (and override? (not (eq? override? 'query)))
 	    (file-not-exists? new-fname)
 	    (and override?

scsh/flock.scm

@@ -67,7 +67,7 @@
 (define set-lock-region:pid        set-%lock-region:pid)
 
 (define (make-lock-region exclusive? start len . maybe-whence)
-  (let ((whence (optional-arg maybe-whence seek/set)))
+  (let ((whence (:optional maybe-whence seek/set)))
     (make-%lock-region exclusive? start len whence 0)))
 
 

scsh/fname.scm

@@ -98,7 +98,7 @@
 
 
 (define (path-list->file-name pathlist . maybe-dir)
-  (let ((root (ensure-file-name-is-nondirectory (optional-arg maybe-dir ".")))
+  (let ((root (ensure-file-name-is-nondirectory (:optional maybe-dir ".")))
 	;; Insert slashes *between* elts of PATHLIST.
 	(w/slashes (if (pair? pathlist)
 		       (let insert-slashes ((pathlist pathlist))
@@ -162,7 +162,7 @@
 	fname)))
 
 (define (resolve-file-name fname . maybe-root)
-  (let* ((root (ensure-file-name-is-nondirectory (optional-arg maybe-root ".")))
+  (let* ((root (ensure-file-name-is-nondirectory (:optional maybe-root ".")))
 	 (fname (ensure-file-name-is-nondirectory fname))
 	 (len (string-length fname)))
     (if (zero? len) "/"

scsh/jcontrol2.scm

@@ -141,7 +141,7 @@
 ;;; Except no MASK for now.
 
 (define (%set-interrupt-handler interrupt handler . args)
-  (receive (flags) (parse-optionals args 0)
+  (let-optionals args ((flags 0))
     (receive (err handler flags)
   	     (%%set-interrupt-handler interrupt handler flags)
       (if err

scsh/network.scm

@@ -143,8 +143,7 @@
 ;;; socket syscall
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 (define (create-socket pf type . maybe-protocol)
-  (receive (protocol)
+  (let ((protocol (:optional maybe-protocol 0)))
-	   (parse-optionals maybe-protocol 0)
     (if (not (and (integer? pf)
 		  (integer? type)
 		  (integer? protocol)))
@@ -366,8 +365,7 @@
 ;;; recv syscall
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 (define (receive-message socket len . maybe-flags) 
-  (receive (flags)
+  (let ((flags (:optional maybe-flags 0)))
-	   (parse-optionals maybe-flags 0)
     (cond ((not (socket? socket))
 	   (error "receive-message: socket expected ~s" socket))
 	  ((or (not (integer? flags))
@@ -383,23 +381,22 @@
 		      (else (substring s 0 nread)))
 		from)))))))
 
-(define (receive-message! socket s . maybe-args)
+(define (receive-message! socket s . args)
   (if (not (string? s))
       (error "receive-message!: string expected ~s" s)
-      (receive (start end flags)
+      (let-optionals args ((start 0) (end (string-length s)) (flags 0))
-	       (parse-optionals maybe-args 0 (string-length s) 0)
+        (cond ((not (socket? socket))
-	       (cond ((not (socket? socket))
+	       (error "receive-message!: socket expected ~s" socket))
-		      (error "receive-message!: socket expected ~s" socket))
+	      ((not (or (integer? flags)
-		     ((not (or (integer? flags)
+			(integer? start)
-			       (integer? start)
+			(integer? end)))
-			       (integer? end)))
+	       (error "receive-message!: integer expected ~s ~s ~s"
-		      (error "receive-message!: integer expected ~s ~s ~s"
+		      flags start end))
-			     flags start end))
+	      (else 
-		     (else 
+	       (generic-receive-message! (socket->fdes socket) flags
-		      (generic-receive-message! (socket->fdes socket) flags
+					 s start end 
-						s start end 
+					 recv-substring!/errno
-						recv-substring!/errno
+					 (socket:family socket)))))))
-						(socket:family socket)))))))
 
 (define (generic-receive-message! sockfd flags s start end reader from)
   (if (bogus-substring-spec? s start end)
@@ -424,8 +421,7 @@
 		   (else (loop (+ i nread)))))))))
 
 (define (receive-message/partial socket len . maybe-flags)
-  (receive (flags)
+  (let ((flags (:optional maybe-flags 0)))
-	   (parse-optionals maybe-flags 0)
     (cond ((not (socket? socket))
 	   (error "receive-message/partial: socket expected ~s" socket))
 	  ((or (not (integer? flags))
@@ -441,23 +437,22 @@
 			     (else (substring s 0 nread)))
 		       addr)))))))
 
-(define (receive-message!/partial socket s . maybe-args)
+(define (receive-message!/partial socket s . args)
   (if (not (string? s))
       (error "receive-message!/partial: string expected ~s" s)
-      (receive (start end flags)
+      (let-optionals args ((start 0) (end (string-length s)) (flags 0))
-	       (parse-optionals maybe-args 0 (string-length s) 0)
+        (cond ((not (socket? socket))
-	       (cond ((not (socket? socket))
+	       (error "receive-message!/partial: socket expected ~s"
-		      (error "receive-message!/partial: socket expected ~s"
+		      socket))
-			     socket))
+	      ((not (integer? flags))
-		     ((not (integer? flags))
+	       (error "receive-message!/partial: integer expected ~s"
-		      (error "receive-message!/partial: integer expected ~s"
+		      flags))
-			     flags))
+	      (else 
-		     (else 
+	       (generic-receive-message!/partial (socket->fdes socket)
-		      (generic-receive-message!/partial (socket->fdes socket)
+						 flags 
-							flags 
+						 s start end
-							s start end
+						 recv-substring!/errno
-							recv-substring!/errno
+						 (socket:family socket)))))))
-							(socket:family socket)))))))
 
 (define (generic-receive-message!/partial sockfd flags s start end reader from)
   (if (bogus-substring-spec? s start end)
@@ -493,10 +488,8 @@
 ;;; send syscall
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 
-(define (send-message socket s . maybe-args)
+(define (send-message socket s . args)
-  (receive (start end flags addr)
+  (let-optionals args ((start 0) (end (string-length s)) (flags 0) (addr #f))
-	   (parse-optionals maybe-args
-			    0 (string-length s) 0 #f)
     (cond ((not (socket? socket))
 	   (error "send-message: socket expected ~s" socket))
 	  ((not (integer? flags))
@@ -527,10 +520,8 @@
 				      s start i end writer)))
 		 (loop (+ i nwritten))))))))
 
-(define (send-message/partial socket s . maybe-args)
+(define (send-message/partial socket s . args)
-  (receive (start end flags addr)
+  (let-optionals args ((start 0) (end (string-length s)) (flags 0) (addr #f))
-	   (parse-optionals maybe-args
-			    0 (string-length s) 0 #f)
     (cond ((not (socket? socket))
 	   (error "send-message/partial: socket expected ~s" socket))
 	  ((not (integer? flags))
@@ -837,13 +828,13 @@
   protocol)				; Protocol name
 
 (define (service-info . args)
-  (cond ((string? (car args))  (apply name->service-info args))
+  (apply (cond ((string?  (car args)) name->service-info)
-	((integer? (car args)) (apply port->service-info args))
+	       ((integer? (car args)) port->service-info)
-	(else (error "service-info: string or integer expected ~s" args))))
+	       (else (error "service-info: string or integer expected ~s" args)))
+	 args))
 
 (define (port->service-info name . maybe-proto)
-  (receive (proto)
+  (let ((proto (:optional maybe-proto "")))
-	   (parse-optionals maybe-proto "")
     (cond ((not (integer? name))
 	   (error "port->service-info: integer expected ~s" name))
 	  ((not (string? proto))
@@ -851,11 +842,10 @@
 	  (else
 	   (receive (result name aliases port protocol)
 		    (%service-port->service-info name proto)
-		    (make-service-info name 
+	     (make-service-info name 
-				       (vector->list
+				(vector->list (C-string-vec->Scheme aliases #f))
-					(C-string-vec->Scheme aliases #f))
+				port
-				       port
+				protocol))))))
-				       protocol))))))
 		  
 (define-foreign %service-port->service-info
   (scheme_serv_port2serv_info (integer name) (string  proto))
@@ -867,18 +857,10 @@
   
   
 (define (name->service-info name . maybe-proto)
-  (receive (proto)
+  (receive (result name aliases port protocol)
-	   (parse-optionals maybe-proto "")
+      (%service-name->service-info name (:optional maybe-proto ""))
-    (if (or (not (string? name))
+    (make-service-info name (vector->list (C-string-vec->Scheme aliases #f))
-	    (not (string? name)))
+		       port protocol)))
-	(error "name->service-info: string expected ~s" name)
-	(receive (result name aliases port protocol)
-		 (%service-name->service-info name proto)
-	   (make-service-info name
-			      (vector->list
-			       (C-string-vec->Scheme aliases #f))
-			      port
-			      protocol)))))
 		  
 (define-foreign %service-name->service-info
   (scheme_serv_name2serv_info (string name) (string proto))

scsh/newports.scm

@@ -135,7 +135,7 @@
     port))
 
 (define (open-input-file fname . maybe-flags)
-  (let ((flags (optional-arg maybe-flags 0)))
+  (let ((flags (:optional maybe-flags 0)))
     (open-file fname (deposit-bit-field flags open/access-mask open/read))))
 
 (define (open-output-file fname . rest)
@@ -291,7 +291,7 @@
 (define-simple-syntax
   (define-r4rs-input (name arg ...) stream s48name body ...)
   (define (name arg ... . maybe-i/o)
-    (let ((stream (optional-arg maybe-i/o (current-input-port))))
+    (let ((stream (:optional maybe-i/o (current-input-port))))
       (cond ((input-port? stream) (s48name arg ... stream))
 	    ((integer? stream) body ...)
 	    (else (error "Not a port or file descriptor" stream))))))
@@ -313,7 +313,7 @@
 (define-simple-syntax
   (define-r4rs-output (name arg ...) stream s48name body ...)
   (define (name arg ... . maybe-i/o)
-    (let ((stream (optional-arg maybe-i/o (current-output-port))))
+    (let ((stream (:optional maybe-i/o (current-output-port))))
       (cond ((output-port? stream) (s48name arg ... stream))
 	    ((integer? stream) body ...)
 	    (else (error "Not a port or file descriptor" stream))))))

scsh/procobj.scm

@@ -35,7 +35,7 @@
 	     #f)))
 
 (define (pid->proc pid . maybe-probe?)
-  (let ((probe? (optional-arg maybe-probe? #f)))
+  (let ((probe? (:optional maybe-probe? #f)))
     (or (maybe-pid->proc pid)
 	(case probe?
 	  ((#f)     (error "Pid has no corresponding process object" pid))
@@ -155,7 +155,7 @@
 
 (define (wait pid/proc . maybe-flags)
   (if (not *autoreap-policy*) (reap-zombies))
-  (let ((flags (check-arg integer? (optional-arg maybe-flags 0) wait))
+  (let ((flags (:optional maybe-flags 0))
 	(proc (->proc pid/proc)))
     (cond ((proc:%status proc) =>	; Already reaped.
 	   (lambda (status)
@@ -176,17 +176,16 @@
 ;;; (wait-any [flags]) -> [proc status]
 
 (define (wait-any . maybe-flags)
-  (let ((flags (check-arg integer? (optional-arg maybe-flags 0) wait-any)))
+  (if (not *autoreap-policy*) (reap-zombies))
-    (if (not *autoreap-policy*) (reap-zombies))
+  (cond ((get-reaped-proc!) =>			; Check internal table.
-    (cond ((get-reaped-proc!) =>			; Check internal table.
+	 (lambda (proc) (values proc (proc:%status proc))))	; Hit.
-	   (lambda (proc) (values proc (proc:%status proc))))	; Hit.
+	(else
-	  (else
+	 (receive (pid status) (%wait-any (:optional maybe-flags 0)) ; Wait.
-	   (receive (pid status) (%wait-any flags) ; Really wait.
+	   (if pid
-	     (if pid
+	       (let ((proc (pid->proc pid)))
-		 (let ((proc (pid->proc pid)))
+		 (cache-wait-status proc status)
-		   (cache-wait-status proc status)
+		 (values proc status))
-		   (values proc status))
+	       (values pid status))))))	; pid = #f -- Empty poll.
-		 (values pid status)))))))	; pid = #f -- Empty poll.
 
 
 ;;; (wait-process-group [proc-group flags])
@@ -195,8 +194,7 @@
 ;;; early autoreaping, since the reaper loses process-group information.
 
 (define (wait-process-group . args)
-  (receive (proc-group flags) (parse-optionals args 0 0)
+  (let-optionals args ((proc-group 0) (flags 0))
-    (check-arg integer? flags wait-process-group)
     (if (not *autoreap-policy*) (reap-zombies))
     (let ((proc-group (cond ((integer? proc-group) proc-group)
 			     ((proc? proc-group)    (proc:pid proc-group))

scsh/re.scm

@@ -16,14 +16,14 @@
 
 (define (match:start match . maybe-index)
   (vector-ref (regexp-match:start match)
-	      (optional-arg maybe-index 0)))
+	      (:optional maybe-index 0)))
 
 (define (match:end match . maybe-index)
   (vector-ref (regexp-match:end match)
-	      (optional-arg maybe-index 0)))
+	      (:optional maybe-index 0)))
 
 (define (match:substring match . maybe-index)
-  (let ((i (optional-arg maybe-index 0)))
+  (let ((i (:optional maybe-index 0)))
     (substring (regexp-match:string match)
 	       (match:start match i)
 	       (match:end match i))))
@@ -38,7 +38,7 @@
 (define (make-regexp str) str)
 
 (define (regexp-exec regexp str . maybe-start)
-  (let ((start (optional-arg maybe-start 0))
+  (let ((start (:optional maybe-start 0))
 	(start-vec (make-vector 10))
 	(end-vec (make-vector 10)))
     (and (%regexp-match regexp str start start-vec end-vec)

scsh/rw.scm

@@ -27,10 +27,10 @@
 				   s start start end source)))
 	      (and (not (zero? nread)) nread))))))
 
-(define (read-string!/partial s . maybe-args)
+(define (read-string!/partial s . args)
-  (receive (fd/port start end)
+  (let-optionals args ((fd/port (current-input-port))
-	   (parse-optionals maybe-args
+		       (start   0)
-			    (current-input-port) 0 (string-length s))
+		       (end     (string-length s)))
     (cond ((integer? fd/port)
 	   (generic-read-string!/partial s start end
 					 read-fdes-substring!/errno fd/port))
@@ -61,7 +61,7 @@
 
 (define (read-string/partial len . maybe-fd/port) 
   (let* ((s (make-string len))
-	 (fd/port (optional-arg maybe-fd/port (current-input-port)))
+	 (fd/port (:optional maybe-fd/port (current-input-port)))
 	 (nread (read-string!/partial s fd/port 0 len)))
     (cond ((not nread) #f) ; EOF
 	  ((= nread len) s)
@@ -89,10 +89,10 @@
 
 		(else (loop (+ i nread))))))))
 
-(define (read-string! s . maybe-args)
+(define (read-string! s . args)
-  (receive (fd/port start end)
+  (let-optionals args ((fd/port (current-input-port))
-	   (parse-optionals maybe-args
+		       (start   0)
-			    (current-input-port) 0 (string-length s))
+		       (end     (string-length s)))
     (cond ((integer? fd/port)
 	   (generic-read-string! s start end
 				 read-fdes-substring!/errno fd/port))
@@ -114,7 +114,7 @@
 
 (define (read-string len . maybe-fd/port) 
   (let* ((s (make-string len))
-	 (fd/port (optional-arg maybe-fd/port (current-input-port)))
+	 (fd/port (:optional maybe-fd/port (current-input-port)))
 	 (nread (read-string! s fd/port 0 len)))
     (cond ((not nread) #f) ; EOF
 	  ((= nread len) s)
@@ -140,10 +140,10 @@
 				   s start start end target)))
 	      nwritten)))))
 
-(define (write-string/partial s . maybe-args)
+(define (write-string/partial s . args)
-  (receive (fd/port start end)
+  (let-optionals args ((fd/port (current-output-port))
-	   (parse-optionals maybe-args
+		       (start 0)
-			    (current-output-port) 0 (string-length s))
+		       (end (string-length s)))
     (cond ((integer? fd/port)
 	   (generic-write-string/partial s start end
 					 write-fdes-substring/errno fd/port))
@@ -171,10 +171,10 @@
 				   s start i end target)))
 	      (loop (+ i nwritten)))))))
 
-(define (write-string s . maybe-args)
+(define (write-string s . args)
-  (receive (fd/port start end)
+  (let-optionals args ((fd/port (current-output-port))
-	   (parse-optionals maybe-args
+		       (start   0)
-			    (current-output-port) 0 (string-length s))
+		       (end     (string-length s)))
     (cond ((integer? fd/port)
 	   (generic-write-string s start end
 				 write-fdes-substring/errno fd/port))
@@ -193,8 +193,7 @@
       (cond ((eof-object? line)
 	     (newline)
 	     (if (= count 0)
-		 (optional-arg* maybe-eof-value
+		 (:optional maybe-eof-value (error "EOF in y-or-n?"))
-				(lambda () (error "EOF in y-or-n?")))
 		 (begin (display "I'll only ask another ")
 			(write count)
 			(display " times.")

scsh/scsh-interfaces.scm

@@ -543,7 +543,6 @@
 (define-interface scsh-utilities-interface
   (export del delete index rindex reduce filter first any first? nth
 	  any? every? mapv mapv! vector-every? copy-vector
-	  optional-arg optional-arg* parse-optionals
 	  check-arg conjoin disjoin negate compose reverse! call/cc
 	  deprecated-proc
 	  deposit-bit-field

scsh/scsh-package.scm

@@ -22,12 +22,16 @@
 ;;;     -Olin
 
 
+;;; The LET-OPT package for optional argument parsing & defaulting
+;;; is found in the let-opt.scm file.
+
+
 (define-structure error-package (export error warn)
   (open signals))
 
 
 (define-structure scsh-utilities scsh-utilities-interface
-  (open bitwise error-package scheme)
+  (open bitwise error-package let-opt scheme)
   (files utilities))
 
 
@@ -37,7 +41,7 @@
   (open receiving	; receive
 	error-package
 	syntactic	; generated?
-	scsh-utilities	; check-arg, optional-arg
+	scsh-utilities	; check-arg
 	scheme
 	)
   (files syntax-helpers))
@@ -55,6 +59,7 @@
 	define-foreign-syntax
 	receiving
 	error-package
+	let-opt			; optional-arg parsing & defaulting
 	scheme)
   (files re))
 
@@ -70,6 +75,7 @@
 	scsh-utilities
 	error-package		; error
 	scsh-level-0		; regexes and delimited readers
+	let-opt			; optional-arg parsing & defaulting
 	scheme
 	)
   (files fr))
@@ -175,6 +181,7 @@
 	scsh-version
 	tty-flags
 	scsh-internal-tty-flags	; Not exported
+	let-opt			; optional-arg parsing & defaulting
 	
 	scheme
 	)

scsh/scsh.scm

@@ -302,7 +302,7 @@
 
 
 (define (temp-file-iterate maker . maybe-template)
-  (let ((template (optional-arg maybe-template (fluid *temp-file-template*))))
+  (let ((template (:optional maybe-template (fluid *temp-file-template*))))
     (let loop ((i 0))
       (if (> i 1000) (error "Can't create temp-file")
 	  (let ((fname (format #f template (number->string i))))
@@ -538,7 +538,7 @@
 		   (lp)))))))
 
 (define (string-filter filter . maybe-buflen)
-  (let* ((buflen (optional-arg maybe-buflen 1024))
+  (let* ((buflen (:optional maybe-buflen 1024))
 	 (buf (make-string buflen)))
     (lambda ()
       (let lp ()
@@ -694,7 +694,7 @@
 
 (define (exit . maybe-status)
   (flush-all-ports)
-  (exit/errno (optional-arg  maybe-status 0))
+  (exit/errno (:optional  maybe-status 0))
   (display "The evil undead walk the earth." 2)
   (error "(exit) returned."))
 

scsh/syntax-helpers.scm

@@ -1,7 +1,7 @@
 ;;; Macro expanding procs for scsh.
 ;;; Written for Clinger/Rees explicit renaming macros.
 ;;; Needs name-export and receive-syntax S48 packages.
-;;; Also needs scsh's utilities package (optional-arg & check-arg).
+;;; Also needs scsh's utilities package (for CHECK-ARG).
 ;;; Must be loaded into for-syntax package.
 ;;; Copyright (c) 1993 by Olin Shivers.
 
@@ -145,28 +145,6 @@
     (blockify `(,@redir-chunks ,pf-chunk) rename compare)))
 
 
-
-;;; These two utility funs are for parsing optional last arguments,
-;;; e.g. the PORT arg in
-;;;    (write-string string [port])
-;;;    (define (write-string str . maybe-port) ...).
-
-(define (optional-arg maybe-arg default)
-  (cond ((null? maybe-arg) default)
-	((null? (cdr maybe-arg))  (car maybe-arg))
-	(else (error "too many optional arguments" maybe-arg))))
-
-
-(define (optional-arg* maybe-arg default-thunk)
-  (if (null? maybe-arg) (default-thunk) (car maybe-arg)))
-
-
-(define (check-arg pred val caller)
-  (let lp ((val val))
-    (if (pred val) val
-	(lp (error "Bad argument" val))))) ; Loop doesn't really work.
-
-
 (define (transcribe-redirection redir rename compare)
   (let* ((backq (make-backquoter rename))
 	 (parse-spec (lambda (x default-fdes) ; Parse an ([fdes] arg) form.

scsh/time.scm

@@ -66,7 +66,7 @@
 (define set-date:year-day	set-%date:year-day)
 
 (define (make-date s mi h md mo y . args)
-  (receive (tzn tzs s? wd yd) (parse-optionals args #f #f #f 0 0)
+  (let-optionals args ((tzn #f) (tzs #f) (s?  #f) (wd  0)  (yd  0))
     (make-%date s mi h md mo y tzn tzs s? wd yd)))
 
 
@@ -160,7 +160,7 @@
 		  (real->exact-integer (check-arg real? (car args) date))
 		  (time)))
 	(zone (check-arg time-zone?
-			 (and (pair? args) (optional-arg (cdr args) #f))
+			 (and (pair? args) (:optional (cdr args) #f))
 			 date)))
     (receive (err seconds minute hour month-day month
 		  year tz-name tz-secs summer? week-day year-day)
@@ -222,14 +222,14 @@
 ;		 (real->exact-integer (check-arg real? (car args) utc-offset))
 ;		 (time)))
 ;	(tz (and (pair? args)
-;		 (check-arg time-zone? (optional-arg (cdr args) #f) utc-offset))))
+;		 (check-arg time-zone? (:optional (cdr args) #f) utc-offset))))
 ;    (if (integer? tz) tz
 ;	(- (time (date tim tz) 0) tim))))
 
 
 ;(define (time-zone . args)	; Optional args [summer? tz]
 ;  (let ((tz (and (pair? args)
-;		 (check-arg time-zone? (optional-arg (cdr args) #f) time-zone))))
+;		 (check-arg time-zone? (:optional (cdr args) #f) time-zone))))
 ;    (if (integer? tz)
 ;	(deintegerize-time-zone tz)
 ;	(let* ((summer? (if (pair? args) (car args) (time)))

scsh/tty.scm

@@ -223,7 +223,7 @@
 (define (send-tty-break fdport . maybe-duration)
   (call/fdes fdport
     (lambda (fdes)
-      (%send-tty-break-fdes fdes (optional-arg maybe-duration 0)))))
+      (%send-tty-break-fdes fdes (:optional maybe-duration 0)))))
 
 (define-errno-syscall (%send-tty-break-fdes fdes duration)
   %send-tty-break-fdes/errno)
@@ -344,7 +344,7 @@
 ;;; SunOS, and SVR4.
 
 (define (open-control-tty ttyname . maybe-flags)
-  (let ((flags (optional-arg maybe-flags open/read+write)))
+  (let ((flags (:optional maybe-flags open/read+write)))
     (receive (errno fd) (open-control-tty/errno ttyname flags)
       (if errno
 	  (errno-error errno open-control-tty ttyname flags)

scsh/utilities.scm

@@ -17,7 +17,7 @@
   (filter (lambda (x) (not (pred x))) lis))
 
 (define (index str c . maybe-start)
-  (let ((start (max 0 (optional-arg maybe-start 0)))
+  (let ((start (max 0 (:optional maybe-start 0)))
 	(len (string-length str)))
     (do ((i start (+ 1 i)))
 	((or (>= i len)
@@ -26,7 +26,7 @@
 
 (define (rindex str c . maybe-start)
   (let* ((len (string-length str))
-	 (start (min (optional-arg maybe-start len)
+	 (start (min (:optional maybe-start len)
 		     len)))
     (do ((i (- start 1) (- i 1)))
 	((or (< i 0)
@@ -109,57 +109,6 @@
 	((< i 0) ans)
       (vector-set! ans i (vector-ref v i)))))
 
-;;; These two utility funs are for parsing optional last arguments,
-;;; e.g. the PORT arg in
-;;;    (write-string string [port])
-;;;    (define (write-string str . maybe-port) ...).
-
-(define (optional-arg maybe-arg default)
-  (cond ((null? maybe-arg) default)
-	((null? (cdr maybe-arg))  (car maybe-arg))
-	(else (error "too many optional arguments" maybe-arg))))
-
-
-(define (optional-arg* maybe-arg default-thunk)
-  (if (null? maybe-arg) (default-thunk) (car maybe-arg)))
-
-;;; (PARSE-OPTIONALS arg-list . default-list)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; This function generalises OPTIONAL-ARG to the multi-argument
-;;; case. ARG-LIST is a list of rest args passed to a procedure.
-;;; DEFAULT-LIST are the default values for the procedure.
-;;; We compute a list of values, with the elts of ARG-LIST overriding
-;;; the defaults. It is an error if there are more args than defaults.
-;;; The values are returned as multiple values, suitable for binding
-;;; with RECEIVE.
-;;;
-;;; Example:
-;;; (define (read-string! str . maybe-args)
-;;;   (receive (port start end)
-;;;            (parse-optionals maybe-args
-;;;                             (current-input-port) 0 (string-length str))
-;;;     ...))
-
-(define (parse-optionals arg-list . default-list)
-  (let lp ((arglist arg-list)
-	   (defaults default-list)
-	   (vals '()))
-    (if (pair? defaults)
-	(if (pair? arglist)
-
-	    ;; The supplied arg overrides the default.
-	    (lp (cdr arglist)
-		(cdr defaults)
-		(cons (car arglist) vals))
-
-	    ;; No more args. Use up all the remaining defaults & return.
-	    (apply values (reverse (append (reverse defaults) vals))))
-
-	;; No more defaults. Better not be any more args.
-	(if (null? arglist)
-	    (apply values (reverse vals))
-	    (error "Too many optional arguments" arg-list)))))
-
 (define (check-arg pred val caller)
   (if (pred val) val
       (check-arg pred (error "Bad argument" val pred caller) caller)))