230 lines
7.2 KiB
Scheme
230 lines
7.2 KiB
Scheme
;; Compiler structures
|
|
;; (c) 1996-1997 Sebastian Good
|
|
;; (c) 1997-2001 PLT
|
|
|
|
;; Mostly structure definitions, mostly for annotations.
|
|
|
|
(module cstructs mzscheme
|
|
(require mzlib/unit
|
|
mzlib/list
|
|
mzlib/etc)
|
|
|
|
(require syntax/zodiac-sig)
|
|
|
|
(require "sig.ss")
|
|
(require "../sig.ss")
|
|
|
|
(provide cstructs@)
|
|
(define-unit cstructs@
|
|
(import compiler:library^
|
|
(prefix zodiac: zodiac^)
|
|
compiler:zlayer^)
|
|
(export compiler:cstructs^)
|
|
|
|
;;----------------------------------------------------------------------------
|
|
;; VARREF ATTRIBUTES
|
|
;; Used as the annotation for zodiac:varref objects
|
|
|
|
(define-struct va (flags i-n-v-oke-module))
|
|
|
|
(define (varref:empty-attributes) (make-va 0 #f))
|
|
(define (varref:add-attribute! ast attr)
|
|
(let ([va (get-annotation ast)])
|
|
(set-va-flags! va (bitwise-ior attr (va-flags va)))))
|
|
(define (varref:has-attribute? ast attr)
|
|
(let ([anno (get-annotation ast)])
|
|
(and (va? anno) (positive? (bitwise-and (va-flags anno) attr)))))
|
|
|
|
(define varref:static 1)
|
|
(define varref:per-load-static 2)
|
|
(define varref:primitive 8)
|
|
(define varref:symbol 16)
|
|
(define varref:inexact 32)
|
|
(define varref:env 64)
|
|
(define varref:in-module 128)
|
|
(define varref:module-stx-string 256)
|
|
|
|
;;----------------------------------------------------------------------------
|
|
;; AST NODES
|
|
;; New AST nodes to augment the zodiac set:
|
|
|
|
;; AST node for the creation of a closure (replaces, e.g., a lambda expression)
|
|
(define-struct (compiler:make-closure zodiac:zodiac) (lambda free-vars args name))
|
|
|
|
;;----------------------------------------------------------------------------
|
|
;; ANNOTATION STRUCTURES
|
|
;;
|
|
|
|
;; mzc annotation for a zodiac:binding, installed in the `known'
|
|
;; analysis phase
|
|
(define-struct binding (rec? ; part of a letrec recursive binding set
|
|
mutable? ; set!ed? (but not for unit or letrec definitions)
|
|
unit-i/e? ; is imported/exported (including uses by in-voke)
|
|
anchor ; zodiac:binding - anchor binding for this binding
|
|
letrec-set?; set! to implement a letrec
|
|
ivar? ; is a class ivar?
|
|
known? ; known to have a fixed value? (i.e., it's not
|
|
;; mutated or detectably #<undefined> for a while?)
|
|
val
|
|
;; ``known'' value as an abitrary AST (so it's
|
|
;; really only *known* if this is a constant
|
|
known-but-used?
|
|
;; known value used in an improper way?
|
|
;; if so, always preserve the variable (i.e., don't
|
|
;; propagate it away entirely)
|
|
rep ; reprsentation (#f until rep-choosing phase)
|
|
))
|
|
|
|
;; copy a binding record
|
|
(define (copy-binding b)
|
|
(make-binding (binding-rec? b)
|
|
(binding-mutable? b)
|
|
(binding-unit-i/e? b)
|
|
(binding-anchor b)
|
|
(binding-letrec-set? b)
|
|
(binding-ivar? b)
|
|
(binding-known? b)
|
|
(binding-val b)
|
|
(binding-known-but-used? b)
|
|
(binding-rep b)))
|
|
|
|
(define (copy-binding-for-light-closures b)
|
|
(make-binding #f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
(binding-known? b) (binding-val b)
|
|
#f
|
|
#f))
|
|
|
|
(define binder:empty-anno
|
|
(make-binding #f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f))
|
|
|
|
(define-struct code (; The following fields, XXX-vars, are
|
|
;; all sets of zodiac:bindings
|
|
free-vars
|
|
;; lexical variables that are free in the
|
|
;; code (i.e., kept in a closure)
|
|
local-vars
|
|
;; variables introduced during the evaluation
|
|
;; of the code; includes, for example, the argument
|
|
;; variables if this is a lambda closure
|
|
global-vars
|
|
;; ``global'' variables used by this code;
|
|
;; we capture globals that are specific to
|
|
;; the namespace at load-time
|
|
used-vars
|
|
;; local variables that are eventually used in
|
|
;; an expression after they are introduced in the
|
|
;; code
|
|
captured-vars
|
|
;; free and used variables that are free within
|
|
;; a closure that is created by this code
|
|
|
|
parent
|
|
;; #f if this is a top-level expression, container
|
|
;; code otherwise
|
|
case-parent
|
|
;; #f, unless it's a code in a case-lambda, then
|
|
;; it's the case-code containing this code
|
|
|
|
children
|
|
;; list of children code structures
|
|
))
|
|
|
|
;; Structure for the annotation given to closures, such
|
|
;; as lambdas or units. The actual annotation will be
|
|
;; an instance of a sub-type of `code', depending on
|
|
;; the kind of closure.
|
|
(define-struct (closure-code code)
|
|
(; Representation and implementation info
|
|
rep
|
|
alloc-rep
|
|
label ; integer - id within vehicle
|
|
vehicle ; integer - vehicle id
|
|
|
|
max-arity
|
|
;; max number of args in applications
|
|
;; within the closure (which is unrelated
|
|
;; to the number of arguments used to call
|
|
;; this closure, if it happens to be a
|
|
;; lambda)
|
|
|
|
return-multi
|
|
;; #f (always single), #t (never single),
|
|
;; or 'possible
|
|
|
|
name
|
|
;; inferred name - can be #f, a varref, a binding,
|
|
;; or a list of inferred names.
|
|
;; (see also vm->c:extract-inferred-name)
|
|
))
|
|
|
|
;; Annotation type for case-lambda closures:
|
|
(define-struct (procedure-code closure-code)
|
|
(case-codes
|
|
;; A list of case-code records
|
|
case-arities
|
|
;; An integer indicating which
|
|
;; arity record in compiler:case-lambdas
|
|
;; contains MzScheme information for
|
|
;; the arity of the case-lambda. For
|
|
;; single-case lambdas, this is #f
|
|
;; because the arity information is
|
|
;; inlined.
|
|
liftable
|
|
;; top-level-varref => procedure is lifted
|
|
method?
|
|
;; #t => arity errors hide first argument
|
|
;; (triggered by 'method-arity-error property)
|
|
))
|
|
|
|
(define-struct (case-code code)
|
|
(; Does the compilation of this case use continue?
|
|
;; If so, output the case body within while(1){...}
|
|
has-continue?))
|
|
|
|
;; annotations given to zodiac:app AST nodes
|
|
(define-struct app (tail?
|
|
;; tail application?
|
|
prim?
|
|
;; application of a known primitive?
|
|
prim-name
|
|
;; MzScheme name for the known primitive, or #f
|
|
))
|
|
|
|
;;----------------------------------------------------------------------------
|
|
;; ACCESSOR
|
|
;;
|
|
|
|
;; Retrives the *annotation* of a zodiac:binding for a zodiac:bound-varref.
|
|
;; (Compare to zodiac:bound-varref-binding, which returns the
|
|
;; zodiac:binding itself, rather than its annotation.)
|
|
(define compiler:bound-varref->binding
|
|
(compose get-annotation zodiac:bound-varref-binding))
|
|
|
|
;;----------------------------------------------------------------------------
|
|
;; special constants
|
|
;;
|
|
(define-struct c-lambda (function-name scheme-name body arity))
|
|
|
|
;;----------------------------------------------------------------------------
|
|
;; error/warning structures
|
|
;;
|
|
(define-struct compiler:message (ast message))
|
|
(define-struct (compiler:error-msg compiler:message) ())
|
|
(define-struct (compiler:fatal-error-msg compiler:message) ())
|
|
(define-struct (compiler:internal-error-msg compiler:message) ())
|
|
(define-struct (compiler:warning-msg compiler:message) ())))
|