1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Mike Sperber
; Things used by the expression returned by REIFY-STRUCTURES.
; Cf. link/reify.scm.
(define (operator name type-exp)
(get-operator name (sexp->type type-exp #t)))
(define (primop name)
(get-primop name))
(define (simple-interface names types)
(make-simple-interface #f
(map (lambda (name type)
(list name (sexp->type type #t)))
(vector->list names)
(vector->list types))))
(define (package names locs get-location uid)
(let ((end (vector-length names))
(p (make-package list list ;(lambda () '())
#f #f "" '()
uid #f)))
(set-package-loaded?! p #t)
(do ((i 0 (+ i 1)))
((= i end))
(let* ((name (vector-ref names i))
(probe (package-lookup p name)))
(if (not (binding? probe))
(package-define! p
name
usual-variable-type
(get-location (vector-ref locs i))
#f))))
(make-table-immutable! (package-definitions p))
p))
(define (transform kind names+proc env type-exp source name)
(cond
((eq? kind 'macro)
(make-transform/macro names+proc env (sexp->type type-exp #t) source name))
((eq? kind 'inline)
(make-transform/inline names+proc env (sexp->type type-exp #t) source name))
(else
(assertion-violation 'transform
"unknown transform kind" kind))))
(define (package-define-static! package name static)
(package-define! package
name
(cond ((transform? static)
(transform-type static))
((primop? static)
(primop-type static))
((operator? static)
(operator-type static))
((structure? static)
structure-type)
(else
(assertion-violation 'package-define-static!
"unknown kind of static value" static)))
#f
static))
|
