suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

release

Browse Source 
original commit: 12edf1ea32ec392222c56a1f4eb67142c40f2210
This commit is contained in:
Matthew Flatt 1997-06-07 21:46:11 +00:00
parent 8b644da108
commit da92e37037
1 changed files with 16 additions and 5 deletions

21
collects/mzlib/awk.ss
View File

@ -8,15 +8,19 @@
(export awk match:start match:end match:substring regexp-exec) (export awk match:start match:end match:substring regexp-exec)
(define awk (define awk
(lambda (get-next-record user-fields . rest) (lambda (get-next-record . rest)
(let*-values ([(counter rest) (if (and (pair? rest) (symbol? (car rest))) (let*-values ([(user-fields rest) (values (car rest) (cdr rest))]
[(counter rest) (if (and (pair? rest) (symbol? (car rest)))
(values (car rest) (cdr rest)) (values (car rest) (cdr rest))
(values (gensym) rest))] (values (gensym) rest))]
[(user-state-var-decls) (car rest)] [(user-state-var-decls rest) (values (car rest) (cdr rest))]
[(continue rest) (if (and (pair? rest) (symbol? (car rest)))
(values (car rest) (cdr rest))
(values (gensym) rest))]
[(user-state-vars) (map car user-state-var-decls)] [(user-state-vars) (map car user-state-var-decls)]
[(local-user-state-vars) (map gensym user-state-vars)] [(local-user-state-vars) (map gensym user-state-vars)]
[(first) (car user-fields)] [(first) (car user-fields)]
[(clauses) (cdr rest)] [(clauses) rest]
[(loop) (gensym)] [(loop) (gensym)]
[(remainder) (gensym)] [(remainder) (gensym)]
[(extras) (gensym)] [(extras) (gensym)]
@ -24,6 +28,7 @@
[(else-ready?) (gensym)] [(else-ready?) (gensym)]
[(orig-on?) (gensym)] [(orig-on?) (gensym)]
[(post-on-on?) (gensym)] [(post-on-on?) (gensym)]
[(escape) (gensym)]
[(initvars) null]) [(initvars) null])
(letrec ([get-after-clauses (letrec ([get-after-clauses
(lambda () (lambda ()
@ -138,7 +143,13 @@
(begin (begin
,@(get-after-clauses)) ,@(get-after-clauses))
(let ([,else-ready? #t]) (let ([,else-ready? #t])
,@testing-clauses (let/ec ,escape
(let ([,continue
(lambda ,(append local-user-state-vars extras)
(set!-values ,user-state-vars
(values ,@local-user-state-vars))
(,escape))])
,@testing-clauses))
(,loop (add1 ,counter))))))))))))) (,loop (add1 ,counter)))))))))))))
(define-struct match (s a)) (define-struct match (s a))