Add a REDUCE-OPERATOR declaration so that users can get the same

functionality as the system already provides for +, -, list, etc.

Shorten some of the warning messages.

diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm
index ca9d3b75c1758bd1b15d079c383779678df93c39..6163f52074e4cec7ee84f05c0b83696f714b3bbe 100644 (file)
--- a/v7/src/sf/make.scm
+++ b/v7/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.3 1988/04/23 08:25:27 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.4 1988/05/11 04:18:27 jinx Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -61,11 +61,11 @@ MIT in each case. |#
     (make-environment
       (define :name "SF")
       (define :version 4)
-      (define :modification 3)
+      (define :modification 4)
       (define :files)
 
       (define :rcs-header              ;RCS sets up this string.
-       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.3 1988/04/23 08:25:27 cph Exp $")
+       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/make.scm,v 4.4 1988/05/11 04:18:27 jinx Exp $")
 
       (define :files-lists
        (list
@@ -95,7 +95,8 @@ MIT in each case. |#
         (cons package/cgen
               '("cgen.bin"))           ; Internal -> SCode
         (cons package/expansion
-              '("usiexp.bin"))         ; Usual Integrations: Expanders
+              '("usiexp.bin"           ; Usual Integrations: Expanders
+                "reduct.bin"))         ; User defined expanders
         (cons package/declarations
               '("pardec.bin"))         ; Declaration Parser
         (cons package/copy

diff --git a/v7/src/sf/pardec.scm b/v7/src/sf/pardec.scm
index b3fccffc76717ba27ce895bce189c438bb819f31..a8d7718f49fc0a3a873adca4a1a26d06b720ce3f 100644 (file)
--- a/v7/src/sf/pardec.scm
+++ b/v7/src/sf/pardec.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/pardec.scm,v 3.7 1988/04/23 08:50:50 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/pardec.scm,v 3.8 1988/05/11 04:18:50 jinx Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -100,6 +100,10 @@ MIT in each case. |#
 (define (declarations/known? declaration)
   (assq (car declaration) known-declarations))
 
+;; before-bindings? should be true if binding <name> should nullify
+;; the declaration.  It should be false if a binding and the
+;; declaration can "coexist".
+
 (define (define-declaration name before-bindings? parser)
   (let ((entry (assq name known-declarations)))
     (if entry
@@ -386,7 +390,23 @@ MIT in each case. |#
                (finish value)))
            (variable/final-value variable environment finish if-not))))))
 \f
-;;;; User provided expansions and processors
+;;;; User provided reductions and expansions
+
+;;; Reductions.  See reduct.scm for a description.
+
+(define-declaration 'REDUCE-OPERATOR false
+  (lambda (block table/cons table reduction-rules)
+    block ; ignored
+    ;; Maybe it wants to be exported?
+    (bind/general table/cons table false 'EXPAND false
+                 (map car reduction-rules)
+                 (map (lambda (rule)
+                        (reducer/make rule block))
+                      reduction-rules))))
+
+;; Expansions.  These should be used with great care, and require
+;; knowing a fair amount about the internals of sf.  This declaration
+;; is purely a hook, with no convenience.
 
 (define expander-evaluation-environment
   (access package/expansion

diff --git a/v7/src/sf/subst.scm b/v7/src/sf/subst.scm
index a0d11d31d28652d947112c7ca14cda1699963151..8be34813e0f4870937b43020516617d3b3acb89a 100644 (file)
--- a/v7/src/sf/subst.scm
+++ b/v7/src/sf/subst.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/subst.scm,v 3.9 1988/04/23 08:51:21 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/subst.scm,v 3.10 1988/05/11 04:19:05 jinx Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -290,7 +290,7 @@ MIT in each case. |#
                    (if (and (not (variable/integrated var))
                             (not (variable/referenced var))
                             (not (variable/can-ignore? var)))
-                       (warn "Open block variable bound and unreferenced:" 
+                       (warn "Unreferenced defined variable:"
                              (variable/name var))))
                  vars))
     (if (open-block/optimized expression)
@@ -357,7 +357,7 @@ you ask for.
                            (if (and (not (variable/referenced variable))
                                     (not (variable/integrated variable))
                                     (not (variable/can-ignore? variable)))
-                               (warn "Procedure variable bound and unreferenced:"
+                               (warn "Unreferenced bound variable:"
                                      (variable/name variable)
                                      *current-block-names*)))
                          (if rest

diff --git a/v7/src/sf/usiexp.scm b/v7/src/sf/usiexp.scm
index 88bdb32c01fc186151d057c324bea342cc0ba8e7..cf772693c461b486635016285efc80e99a111fb5 100644 (file)
--- a/v7/src/sf/usiexp.scm
+++ b/v7/src/sf/usiexp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/usiexp.scm,v 3.7 1988/04/23 08:52:33 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/sf/usiexp.scm,v 3.8 1988/05/11 04:19:27 jinx Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -327,6 +327,10 @@ MIT in each case. |#
   (map cons
        usual-integrations/expansion-names
        usual-integrations/expansion-values))
+\f
+;;;;  Hooks and utilities for user defined reductions and expanders
+
+;;; User defined reductions appear in reduct.scm
 
 ;;; Scode->Scode expanders
 

diff --git a/v8/src/sf/make.scm b/v8/src/sf/make.scm
index 519a6cd550dba6bd1313f2101929ee4113689c36..08c8b0891195c44634b6af0f9326a52749de492d 100644 (file)
--- a/v8/src/sf/make.scm
+++ b/v8/src/sf/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.3 1988/04/23 08:25:27 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.4 1988/05/11 04:18:27 jinx Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -61,11 +61,11 @@ MIT in each case. |#
     (make-environment
       (define :name "SF")
       (define :version 4)
-      (define :modification 3)
+      (define :modification 4)
       (define :files)
 
       (define :rcs-header              ;RCS sets up this string.
-       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.3 1988/04/23 08:25:27 cph Exp $")
+       "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/sf/make.scm,v 4.4 1988/05/11 04:18:27 jinx Exp $")
 
       (define :files-lists
        (list
@@ -95,7 +95,8 @@ MIT in each case. |#
         (cons package/cgen
               '("cgen.bin"))           ; Internal -> SCode
         (cons package/expansion
-              '("usiexp.bin"))         ; Usual Integrations: Expanders
+              '("usiexp.bin"           ; Usual Integrations: Expanders
+                "reduct.bin"))         ; User defined expanders
         (cons package/declarations
               '("pardec.bin"))         ; Declaration Parser
         (cons package/copy