Beautiful Code [283]
(define top-mark (make-mark))
(define top-marked?
(lambda (wrap)
(and (not (null? wrap))
(or (eq? (car wrap) top-mark)
(top-marked? (cdr wrap))))))
When the expander creates a syntax object representing the original input, it uses a wrap that contains the top mark at its base, specifically to allow the stripping code detect when it has reached the syntax-object base and need not traverse the object further. This feature prevents the expander from traversing constants unnecessarily so that it can easily preserve shared and cyclic structure, and not be confused by the presence of quoted syntax objects in the input.
25.2.4. Syntax Errors
The expander reports syntax errors via syntax-error, which is defined as follows:
(define syntax-error
(lambda (object message)
(error #f "~a ~s" message (strip object))))
If the implementation attaches source information to syntax objects, this source information can be used to construct an error message that incorporates the source line and character position.
25.2.5. Structural Predicates
The nonatomic structure of a syntax object is always determined with the patterns of a syntax-case form. The identifier? predicate determines whether a syntax object represents an identifier:
(define identifier?
(lambda (x)
(and (syntax-object? x)
(symbol? (syntax-object-expr x)))))
Similarly, the self-evaluating? predicate is used, after stripping a syntax object, to deter-mine whether it represents a constant:
(define self-evaluating?
(lambda (x)
(or (boolean? x) (number? x) (string? x) (char? x))))
25.2.6. Creating Wraps
A mark or substitution is added to a syntax object by extending the wrap:
(define add-mark
(lambda (mark x)
(extend-wrap (list mark) x)))
(define add-subst
(lambda (id label x)
(extend-wrap
(list (make-subst
(syntax-object-expr id)
(wrap-marks (syntax-object-wrap id))
label))
x)))
If the syntax object is only partially wrapped, the wrap is extended simply by creating a syntax object encapsulating the partially wrapped structure. Otherwise, the syntax object is rebuilt with the new wrap joined to the old wrap:
(define extend-wrap
(lambda (wrap x)
(if (syntax-object? x)
(make-syntax-object
(syntax-object-expr x)
(join-wraps wrap (syntax-object-wrap x)))
(make-syntax-object x wrap))))
Joining two wraps is almost as simple as appending the lists of marks. The only complication is that the expansion algorithm requires that two like marks cancel when they meet.
(define join-wraps
(lambda (wrap1 wrap2)
(cond
[(null? wrap1) wrap2]
[(null? wrap2) wrap1]
[else
(let f ([w (car wrap1)] [w* (cdr wrap1)])
(if (null? w*)
(if (and (mark? w) (eq? (car wrap2) w))
(cdr wrap2)
(cons w wrap2))
(cons w (f (car w*) (cdr w*)))))])))
25.2.7. Manipulating Environments
Environments map labels to bindings and are represented as association lists. Extending an environment therefore involves adding a single pair mapping a label to a binding:
(define extend-env
(lambda (label binding env)
(cons (cons label binding) env)))
25.2.8. Identifier Resolution
Determining the binding associated with an identifier is a two-step process. The first step is to determine the label associated with the identifier in the identifier's wrap, and the second is to look the label up in the current environment:
define id-binding
(lambda (id r)
(label-binding id (id-label id) r)))
The marks and substitutions that appear in an identifier's wrap determine the associated label, if any. Substitutions map names and lists of marks to labels. Any substitution whose name is not the name of the identifier is ignored, as is any whose marks do not match. The names are symbols and are thus compared using the pointer equivalence operator, eq?.
The set of marks considered relevant are those that were layered onto the wrap before the substitution. Thus, the set of marks to which a substitution's marks are compared changes