home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / comp / front_end / envs.t < prev    next >
Encoding:
Text File  |  1988-02-05  |  9.0 KB  |  228 lines
  1. (herald (front_end envs)
  2.   (env t (orbit_top defs)))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. ;;;    This implements the early binding database for ORBIT.  DEFINE and its
  28. ;;; cousins generate early binding information for the variable defined.
  29. ;;;    Currently the only information saved is the type of the variable's value
  30. ;;; and an integrable value if the definition is declared to be constant.
  31.  
  32. ;;;    A definition table contains the definition information for a given
  33. ;;; module.  This includes a table of mapping names to definitions and a list
  34. ;;; of the primops defined in the module.
  35. ;;;
  36. ;;;  (<table> <symbol>) => the definition for <symbol> in the locale.  This
  37. ;;;      is settable.
  38. ;;;  (WALK-DEFINITIONS <table> <proc>) => (<proc> <symbol> <definition>) for
  39. ;;;      each <symbol> in the table.
  40. ;;;  (ADD-PRIMOP <table> <primop>) adds the primop to the table's primop set.
  41. ;;;  (PRIMOP-LIST <table>) => a list of all the primops defined in the module.
  42.  
  43. ;;;  The method for AUGMENT-CONTEXT is used by the HERALD special form.
  44.  
  45. (define (make-definition-table id)
  46.   (let ((table (make-table id))
  47.         (primops '()))
  48.     (object (lambda (name)
  49.               (table-entry table name))
  50.       ((setter self)
  51.        (lambda (name value)
  52.          (set (table-entry table name) value)))
  53.       ((walk-definitions self proc)
  54.        (table-walk table proc))
  55.       ((add-primop self primop) (push primops primop))
  56.       ((primop-list self) primops)
  57.       ((early-binding-table? self) t)
  58.       ((module-id env) id)
  59.       ((identification self) id)
  60.       ((print self stream)
  61.        (format stream "#{Early-binding-table ~D ~S}" (object-hash self) id)))))
  62.  
  63. (define-predicate early-binding-table?)
  64. (define-predicate early-binding-env?)
  65. (define-operation (module-id env))
  66. (define-operation (walk-definitions env proc))
  67. (define-operation (add-primop env primop))
  68. (define-operation (primop-list env))
  69. (define-operation (instantiate-definition-table env table))
  70.  
  71. (define (make-empty-definition-table id)
  72.   (make-definition-table id))
  73.  
  74. (define (make-empty-definition-env id)
  75.   (make-definition-env false id))
  76.  
  77. ;;;   The information in a definition table is used by instantiating the table 
  78. ;;; in a definition environment and then using the environment for support.
  79. ;;; The compile-time environments mimic the behavior of T's run-time
  80. ;;; environments.
  81.  
  82. (define (make-definition-env super id)
  83.   (let ((definition-table (make-table id))
  84.         (primops '()))
  85.     (object (lambda (name)
  86.               (cond ((table-entry definition-table name)
  87.                      => identity)
  88.                     (else
  89.                      (super name))))
  90.       ((setter self)
  91.        (lambda (name def)
  92.          (set (table-entry definition-table name) def)))
  93.       ((instantiate-definition-table self table)
  94.        (let ((table (enforce early-binding-table? table)))
  95.          (instantiate-table self table definition-table (locative primops))))
  96.       ((walk-definitions self proc)
  97.        (table-walk definition-table proc))
  98.       ((add-primop self primop) (push primops primop))
  99.       ((primop-list self) primops)
  100.       ((module-id env) id)
  101.       ((identification self) id)
  102.       ((early-binding-env? self) t)
  103.       ((augment-context self . rest)
  104.        (get-definition-environment self nil rest))
  105.       ((print self stream)
  106.        (format stream "#{Early-binding-env ~D ~S}"
  107.                       (object-hash self) id)))))
  108.  
  109. ;;; Instantiate a definition-table by instantiating each of its definitions.
  110. ;;; The primops are added to the primop set of the environment.
  111.  
  112. (define (instantiate-table env table defs primops)
  113.   (walk-definitions table
  114.                     (lambda (name def)
  115.                       (set (table-entry defs name)
  116.                            (instantiate-definition def env))))
  117.   (set (contents primops)
  118.        (append (primop-list table) (contents primops)))
  119.   (return))
  120.  
  121. ;;; Construct a definition environment containing the modules designated by
  122. ;;; SPECS and with superior environment SUPER.
  123.  
  124. (define (get-definition-environment super id specs)
  125.   (let ((new (make-definition-env super id)))
  126.     (walk (lambda (spec)
  127.             (instantiate-definition-table new
  128.                                           (get-definition-table spec)))
  129.           specs)
  130.     new))
  131.  
  132. (lset *standard-definition-env* (make-empty-definition-env 'empty-env))
  133.  
  134. ;;;   Change all CONSTANT definitions to DEFINE definitions.  This means that
  135. ;;; the environment's information will be used for error checking only, no
  136. ;;; integration will be done.
  137.  
  138. (define (weaken-definition-env env)
  139.   (walk-definitions env
  140.                     (lambda (name definition)
  141.                       (ignore name)
  142.                       (cond ((eq? 'constant (definition-variant definition))
  143.                              (set (definition-value definition) nil)
  144.                              (set (definition-variant definition) 'define)))))
  145.   (return))
  146.  
  147.  
  148. ;;;                      DEFINITION structures
  149. ;;;============================================================================
  150. ;;;   Structure to hold information for a symbol in a particular environment.
  151.  
  152. (define-structure-type definition
  153.   variant   ; What kind of definition this is, one of 'DEFINE etc.
  154.   value     ; The value VARIABLE is bound to if VARIABLE is integrable.
  155.   env       ; The environment this definition is instantiated in.
  156.   type      ; The type of the value VARIABLE is bound to.
  157.   data      ; Not currently used.
  158.   (((print self stream)
  159.     (format stream "#{Definition~_~S}" (object-hash self)))))
  160.  
  161. (let ((s (stype-master definition-stype)))
  162.   (set (definition-env s) false))
  163.  
  164. (define (make-definition-entry var table data variant value type)
  165.   (let ((s (make-definition)))
  166.     (set (definition-data     s) data)
  167.     (set (definition-variant  s) variant)
  168.     (set (definition-value    s) value)
  169.     (set (definition-env      s) nil)
  170.     (set (definition-type     s) type)
  171.     (set (variable-definition var) s)
  172.     (if table (set (table (variable-name var)) s))
  173.     s))
  174.  
  175. ;;; A definition is instantiated by copying it and setting the ENV slot of the
  176. ;;; copy.  This is only necessary if the definition has a value (and sometimes
  177. ;;; not even then).
  178.  
  179. (define (instantiate-definition def env)
  180.   (cond ((not (definition-value def))
  181.          def)
  182.         (else
  183.          (let ((new (copy-structure def)))
  184.            (set (definition-env new) env)
  185.            new))))
  186.  
  187. ;;;   Get the definition of a variable.  If the value of the variable is another
  188. ;;; variable the second variable's definition is returned instead.
  189.  
  190. (define (get-variable-definition variable)
  191.   (let ((def (variable-definition variable)))
  192.     (cond ((and def
  193.                 (eq? 'constant (definition-variant def))
  194.                 (definition->variable def))
  195.            => get-variable-definition)
  196.           (else def))))
  197.  
  198. ;;;   A predicate that determines if REF is the definition of some variable.
  199. ;;; Returns the definiiton variant if it exists.
  200.  
  201. (define (supports-definition ref)
  202.   (and (call-arg? (node-role ref))
  203.        (let ((proc (call-proc (node-parent ref))))
  204.          (if (and (eq? (call-arg 2) (node-role ref))
  205.                   (primop-node? proc)
  206.                   (primop.definition? (primop-value proc)))
  207.              (primop.definition-variant (primop-value proc))
  208.              nil))))
  209.  
  210. ;;; Is this definition local to the module currently being compiled.
  211.  
  212. (define (local-definition? def)
  213.   (eq? *new-env* (definition-env def)))
  214.        
  215. ;;; Is NODE an integrable definition.
  216.  
  217. (define (integrable-definition? node)
  218.   (cond ((and (reference-node? node)
  219.               (get-variable-definition (reference-variable node)))
  220.          => (lambda (def)
  221.               (eq? 'constant (definition-variant def))))
  222.         (else nil)))
  223.  
  224.  
  225.  
  226.  
  227.  
  228.