From: Taylor R Campbell Date: Thu, 3 Jan 2019 16:10:04 +0000 (+0000) Subject: Restore sf predicates, not scode predicates. X-Git-Tag: mit-scheme-pucked-10.1.9~3^2~34 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=48f4ecfdcd3967c8d91bf1b51df484aed6d4f519;p=mit-scheme.git Restore sf predicates, not scode predicates. Various parts of sf were silently disabled in the overly aggressive change commit 816b9122751c9b60b85f9ce3db0df8a516f763cb Author: Chris Hanson 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 32d133ee6..ab4f5b7e7 100644 --- 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 db073f59d..64e464aa4 100644 --- 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 034ec2ed5..954c6c4b9 100644 --- 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 78fa6d361..976d80895 100644 --- 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)))