home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pseudo-s / pseudo_2.lha / generate.scm < prev    next >
Encoding:
Text File  |  1991-06-23  |  18.5 KB  |  580 lines
  1. ; -*- Mode: Scheme; Syntax: Scheme; Package: Scheme; -*-
  2. ; File generate.scm / Copyright (c) 1991 Jonathan Rees / See file COPYING
  3.  
  4. ;;;; Common Lisp back end
  5.  
  6. ; Translation of a single expression
  7.  
  8. ; Compare this with SCHEMIFY, which is a different back end.
  9.  
  10. ;+++
  11. ; To do:
  12. ;  - Pass continuations around so that RETURN's can be propagated
  13. ;    inside of PROG statements (for readability)
  14.  
  15. (define @lambda-encountered? (make-fluid #f))
  16.  
  17. ; GENERATE
  18.  
  19. (define (generate-top node env ignore?)
  20.   (case (node-type node)
  21.     ((begin)
  22.      (prognify (append (deprognify (generate-top (begin-first node) env #t))
  23.                (deprognify (generate-top (begin-second node)
  24.                          env ignore?)))))
  25.     ((define)
  26.      (generate-define node env))
  27.     (else
  28.      (generate-expression-top node env ignore?))))
  29.  
  30. ; DEFINE
  31.  
  32. (define (generate-define def env)
  33.   (let ((lhs (define-lhs def)))
  34.     (let-fluid @where (program-variable-name lhs)
  35.       (lambda ()
  36.     (let ((rhs (define-rhs def))
  37.           (CL-sym (program-variable-CL-symbol lhs))
  38.           (name (program-variable-name lhs)))
  39.     (cond ((mutable-program-variable? lhs)
  40.            `(lisp:progn
  41.          ,(generate-setq-top lhs rhs env)
  42.          (schi:set-forwarding-function (lisp:quote ,CL-sym)
  43.                            (lisp:quote ,name))))
  44.           ((lambda? rhs)
  45.            `(lisp:progn
  46.          (lisp:defun ,CL-sym ,@(cdr (generate-lambda-top rhs env)))
  47.          (schi:set-value-from-function (lisp:quote ,CL-sym)
  48.                            (lisp:quote ,name))))
  49.  
  50.           (else
  51.            `(lisp:progn
  52.          ,(generate-setq-top lhs rhs env)
  53.          (schi:set-function-from-value (lisp:quote ,CL-sym)
  54.                            (lisp:quote ,name))))))))))
  55.  
  56. (define (generate-expression-top node env ignore?)
  57.   (let-fluid @lambda-encountered? #f
  58.     (lambda ()
  59.       (noting-variable-references
  60.        (lambda ()
  61.      ;; Don't beta-reduce this LET (?)
  62.      (let ((code (generate node env (if ignore? cont/ignore cont/value))))
  63.        (emit-top-level
  64.         (locally-specialize (deprognify code)))))))))
  65.  
  66. (define (generate-lambda-top node env)
  67.   (let-fluid @lambda-encountered? #f
  68.     (lambda ()
  69.       (noting-variable-references
  70.        (lambda ()
  71.      (let* ((bvl+body (generate-lambda-aux node env cont/value))
  72.         (body (locally-specialize (cdr bvl+body))))
  73.        `(lisp:lambda ,(car bvl+body)
  74.           ,@(if (and (pair? body)
  75.              (null? (cdr body))
  76.              (car-is? (car body) 'lisp:locally))
  77.             (cdr (car body))
  78.             body))))))))
  79.  
  80. (define (generate-setq-top lhs rhs env)
  81.   (let-fluid @lambda-encountered? #f
  82.     (lambda ()
  83.       (noting-variable-references
  84.        (lambda ()
  85.      ;; Don't beta-reduce this LET (?)
  86.      (let ((code (generate rhs env cont/ignore)))
  87.        (note-variable-reference! lhs)
  88.        (emit-top-level
  89.         (locally-specialize `((lisp:setq ,(program-variable-CL-symbol lhs)
  90.                          ,code))))))))))
  91.  
  92.  
  93.  
  94. ; Generate code for a single expressions
  95.  
  96. (define (generate node env cont)
  97.   (case (node-type node)
  98.     ((local-variable) (generate-local-variable node env cont))
  99.     ((program-variable) (generate-program-variable node env cont))
  100.     ((constant) (generate-constant node env cont))
  101.     ((call)     (generate-call       node env cont))
  102.     ((lambda)   (generate-lambda   node env cont))
  103.     ((letrec)   (generate-letrec   node env cont))
  104.     ((if)       (generate-if       node env cont))
  105.     ((begin)    (generate-begin       node env cont))
  106.     ((set!)    (generate-set!       node env cont))
  107.     (else (note "don't know how to generate" node))))
  108.  
  109. (define (generate-list node-list env)
  110.   (map (lambda (node) (generate node env cont/value))
  111.        node-list))
  112.  
  113. (define (generate-body node env cont)
  114.   (deprognify (generate node env cont)))
  115.  
  116. ; Constant
  117.  
  118. (define (generate-constant node env cont)
  119.   env                    ;ignored
  120.   (let ((val (constant-value node)))
  121.     (cond ((constant-quoted? node)
  122.        (deliver-value-to-cont `(lisp:quote ,val) cont))
  123.       ;; Hack for bootstrap from Schemes that don't distinguish ()
  124.       ;; from #f: the expression #f or () is translated as schi:false,
  125.       ;; while '#f or '() is translated as '().
  126.       ((eq? val #t) (deliver-value-to-cont `schi:true cont))
  127.       ((eq? val #f)
  128.        (if (eq? (continuation-type cont) 'cont/test)
  129.            `lisp:nil
  130.            (deliver-value-to-cont `schi:false cont)))
  131.       (else
  132.        ;; Not quoted in Scheme implies doesn't need quoting in Common Lisp
  133.        (deliver-value-to-cont val cont)))))
  134.  
  135. ; Variable
  136.  
  137. (define (generate-local-variable var env cont)
  138.   env ;ignored
  139.   (let ((sub (variable-substitution var)))
  140.     (deliver-value-to-cont
  141.      (if (pair? sub)
  142.      (case (car sub)
  143.        ((val) (cadr sub))
  144.        ((fun) `(lisp:function ,(cadr sub)))
  145.        (else (error "lossage in generate-local-variable" sub)))
  146.      sub)
  147.      cont)))
  148.  
  149. (define (generate-program-variable var env cont)
  150.   env ;ignored
  151.   (let ((sub (get-integration var)))
  152.     (deliver-value-to-cont
  153.      (if (pair? sub)
  154.      (case (car sub)
  155.        ((val) (cadr sub))
  156.        ((fun) `(lisp:function ,(cadr sub)))
  157.        (else
  158.         (note-variable-reference! var)
  159.         (program-variable-CL-symbol var)))
  160.      (begin (note-variable-reference! var)
  161.         (program-variable-CL-symbol var)))
  162.      cont)))
  163.  
  164. (define (get-integration var)
  165.   (table-ref integrations-table var))
  166.  
  167. (define *declare-program-variables-special?* #t)
  168.  
  169. (define (note-variable-reference! var)
  170.   (if (and (not (qualified-symbol? (program-variable-name var)))
  171.        *declare-program-variables-special?*)
  172.       (let ((g (fluid @CL-variable-references)))
  173.     (if (and (not (eq? g 'dont-accumulate))
  174.          (not (memq var g)))
  175.         (set-fluid! @CL-variable-references (cons var g))))))
  176.  
  177. ; Combinations
  178.  
  179. (define (generate-call node env cont)
  180.   (let ((proc (call-proc node))
  181.     (args (call-args node)))
  182.     (case (node-type proc)
  183.       ((program-variable)
  184.        (if (mutable-program-variable? proc)
  185.        (generate-general-call proc args env cont)
  186.        (generate-call-to-program-variable proc args env cont)))
  187.       ((local-variable)
  188.        (if (and (pair? (variable-substitution proc))
  189.         (eq? (car (variable-substitution proc)) '--generate-call--))
  190.        ((cadr (variable-substitution proc))
  191.         (generate-list args env)
  192.         cont)
  193.        (generate-general-call proc args env cont)))
  194.       ((lambda)
  195.        (if (and (not (n-ary? proc))
  196.         (= (length args) (length (lambda-vars proc))))
  197.        (generate-let proc args env cont)
  198.        (generate-general-call proc args env cont)))
  199.       (else
  200.        (generate-general-call proc args env cont)))))
  201.  
  202. (define (generate-general-call proc args env cont)
  203.   (deliver-value-to-cont
  204.    (funcallify (generate proc env cont/value)
  205.            (generate-list args env))
  206.    cont))
  207.  
  208. (define (generate-call-to-program-variable pvar args env cont)
  209.   (let ((sub (get-integration pvar)))
  210.     (if (not (pair? sub))
  211.     (generate-call-to-unknown pvar args env cont)
  212.     (case (car sub)
  213.       ((subst)
  214.        (let ((params (cadr sub))
  215.          (body (prognify (cddr sub))))
  216.          (if (= (length args) (length params))
  217.          (substitute-and-peep (map cons
  218.                        params
  219.                        (generate-list args env))
  220.                       ;; ??? kind of kludgey
  221.                       (deliver-value-to-cont body cont))
  222.          (begin (note "wrong number of arguments"
  223.                   (make-call pvar args))
  224.             (generate-call-to-unknown pvar args env cont)))))
  225.       ((lambda)
  226.        (if (= (length args) (length (cadr sub)))
  227.            `(lisp:let ,(map list (cadr sub) (generate-list args env))
  228.           ,@(deprognify
  229.              (deliver-value-to-cont (prognify (cddr sub))
  230.                         cont)))
  231.            (generate-call-to-unknown pvar args env cont)))
  232.       ((fun)
  233.        (deliver-value-to-cont `(,(cadr sub) ,@(generate-list args env))
  234.                   cont))
  235.       ((pred)
  236.        (deliver-test-to-cont `(,(cadr sub) ,@(generate-list args env))
  237.                  cont))
  238.       ((val)
  239.        (deliver-value-to-cont (funcallify (cadr sub)
  240.                           (generate-list args env))
  241.                   cont))
  242.       ((special)
  243.        (case (program-variable-name pvar) ;lose
  244.          ((not)
  245.           (if (= (length args) 1)
  246.           (deliver-test-to-cont
  247.              `(lisp:not ,(generate (car args) env cont/test))
  248.              cont)
  249.           (generate-call-to-unknown pvar args env cont)))
  250.          ((and-aux)
  251.           ;; We can assume that the arg count is OK.
  252.           (generate-and (car args)
  253.                 (if (lambda? (cadr args))
  254.                 (lambda-body (cadr args))
  255.                 (make-call (cadr args) '()))
  256.                 env
  257.                 cont))
  258.          ((or-aux)
  259.           (generate-or (car args)
  260.                (if (lambda? (cadr args))
  261.                    (lambda-body (cadr args))
  262.                    (make-call (cadr args) '()))
  263.                env
  264.                cont))
  265.          ((case-aux)
  266.           (generate-case (car args) (cadr args) (caddr args) (cdddr args)
  267.                  env cont))
  268.          ((=>-aux)
  269.           (let* ((proc-thunk (cadr args))
  270.              (proc (if (lambda? proc-thunk)
  271.                    (lambda-body proc-thunk)
  272.                    (make-call proc-thunk '()))))
  273.         (if (and (lambda? proc)
  274.              (= (length (lambda-vars proc)) 1))
  275.             (generate-=> (car args)
  276.                  (car (lambda-vars proc))
  277.                  (lambda-body proc)
  278.                  (caddr args)
  279.                  cont)
  280.             (let ((var (make-local-variable 'temp)))
  281.               (generate-=> (car args)
  282.                    var
  283.                    (make-call proc (list var))
  284.                    (caddr args)
  285.                    cont)))))
  286.          (else
  287.           (error "losing built-in" pvar))))
  288.       (else
  289.        (error "losing CASE" sub))))))
  290.  
  291. ;(and x y)         == (if x y #f)
  292. ;           == (lisp:if (truep x) y #f)
  293. ;
  294. ;(and (true? x) y) == (if (true? x) y #f)
  295. ;                  == (lisp:if (truep (true? x)) y #f)
  296. ;                  == (lisp:if x y #f)
  297. ;
  298. ;(truep (and x y)) == (truep (if x y #f))
  299. ;                  == (truep (lisp:if (truep x) y #f))
  300. ;                  == (lisp:if (truep x) (truep y) nil)    [(truep #f) = nil]
  301. ;                  == (lisp:and (truep x) (truep y))
  302.  
  303. (define (generate-and first second env cont)
  304.   (case (continuation-type cont)
  305.     ((cont/test cont/ignore)
  306.      `(lisp:and ,(generate first env cont/test)
  307.         ,@(deandify (generate second env cont/test))))
  308.     (else
  309.      `(lisp:if ,(generate first env cont/test)
  310.            ,(generate second env cont)
  311.            ,(deliver-value-to-cont `schi:false cont)))))
  312.  
  313. ;(or x y)          == (let ((temp x)) (if temp temp y))
  314. ;           == (let ((temp x)) (lisp:if (truep temp) temp y))
  315. ;
  316. ;(or (true? x) y)  == (if (true? x) (true? x) y)
  317. ;                  == (lisp:if (truep (true? x)) (true? x) y)
  318. ;                  == (lisp:if x (true? x) y)      [cf. value-form->test-form]
  319. ;                  == (lisp:if x (lisp:or x #f) y)
  320. ;                  == (lisp:if x x y)
  321. ;                  == (lisp:or x y)
  322. ;
  323. ;(truep (or x y))  == (truep (if x x y))
  324. ;                  == (truep (lisp:if (truep x) x y))
  325. ;                  == (truep (lisp:if (truep x) x y))
  326. ;                  == (lisp:if (truep x) (truep x) (truep y))
  327. ;                  == (lisp:or (truep x) (truep y))
  328.  
  329. (define (generate-or first second env cont)
  330.   (case (continuation-type cont)
  331.     ((cont/test cont/ignore)
  332.      `(lisp:or ,(generate first env cont/test)
  333.            ,@(deorify
  334.           (generate second env cont))))
  335.     (else
  336.      (let ((first-code (generate first env cont/value)))
  337.        (if (car-is? first-code 'schi:true?)
  338.        ;; This assumes that #t = t.
  339.        `(lisp:or ,(cadr first-code)
  340.              ,@(deorify (generate second env cont)))
  341.        (let* ((var (make-local-variable 'temp))
  342.           (new-name (cl-externalize-local 'temp env))
  343.           (new-env (bind-variables (list var) (list new-name) env)))
  344.          `(lisp:let ((,new-name ,first-code))
  345.         (lisp:if (schi:truep ,new-name)
  346.              ,(deliver-value-to-cont new-name cont)
  347.              ,(generate second new-env cont)))))))))
  348.  
  349. (define (generate-case key key-lists else-thunk thunks env cont)
  350.   `(lisp:case ,(generate key env cont/value)
  351.      ,@(map (lambda (key-list thunk)
  352.           `(,key-list
  353.         ,@(deprognify (generate (if (lambda? thunk)
  354.                         (lambda-body thunk)
  355.                         (make-call thunk '()))
  356.                     env
  357.                     cont))))
  358.         (if (constant? key-lists)
  359.         (constant-value key-lists)
  360.         (error "case: invalid key-lists" key-lists))
  361.         thunks)
  362.      (lisp:otherwise
  363.       ,@(deprognify (generate (if (lambda? else-thunk)
  364.                   (lambda-body else-thunk)
  365.                   (make-call else-thunk '()))
  366.                   env
  367.                   cont)))))
  368.  
  369. (define (generate-=> test var then else-thunk cont)
  370.   (let* ((new-name (cl-externalize-local (local-variable-name var) env))
  371.      (new-env (bind-variables (list var) (list new-name) env)))
  372.     `(lisp:let ((,new-name ,(generate test env cont/test)))
  373.        (lisp:if ,new-name
  374.         ,(generate then new-env cont)
  375.         ,(generate (if (lambda? else-thunk)
  376.                    (lambda-body else-thunk)
  377.                    (make-call else-thunk '()))
  378.                new-env
  379.                cont)))))
  380.  
  381. (define (generate-call-to-unknown pvar args env cont)
  382.   ;; Go through scheme symbol's function cell
  383.   (let ((CL-sym (program-variable-CL-symbol pvar))
  384.     (args-code (generate-list args env)))
  385.     (deliver-value-to-cont
  386.      (if (and (not (qualified-symbol? CL-sym))
  387.           (not (eq? (lisp:macro-function CL-sym) 'lisp:nil)))
  388.      ;; Prevent infinite compilation loops!
  389.      `(lisp:funcall ,CL-sym ,@args-code)
  390.      `(,CL-sym ,@args-code))
  391.      cont)))
  392.  
  393. ; LAMBDA
  394.  
  395. (define (generate-lambda node env cont)
  396.   (set-fluid! @lambda-encountered? #t)
  397.   (deliver-value-to-cont
  398.      `(lisp:function (lisp:lambda ,@(generate-lambda-aux node env cont/value)))
  399.      cont))
  400.  
  401. ; Returns (bvl . body)
  402. (define (generate-lambda-aux node env cont)
  403.   (let* ((bvl (lambda-vars node))
  404.      (vars (proper-listify bvl))
  405.      (new-names (cl-externalize-locals vars env))
  406.      (new-env (bind-variables vars new-names env))
  407.      (body-code (generate-body (lambda-body node) new-env cont)))
  408.     (if (n-ary? node)
  409.     (let* ((bvl (insert-&rest new-names))
  410.            (rest-var (car (last-pair bvl))))
  411.       `(,bvl
  412.         ,@(emit-sharp-plus ':lispm
  413.                    `(lisp:setq ,rest-var
  414.                        (lisp:copy-list ,rest-var)))
  415.         ,@body-code))
  416.     `(,new-names ,@body-code))))
  417.  
  418. (define (generate-let proc args env cont)
  419.   (let ((vars (lambda-vars proc)))
  420.     (if (function-bindable? vars args)
  421.     (let* ((new-names (cl-externalize-locals vars env))
  422.            (new-env (bind-functions vars new-names env)))
  423.       `(lisp:flet ,(map (lambda (new-name proc)
  424.                    `(,new-name
  425.                  ,@(generate-lambda-aux proc env cont/value)))
  426.                 new-names
  427.                 args)
  428.          ,@(generate-body (lambda-body proc) new-env cont)))
  429.     (let ((bvl+body (generate-lambda-aux proc env cont)))
  430.       `(lisp:let ,(map list (car bvl+body) (generate-list args env))
  431.          ,@(cdr bvl+body))))))
  432.  
  433. ; IF
  434.  
  435. (define (generate-if node env cont)
  436.   (let ((test (generate (if-test node) env cont/test))
  437.     (con  (generate (if-con node) env cont))
  438.     (alt  (generate (if-alt node) env cont)))
  439.     ;;+++ Reconstruct COND, WHEN, UNLESS ?
  440.     (if (and (eq? alt 'schi:unspecified)
  441.          (or (eq? (continuation-type cont) 'cont/ignore)
  442.          (fluid @translating-to-file?)))
  443.     `(lisp:if ,test ,con)        ;Make prettier code
  444.     `(lisp:if ,test ,con ,alt))))
  445.  
  446. ; BEGIN
  447.  
  448. (define (generate-begin node env cont)
  449.   (prognify (append (deprognify (generate (begin-first node) env cont/ignore))
  450.             (deprognify (generate (begin-second node) env cont)))))
  451.  
  452. ; SET!
  453.  
  454. (define (generate-set! node env cont)
  455.   (let ((var (set!-lhs node))
  456.     (rhs-code (generate (set!-rhs node) env cont/value)))
  457.     (cond ((program-variable? var)
  458.        (if (get-integration var)
  459.            (note "SET! of an integrated variable" node))
  460.        (let ((CL-sym (program-variable-CL-symbol var)))
  461.          (note-variable-reference! var)
  462.          (deliver-value-to-cont
  463.           (emit-program-variable-set! var CL-sym rhs-code)
  464.           cont)))
  465.       (else
  466.        (let ((the-setq
  467.           `(lisp:setq ,(variable-substitution var) ,rhs-code)))
  468.          (if (eq? (continuation-type cont) 'cont/ignore)
  469.          the-setq
  470.          `(lisp:progn ,the-setq
  471.                   ,(deliver-value-to-cont `schi:unspecified
  472.                               cont))))))))
  473.  
  474. ; LETREC
  475.  
  476. (define (generate-letrec node env cont)
  477.   (case (get-letrec-strategy node)
  478.     ((general) (generate-general-letrec node env cont))
  479.     ((labels)  (generate-labels-letrec node env cont))
  480.     ((prog)    (generate-prog-letrec node env cont))
  481.     (else (error "unknown strategy" (get-letrec-strategy node)))))
  482.  
  483. (define (generate-general-letrec node env cont)
  484.   (let* ((vars (letrec-vars node))
  485.      (vals (letrec-vals node))
  486.      (new-names (cl-externalize-locals vars env))
  487.      (new-env (bind-variables vars new-names env)))
  488.     `(lisp:let ,(map (lambda (new-name)
  489.                `(,new-name schi:unassigned))
  490.              new-names)
  491.        ,@(map (lambda (var val)
  492.         `(lisp:setq ,var ,(generate val new-env cont/value)))
  493.           new-names
  494.           vals)
  495.        ,@(deprognify (generate (letrec-body node) new-env cont)))))
  496.  
  497. (define (generate-labels-letrec node env cont)
  498.   (let* ((vars (letrec-vars node))
  499.      (vals (letrec-vals node))
  500.      (new-names (cl-externalize-locals vars env))
  501.      (new-env (bind-functions vars new-names env)))
  502.     `(lisp:labels ,(map (lambda (new-name proc)
  503.                `(,new-name
  504.                  ,@(generate-lambda-aux proc new-env cont/value)))
  505.             new-names
  506.             vals)
  507.        ,@(generate-body (letrec-body node) new-env cont))))
  508.  
  509. ; Sorry, I guess this is pretty hairy.  So it goes.
  510. ; It would certainly be cleaner if there were a separate pass that
  511. ; transformed the code tree to change argument passing into assignment.
  512.  
  513. (define (generate-prog-letrec node env cont)
  514.   (let* ((vars (letrec-vars node))
  515.      (procs (letrec-vals node))
  516.      (new-names (cl-externalize-locals vars env))
  517.      (new-env (bind-variables vars new-names env))
  518.      (temp-lists
  519.       (map (lambda (proc)
  520.          (map (lambda (var)
  521.             (if (variable-closed-over? var)
  522.                 (make-name-from-uid (local-variable-name var)
  523.                         (generate-uid))
  524.                 #f))
  525.               (lambda-vars proc)))
  526.            procs))
  527.      (proc-new-nameses (map (lambda (proc)
  528.                  (cl-externalize-locals (lambda-vars proc)
  529.                             new-env))
  530.                    procs))
  531.      (proc-envs (map (lambda (proc new-names)
  532.                (bind-variables (lambda-vars proc)
  533.                        new-names new-env))
  534.              procs
  535.              proc-new-nameses)))
  536.     (for-each set-letrec-substitution!
  537.           vars new-names proc-new-nameses temp-lists)
  538.     (deliver-value-to-cont        ;Suboptimal.
  539.      `(lisp:prog ,(apply append (map (lambda (temp-list new-names)
  540.                        (map (lambda (temp new-name)
  541.                           (or temp new-name))
  542.                         temp-list
  543.                         new-names))
  544.                      temp-lists
  545.                      proc-new-nameses))
  546.     ,@(generate-body (letrec-body node) new-env cont/return)
  547.     ,@(apply append
  548.          (map (lambda (new-name proc temp-list proc-new-names proc-env)
  549.             `(,new-name
  550.               ,(letify (filter cadr
  551.                        (map list proc-new-names temp-list))
  552.                    (generate (lambda-body proc)
  553.                          proc-env
  554.                          cont/return))))
  555.               new-names procs temp-lists proc-new-nameses proc-envs)))
  556.      cont)))
  557.  
  558. (define (set-letrec-substitution! var new-name proc-new-names temp-list)
  559.   (set-substitution!
  560.    var
  561.    (list '--generate-call--
  562.      (lambda (args cont)
  563.        ;; Return a CL expression to do the call.
  564.        ;; Args are already translated.
  565.        (if (not (eq? (continuation-type cont) 'cont/return))
  566.            (note "screwed-up LETREC" cont))
  567.        (if (null? args)
  568.            `(lisp:go ,new-name)
  569.            `(lisp:progn
  570.          ;; If we had free-variable information, we could
  571.          ;; optimize this PSETQ into a SETQ, sometimes.
  572.          (,(if (null? (cdr args)) 'lisp:setq 'lisp:psetq)
  573.           ,@(apply append
  574.                (map (lambda (new-name temp actual)
  575.                   `(,(or temp new-name) ,actual))
  576.                 proc-new-names
  577.                 temp-list
  578.                 args)))
  579.          (lisp:go ,new-name)))))))
  580.