From 7642842a3afe38c18aa569eec7169f197af762f1 Mon Sep 17 00:00:00 2001 From: frese Date: Tue, 24 Aug 2004 13:18:29 +0000 Subject: [PATCH] - removed obsolete code - cleaned up syntax rules - moved eof-patter to interact.scm --- scheme/expect.scm | 213 ++++++++++++++-------------------------------- 1 file changed, 65 insertions(+), 148 deletions(-) diff --git a/scheme/expect.scm b/scheme/expect.scm index 9aeeff6..7998354 100644 --- a/scheme/expect.scm +++ b/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-clause becomes the following chunk of code -;;; that is executed after the select call on ivec[]. I is the index of -;;; '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 - (do-match-hacking task m s input monitor) - (monitor task m) ;; ?? + ;; Log all new data up to the match. + (let* ((delta (- (string-length s) + (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 loop (test exp body ...) clause ...) + (expect-action-clauses clause ...))) + ((expect-action-clauses (test exp body ...) clause ...) (cons (list 'test (lambda () exp) (lambda (_) body ...)) - (expect-action-clauses loop clause ...))) - ((expect-action-clauses loop (test exp => proc) clause ...) + (expect-action-clauses 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 loop (pattern (mvars ...) body ...) clause ...) + (expect-action-clauses clause ...))) + ((expect-action-clauses (pattern (match mvars ...) body ...) clause ...) (cons (list 'match (lambda () pattern) (lambda (m) - (let-match m (mvars ...) body ...))) - (expect-action-clauses loop clause ...))) - ((expect-action-clauses loop (else body ...) clause ...) + (let ((match m)) + (let-match m (mvars ...) body ...)))) + (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 - (syntax-rules () - ((expect-task-clauses loop) - '()) - ((expect-task-clauses loop (task aclause ...) clause ...) - (append (cons task (expect-action-clauses loop aclause ...)) - (expect-task-clauses loop clause ...))))) +(define-syntax expect-clauses + (syntax-rules (option) + ((expect-clauses) + (cons '() '())) + ((expect-clauses (option oclause ...) clause ...) + (let ((res (expect-clauses 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 ...) - (expect-task-clauses name eclause ...)))) + (let ((r (expect-clauses eclause ...))) + (expect* (car r) (cdr r))))) ((expect (x ...) eclause ...) - (let loop () - (expect* (expect-options-clauses loop (x ...) eclause ...) - (expect-task-clauses loop (x ...) eclause ...)))))) + (let ((r (expect-clauses (x ...) eclause ...))) + (expect* (car r) (cdr r))))))