home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pseudo-s / pseudo_2.lha / module.scm < prev    next >
Encoding:
Text File  |  1991-06-21  |  4.6 KB  |  144 lines
  1. ; -*- Mode: Scheme; Syntax: Scheme; Package: Scheme; -*-
  2. ; File module.scm / Copyright (c) 1991 Jonathan Rees / See file COPYING
  3.  
  4. ;;;; Signatures, program environments, modules
  5.  
  6. ;(schi::set-file-context! si:fdefine-file-pathname schi::scheme-translator-context)
  7.  
  8. ; Signatures
  9.  
  10. (define signature-rtd
  11.   (make-record-type 'signature '(id names aux-names)))
  12.  
  13. (define make-signature
  14.   (record-constructor signature-rtd '(id names aux-names)))
  15.  
  16. (define signature-names (record-accessor signature-rtd 'names))
  17. (define signature-aux-names (record-accessor signature-rtd 'aux-names))
  18.  
  19. ; SIGNATURE-REF returns one of
  20. ;   #F       if the name is not exported
  21. ;   PUBLIC   if exported as a value
  22. ;   PRIVATE  if exported as an auxiliary value
  23.  
  24. ;+++ This can be slow if SIG exports many variables (as does the r^4
  25. ; signature).  If this becomes a problem, change it so that it does a
  26. ; table lookup (after some threshold size?).
  27.  
  28. (define (signature-ref sig name)
  29.   (cond ((memq name (signature-names sig)) 'public)
  30.     (else #f)))
  31.  
  32. (define (signature-ref-aux sig name)
  33.   (cond ((memq name (signature-names sig)) 'public)
  34.     ((memq name (signature-aux-names sig)) 'private)
  35.     (else #f)))
  36.  
  37.  
  38. ; Program (i.e. top-level) environments contain macro definitions.
  39.  
  40. (define program-env-rtd
  41.   (make-record-type 'program-env '(id use-list table package)))
  42. (define program-env-id       (record-accessor program-env-rtd 'id))
  43. (define program-env-use-list (record-accessor program-env-rtd 'use-list))
  44. (define program-env-table    (record-accessor program-env-rtd 'table))
  45. (define program-env-package  (record-accessor program-env-rtd 'package))
  46. (define program-env? (record-predicate program-env-rtd))
  47.  
  48. (define make-program-env
  49.   (let ((create (record-constructor program-env-rtd
  50.                     '(id use-list table package))))
  51.     (lambda (id use-list)
  52.       (let ((env
  53.          (create id
  54.              use-list
  55.              (make-table)
  56.              (make-package-using id (map module-package use-list)))))
  57.     (init-environment-for-syntax! env)
  58.     env))))
  59.  
  60. (define-record-discloser program-env-rtd
  61.   (lambda (r) (list "Program-env" (program-env-id r))))
  62.  
  63. ; Careful, name need not be a symbol
  64.  
  65. (define (program-env-lookup program-env name)
  66.   (or (table-ref (program-env-table program-env) name)
  67.       (let ((q? (and (symbol? name)
  68.              (qualified-symbol? name))))
  69.     (or (and (not q?)
  70.          (let loop ((mods (program-env-use-list program-env)))
  71.            (and (not (null? mods))
  72.             (or (module-ref (car mods) name)
  73.                 (loop (cdr mods))))))
  74.         ;; SIDE EFFECT!  Not so good.
  75.         (let ((node (make-program-variable
  76.              name
  77.              (if q?
  78.                  name
  79.                  (scheme-hacks:intern-renaming-perhaps
  80.                   (name->string name)
  81.                   (program-env-package program-env))))))
  82.           (table-set! (program-env-table program-env) name node)
  83.           node)))))
  84.  
  85. (define (program-env-define! program-env name binding)
  86.   (table-set! (program-env-table program-env) name binding))
  87.  
  88. (define client-lookup program-env-lookup)   ;for classify
  89. (define client-define! program-env-define!) ;for classify
  90.  
  91.  
  92. ; Get the environment in which to evaluate transformer procedure expressions.
  93.  
  94. (define environment-for-syntax-key
  95.   (list 'environment-for-syntax-key))  ;any unique id
  96.  
  97. (define (get-environment-for-syntax env)
  98.   (force (lookup env environment-for-syntax-key)))
  99.  
  100. (define (define-transformer-env! env t-env-promise)
  101.   (define! env environment-for-syntax-key t-env-promise))
  102.  
  103. (define (init-environment-for-syntax! env)
  104.   (define-transformer-env! env
  105.     (delay (make-program-env
  106.         (string->symbol
  107.          (string-append (symbol->string (program-env-id env))
  108.                 "[META]"))
  109.         (list revised^4-scheme-module)))))
  110.  
  111.  
  112. ; A module is a pair <signature, program-environment>.
  113. ; Pavel Curtis would prefer to call these things "interfaces".
  114.  
  115. (define module-rtd
  116.   (make-record-type 'module '(id sig program-env package)))
  117. (define make-module
  118.   (let ((create
  119.      (record-constructor module-rtd '(id sig program-env package))))
  120.     (lambda (id sig env)
  121.       (create id sig env
  122.           (make-package-exporting
  123.                id
  124.            (let ((ppackage (program-env-package env)))
  125.              (map (lambda (name)
  126.                 (scheme-hacks:intern-renaming-perhaps
  127.                          (symbol->string name) ppackage))
  128.               (signature-names sig))))))))
  129.  
  130.  
  131. (define module-id        (record-accessor module-rtd 'id))
  132. (define module-signature (record-accessor module-rtd 'sig))
  133. (define module-program-env (record-accessor module-rtd 'program-env))
  134. (define module-package   (record-accessor module-rtd 'package))
  135.  
  136. (define-record-discloser module-rtd
  137.   (lambda (r) (list "Module" (module-id r))))
  138.  
  139. (define (module-ref mod name)
  140.   (if (eq? (signature-ref (module-signature mod) name)
  141.        'public)
  142.       (program-env-lookup (module-program-env mod) name)
  143.       #f))
  144.