- removed obsolete code

- cleaned up syntax rules
- moved eof-patter to interact.scm

scheme/expect.scm

@@ -96,121 +96,6 @@
   (close (task:in task))
   (close (task:out task)))
 
-;;;; Append info to a buffer without its going over the max size.
-;;;; As data is moved out of the match buffer, it is moved into
-;;;; the pre-match buffer.
-;;;;
-;;;; Ack, this is not too efficient. Need to change this whole style.
-;
-;(define (buf-append task str max-size)
-;    (let* ((buf (task:buf task))
-;	   (buf-size (string-length buf))
-;	   (str-size (string-length str))
-;	   (total-size (+ buf-size str-size)))
-;
-;      (cond ((<= total-size max-size)	; BUF := all of BUF + all of STR.
-;	     (string-append buf str))
-;
-;	    ;; BUF := some of BUF + all of STR.
-;	    ((<= str-size max-size)
-;	     (let ((i (- total-size max-size)))
-;	       (set-task:pre-match! (string-append (task:pre-match task)
-;						  (substring buf 0 i)))
-;	       (string-append (substring buf i buf-size)
-;			      str)))
-;	    
-;	    ;; BUF := some of STR.
-;	    (else (let ((i (- str-size max-size)))
-;		    (set-task:pre-match! (string-append (task:pre-match task)
-;						       buf
-;						       (substring str 0 i)))
-;		    (substring str i str-size))))))
-
-
-;;; We just matched M out of BUFFER. 
-;;; - Put everything in BUFFER *before* the match into (TASK:PRE-MATCH TASK). 
-;;; - Put everything in BUFFER *after* the match into (TASK:BUF TASK).
-
-(define (set-prematch task buffer m)
-  (set-task:pre-match! task (substring buffer 0 (match:start m)))
-  (set-task:buf! task
-		 (substring buffer (match:end m) (string-length buffer))))
-
-
-;;; Slurp in data from port ivec[i] and add it to the task's buffer.
-;;; Return the new data (not the whole buffer).
-;;; If we get EOF instead, set ivec[i] to #f and return false. This is
-;;; really inefficient in space and time -- every time we get a little bit
-;;; of input, we copy and throw away the whole match buffer. Argh.
-
-(define (do-input task)
-  (let* ((port (task:in task))
-
-	 ;; If the read blows up, return #f. This is how tty's indicate 
-	 ;; to pty's they've been closed. Ugh.
-	 (s (with-errno-handler ((e p) ((errno/io) #f))
-	      (read-string/partial 256 port))))
-
-    (and s (let ((newbuf (string-append (task:buf task) s)))
-	     (set-task:buf! task newbuf)
-	     s))))
-
-;;; A (<task> <aclause> ...) task-clause becomes the following chunk of code
-;;; that is executed after the select call on ivec[]. I is the index of
-;;; <task>'s input port in the port vector ivec:
-;;;
-;;; If ivec[i] is non-#f
-;;;   -- Select says there's input available.
-;;;   Get input from task
-;;;   If EOF
-;;;     ivec[i] := #f	(This task is now permanently out of the running.)
-;;;     If there's an ON-EOF clause, do it and quit.
-;;;     If no ON-EOF clause, go on to task i+1.
-;;;   else we got some data:
-;;;     Try out matches. On match, do the match action & we are done.
-;;;     If no match, go on to task i+1
-;;; 
-;;; If ivec[i] is #f
-;;;   -- No input available right now.
-;;;  ivec[i] := taski.in	(Put the input port back in the vector)
-;;;  go on to task i+1
-;;;
-;;; "go on to task i+i" means "loop back to the select call" when task i
-;;; is the last one.
-
-(define (try-task ivec i task try-match-clauses do-next do-eof monitor)
-  (if (vector-ref ivec i)
-
-      ;; Input is available (or EOF). Read it in.
-      ;; If we get some, try out the pattern/action clauses.
-      ;; If we get EOF, do the EOF action (which is the ON-EOF action clause,
-      ;; if there is one, or go on to the next task clause if there isn't).
-      (cond ((do-input task) =>
-	     (lambda (i) (try-match-clauses (task:buf task) i do-next)))
-	    (else
-	     (set-task:pre-match! task (task:buf task))
-	     (set-task:buf! task "")
-	     (monitor task #f) ; Signal EOF
-	     (do-eof)
-	     (vector-set! ivec i #f)))
-
-      ;; No input available for task i. Put it back in the select vector
-      ;; for next time, and go on to the next thing.
-      (begin (vector-set! ivec i (task:in task))
-	     (do-next))))
-
-
-;;; M is the match. S is the total string. I is the new data that just
-;;; arrived -- a non-empty suffix of S.
-(define (do-match-hacking task m s i monitor)
-  ;; Log all new data up to the match.
-  (let* ((delta (- (string-length s) (string-length i)))
-	 (mend (- (match:end m 0) delta)))
-    (monitor task (substring i 0 mend))
-    (monitor task m))
-  (set-prematch task s m))	; Set the prematch buffer.
-
-
 ;;; The default monitor -- does nothing.
 (define (null-monitor task event) #f)
 
@@ -289,12 +174,6 @@
 (define *default-echo* #f)
 (define *default-max-size* #f)
 
-(define-record-type :eof-pattern
-  (make-eof-pattern)
-  eof-pattern?)
-
-(define eof-pattern (make-eof-pattern))
-
 (define (in-select! rvec timeout)
   (receive (in out ex)
 	   (select! rvec '#() '#() timeout)
@@ -323,6 +202,33 @@
 		   (else *default-max-size*))))
     (expect-1* on-timeout monitor timeout echo max-size tasks-patterns-alist)))
 
+;;; Slurp in data from port and add it to the task's buffer.  Return
+;;; the new data (not the whole buffer).  If we get EOF instead, set
+;;; ivec[i] to #f and return false. This is really inefficient in
+;;; space and time -- every time we get a little bit of input, we copy
+;;; and throw away the whole match buffer. Argh.
+
+(define (do-input task)
+  (let* ((port (task:in task))
+
+	 ;; If the read blows up, return #f. This is how tty's indicate 
+	 ;; to pty's they've been closed. Ugh.
+	 (s (with-errno-handler ((e p) ((errno/io) #f))
+	      (read-string/partial 256 port))))
+
+    (and s (let ((newbuf (string-append (task:buf task) s)))
+	     (set-task:buf! task newbuf)
+	     s))))
+
+;;; We just matched M out of BUFFER. 
+;;; - Put everything in BUFFER *before* the match into (TASK:PRE-MATCH TASK). 
+;;; - Put everything in BUFFER *after* the match into (TASK:BUF TASK).
+
+(define (set-prematch task buffer m)
+  (set-task:pre-match! task (substring buffer 0 (match:start m)))
+  (set-task:buf! task
+		 (substring buffer (match:end m) (string-length buffer))))
+
 (define (expect-1* on-timeout monitor timeout echo max-size
 		   tasks-patterns-alist)
   (let ((handle-input
@@ -336,9 +242,14 @@
 		       ((match)
 			(let ((m (string-match ((cadr pattern)) s)))
 			  (if m
-			      (begin
+			      ;; Log all new data up to the match.
-				(do-match-hacking task m s input monitor)
+			      (let* ((delta (- (string-length s)
-				(monitor task m) ;; ??
+					       (string-length input)))
+				     (mend (- (match:end m 0) delta)))
+				(monitor task (substring input 0 mend))
+				(monitor task m)
+				;; Set the prematch buffer.
+				(set-prematch task s m)
 				((caddr pattern) m))
 			      (loop (cdr patterns)))))
 		       ((eof) (loop (cdr patterns)))
@@ -446,46 +357,52 @@
 
 (define-syntax expect-action-clauses
   (syntax-rules (on-eof test => else)
-    ((expect-action-clauses loop)
+    ((expect-action-clauses)
      '())
-    ((expect-action-clauses loop (on-eof body ...) clause ...)
+    ((expect-action-clauses (on-eof body ...) clause ...)
      (cons (list 'eof
 		 (lambda () body ...))
-	   (expect-action-clauses loop clause ...)))
+	   (expect-action-clauses clause ...)))
-    ((expect-action-clauses loop (test exp body ...) clause ...)
+    ((expect-action-clauses (test exp body ...) clause ...)
      (cons (list 'test
 		 (lambda () exp)
 		 (lambda (_) body ...))
-	   (expect-action-clauses loop clause ...)))
+	   (expect-action-clauses clause ...)))
-    ((expect-action-clauses loop (test exp => proc) clause ...)
+    ((expect-action-clauses (test exp => proc) clause ...)
      (cons (list 'test
 		 (lambda () exp)
 		 (lambda (v) (proc v)))
-	   (expect-action-clauses loop clause ...)))
+	   (expect-action-clauses clause ...)))
-    ((expect-action-clauses loop (pattern (mvars ...) body ...) clause ...)
+    ((expect-action-clauses (pattern (match mvars ...) body ...) clause ...)
      (cons (list 'match (lambda () pattern)
 		 (lambda (m)
-		   (let-match m (mvars ...) body ...)))
+		   (let ((match m))
-	   (expect-action-clauses loop clause ...)))
+		     (let-match m (mvars ...) body ...))))
-    ((expect-action-clauses loop (else body ...) clause ...)
+	   (expect-action-clauses clause ...)))
+    ((expect-action-clauses (else body ...) clause ...)
      (cons (list else (lambda () body ...))
-	   (expect-action-clauses loop clause ...)))))
+	   (expect-action-clauses clause ...)))))
 
-(define-syntax expect-task-clauses
+(define-syntax expect-clauses
-  (syntax-rules ()
+  (syntax-rules (option)
-    ((expect-task-clauses loop)
+    ((expect-clauses)
-     '())
+     (cons '() '()))
-    ((expect-task-clauses loop (task aclause ...) clause ...)
+    ((expect-clauses (option oclause ...) clause ...)
-     (append (cons task (expect-action-clauses loop aclause ...))
+     (let ((res (expect-clauses clause ...)))
-	     (expect-task-clauses loop clause ...)))))
+       (cons (append (expect-options-clauses oclause ...) (car res))
+	     (cdr res))))
+    ((expect-task-clauses (task aclause ...) clause ...)
+     (let ((res (expect-clauses clause ...)))
+       (cons (car res)
+	     (cons (cons task (expect-action-clauses aclause ...))
+		   (cdr res)))))))
 
 (define-syntax expect
   (syntax-rules ()
     ((expect name (var-inits ...) eclause ...)
      (let name (var-inits ...)
-       (expect* (expect-options-clauses eclause ...)
+       (let ((r (expect-clauses eclause ...)))
-		(expect-task-clauses name eclause ...))))
+	 (expect* (car r) (cdr r)))))
     ((expect (x ...) eclause ...)
-     (let loop ()
+     (let ((r (expect-clauses (x ...) eclause ...)))
-       (expect* (expect-options-clauses loop (x ...) eclause ...)
+       (expect* (car r) (cdr r))))))
-		(expect-task-clauses loop (x ...) eclause ...))))))