Redo the previous change: it was causing VERY BAD things to happen.

This one should be considerably safer.

diff --git a/v7/src/sf/pardec.scm b/v7/src/sf/pardec.scm
index bfb360963bbacf901beaaf824d13f46d648be82b..ed2f9ad7500b7af1acc383a57e44820dcbb416be 100644 (file)
--- a/v7/src/sf/pardec.scm
+++ b/v7/src/sf/pardec.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: pardec.scm,v 4.20 2008/02/10 04:42:41 cph Exp $
+$Id: pardec.scm,v 4.21 2008/02/13 06:21:03 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -216,13 +216,7 @@ USA.
                          usual-integrations/constant-values)
          (for-each (constructor 'INTEGRATE)
                    constant-names
-                   constant-values))
-       (receive (primitive-names primitive-values)
-           (do-deletions usual-integrations/primitive-names
-                         usual-integrations/primitive-values)
-         (for-each (constructor 'INTEGRATE-OPERATOR)
-                   primitive-names
-                   primitive-values)))
+                   constant-values)))
       (map* declarations
            (let ((top-level-block
                   (let loop ((block block))

diff --git a/v7/src/sf/subst.scm b/v7/src/sf/subst.scm
index f802c0602ddfbaef6a9f0d5516db38c0e10721f4..ab615284781b0112174c5a188093360766d66d05 100644 (file)
--- a/v7/src/sf/subst.scm
+++ b/v7/src/sf/subst.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: subst.scm,v 4.24 2008/02/10 04:42:42 cph Exp $
+$Id: subst.scm,v 4.25 2008/02/13 06:21:05 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -663,8 +663,7 @@ you ask for.
           => (lambda (operands*)
                (integrate/combination expression operations environment
                                       block (car operands*) (cdr operands*))))
-         ((or (assq name usual-integrations/constant-alist)
-              (assq name usual-integrations/primitive-alist))
+         ((assq name usual-integrations/constant-alist)
           => (lambda (entry)
                (integrate/combination expression operations environment
                                       block (cdr entry) operands)))

diff --git a/v7/src/sf/usicon.scm b/v7/src/sf/usicon.scm
index 10e194901fe39d36bb5cb9bca8451ad5b298d80e..8a9136d8b95e4c806f5696fe31c94262750dea4a 100644 (file)
--- a/v7/src/sf/usicon.scm
+++ b/v7/src/sf/usicon.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: usicon.scm,v 4.13 2008/02/10 06:12:08 cph Exp $
+$Id: usicon.scm,v 4.14 2008/02/13 06:21:06 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -30,13 +30,10 @@ USA.
 
 (declare (usual-integrations)
         (integrate-external "object"))
-\f
+
 (define usual-integrations/constant-names)
 (define usual-integrations/constant-values)
 (define usual-integrations/constant-alist)
-(define usual-integrations/primitive-names)
-(define usual-integrations/primitive-values)
-(define usual-integrations/primitive-alist)
 
 (define (usual-integrations/cache!)
   (set! usual-integrations/constant-names
@@ -67,16 +64,4 @@ USA.
                      #f
                      (environment-lookup system-global-environment name))))
             usual-integrations/constant-names))
-  (set! usual-integrations/primitive-names
-       (map car global-primitives))
-  (set! usual-integrations/primitive-values
-       (map (lambda (p)
-              (constant->integration-info
-               (make-primitive-procedure (cadr p))))
-            global-primitives))
-  (set! usual-integrations/primitive-alist
-       (map (lambda (p)
-              (cons (car p)
-                    (constant/make #f (make-primitive-procedure (cadr p)))))
-            global-primitives))
   unspecific)
\ No newline at end of file

diff --git a/v7/src/sf/usiexp.scm b/v7/src/sf/usiexp.scm
index cdbaa53102c5983fc272f9ef42e4b3fa1d1d83c9..c475256a50d5f3ade21afffde2fd1afcec49514d 100644 (file)
--- a/v7/src/sf/usiexp.scm
+++ b/v7/src/sf/usiexp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: usiexp.scm,v 4.49 2008/01/30 20:02:38 cph Exp $
+$Id: usiexp.scm,v 4.50 2008/02/13 06:21:07 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -576,170 +576,178 @@ USA.
                         (ucode-primitive integer->flonum 2)
                         (list (car operands) (constant/make #f #b10))))
       (if-not-expanded)))
+
+(define (make-primitive-expander primitive)
+  (lambda (expr operands if-expanded if-not-expanded block)
+    (if (procedure-arity-valid? primitive (length operands))
+       (if-expanded (make-combination expr block primitive operands))
+       (if-not-expanded))))
 \f
 ;;;; Tables
 
 (define usual-integrations/expansion-names
-  '(
-    *
-    +
-    -
-    -1+
-    /
-    1+
-    <
-    <=
-    =
-    >
-    >=
-    apply
-    caaaar
-    caaadr
-    caaar
-    caadar
-    caaddr
-    caadr
-    caar
-    cadaar
-    cadadr
-    cadar
-    caddar
-    cadddr
-    caddr
-    cadr
-    call-with-values
-    cdaaar
-    cdaadr
-    cdaar
-    cdadar
-    cdaddr
-    cdadr
-    cdar
-    cddaar
-    cddadr
-    cddar
-    cdddar
-    cddddr
-    cdddr
-    cddr
-    char=?
-    complex?
-    cons*
-    default-object?
-    eighth
-    exact-integer?
-    exact-rational?
-    expt
-    fifth
-    first
-    fix:<=
-    fix:=
-    fix:>=
-    fourth
-    int:->flonum
-    int:integer?
-    intern
-    list
-    make-string
-    make-vector-8b
-    ;; modulo  ; Compiler does not currently open-code it.
-    negative?
-    number?
-    positive?
-    quotient
-    remainder
-    second
-    seventh
-    sixth
-    string->symbol
-    symbol?
-    third
-    values
-    weak-pair?
-    with-values
-    zero?
-    ))
+  (append '(*
+           +
+           -
+           -1+
+           /
+           1+
+           <
+           <=
+           =
+           >
+           >=
+           apply
+           caaaar
+           caaadr
+           caaar
+           caadar
+           caaddr
+           caadr
+           caar
+           cadaar
+           cadadr
+           cadar
+           caddar
+           cadddr
+           caddr
+           cadr
+           call-with-values
+           cdaaar
+           cdaadr
+           cdaar
+           cdadar
+           cdaddr
+           cdadr
+           cdar
+           cddaar
+           cddadr
+           cddar
+           cdddar
+           cddddr
+           cdddr
+           cddr
+           char=?
+           complex?
+           cons*
+           default-object?
+           eighth
+           exact-integer?
+           exact-rational?
+           expt
+           fifth
+           first
+           fix:<=
+           fix:=
+           fix:>=
+           fourth
+           int:->flonum
+           int:integer?
+           intern
+           list
+           make-string
+           make-vector-8b
+           ;; modulo   ; Compiler does not currently open-code it.
+           negative?
+           number?
+           positive?
+           quotient
+           remainder
+           second
+           seventh
+           sixth
+           string->symbol
+           symbol?
+           third
+           values
+           weak-pair?
+           with-values
+           zero?)
+         (map car global-primitives)))
 \f
 (define usual-integrations/expansion-values
-  (list
-   *-expansion
-   +-expansion
-   --expansion
-   -1+-expansion
-   /-expansion
-   1+-expansion
-   <-expansion
-   <=-expansion
-   =-expansion
-   >-expansion
-   >=-expansion
-   apply*-expansion
-   caaaar-expansion
-   caaadr-expansion
-   caaar-expansion
-   caadar-expansion
-   caaddr-expansion
-   caadr-expansion
-   caar-expansion
-   cadaar-expansion
-   cadadr-expansion
-   cadar-expansion
-   caddar-expansion
-   cadddr-expansion
-   caddr-expansion
-   cadr-expansion
-   call-with-values-expansion
-   cdaaar-expansion
-   cdaadr-expansion
-   cdaar-expansion
-   cdadar-expansion
-   cdaddr-expansion
-   cdadr-expansion
-   cdar-expansion
-   cddaar-expansion
-   cddadr-expansion
-   cddar-expansion
-   cdddar-expansion
-   cddddr-expansion
-   cdddr-expansion
-   cddr-expansion
-   char=?-expansion
-   complex?-expansion
-   cons*-expansion
-   default-object?-expansion
-   eighth-expansion
-   exact-integer?-expansion
-   exact-rational?-expansion
-   expt-expansion
-   fifth-expansion
-   first-expansion
-   fix:<=-expansion
-   fix:=-expansion
-   fix:>=-expansion
-   fourth-expansion
-   int:->flonum-expansion
-   exact-integer?-expansion
-   intern-expansion
-   list-expansion
-   make-string-expansion
-   make-string-expansion
-   ;; modulo-expansion
-   negative?-expansion
-   complex?-expansion
-   positive?-expansion
-   quotient-expansion
-   remainder-expansion
-   second-expansion
-   seventh-expansion
-   sixth-expansion
-   string->symbol-expansion
-   symbol?-expansion
-   third-expansion
-   values-expansion
-   weak-pair?-expansion
-   call-with-values-expansion
-   zero?-expansion
-   ))
+  (append (list
+          *-expansion
+          +-expansion
+          --expansion
+          -1+-expansion
+          /-expansion
+          1+-expansion
+          <-expansion
+          <=-expansion
+          =-expansion
+          >-expansion
+          >=-expansion
+          apply*-expansion
+          caaaar-expansion
+          caaadr-expansion
+          caaar-expansion
+          caadar-expansion
+          caaddr-expansion
+          caadr-expansion
+          caar-expansion
+          cadaar-expansion
+          cadadr-expansion
+          cadar-expansion
+          caddar-expansion
+          cadddr-expansion
+          caddr-expansion
+          cadr-expansion
+          call-with-values-expansion
+          cdaaar-expansion
+          cdaadr-expansion
+          cdaar-expansion
+          cdadar-expansion
+          cdaddr-expansion
+          cdadr-expansion
+          cdar-expansion
+          cddaar-expansion
+          cddadr-expansion
+          cddar-expansion
+          cdddar-expansion
+          cddddr-expansion
+          cdddr-expansion
+          cddr-expansion
+          char=?-expansion
+          complex?-expansion
+          cons*-expansion
+          default-object?-expansion
+          eighth-expansion
+          exact-integer?-expansion
+          exact-rational?-expansion
+          expt-expansion
+          fifth-expansion
+          first-expansion
+          fix:<=-expansion
+          fix:=-expansion
+          fix:>=-expansion
+          fourth-expansion
+          int:->flonum-expansion
+          exact-integer?-expansion
+          intern-expansion
+          list-expansion
+          make-string-expansion
+          make-string-expansion
+          ;; modulo-expansion
+          negative?-expansion
+          complex?-expansion
+          positive?-expansion
+          quotient-expansion
+          remainder-expansion
+          second-expansion
+          seventh-expansion
+          sixth-expansion
+          string->symbol-expansion
+          symbol?-expansion
+          third-expansion
+          values-expansion
+          weak-pair?-expansion
+          call-with-values-expansion
+          zero?-expansion)
+         (map (lambda (p)
+                (make-primitive-expander
+                 (make-primitive-procedure (cadr p))))
+              global-primitives)))
 
 (define usual-integrations/expansion-alist
   (map cons