home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / comp / front_end / user.t < prev   
Encoding:
Text File  |  1989-06-30  |  4.5 KB  |  120 lines
  1. (herald (front_end user)
  2.   (env t (orbit_top defs)))
  3.  
  4. ;;; Print out the status of the locale variables encountered in the program.
  5.  
  6. ;;; Blow off the old PRINT-VARIABLE-INFO (is it still necessary to do this?)
  7. (define print-variable-info false)
  8.  
  9. ;;; (VARIABLES
  10. ;;;   FREE          variables free in this file
  11. ;;;   EARLY-BOUND   declared variables used in this file that have not been
  12. ;;;                 entirely integrated
  13. ;;;   DEFINED       variables defined
  14. ;;;   LSET                    lset
  15. ;;;   SET                     set
  16. ;;;   ERROR         multiply defined variables
  17. ;;;   INTEGRATED    variables whose values were integrated
  18. ;;;   LOCAL         variables declared to be local to this file
  19. ;;;   UNREFERENCED  defined, lset, and set variables that are not referenced
  20. ;;; )
  21.  
  22. (define (new-print-variable-info defined free borrowed old-env)
  23.   (receive (defs lsets error set local unreferenced early-bound1 integrated1)
  24.            (sort-new-variables defined old-env)
  25.     (receive (early-bound2 integrated2)
  26.              (sort-borrowed-variables borrowed)
  27.       (let ((stream *noise+terminal*))
  28.         (format stream "~&(VARIABLES~%")
  29.         (format stream "  FREE ~S~%" (get-free-variables free))
  30.         (format stream "  EARLY-BOUND ~S~%" (append! early-bound1 early-bound2))
  31.         (format stream "  DEFINED ~S~%" defs)
  32.         (format stream "  LSET ~S~%" lsets)
  33.         (format stream "  SET ~S~%" set)
  34.         (format stream "  ERROR ~S~%" error)
  35.         (format stream "  INTEGRATED ~S~%" (append! integrated1 integrated2))
  36.         (format stream "  LOCAL ~S~%" local)
  37.         (format stream "  UNREFERENCED ~S)~%" unreferenced)
  38.         ))))
  39.  
  40. (define (sort-new-variables defined old-env)
  41.   (let ((vars '()))
  42.     (table-walk defined
  43.                 (lambda (#f var)
  44.                   (push vars var)))
  45.     (iterate loop ((v vars) (d '()) (l '()) (e '()) (s '()) (o '()) (u '())
  46.                             (eb '()) (i '()))
  47.       (cond ((null? v)
  48.              (return d l e s o u eb i))
  49.             (else
  50.              (let* ((var (car v))
  51.                     (n (variable-name var))
  52.                     (def (variable-definition var))
  53.                     (u (if (and (null? (cdr (variable-refs var)))
  54.                                 (not (memq? 'integrated (variable-flags var))))
  55.                            (cons n u)
  56.                            u))
  57.                     (o (if (memq? 'local (definition-data def))
  58.                            (cons n o)
  59.                            o)))
  60.                (xcase (definition-variant (variable-definition var))
  61.                  ((set)
  62.                   (if (lset-early-binding? n old-env)
  63.                       (loop (cdr v) d l e (cons n s) o u (cons n eb) i)
  64.                       (loop (cdr v) d l e (cons n s) o u eb i)))
  65.                  ((multiple)
  66.                   (loop (cdr v) d l (cons n e) s o u eb i))
  67.                  ((lset)
  68.                   (if (set-variable? var)
  69.                       (loop (cdr v) d (cons n l) e (cons n s) o u eb i)
  70.                       (loop (cdr v) d (cons n l) e s o u eb i))) 
  71.                  ((define)
  72.                   (loop (cdr v) (cons n d) l e s o u eb i))
  73.                  ((constant)
  74.                   (if (memq? 'integrated (variable-flags var))
  75.                       (loop (cdr v) (cons n d) l e s o u eb (cons n i))
  76.                       (loop (cdr v) (cons n d) l e s o u eb i))))))))))
  77.  
  78. (define (sort-borrowed-variables borrowed)
  79.   (let ((eb '())
  80.         (i '()))
  81.     (table-walk borrowed
  82.                 (lambda (name var)
  83.                   (if (not (null? (variable-refs var)))
  84.                       (push eb name))
  85.                   (if (memq? 'integrated (variable-flags var))
  86.                       (push i name))))
  87.     (return eb i)))
  88.  
  89. (define (get-free-variables free)
  90.   (let ((f '()))
  91.     (table-walk free
  92.                 (lambda (name var)
  93.                   (ignore var)
  94.                   (push f name)))
  95.     f))
  96.  
  97. (define (set-variable? var)
  98.   (memq? 'set (definition-data (variable-definition var))))
  99.  
  100. (define (lset-early-binding? name env)
  101.   (and (env name)
  102.        (eq? 'lset (definition-variant (env name)))))
  103.  
  104. ;;; Mark the variable referenced by NODE (if any) as having been used.
  105.  
  106. (define (mark-reference-used node)
  107.   (if (and (reference-node? node)
  108.            (variable-definition (reference-variable node)))
  109.       (mark-variable-used (reference-variable node))))
  110.  
  111. ;;; Mark the variable as having been used so that it will show up as INTEGRATED
  112. ;;; in the locale variable information.
  113.  
  114. (define (mark-variable-used var)
  115.   (if (not (memq? 'integrated (variable-flags var)))
  116.       (push (variable-flags var) 'integrated)))
  117.  
  118.  
  119.  
  120.