Use "compare" und "rename" to compare symbols.

This commit is contained in:
mainzelm 2002-10-21 17:30:49 +00:00
parent d1142b703c
commit 96060828fa
1 changed files with 49 additions and 39 deletions

View File

@ -77,25 +77,34 @@
(define (transcribe-process-form pf rename compare)
(if (and (list? pf) (pair? pf))
(case (car pf)
((begin) (transcribe-begin-process-form (cdr pf) rename compare))
(let ((head (car pf)))
(cond
((compare head (rename 'begin))
(transcribe-begin-process-form (cdr pf) rename compare))
((epf) (transcribe-extended-process-form (cdr pf) rename compare))
((compare head (rename 'epf))
(transcribe-extended-process-form (cdr pf) rename compare))
((pipe) (transcribe-simple-pipeline (cdr pf) rename compare))
((|) (transcribe-simple-pipeline (cdr pf) rename compare))
((compare head (rename 'pipe))
(transcribe-simple-pipeline (cdr pf) rename compare))
((|+) (let ((conns (backq (cadr pf) rename))
((compare head (rename '|))
(transcribe-simple-pipeline (cdr pf) rename compare))
((compare head (rename '|+))
(let ((conns (backq (cadr pf) rename))
(pfs (cddr pf)))
(transcribe-complex-pipeline conns pfs rename compare)))
((pipe+)(let ((conns (backq (cadr pf) rename))
((compare head (rename 'pipe+))
(let ((conns (backq (cadr pf) rename))
(pfs (cddr pf)))
(transcribe-complex-pipeline conns pfs rename compare)))
(else (let ((%apply (rename 'apply))
(%exec-path (rename 'exec-path))
(pf (backq pf rename)))
`(,%apply ,%exec-path ,pf))))
`(,%apply ,%exec-path ,pf)))))
(error "Illegal process form" pf)))
@ -173,13 +182,14 @@
(%port (rename 'port))
(%stdports->stdio (rename 'stdports->stdio)))
(cond ((pair? redir)
(let ((args (cdr redir)))
(case (car redir)
((<)
(let ((args (cdr redir))
(op (car redir)))
(cond
((compare op (rename '<))
(receive (fdes fname) (parse-spec args 0)
`(,%open ,fname 0 ,fdes)))
((>)
((compare op (rename '>))
(receive (fdes fname) (parse-spec args 1)
`(,%open ,fname ,%open/create+trunc ,fdes)))
@ -190,27 +200,27 @@
;; We save the port in the global variable <<-port-holder to prevent a
;; GC from closing the port before the exec().
((<<)
((compare op (rename '<<))
(receive (fdes exp) (parse-spec args 0)
`(,%let ((,%port (,%open-string-source ,exp)))
(,%set! ,%<<-port-holder ,%port)
(,%move->fdes ,%port ,fdes))))
((>>)
((compare op (rename '>>))
(receive (fdes fname) (parse-spec args 1)
`(,%open ,fname ,%open/write+append+create ,fdes)))
((=)
((compare op (rename '=))
(assert (= 2 (length args))) ; Syntax check.
`(,%dup->fdes ,(backq (cadr args)) ,(backq (car args))))
((-) ; (- fdes) => close the fdes.
((compare op (rename '-)) ; (- fdes) => close the fdes.
(assert (= 1 (length args))) ; Syntax check.
`(,%close ,(backq (car args))))
(else (oops)))))
((eq? redir 'stdports)
((compare redir (rename 'stdports))
`(,%stdports->stdio))
(else (oops)))))