#| -*-Scheme-*-
-$Id: scode.scm,v 4.10 1999/01/02 06:06:43 cph Exp $
+$Id: scode.scm,v 4.11 2001/12/20 16:28:22 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; SCode Interface
delay-expression
make-disjunction disjunction? disjunction-components
disjunction-predicate disjunction-alternative
- make-in-package in-package? in-package-components
- in-package-environment in-package-expression
make-lambda lambda? lambda-components
make-open-block open-block? open-block-components
primitive-procedure? procedure?
#| -*-Scheme-*-
-$Id: canon.scm,v 1.16 1999/01/02 06:06:43 cph Exp $
+$Id: canon.scm,v 1.17 2001/12/20 16:28:22 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; Scode canonicalization.
environment. This is used by the LOW optimization level.
TOP-LEVEL: The expression appears at top level of the original
- expression or an in-package special form. It is not
- surrounded by any lambda expressions in the input form.
- It is assumed that such expressions are only executed
- (evaluated) once.
+ expression. It is not surrounded by any lambda
+ expressions in the input form. It is assumed that
+ such expressions are only executed (evaluated) once.
ONCE-ONLY: The expression will be executed only once (as long as
the corresponding top level expression is executed
(default)
exp))))))))))))
\f
-;;;; Hair squared
-
-(define (canonicalize/in-package expr bound context)
- (scode/in-package-components
- expr
- (lambda (environment expression)
- (let ((nexpr (canonicalize/expression
- expression '()
- (if (canonicalize/optimization-low? context)
- 'FIRST-CLASS
- 'TOP-LEVEL)))
- (nenv (canonicalize/expression environment bound context)))
-
- (define (good expr)
- (canonicalize/combine-unary
- (lambda (env)
- (scode/make-evaluation expr
- env
- (and (not (eq? context 'TOP-LEVEL))
- (not (eq? context 'ONCE-ONLY)))
- expr))
- nenv))
-
- (cond ((canout-splice? nexpr)
- ;; Random optimization. The in-package expression has no
- ;; free variables. Turn it into a sequence.
- (canonicalize/combine-unary scode/make-sequence
- (combine-list (list nenv nexpr))))
- ((canonicalize/optimization-low? context)
- (canonicalize/combine-unary
- (lambda (exp)
- (canonicalize/bind-environment (canout-expr nexpr)
- exp
- expr))
- nenv))
- ((not (canout-needs? nexpr))
- (good (canout-expr nexpr)))
- (else
- (good
- (canonicalize/bind-environment (canout-expr nexpr)
- (scode/make-the-environment)
- expr))))))))
-\f
;;;; Hair cubed
#|
(nary-entry unary delay)
(binary-entry disjunction)
(standard-entry variable)
- (standard-entry in-package)
(standard-entry the-environment)
(dispatch-entries (combination-1 combination-2 combination
primitive-combination-0
#| -*-Scheme-*-
-$Id: fggen.scm,v 4.32 1999/01/02 06:06:43 cph Exp $
+$Id: fggen.scm,v 4.33 2001/12/20 16:28:22 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; Flow Graph Generation
\f
(define-structure (context (conc-name context/)
(constructor context/make))
- (unconditional? false read-only true type boolean)
- (static? false read-only true type boolean))
+ (unconditional? #f read-only #t type boolean)
+ (static? #f read-only #t type boolean))
(define-integrable (context/make-initial)
- (context/make true true))
+ (context/make #t #t))
(define-integrable (context/make-internal)
- (context/make true false))
+ (context/make #t #f))
(define-integrable (context/conditional context)
- (context/make false
- (context/static? context)))
+ (context/make #f (context/static? context)))
(define-integrable (context/unconditional context)
- (context/make true
- (context/static? context)))
-
+ (context/make #t (context/static? context)))
\f
(define (construct-graph scode)
(fluid-let ((*virtual-continuations* '())
(*global-variables* '()))
- (let ((block (make-block false 'EXPRESSION)))
+ (let ((block (make-block #f 'EXPRESSION)))
(let ((continuation (make-continuation-variable block)))
(let ((expression
(make-expression
(set-procedure-entry-node! procedure next)))))
*procedures*)
(for-each (lambda (continuation)
- (set-virtual-continuation/parent! continuation false))
+ (set-virtual-continuation/parent! continuation #f))
*virtual-continuations*)
(initialize-reference-contexts! expression *procedures*)
expression)))))
(define (continuation/rvalue continuation)
(make-reference (continuation/block continuation)
(continuation/parameter continuation)
- true))
+ #t))
(define-integrable (continuation/next-hooks continuation)
(list (make-hook (continuation/entry-node continuation)
set-snode-next-edge!)))
(define-integrable (continuation-reference block continuation)
- (cond ((variable? continuation) (make-reference block continuation true))
+ (cond ((variable? continuation) (make-reference block continuation #t))
((procedure? continuation) continuation)
(else (error "Illegal continuation" continuation))))
(scfg*value->value! push
(generator (cfg-entry-node push)
continuation))))
- (generator false continuation)))
+ (generator #f continuation)))
(define (make-subproblem/canonical prefix continuation)
(make-subproblem prefix
(define (continue/predicate-constant block continuation rvalue)
block continuation ;; ignored
(if (and (rvalue/constant? rvalue)
- (false? (constant-value rvalue)))
+ (not (constant-value rvalue)))
(snode->pcfg-false (make-fg-noop))
(snode->pcfg-true (make-fg-noop))))
rvalue))
(define (continue/unknown block continuation rvalue)
- (make-return block (make-reference block continuation true) rvalue))
+ (make-return block (make-reference block continuation #t) rvalue))
(define (continue/effect block continuation rvalue)
rvalue ;; ignored
(if (variable? continuation)
- (continue/unknown block continuation (make-constant false))
+ (continue/unknown block continuation (make-constant #f))
(make-null-cfg)))
(define-integrable (continue/predicate block continuation rvalue)
safe?))))
(define generate/variable
- (make-variable-generator scode/variable-name false))
+ (make-variable-generator scode/variable-name #f))
(define generate/safe-variable
- (make-variable-generator scode/safe-variable-name true))
+ (make-variable-generator scode/safe-variable-name #t))
(define generate/global-variable
- (make-variable-generator scode/global-variable-name false))
+ (make-variable-generator scode/global-variable-name #f))
(define-integrable (scode/make-safe-variable name)
(cons safe-variable-tag name))
(define (generate/lambda block continuation context expression)
(generate/lambda* block continuation
context (context/make-internal)
- expression false false))
+ expression #f #f))
;; context is the context of the lambda expression.
;; context* is the context of its subexpressions.
(set-block-bound-variables! block `(,continuation ,@vars))
(if (context/static? context*)
(for-each (lambda (var)
- (lvalue-put! var 'STATIC true))
+ (lvalue-put! var 'STATIC #t))
vars)))
(let ((procedure
(make-procedure
;; be either a constant or a procedure.
(subproblem-rvalue
(generate/subproblem/value block continuation
- context* value false)))
+ context* value #f)))
values)
(generate/body block continuation
context* declarations body*))))
(if closure-block
(set-procedure-closure-context! procedure closure-block))
(if (context/unconditional? context)
- (procedure-put! procedure 'UNCONDITIONAL true))
+ (procedure-put! procedure 'UNCONDITIONAL #t))
(set-procedure-debugging-info!
procedure
(if (and
(return-3 '() '()
(scode/make-combination
(scode/make-lambda
- lambda-tag:let auxiliary '() false names '()
+ lambda-tag:let auxiliary '() #f names '()
(scode/make-sequence
(map* actions scode/make-assignment names values)))
(map (lambda (name)
(define (generate/operands expression operands block continuation context index)
(let walk ((operands operands) (index index))
- (if (null? operands)
- '()
+ (if (pair? operands)
;; This forces the order of evaluation
(let ((next (generate/subproblem/value block continuation context
(car operands) 'COMBINATION-OPERAND
expression index)))
(cons next
- (walk (cdr operands) (1+ index)))))))
+ (walk (cdr operands) (1+ index))))
+ '())))
\f
(define (generate/operator block continuation context expression operator operands*)
(let ((make-combination
context (context/unconditional context)
operator
(continuation/known-type continuation)
- false))
+ #f))
((scode/absolute-reference? operator)
(generate/global-variable block continuation*
context operator))
operands*
push))))
((continuation/case continuation
- (lambda () (make-combination false continuation))
+ (lambda () (make-combination #f continuation))
(lambda ()
(if (variable? continuation)
- (make-combination false continuation)
+ (make-combination #f continuation)
(with-reified-continuation block
continuation
scfg*scfg->scfg!
(continuation/next-hooks (subproblem-continuation subproblem)))
(subproblem-prefix subproblem))
(maker block (find-name block name) (subproblem-rvalue subproblem))
- (continue/effect block continuation false))))
+ (continue/effect block continuation #f))))
(define (generate/assignment block continuation context expression)
(scode/assignment-components expression
(lambda (predicate alternative)
(generate/conditional
block continuation context
- (scode/make-conditional predicate true alternative)))))
+ (scode/make-conditional predicate #t alternative)))))
(define (generate/disjunction/value block continuation context expression)
(scode/disjunction-components expression
(scode/combination-operator predicate)))
(generate/conditional
block continuation context
- (scode/make-conditional predicate true alternative))
+ (scode/make-conditional predicate #t alternative))
(generate/combination
block continuation context
(let ((temp (generate-uninterned-symbol "or-predicate-")))
(boolean-valued-function-variable?
(scode/absolute-reference-name operator)))
(else
- false)))
+ #f)))
\f
(define (generate/access block continuation context expression)
(scode/access-components expression
(make-constant
(compile-recursively
(scode/quotation-expression expression)
- false
- false))))
+ #f
+ #f))))
((COMPILE-PROCEDURE)
(let ((process
(lambda (name)
(continue/rvalue-constant
block continuation
(make-constant
- (compile-recursively expression true name)))
+ (compile-recursively expression #t name)))
(generate/expression block continuation
context expression))))
(fail
(block-parent block) continuation
context (context/make-internal)
(scode/quotation-expression (car operands))
- false
+ #f
(make-reference block
(find-name block
(scode/variable-name (cadr operands)))
- false)))))
+ #f)))))
\f
(define (generate/delay block continuation context expression)
(generate/combination
(ucode-primitive system-pair-cons)
(list (ucode-type delayed)
0
- (scode/make-lambda lambda-tag:unnamed '() '() false '() '()
+ (scode/make-lambda lambda-tag:unnamed '() '() #f '() '()
(scode/delay-expression expression))))))
(define (generate/error-combination block continuation context expression)
(scode/make-combination compiled-error-procedure
(cons message irritants))))))
-(define (generate/in-package block continuation context expression)
- (warn "generate/in-package: expression will be interpreted"
- expression)
- (scode/in-package-components expression
- (lambda (environment expression)
- (generate/combination
- block continuation context
- (scode/make-combination
- (ucode-primitive scode-eval)
- (list (scode/make-quotation expression)
- environment))))))
-
(define (generate/quotation block continuation context expression)
(generate/combination
block continuation context
(standard-entry definition)
(standard-entry delay)
(standard-entry disjunction)
- (standard-entry in-package)
(standard-entry pair)
(standard-entry quotation)
(standard-entry the-environment)
#| -*-Scheme-*-
-$Id: anfile.scm,v 1.6 1999/01/02 06:11:34 cph Exp $
+$Id: anfile.scm,v 1.7 2001/12/20 16:28:22 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; Free/Bound Variable Analysis
(DELAY ,analyze/delay)
(DISJUNCTION ,analyze/disjunction)
(ERROR-COMBINATION ,analyze/error-combination)
- (IN-PACKAGE ,analyze/error)
(LAMBDA ,analyze/lambda)
(SEQUENCE ,analyze/sequence)
(VARIABLE ,analyze/variable))))
#| -*-Scheme-*-
-$Id: codwlk.scm,v 14.3 1999/01/02 06:11:34 cph Exp $
+$Id: codwlk.scm,v 14.4 2001/12/20 16:28:22 cph Exp $
-Copyright (c) 1988, 1999 Massachusetts Institute of Technology
+Copyright (c) 1988, 1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; SCode Walker
\f
(define-structure (scode-walker (constructor %make-scode-walker)
(conc-name scode-walker/))
- (access false read-only true)
- (assignment false read-only true)
- (combination false read-only true)
- (comment false read-only true)
- (conditional false read-only true)
- (constant false read-only true)
- (declaration false read-only true)
- (definition false read-only true)
- (delay false read-only true)
- (disjunction false read-only true)
- (error-combination false read-only true)
- (in-package false read-only true)
- (lambda false read-only true)
- (open-block false read-only true)
- (quotation false read-only true)
- (sequence false read-only true)
- (the-environment false read-only true)
- (unassigned? false read-only true)
- (variable false read-only true))
-\f
+ (access #f read-only #t)
+ (assignment #f read-only #t)
+ (combination #f read-only #t)
+ (comment #f read-only #t)
+ (conditional #f read-only #t)
+ (constant #f read-only #t)
+ (declaration #f read-only #t)
+ (definition #f read-only #t)
+ (delay #f read-only #t)
+ (disjunction #f read-only #t)
+ (error-combination #f read-only #t)
+ (lambda #f read-only #t)
+ (open-block #f read-only #t)
+ (quotation #f read-only #t)
+ (sequence #f read-only #t)
+ (the-environment #f read-only #t)
+ (unassigned? #f read-only #t)
+ (variable #f read-only #t))
+
(define (make-scode-walker default alist)
(let ((alist
(map (lambda (entry)
(lookup 'DISJUNCTION default)
(lookup 'ERROR-COMBINATION
combination-handler)
- (lookup 'IN-PACKAGE default)
(lookup 'LAMBDA default)
(lookup 'OPEN-BLOCK sequence-handler)
(lookup 'QUOTATION default)
(DEFINITION ,walk/definition)
(DELAY ,walk/delay)
(DISJUNCTION ,walk/disjunction)
- (IN-PACKAGE ,walk/in-package)
((LAMBDA LEXPR EXTENDED-LAMBDA) ,walk/lambda)
(QUOTATION ,walk/quotation)
((SEQUENCE-2 SEQUENCE-3) ,walk/sequence)
(if (open-block? expression)
(scode-walker/open-block walker)
(scode-walker/sequence walker)))
-\f
+
(define (walk/access walker expression)
expression
(scode-walker/access walker))
expression
(scode-walker/disjunction walker))
-(define (walk/in-package walker expression)
- expression
- (scode-walker/in-package walker))
-
(define (walk/lambda walker expression)
expression
(scode-walker/lambda walker))
#| -*-Scheme-*-
-$Id: illdef.scm,v 1.4 1999/01/02 06:11:34 cph Exp $
+$Id: illdef.scm,v 1.5 2001/12/20 16:28:22 cph Exp $
-Copyright (c) 1991-1999 Massachusetts Institute of Technology
+Copyright (c) 1991-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; Check for Illegal Definitions
(DEFINITION ,walk/definition)
(DELAY ,walk/delay)
(DISJUNCTION ,walk/disjunction)
- (IN-PACKAGE ,walk/in-package)
(LAMBDA ,walk/lambda)
(SEQUENCE ,walk/sequence))))
unspecific)
(lambda (name required optional rest auxiliary declarations body)
name required optional rest
(unscan-defines auxiliary declarations body))))))
- (if (null? (cdr expressions))
- (walk/no-definitions (car expressions))
+ (if (pair? (cdr expressions))
(begin
(walk/expression (car expressions) 'LEGAL)
- (loop (cdr expressions))))))
+ (loop (cdr expressions)))
+ (walk/no-definitions (car expressions)))))
(define (walk/definition expression context)
(case context
(define (walk/disjunction expression context)
(walk/no-definitions (disjunction-predicate expression))
(walk/expression (disjunction-alternative expression)
- (if (eq? 'LEGAL context) 'UNUSUAL context)))
-
-(define (walk/in-package expression context)
- context
- (walk/no-definitions (in-package-environment expression))
- (check-for-illegal-definitions (in-package-expression expression)))
\ No newline at end of file
+ (if (eq? 'LEGAL context) 'UNUSUAL context)))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: prgcop.scm,v 1.6 1999/01/02 06:06:43 cph Exp $
+$Id: prgcop.scm,v 1.7 2001/12/20 16:28:22 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; Program copier
(DEFINITION ,(%copy-pair (ucode-type DEFINITION)))
(DELAY ,(%copy-pair (ucode-type DELAY)))
(DISJUNCTION ,(%copy-pair (ucode-type DISJUNCTION)))
- (IN-PACKAGE ,(%copy-pair (ucode-type IN-PACKAGE)))
(LAMBDA ,copy-LAMBDA-object)
(QUOTATION ,(%copy-pair (ucode-type QUOTATION)))
(SEQUENCE ,copy-SEQUENCE-object)
\f
;;;; Top level
-(define *default/copy-constants?* false)
+(define *default/copy-constants?* #f)
(define *copy-constants?*)
#| -*-Scheme-*-
-$Id: runtime.pkg,v 14.394 2001/12/20 16:13:18 cph Exp $
+$Id: runtime.pkg,v 14.395 2001/12/20 16:28:22 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
delay-components
delay-expression
delay?
- in-package-components
- in-package-environment
- in-package-expression
- in-package?
make-absolute-reference
make-access
make-assignment
make-declaration
make-definition
make-delay
- make-in-package
make-quotation
make-the-environment
make-variable
#| -*-Scheme-*-
-$Id: scode.scm,v 14.16 1999/01/02 06:11:34 cph Exp $
+$Id: scode.scm,v 14.17 2001/12/20 16:28:22 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; SCode Abstraction
(define (scode-constant? object)
(if (vector-ref scode-constant/type-vector (object-type object))
- true
+ #t
(and (compiled-code-address? object)
(not (eq? (compiled-entry-type object) 'COMPILED-EXPRESSION)))))
(define (make-scode-constant/type-vector)
- (let ((type-vector (make-vector (microcode-type/code-limit) false)))
+ (let ((type-vector (make-vector (microcode-type/code-limit) #f)))
(for-each (lambda (name)
- (vector-set! type-vector (microcode-type name) true))
+ (vector-set! type-vector (microcode-type name) #t))
'(BIGNUM
CHARACTER
COMPILED-CODE-BLOCK
;;;; Variable
(define-integrable (make-variable name)
- (system-hunk3-cons (ucode-type variable) name true '()))
+ (system-hunk3-cons (ucode-type variable) name #t '()))
(define-integrable (variable? object)
(object-type? (ucode-type variable) object))
(define (make-absolute-reference name . rest)
(let loop ((reference (make-access system-global-environment name))
(rest rest))
- (if (null? rest)
- reference
- (loop (make-access reference (car rest)) (cdr rest)))))
+ (if (pair? rest)
+ (loop (make-access reference (car rest)) (cdr rest))
+ reference)))
(define (absolute-reference? object)
(and (access? object)
(define (absolute-reference-to? object name)
(and (absolute-reference? object)
(eq? (absolute-reference-name object) name)))
-\f
-;;;; In-Package
-
-(define-integrable (make-in-package environment expression)
- (&typed-pair-cons (ucode-type in-package) environment expression))
-
-(define-integrable (in-package? object)
- (object-type? (ucode-type in-package) object))
-
-(define-integrable (in-package-environment expression)
- (&pair-car expression))
-
-(define-integrable (in-package-expression expression)
- (&pair-cdr expression))
-
-(define (in-package-components expression receiver)
- (receiver (in-package-environment expression)
- (in-package-expression expression)))
;;;; Delay
#| -*-Scheme-*-
-$Id: unsyn.scm,v 14.21 2001/03/21 19:15:29 cph Exp $
+$Id: unsyn.scm,v 14.22 2001/12/20 16:28:22 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
(DEFINITION ,unsyntax-DEFINITION-object)
(DELAY ,unsyntax-DELAY-object)
(DISJUNCTION ,unsyntax-DISJUNCTION-object)
- (IN-PACKAGE ,unsyntax-IN-PACKAGE-object)
(LAMBDA ,unsyntax-LAMBDA-object)
(OPEN-BLOCK ,unsyntax-OPEN-BLOCK-object)
(QUOTATION ,unsyntax-QUOTATION)
(VARIABLE ,unsyntax-VARIABLE-object))))
unspecific)
-(define unsyntaxer:macroize?
- true)
-
-(define unsyntaxer:show-comments?
- false)
-
-(define unsyntaxer:elide-global-accesses?
- false)
+(define unsyntaxer:macroize? #t)
+(define unsyntaxer:show-comments? #f)
+(define unsyntaxer:elide-global-accesses? #f)
(define substitutions '())
(action object))))
(define-integrable (has-substitution? object)
- (and (not (null? substitutions))
+ (and (pair? substitutions)
(assq object substitutions)))
(define bound (list #F '()))
(define unsyntaxer/scode-walker)
(define (unsyntax-objects objects)
- (if (null? objects)
- '()
+ (if (pair? objects)
(cons (unsyntax-object (car objects))
- (unsyntax-objects (cdr objects)))))
+ (unsyntax-objects (cdr objects)))
+ '()))
(define (unsyntax-error keyword message . irritants)
(apply error
`(ACCESS ,@(unexpand-access object))))
(define (unexpand-access object)
- (let loop ((object object) (separate? true))
+ (let loop ((object object) (separate? #t))
(if (and separate?
(access? object)
(not (has-substitution? object)))
(define (unsyntax-sequence-actions seq)
(let ((actions (sequence-immediate-actions seq)))
(let loop ((actions actions))
- (if (null? actions)
- '()
+ (if (pair? actions)
(let ((substitution (has-substitution? (car actions))))
(cond (substitution
(cons (cdr substitution)
(loop (cdr actions))))
(else
(cons (unsyntax-object (car actions))
- (loop (cdr actions))))))))))
+ (loop (cdr actions))))))
+ '()))))
(define (unsyntax-OPEN-BLOCK-object open-block)
(if (eq? #t unsyntaxer:macroize?)
(define (unsyntax-DELAY-object object)
`(DELAY ,(unsyntax-object (delay-expression object))))
-(define (unsyntax-IN-PACKAGE-object object)
- (in-package-components object
- (lambda (environment expression)
- `(IN-PACKAGE ,(unsyntax-object environment)
- ,@(unsyntax-sequence expression)))))
-
(define (unsyntax-THE-ENVIRONMENT-object object)
object
`(THE-ENVIRONMENT))
,(unsyntax-object alternative)))
(define (unsyntax-conditional predicate consequent alternative)
- (cond ((false? alternative)
+ (cond ((not alternative)
`(AND ,@(unexpand-conjunction predicate consequent)))
((eq? alternative undefined-conditional-branch)
`(IF ,(unsyntax-object predicate)
`(,(unsyntax-object predicate)
,@(conditional-components consequent
(lambda (predicate consequent alternative)
- (if (false? alternative)
+ (if (not alternative)
(unexpand-conjunction predicate consequent)
`(,(unsyntax-conditional predicate
consequent
(lambda-components** operator
(lambda (name required optional rest body)
(if (and (null? optional)
- (false? rest)
+ (not rest)
(= (length required) (length operands)))
(cond ((or (eq? name lambda-tag:unnamed)
(eq? name lambda-tag:let))
;; the entire expresion to find out if it has any substitutable
;; subparts, we just treat it as malformed if there are active
;; substitutions.
- (cond ((not (null? substitutions))
+ (cond ((pair? substitutions)
(if-malformed))
((and (or (absolute-reference-to? operator 'SHALLOW-FLUID-BIND)
(and (variable? operator)
((and (eq? operator (ucode-primitive with-saved-fluid-bindings 1))
(null? names)
(null? values)
- (not (null? operands))
+ (pair? operands)
(lambda? (car operands))
(null? (cdr operands)))
(unsyntax/fluid-let/deep (car operands)))
(map extract-transfer-var
(sequence-actions (lambda-body (car operands))))
(let every-other ((values values))
- (if (null? values)
- '()
- (cons (car values) (every-other (cddr values))))))
+ (if (pair? values)
+ (cons (car values) (every-other (cddr values)))
+ '())))
,@(lambda-components** (cadr operands)
(lambda (name required optional rest body)
name required optional rest
#| -*-Scheme-*-
-$Id: xeval.scm,v 1.6 1999/01/02 06:19:10 cph Exp $
+$Id: xeval.scm,v 1.7 2001/12/20 16:28:23 cph Exp $
-Copyright (c) 1989-1999 Massachusetts Institute of Technology
+Copyright (c) 1989-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; SCode Evaluator extended for compiled-code environments
(open-block-components expression
(lambda (names declarations body)
declarations body
- (not (null? names))))))
+ (pair? names)))))
(error
"Can't perform definition in compiled-code environment:"
(unsyntax expression)))
(CONDITIONAL ,rewrite/conditional)
(DELAY ,rewrite/delay)
(DISJUNCTION ,rewrite/disjunction)
- (IN-PACKAGE ,rewrite/in-package)
(LAMBDA ,rewrite/lambda)
(SEQUENCE ,rewrite/sequence)
(THE-ENVIRONMENT ,rewrite/the-environment)
environment
bound-names)))
-(define (rewrite/in-package expression environment bound-names)
- (make-in-package (rewrite/expression (in-package-environment expression)
- environment
- bound-names)
- (in-package-expression expression)))
-
(define (rewrite/sequence expression environment bound-names)
(make-sequence (rewrite/expressions (sequence-actions expression)
environment
#| -*-Scheme-*-
-$Id: cgen.scm,v 4.4 1999/01/02 06:19:10 cph Exp $
+$Id: cgen.scm,v 4.5 2001/12/20 16:28:23 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; SCode Optimizer: Generate SCode from Expression
(make-disjunction
(cgen/expression interns (disjunction/predicate expression))
(cgen/expression interns (disjunction/alternative expression)))))
-
-(define-method/cgen 'IN-PACKAGE
- (lambda (interns expression)
- (make-in-package
- (cgen/expression interns (in-package/environment expression))
- (cgen/top-level (in-package/quotation expression)))))
\f
(define-method/cgen 'PROCEDURE
(lambda (interns procedure)
#| -*-Scheme-*-
-$Id: chtype.scm,v 4.3 1999/01/02 06:19:10 cph Exp $
+$Id: chtype.scm,v 4.4 2001/12/20 16:28:23 cph Exp $
-Copyright (c) 1988, 1993, 1999 Massachusetts Institute of Technology
+Copyright (c) 1988, 1993, 1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; SCode Optimizer: Intern object types
(change-type/expression (disjunction/predicate expression))
(change-type/expression (disjunction/alternative expression))))
-(define-method/change-type 'IN-PACKAGE
- (lambda (expression)
- (change-type/expression (in-package/environment expression))
- (change-type/quotation (in-package/quotation expression))))
-
(define-method/change-type 'PROCEDURE
(lambda (expression)
(change-type/expression (procedure/body expression))))
#| -*-Scheme-*-
-$Id: copy.scm,v 4.5 1999/01/02 06:19:10 cph Exp $
+$Id: copy.scm,v 4.6 2001/12/20 16:28:23 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; SCode Optimizer: Copy Expression
(copy/expression block
environment
(disjunction/alternative expression)))))
-
-(define-method/copy 'IN-PACKAGE
- (lambda (block environment expression)
- (in-package/make
- (in-package/scode expression)
- (copy/expression block environment (in-package/environment expression))
- (copy/quotation (in-package/quotation expression)))))
\f
(define-method/copy 'PROCEDURE
(lambda (block environment procedure)
#| -*-Scheme-*-
-$Id: free.scm,v 4.3 1999/01/02 06:19:10 cph Exp $
+$Id: free.scm,v 4.4 2001/12/20 16:28:23 cph Exp $
-Copyright (c) 1988, 1993, 1999 Massachusetts Institute of Technology
+Copyright (c) 1988, 1993, 1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; SCode Optimizer: Free Variable Analysis
(set/union (free/expression (disjunction/predicate expression))
(free/expression (disjunction/alternative expression)))))
-(define-method/free 'IN-PACKAGE
- (lambda (expression)
- (free/expression (in-package/environment expression))))
-
(define-method/free 'PROCEDURE
(lambda (expression)
(set/difference
#| -*-Scheme-*-
-$Id: object.scm,v 4.9 1999/01/02 06:19:10 cph Exp $
+$Id: object.scm,v 4.10 2001/12/20 16:28:23 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; SCode Optimizer: Data Types
(define (enumeration/make names)
(let ((enumerands
(let loop ((names names) (index 0))
- (if (null? names)
- '()
- (cons (vector false (car names) index)
- (loop (cdr names) (1+ index)))))))
+ (if (pair? names)
+ (cons (vector #f (car names) index)
+ (loop (cdr names) (1+ index)))
+ '()))))
(let ((enumeration
(cons (list->vector enumerands)
(map (lambda (enumerand)
(define-structure (enumerand (type vector)
(conc-name enumerand/))
- (enumeration false read-only true)
- (name false read-only true)
- (index false read-only true))
+ (enumeration #f read-only #t)
+ (name #f read-only #t)
+ (index #f read-only #t))
(define-integrable (enumeration/cardinality enumeration)
(vector-length (car enumeration)))
declaration
delay
disjunction
- in-package
open-block
procedure
quotation
(conc-name delayed-integration/)
(constructor delayed-integration/make (operations value)))
(state 'NOT-INTEGRATED)
- (environment false)
+ (environment #f)
operations
value)
(CONC-NAME ,(symbol-append name '/))
(CONSTRUCTOR ,(symbol-append name '/MAKE)))
,@(if (or (default-object? scode?) scode?)
- `((scode false read-only true))
+ `((scode #f read-only #t))
`())
,@slots))))
(define-simple-type variable (block name flags) #F)
(define-simple-type declaration (declarations expression))
(define-simple-type delay (expression))
(define-simple-type disjunction (predicate alternative))
- (define-simple-type in-package (environment quotation))
(define-simple-type open-block (block variables values actions optimized))
(define-simple-type procedure (block name required optional rest body))
(define-simple-type quotation (block expression))
(enumeration/name->index enumeration/expression name)))
(define-integrable (global-ref/make name)
- (access/make false
- (constant/make false system-global-environment)
+ (access/make #f
+ (constant/make #f system-global-environment)
name))
(define (global-ref? object)
(access/name object)))
(define-integrable (constant->integration-info constant)
- (make-integration-info (constant/make false constant)))
+ (make-integration-info (constant/make #f constant)))
(define-integrable (integration-info? object)
(and (pair? object)
#| -*-Scheme-*-
-$Id: sf.sf,v 4.10 2001/12/19 21:53:03 cph Exp $
+$Id: sf.sf,v 4.11 2001/12/20 16:28:23 cph Exp $
Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
DECLARATION?
DELAY?
DISJUNCTION?
- IN-PACKAGE?
OPEN-BLOCK?
PROCEDURE?
QUOTATION?
#| -*-Scheme-*-
-$Id: subst.scm,v 4.16 1999/01/02 06:06:43 cph Exp $
+$Id: subst.scm,v 4.17 2001/12/20 16:28:23 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; SCode Optimizer: Beta Substitution
(integrate/expression operations environment
(delay/expression expression)))))
-(define-method/integrate 'IN-PACKAGE
- (lambda (operations environment expression)
- (in-package/make (in-package/scode expression)
- (integrate/expression operations environment
- (in-package/environment expression))
- (integrate/quotation (in-package/quotation expression)))))
-
(define (integrate/quotation quotation)
(call-with-values
(lambda ()
#| -*-Scheme-*-
-$Id: xform.scm,v 4.10 2000/03/01 23:48:45 cph Exp $
+$Id: xform.scm,v 4.11 2001/12/20 16:28:23 cph Exp $
-Copyright (c) 1988-2000 Massachusetts Institute of Technology
+Copyright (c) 1988-2001 Massachusetts Institute of Technology
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
|#
;;;; SCode Optimizer: Transform Input Expression
(transform/expression block environment predicate)
(transform/expression block environment alternative)))))
-(define (transform/in-package block environment expression)
- (in-package-components expression
- (lambda (environment* expression*)
- (in-package/make expression
- (transform/expression block environment environment*)
- (transform/quotation* false expression*)))))
-
(define (transform/quotation block environment expression)
block environment ;ignored
(transform/quotation* expression (quotation-expression expression)))
(DEFINITION ,transform/definition)
(DELAY ,transform/delay)
(DISJUNCTION ,transform/disjunction)
- (IN-PACKAGE ,transform/in-package)
(LAMBDA ,transform/lambda)
(OPEN-BLOCK ,transform/open-block)
(QUOTATION ,transform/quotation)
;;; -*-Scheme-*-
;;;
-;;; $Id: macros.scm,v 1.10 2000/04/06 03:43:15 cph Exp $
+;;; $Id: macros.scm,v 1.11 2001/12/20 16:28:23 cph Exp $
;;;
-;;; Copyright (c) 1993-2000 Massachusetts Institute of Technology
+;;; Copyright (c) 1993-2001 Massachusetts Institute of Technology
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
;;;; Macros
,(lambda (name expr)
(and (not (eq? name (definition-name expr)))
(do-expr name (definition-value expr)))))
- (IN-PACKAGE ,(lambda (name expr) name (illegal expr)))
(LAMBDA
,(lambda (name expr)
(lambda-components expr
projects / mit-scheme.git / commitdiff