home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / compiler / machines / C / decls.scm < prev    next >
Text File  |  1999-01-02  |  21KB  |  597 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: decls.scm,v 1.4 1999/01/02 06:06:43 cph Exp $
  4.  
  5. Copyright (c) 1992-1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. |#
  21.  
  22. ;;;; Compiler File Dependencies
  23. ;;; package: (compiler declarations)
  24.  
  25. (declare (usual-integrations))
  26.  
  27. (define (initialize-package!)
  28.   (add-event-receiver! event:after-restore reset-source-nodes!)
  29.   (reset-source-nodes!))
  30.  
  31. (define (reset-source-nodes!)
  32.   (set! source-filenames '())
  33.   (set! source-hash)
  34.   (set! source-nodes)
  35.   (set! source-nodes/by-rank)
  36.   unspecific)
  37.  
  38. (define (maybe-setup-source-nodes!)
  39.   (if (null? source-filenames)
  40.       (setup-source-nodes!)))
  41.  
  42. (define (setup-source-nodes!)
  43.   (let ((filenames
  44.      (append-map!
  45.       (lambda (subdirectory)
  46.         (map (lambda (pathname)
  47.            (string-append subdirectory
  48.                   "/"
  49.                   (pathname-name pathname)))
  50.          (directory-read
  51.           (string-append subdirectory
  52.                  "/"
  53.                  source-file-expression))))
  54.       '("back" "base" "fggen" "fgopt" "rtlbase" "rtlgen" "rtlopt"
  55.            "machines/C"))))
  56.     (if (null? filenames)
  57.     (error "Can't find source files of compiler"))
  58.     (set! source-filenames filenames))
  59.   (set! source-hash (make-string-hash-table))
  60.   (set! source-nodes
  61.     (map (lambda (filename)
  62.            (let ((node (make/source-node filename)))
  63.          (hash-table/put! source-hash filename node)
  64.          node))
  65.          source-filenames))
  66.   (initialize/syntax-dependencies!)
  67.   (initialize/integration-dependencies!)
  68.   (initialize/expansion-dependencies!)
  69.   (source-nodes/rank!))
  70.  
  71. (define source-file-expression "*.scm")
  72. (define source-filenames)
  73. (define source-hash)
  74. (define source-nodes)
  75. (define source-nodes/by-rank)
  76.  
  77. (define (filename/append directory . names)
  78.   (map (lambda (name) (string-append directory "/" name)) names))
  79.  
  80. (define-structure (source-node
  81.            (conc-name source-node/)
  82.            (constructor make/source-node (filename)))
  83.   (filename false read-only true)
  84.   (pathname (->pathname filename) read-only true)
  85.   (forward-links '())
  86.   (backward-links '())
  87.   (forward-closure '())
  88.   (backward-closure '())
  89.   (dependencies '())
  90.   (dependents '())
  91.   (rank false)
  92.   (syntax-table false)
  93.   (declarations '())
  94.   (modification-time false))
  95.  
  96. (define (filename->source-node filename)
  97.   (let ((node (hash-table/get source-hash filename #f)))
  98.     (if (not node)
  99.     (error "Unknown source file:" filename))
  100.     node))
  101.  
  102. (define (source-node/circular? node)
  103.   (memq node (source-node/backward-closure node)))
  104.  
  105. (define (source-node/link! node dependency)
  106.   (if (not (memq dependency (source-node/backward-links node)))
  107.       (begin
  108.     (set-source-node/backward-links!
  109.      node
  110.      (cons dependency (source-node/backward-links node)))
  111.     (set-source-node/forward-links!
  112.      dependency
  113.      (cons node (source-node/forward-links dependency)))
  114.     (source-node/close! node dependency))))
  115.  
  116. (define (source-node/close! node dependency)
  117.   (if (not (memq dependency (source-node/backward-closure node)))
  118.       (begin
  119.     (set-source-node/backward-closure!
  120.      node
  121.      (cons dependency (source-node/backward-closure node)))
  122.     (set-source-node/forward-closure!
  123.      dependency
  124.      (cons node (source-node/forward-closure dependency)))
  125.     (for-each (lambda (dependency)
  126.             (source-node/close! node dependency))
  127.           (source-node/backward-closure dependency))
  128.     (for-each (lambda (node)
  129.             (source-node/close! node dependency))
  130.           (source-node/forward-closure node)))))
  131.  
  132. ;;;; Rank
  133.  
  134. (define (source-nodes/rank!)
  135.   (compute-dependencies! source-nodes)
  136.   (compute-ranks! source-nodes)
  137.   (set! source-nodes/by-rank (source-nodes/sort-by-rank source-nodes))
  138.   unspecific)
  139.  
  140. (define (compute-dependencies! nodes)
  141.   (for-each (lambda (node)
  142.           (set-source-node/dependencies!
  143.            node
  144.            (list-transform-negative (source-node/backward-closure node)
  145.          (lambda (node*)
  146.            (memq node (source-node/backward-closure node*)))))
  147.           (set-source-node/dependents!
  148.            node
  149.            (list-transform-negative (source-node/forward-closure node)
  150.          (lambda (node*)
  151.            (memq node (source-node/forward-closure node*))))))
  152.         nodes))
  153.  
  154. (define (compute-ranks! nodes)
  155.   (let loop ((nodes nodes) (unranked-nodes '()))
  156.     (if (null? nodes)
  157.     (if (not (null? unranked-nodes))
  158.         (loop unranked-nodes '()))
  159.     (loop (cdr nodes)
  160.           (let ((node (car nodes)))
  161.         (let ((rank (source-node/rank* node)))
  162.           (if rank
  163.               (begin
  164.             (set-source-node/rank! node rank)
  165.             unranked-nodes)
  166.               (cons node unranked-nodes))))))))
  167.  
  168. (define (source-node/rank* node)
  169.   (let loop ((nodes (source-node/dependencies node)) (rank -1))
  170.     (if (null? nodes)
  171.     (1+ rank)
  172.     (let ((rank* (source-node/rank (car nodes))))
  173.       (and rank*
  174.            (loop (cdr nodes) (max rank rank*)))))))
  175.  
  176. (define (source-nodes/sort-by-rank nodes)
  177.   (sort nodes (lambda (x y) (< (source-node/rank x) (source-node/rank y)))))
  178.  
  179. ;;;; File Syntaxer
  180.  
  181. (define (syntax-files!)
  182.   (maybe-setup-source-nodes!)
  183.   (for-each
  184.    (lambda (node)
  185.      (let ((modification-time
  186.         (let ((source (modification-time node "scm"))
  187.           (binary (modification-time node "bin")))
  188.           (if (not source)
  189.           (error "Missing source file" (source-node/filename node)))
  190.           (and binary (< source binary) binary))))
  191.      (set-source-node/modification-time! node modification-time)
  192.      (if (not modification-time)
  193.      (begin (write-string "\nSource file newer than binary: ")
  194.         (write (source-node/filename node))))))
  195.    source-nodes)
  196.   (if compiler:enable-integration-declarations?
  197.       (begin
  198.     (for-each
  199.      (lambda (node)
  200.        (let ((time (source-node/modification-time node)))
  201.          (if (and time
  202.               (there-exists? (source-node/dependencies node)
  203.             (lambda (node*)
  204.               (let ((newer?
  205.                  (let ((time*
  206.                     (source-node/modification-time node*)))
  207.                    (or (not time*)
  208.                        (> time* time)))))
  209.                 (if newer?
  210.                 (begin
  211.                   (write-string "\nBinary file ")
  212.                   (write (source-node/filename node))
  213.                   (write-string " newer than dependency ")
  214.                   (write (source-node/filename node*))))
  215.                 newer?))))
  216.          (set-source-node/modification-time! node false))))
  217.      source-nodes)
  218.     (for-each
  219.      (lambda (node)
  220.        (if (not (source-node/modification-time node))
  221.            (for-each (lambda (node*)
  222.                (if (source-node/modification-time node*)
  223.                    (begin
  224.                  (write-string "\nBinary file ")
  225.                  (write (source-node/filename node*))
  226.                  (write-string " depends on ")
  227.                  (write (source-node/filename node))))
  228.                (set-source-node/modification-time! node* false))
  229.              (source-node/forward-closure node))))
  230.      source-nodes)))
  231.   (for-each (lambda (node)
  232.           (if (not (source-node/modification-time node))
  233.           (pathname-delete!
  234.            (pathname-new-type (source-node/pathname node) "ext"))))
  235.         source-nodes/by-rank)
  236.   (write-string "\n\nBegin pass 1:")
  237.   (for-each (lambda (node)
  238.           (if (not (source-node/modification-time node))
  239.           (source-node/syntax! node)))
  240.         source-nodes/by-rank)
  241.   (if (there-exists? source-nodes/by-rank
  242.     (lambda (node)
  243.       (and (not (source-node/modification-time node))
  244.            (source-node/circular? node))))
  245.       (begin
  246.     (write-string "\n\nBegin pass 2:")
  247.     (for-each (lambda (node)
  248.             (if (not (source-node/modification-time node))
  249.             (if (source-node/circular? node)
  250.                 (source-node/syntax! node)
  251.                 (source-node/touch! node))))
  252.           source-nodes/by-rank))))
  253.  
  254. (define (source-node/touch! node)
  255.   (with-values
  256.       (lambda ()
  257.     (sf/pathname-defaulting (source-node/pathname node) "" false))
  258.     (lambda (input-pathname bin-pathname spec-pathname)
  259.       input-pathname
  260.       (pathname-touch! bin-pathname)
  261.       (pathname-touch! (pathname-new-type bin-pathname "ext"))
  262.       (if spec-pathname (pathname-touch! spec-pathname)))))
  263.  
  264. (define (pathname-touch! pathname)
  265.   (if (file-exists? pathname)
  266.       (begin
  267.     (write-string "\nTouch file: ")
  268.     (write (enough-namestring pathname))
  269.     (file-touch pathname))))
  270.  
  271. (define (pathname-delete! pathname)
  272.   (if (file-exists? pathname)
  273.       (begin
  274.     (write-string "\nDelete file: ")
  275.     (write (enough-namestring pathname))
  276.     (delete-file pathname))))
  277.  
  278. (define (sc filename)
  279.   (maybe-setup-source-nodes!)
  280.   (source-node/syntax! (filename->source-node filename)))
  281.  
  282. (define (source-node/syntax! node)
  283.   (with-values
  284.       (lambda ()
  285.     (sf/pathname-defaulting (source-node/pathname node) "" false))
  286.     (lambda (input-pathname bin-pathname spec-pathname)
  287.       (sf/internal
  288.        input-pathname bin-pathname spec-pathname
  289.        (source-node/syntax-table node)
  290.        ((if compiler:enable-integration-declarations?
  291.         identity-procedure
  292.         (lambda (declarations)
  293.           (list-transform-negative declarations
  294.         integration-declaration?)))
  295.     ((if compiler:enable-expansion-declarations?
  296.          identity-procedure
  297.          (lambda (declarations)
  298.            (list-transform-negative declarations
  299.          expansion-declaration?)))
  300.      (source-node/declarations node)))))))
  301.  
  302. (define-integrable (modification-time node type)
  303.   (file-modification-time
  304.    (pathname-new-type (source-node/pathname node) type)))
  305.  
  306. ;;;; Syntax dependencies
  307.  
  308. (define (initialize/syntax-dependencies!)
  309.   (let ((file-dependency/syntax/join
  310.      (lambda (filenames syntax-table)
  311.        (for-each (lambda (filename)
  312.                (set-source-node/syntax-table!
  313.             (filename->source-node filename)
  314.             syntax-table))
  315.              filenames))))
  316.     (file-dependency/syntax/join
  317.      (append (filename/append "base"
  318.                   "toplev"    ; "asstop" "crstop"
  319.                   "blocks" "cfg1" "cfg2" "cfg3" "constr"
  320.                   "contin" "ctypes" "debug" "enumer"
  321.                   "infnew" "lvalue" "object" "pmerly" "proced"
  322.                   "refctx" "rvalue" "scode" "sets" "subprb"
  323.                   "switch" "utils")
  324.          (filename/append "back"
  325.                   "insseq" "lapgn1" "lapgn2" "linear" "regmap")
  326.          (filename/append "machines/C"
  327.                   "cout" "ctop" "machin" "rulrew" "rgspcm")
  328.          (filename/append "fggen"
  329.                   "declar" "fggen" "canon")
  330.          (filename/append "fgopt"
  331.                   "blktyp" "closan" "conect" "contan" "delint"
  332.                   "desenv" "envopt" "folcon" "offset" "operan"
  333.                   "order" "outer" "param" "reord" "reteqv" "reuse"
  334.                   "sideff" "simapp" "simple" "subfre" "varind")
  335.          (filename/append "rtlbase"
  336.                   "regset" "rgraph" "rtlcfg" "rtlcon" "rtlexp"
  337.                   "rtline" "rtlobj" "rtlreg" "rtlty1" "rtlty2"
  338.                   "valclass")
  339.          (filename/append "rtlgen"
  340.                   "fndblk" "fndvar" "opncod" "rgcomb" "rgproc"
  341.                   "rgretn" "rgrval" "rgstmt" "rtlgen")
  342.          (filename/append "rtlopt"
  343.                   "ralloc" "rcompr" "rcse1" "rcse2" "rcseep"
  344.                   "rcseht" "rcserq" "rcsesr" "rdebug" "rdflow"
  345.                   "rerite" "rinvex" "rlife" "rtlcsm"))
  346.      compiler-syntax-table)
  347.     (file-dependency/syntax/join
  348.      (filename/append "machines/C"
  349.               "lapgen"
  350.               "rules1" "rules2" "rules3" "rules4" "rulfix" "rulflo" "cout")
  351.      lap-generator-syntax-table)))
  352.  
  353. ;;;; Integration Dependencies
  354.  
  355. (define (initialize/integration-dependencies!)
  356.  
  357.   (define (add-declaration! declaration filenames)
  358.     (for-each (lambda (filenames)
  359.         (let ((node (filename->source-node filenames)))
  360.           (set-source-node/declarations!
  361.            node
  362.            (cons declaration
  363.              (source-node/declarations node)))))
  364.           filenames))
  365.  
  366.   (let* ((front-end-base
  367.       (filename/append "base"
  368.                "blocks" "cfg1" "cfg2" "cfg3"
  369.                "contin" "ctypes" "enumer" "lvalue"
  370.                "object" "proced" "rvalue"
  371.                "scode" "subprb" "utils"))
  372.      (C-base
  373.       (filename/append "machines/C" "machin"))
  374.      (rtl-base
  375.       (filename/append "rtlbase"
  376.                "regset" "rgraph" "rtlcfg" "rtlobj"
  377.                "rtlreg" "rtlty1" "rtlty2"))
  378.      (cse-base
  379.       (filename/append "rtlopt"
  380.                "rcse1" "rcseht" "rcserq" "rcsesr"))
  381.      (cse-all
  382.       (append (filename/append "rtlopt"
  383.                    "rcse2" "rcseep")
  384.           cse-base))
  385.      (instruction-base
  386.       (filename/append "machines/C" "machin"))
  387.      (lapgen-base
  388.       (append (filename/append "back" "linear" "regmap")
  389.           (filename/append "machines/C" "lapgen")))
  390.      (lapgen-body
  391.       (append
  392.        (filename/append "back" "lapgn1" "lapgn2")
  393.        (filename/append "machines/C"
  394.                 "rules1" "rules2" "rules3" "rules4"
  395.                 "rulfix" "rulflo" "cout"
  396.                 ))))
  397.     
  398.     (define (file-dependency/integration/join filenames dependencies)
  399.       (for-each (lambda (filename)
  400.           (file-dependency/integration/make filename dependencies))
  401.         filenames))
  402.  
  403.     (define (file-dependency/integration/make filename dependencies)
  404.       (let ((node (filename->source-node filename)))
  405.     (for-each (lambda (dependency)
  406.             (let ((node* (filename->source-node dependency)))
  407.               (if (not (eq? node node*))
  408.               (source-node/link! node node*))))
  409.           dependencies)))
  410.  
  411.     (define (define-integration-dependencies directory name directory* . names)
  412.       (file-dependency/integration/make
  413.        (string-append directory "/" name)
  414.        (apply filename/append directory* names)))
  415.  
  416.     (define-integration-dependencies "base" "object" "base" "enumer")
  417.     (define-integration-dependencies "base" "enumer" "base" "object")
  418.     (define-integration-dependencies "base" "utils" "base" "scode")
  419.     (define-integration-dependencies "base" "cfg1" "base" "object")
  420.     (define-integration-dependencies "base" "cfg2" "base"
  421.       "cfg1" "cfg3" "object")
  422.     (define-integration-dependencies "base" "cfg3" "base" "cfg1" "cfg2")
  423.     (define-integration-dependencies "base" "ctypes" "base"
  424.       "blocks" "cfg1" "cfg2" "cfg3" "contin" "lvalue" "object" "subprb")
  425.     (define-integration-dependencies "base" "rvalue" "base"
  426.       "blocks" "cfg1" "cfg2" "cfg3" "enumer" "lvalue" "object" "utils")
  427.     (define-integration-dependencies "base" "lvalue" "base"
  428.       "blocks" "object" "proced" "rvalue" "utils")
  429.     (define-integration-dependencies "base" "blocks" "base"
  430.       "enumer" "lvalue" "object" "proced" "rvalue" "scode")
  431.     (define-integration-dependencies "base" "proced" "base"
  432.       "blocks" "cfg1" "cfg2" "cfg3" "contin" "enumer" "lvalue" "object"
  433.       "rvalue" "utils")
  434.     (define-integration-dependencies "base" "contin" "base"
  435.       "blocks" "cfg3" "ctypes")
  436.     (define-integration-dependencies "base" "subprb" "base"
  437.       "cfg3" "contin" "enumer" "object" "proced")
  438.  
  439.     (define-integration-dependencies "machines/C" "machin" "rtlbase"
  440.       "rtlreg" "rtlty1" "rtlty2")
  441.  
  442.     (define-integration-dependencies "rtlbase" "regset" "base")
  443.     (define-integration-dependencies "rtlbase" "rgraph" "base" "cfg1" "cfg2")
  444.     (define-integration-dependencies "rtlbase" "rgraph" "machines/C"
  445.       "machin")
  446.     (define-integration-dependencies "rtlbase" "rtlcfg" "base"
  447.       "cfg1" "cfg2" "cfg3")
  448.     (define-integration-dependencies "rtlbase" "rtlcon" "base" "cfg3" "utils")
  449.     (define-integration-dependencies "rtlbase" "rtlcon" "machines/C"
  450.       "machin")
  451.     (define-integration-dependencies "rtlbase" "rtlexp" "rtlbase"
  452.       "rtlreg" "rtlty1")
  453.     (define-integration-dependencies "rtlbase" "rtline" "base" "cfg1" "cfg2")
  454.     (define-integration-dependencies "rtlbase" "rtline" "rtlbase"
  455.       "rtlcfg" "rtlty2")
  456.     (define-integration-dependencies "rtlbase" "rtlobj" "base"
  457.       "cfg1" "object" "utils")
  458.     (define-integration-dependencies "rtlbase" "rtlreg" "machines/C"
  459.       "machin")
  460.     (define-integration-dependencies "rtlbase" "rtlreg" "rtlbase"
  461.       "rgraph" "rtlty1")
  462.     (define-integration-dependencies "rtlbase" "rtlty1" "rtlbase" "rtlcfg")
  463.     (define-integration-dependencies "rtlbase" "rtlty2" "base" "scode")
  464.     (define-integration-dependencies "rtlbase" "rtlty2" "machines/C"
  465.       "machin")
  466.     (define-integration-dependencies "rtlbase" "rtlty2" "rtlbase" "rtlty1")
  467.  
  468.     (file-dependency/integration/join
  469.      (append
  470.       (filename/append "base" "refctx")
  471.       (filename/append "fggen"
  472.                "declar" "fggen") ; "canon" needs no integrations
  473.       (filename/append "fgopt"
  474.                "blktyp" "closan" "conect" "contan" "delint" "desenv"
  475.                "envopt" "folcon" "offset" "operan" "order" "param"
  476.                "outer" "reuse" "reteqv" "sideff" "simapp" "simple"
  477.                "subfre" "varind"))
  478.      (append C-base front-end-base))
  479.  
  480.     (define-integration-dependencies "fgopt" "reuse" "fgopt" "reord")
  481.  
  482.     (file-dependency/integration/join
  483.      (filename/append "rtlgen"
  484.               "fndblk" "fndvar" "opncod" "rgcomb" "rgproc" "rgretn"
  485.               "rgrval" "rgstmt" "rtlgen")
  486.      (append C-base front-end-base rtl-base))
  487.  
  488.     (file-dependency/integration/join
  489.      (append cse-all
  490.          (filename/append "rtlopt" "ralloc" "rcompr" "rdebug" "rdflow"
  491.                   "rerite" "rinvex" "rlife" "rtlcsm")
  492.          (filename/append "machines/C" "rulrew"))
  493.      (append C-base rtl-base))
  494.  
  495.     (file-dependency/integration/join cse-all cse-base)
  496.  
  497.     (file-dependency/integration/join
  498.      (filename/append "rtlopt" "ralloc" "rcompr" "rdebug" "rlife")
  499.      (filename/append "rtlbase" "regset"))
  500.  
  501.     (file-dependency/integration/join
  502.      (filename/append "rtlopt" "rcseht" "rcserq")
  503.      (filename/append "base" "object"))
  504.  
  505.     (define-integration-dependencies "rtlopt" "rlife"  "base" "cfg2")
  506.  
  507.     (let ((dependents
  508.        (append instruction-base
  509.            lapgen-base
  510.            lapgen-body
  511.            (filename/append "back" "linear"))))
  512.       (add-declaration! '(USUAL-DEFINITION (SET EXPT)) dependents)
  513.       (file-dependency/integration/join dependents instruction-base))
  514.  
  515.     (file-dependency/integration/join (append lapgen-base lapgen-body)
  516.                       lapgen-base)
  517.  
  518.     (define-integration-dependencies "back" "lapgn1" "base"
  519.       "cfg1" "cfg2" "utils")
  520.     (define-integration-dependencies "back" "lapgn1" "rtlbase"
  521.       "regset" "rgraph" "rtlcfg")
  522.     (define-integration-dependencies "back" "lapgn2" "rtlbase" "rtlreg")
  523.     (define-integration-dependencies "back" "linear" "base" "cfg1" "cfg2")
  524.     (define-integration-dependencies "back" "linear" "rtlbase" "rtlcfg")
  525.     (define-integration-dependencies "back" "mermap" "back" "regmap")
  526.     (define-integration-dependencies "back" "regmap" "base" "utils"))
  527.  
  528.   (for-each (lambda (node)
  529.           (let ((links (source-node/backward-links node)))
  530.         (if (not (null? links))
  531.             (set-source-node/declarations!
  532.              node
  533.              (cons (make-integration-declaration
  534.                 (source-node/pathname node)
  535.                 (map source-node/pathname links))
  536.                (source-node/declarations node))))))
  537.         source-nodes))
  538.  
  539. (define (make-integration-declaration pathname integration-dependencies)
  540.   `(INTEGRATE-EXTERNAL
  541.     ,@(map (let ((default
  542.           (make-pathname
  543.            false
  544.            false
  545.            (cons 'RELATIVE
  546.              (make-list
  547.               (length (cdr (pathname-directory pathname)))
  548.               'UP))
  549.            false
  550.            false
  551.            false)))
  552.          (lambda (pathname)
  553.            (merge-pathnames pathname default)))
  554.        integration-dependencies)))
  555.  
  556. (define-integrable (integration-declaration? declaration)
  557.   (eq? (car declaration) 'INTEGRATE-EXTERNAL))
  558.  
  559. ;;;; Expansion Dependencies
  560.  
  561. (define (initialize/expansion-dependencies!)
  562.   (let ((file-dependency/expansion/join
  563.      (lambda (filenames expansions)
  564.        (for-each (lambda (filename)
  565.                (let ((node (filename->source-node filename)))
  566.              (set-source-node/declarations!
  567.               node
  568.               (cons (make-expansion-declaration expansions)
  569.                 (source-node/declarations node)))))
  570.              filenames))))
  571.     (file-dependency/expansion/join
  572.      (filename/append "machines/C"
  573.               "lapgen"
  574.               "rules1" "rules2" "rules3" "rules4"
  575.               "rulfix" "rulflo" "cout"
  576.               )
  577.      (map (lambda (entry)
  578.         `(,(car entry)
  579.           (PACKAGE/REFERENCE (FIND-PACKAGE '(COMPILER LAP-SYNTAXER))
  580.                  ',(cadr entry))))
  581.       '((LAP:SYNTAX-INSTRUCTION LAP:SYNTAX-INSTRUCTION-EXPANDER)
  582.         (INSTRUCTION->INSTRUCTION-SEQUENCE
  583.          INSTRUCTION->INSTRUCTION-SEQUENCE-EXPANDER)
  584.         (SYNTAX-EVALUATION SYNTAX-EVALUATION-EXPANDER)
  585.         (CONS-SYNTAX CONS-SYNTAX-EXPANDER)
  586.         (OPTIMIZE-GROUP-EARLY OPTIMIZE-GROUP-EXPANDER)
  587.         (EA-KEYWORD-EARLY EA-KEYWORD-EXPANDER)
  588.         (EA-MODE-EARLY EA-MODE-EXPANDER)
  589.         (EA-REGISTER-EARLY EA-REGISTER-EXPANDER)
  590.         (EA-EXTENSION-EARLY EA-EXTENSION-EXPANDER)
  591.         (EA-CATEGORIES-EARLY EA-CATEGORIES-EXPANDER))))))
  592.  
  593. (define-integrable (make-expansion-declaration expansions)
  594.   `(EXPAND-OPERATOR ,@expansions))
  595.  
  596. (define-integrable (expansion-declaration? declaration)
  597.   (eq? (car declaration) 'EXPAND-OPERATOR))