Restore sf predicates, not scode predicates.

Various parts of sf were silently disabled in the overly aggressive
change

   commit 816b9122751c9b60b85f9ce3db0df8a516f763cb
   Author: Chris Hanson <org/chris-hanson/cph>
   Date:   Wed Jan 24 00:07:59 2018 -0800

       Greatly simplify SCode abstraction and change names to contain "scode".

       Also remove all FOO-components and FOO-subexpressions procedures.
       More work remains: the lambda abstraction is an unholy mess and needs to be
       cleaned up.  The scan-defines stuff also merits some consideration.

which kinda reflects on the sensibility of using disjoint type
predicates across domains like this as one does in Scheme.

diff --git a/src/sf/object.scm b/src/sf/object.scm
index 32d133ee67ac697e3e19fa4d5e256a6806a65479..ab4f5b7e75f47182ccc50a7248065f86cab55e91 100644 (file)
--- a/src/sf/object.scm
+++ b/src/sf/object.scm
@@ -263,7 +263,7 @@ USA.
 
 ;; True if expression is a call to one of the primitive-boolean-predicates.
 (define (expression/call-to-boolean-predicate? expression)
-  (and (scode-combination? expression)
+  (and (combination? expression)
        (let ((operator (combination/operator expression)))
          (and (constant? operator)
               (let ((operator-value (constant/value operator)))
@@ -296,7 +296,7 @@ USA.
 
 ;; True if expression is a call to one of the effect-free-primitives.
 (define (expression/call-to-effect-free-primitive? expression)
-  (and (scode-combination? expression)
+  (and (combination? expression)
        (let ((operator (combination/operator expression)))
          (and (constant? operator)
               (let ((operator-value (constant/value operator)))
@@ -308,7 +308,7 @@ USA.
 ;; True if expression is a call to NOT.
 ;; Used in conditional simplification.
 (define (expression/call-to-not? expression)
-  (and (scode-combination? expression)
+  (and (combination? expression)
        (let ((operator (combination/operator expression)))
          (and (constant? operator)
               (let ((operator-value (constant/value operator)))
@@ -319,7 +319,7 @@ USA.
 
 (define (expression/constant-eq? expression value)
   (cond ((constant? expression) (eq? (constant/value expression) value))
-        ((scode-declaration? expression)
+        ((declaration? expression)
          (expression/constant-eq? (declaration/expression expression) value))
         (else #f)))
 
@@ -330,7 +330,7 @@ USA.
                name))
 
 (define (global-ref? object)
-  (and (scode-access? object)
+  (and (access? object)
        (expression/constant-eq? (access/environment object)
                                system-global-environment)
        (access/name object)))
@@ -578,7 +578,7 @@ USA.
 (define (sequence/make scode actions)
   (define (sequence/collect-actions collected actions)
     (fold-left (lambda (reversed action)
-                 (if (scode-sequence? action)
+                 (if (sequence? action)
                      (sequence/collect-actions reversed
                                               (sequence/actions action))
                      (cons action reversed)))

diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index db073f59d0de7a1b2acf2e1d869e55d4ee459dfd..64e464aa40b7df88240743f7539d2209ea1df994 100644 (file)
--- a/src/sf/subst.scm
+++ b/src/sf/subst.scm
@@ -176,7 +176,7 @@ USA.
                                integrated-predicate
                                consequent
                                alternative)
-  (cond ((scode-sequence? integrated-predicate)
+  (cond ((sequence? integrated-predicate)
          (sequence/make
           (and expression (object/scode expression))
           (append (except-last-pair (sequence/actions integrated-predicate))
@@ -263,7 +263,7 @@ USA.
                               (integrate/expression
                                operations environment alternative))))
 
-        ((scode-sequence? integrated-predicate)
+        ((sequence? integrated-predicate)
          (sequence/make
           (and expression (object/scode expression))
           (append (except-last-pair (sequence/actions integrated-predicate))
@@ -708,7 +708,7 @@ USA.
            (if (null? (constant/value operand))
                '()
                'fail))
-          ((not (scode-combination? operand))
+          ((not (combination? operand))
            'fail)
           (else
            (let ((rator (combination/operator operand)))
@@ -780,7 +780,7 @@ USA.
              (procedure-with-body body (encloser (procedure/body body))))
         (scan-operator body encloser)))
   (define (scan-operator operator encloser)
-    (cond ((scode-sequence? operator)
+    (cond ((sequence? operator)
            (let ((reversed-actions (reverse (sequence/actions operator))))
              (scan-body (car reversed-actions)
                         (let ((commands (cdr reversed-actions)))
@@ -789,7 +789,7 @@ USA.
                              (sequence-with-actions
                               operator
                               (reverse (cons expression commands)))))))))
-          ((scode-combination? operator)
+          ((combination? operator)
            (let ((descend
                   (lambda (operator*)
                     (and (not (open-block? (procedure/body operator*)))
@@ -807,7 +807,7 @@ USA.
                      (combination/operands operator))
                     => descend)
                    (else #f))))
-          ((scode-declaration? operator)
+          ((declaration? operator)
            (scan-body (declaration/expression operator)
                       (lambda (expression)
                         (encloser

diff --git a/src/sf/usiexp.scm b/src/sf/usiexp.scm
index 034ec2ed5a8ec8ec1ca4c190647d7f4f8339d9cd..954c6c4b9f9427d402fb27943cb8e16f31aad0fa 100644 (file)
--- a/src/sf/usiexp.scm
+++ b/src/sf/usiexp.scm
@@ -374,17 +374,17 @@ USA.
 ;;;; General CAR/CDR Encodings
 
 (define (call-to-car? expression)
-  (and (scode-combination? expression)
+  (and (combination? expression)
        (constant-eq? (combination/operator expression) (ucode-primitive car))
        (length=? (combination/operands expression) 1)))
 
 (define (call-to-cdr? expression)
-  (and (scode-combination? expression)
+  (and (combination? expression)
        (constant-eq? (combination/operator expression) (ucode-primitive cdr))
        (length=? (combination/operands expression) 1)))
 
 (define (call-to-general-car-cdr? expression)
-  (and (scode-combination? expression)
+  (and (combination? expression)
        (constant-eq? (combination/operator expression)
                     (ucode-primitive general-car-cdr))
        (length=? (combination/operands expression) 2)

diff --git a/src/sf/xform.scm b/src/sf/xform.scm
index 78fa6d361b96c954b81624ff57eb19b5a0aa20c8..976d80895b7fc5c1cc1e4a64d2d63830bf0f4d9a 100644 (file)
--- a/src/sf/xform.scm
+++ b/src/sf/xform.scm
@@ -209,7 +209,7 @@ USA.
 ;; If procedure body is a sequence, scan the first elements and turn variable
 ;; references into IGNORE declarations.
 (define (build-procedure expression block name required optional rest body)
-  (if (scode-sequence? body)
+  (if (sequence? body)
       (do ((actions (sequence/actions body) (cdr actions))
           (ignores '()
                    (cons (variable/name (reference/variable (car actions)))