From: Chris Hanson Date: Wed, 21 Feb 2018 05:31:51 +0000 (-0800) Subject: Rename spar-require-X to spar-match-X. X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~231 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=7d140950ca955de868598bcefb88baf13ec75559;p=mit-scheme.git Rename spar-require-X to spar-match-X. --- diff --git a/src/runtime/mit-syntax.scm b/src/runtime/mit-syntax.scm index 8fa07eb7a..f86de57cc 100644 --- a/src/runtime/mit-syntax.scm +++ b/src/runtime/mit-syntax.scm @@ -80,7 +80,7 @@ USA. deferred-items))) spar-discard-elt (spar* spar-push-deferred-classified-elt) - spar-require-null)))) + spar-match-null)))) (define :if (spar-promise->runtime @@ -91,7 +91,7 @@ USA. spar-push-classified-elt (spar-alt spar-push-classified-elt (spar-push-thunk-value unspecific-item)) - spar-require-null)))) + spar-match-null)))) (define :quote (spar-promise->runtime @@ -99,7 +99,7 @@ USA. (spar-call-with-values constant-item spar-discard-elt (spar-elt (spar-push-mapped-form strip-syntactic-closures)) - spar-require-null)))) + spar-match-null)))) (define :quote-identifier (spar-promise->runtime @@ -107,7 +107,7 @@ USA. (spar-call-with-values quoted-id-item spar-discard-elt (spar-elt (spar-push-mapped-full lookup-identifier)) - spar-require-null)))) + spar-match-null)))) (define :set! (spar-promise->runtime @@ -121,13 +121,13 @@ USA. rhs-item))) spar-discard-elt spar-push-classified-elt - (spar-require-value + (spar-match-value (lambda (lhs-item) (or (var-item? lhs-item) (access-item? lhs-item)))) (spar-alt spar-push-classified-elt (spar-push-thunk-value unassigned-item)) - spar-require-null)))) + spar-match-null)))) ;; TODO: this is a classifier rather than a macro because it uses the ;; special OUTPUT/DISJUNCTION. Unfortunately something downstream in @@ -139,7 +139,7 @@ USA. (spar-encapsulate-values or-item spar-discard-elt (spar* spar-push-classified-elt) - spar-require-null)))) + spar-match-null)))) ;;;; Definitions @@ -149,10 +149,10 @@ USA. (spar-call-with-values defn-item spar-discard-elt (spar-elt - (spar-require-form identifier?) + (spar-match-form identifier?) (spar-push-mapped-full bind-variable)) spar-push-classified-elt - spar-require-null)))) + spar-match-null)))) (define :define-syntax (spar-promise->runtime @@ -174,8 +174,8 @@ USA. spar-push-id-elt spar-push-senv spar-push-classified-elt - (spar-require-value keyword-item?) - spar-require-null)))) + (spar-match-value keyword-item?) + spar-match-null)))) ;;;; Lambdas @@ -186,7 +186,7 @@ USA. (lambda (bvl body senv) (assemble-lambda-item scode-lambda-name:unnamed bvl body senv)) spar-discard-elt - (spar-elt (spar-require-form mit-lambda-list?) + (spar-elt (spar-match-form mit-lambda-list?) spar-push-form) spar-push-body spar-push-senv)))) @@ -199,7 +199,7 @@ USA. (assemble-lambda-item (identifier->symbol name) bvl body senv)) spar-discard-elt (spar-elt spar-push-id-elt - (spar-require-form mit-lambda-list?) + (spar-match-form mit-lambda-list?) spar-push-form) spar-push-body spar-push-senv)))) @@ -219,7 +219,7 @@ USA. (spar-call-with-values delay-item spar-discard-elt spar-push-deferred-classified-elt - spar-require-null)))) + spar-match-null)))) ;;;; LET-like @@ -243,8 +243,8 @@ USA. (spar-call-with-values cons (spar-elt spar-push-id-elt spar-push-classified-elt - spar-require-null)))) - spar-require-null) + spar-match-null)))) + spar-match-null) spar-push-body spar-push-senv)))) @@ -264,8 +264,8 @@ USA. (spar-call-with-values cons (spar-elt spar-push-id-elt spar-push-classified-elt - spar-require-null)))) - spar-require-null) + spar-match-null)))) + spar-match-null) spar-push-body spar-push-senv))) @@ -299,8 +299,8 @@ USA. (spar-call-with-values cons (spar-elt spar-push-id-elt spar-push-open-classified-elt - spar-require-null)))) - spar-require-null) + spar-match-null)))) + spar-match-null) spar-push-body spar-push-senv)))) @@ -319,7 +319,7 @@ USA. spar-discard-elt spar-push-id-elt spar-push-classified-elt - spar-require-null)))) + spar-match-null)))) (define-item-compiler access-item? (lambda (item) @@ -330,9 +330,9 @@ USA. (spar-promise->runtime (delay (spar-seq - (spar-require-senv senv-top-level?) + (spar-match-senv senv-top-level?) spar-discard-elt - spar-require-null + spar-match-null (spar-push-thunk-value the-environment-item))))) (define keyword:unspecific @@ -340,7 +340,7 @@ USA. (delay (spar-seq spar-discard-elt - spar-require-null + spar-match-null (spar-push-thunk-value unspecific-item))))) (define keyword:unassigned @@ -348,7 +348,7 @@ USA. (delay (spar-seq spar-discard-elt - spar-require-null + spar-match-null (spar-push-thunk-value unassigned-item))))) ;;;; Declarations @@ -372,13 +372,13 @@ USA. (spar-push-values (spar* (spar-elt - (spar-require-form + (spar-match-form (lambda (form) (and (pair? form) (identifier? (car form)) (list? (cdr form))))) spar-push-form))) - spar-require-null + spar-match-null spar-push-senv spar-push-hist)))) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index a447c98ae..99c0853c4 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -4556,6 +4556,11 @@ USA. spar-push-id-elt spar-push-id-elt= spar-map-values + spar-match-form + spar-match-full + spar-match-null + spar-match-senv + spar-match-value spar-opt spar-push-body spar-push-closed-elt @@ -4570,11 +4575,6 @@ USA. spar-push-thunk-value spar-push-values spar-repeat - spar-require-form - spar-require-full - spar-require-null - spar-require-senv - spar-require-value spar-seq spar-succeed spar-transform-values diff --git a/src/runtime/syntax-parser.scm b/src/runtime/syntax-parser.scm index 0d3e9f201..71fbf430a 100644 --- a/src/runtime/syntax-parser.scm +++ b/src/runtime/syntax-parser.scm @@ -145,25 +145,25 @@ USA. ;;;; Primitives -(define (spar-require-form predicate) +(define (spar-match-form predicate) (lambda (input senv output success failure) (if (predicate (%input-form input)) (success input senv output failure) (failure)))) -(define (spar-require-senv predicate) +(define (spar-match-senv predicate) (lambda (input senv output success failure) (if (predicate senv) (success input senv output failure) (failure)))) -(define (spar-require-full predicate) +(define (spar-match-full predicate) (lambda (input senv output success failure) (if (predicate (%input-form input) senv) (success input senv output failure) (failure)))) -(define (spar-require-value predicate) +(define (spar-match-value predicate) (lambda (input senv output success failure) (if (predicate (%output-top output)) (success input senv output failure) @@ -358,8 +358,8 @@ USA. (define spar-discard-elt (spar-elt spar-discard-form)) -(define spar-require-null - (spar-require-form null?)) +(define spar-match-null + (spar-match-form null?)) (define spar-push-elt (spar-elt spar-push-form)) @@ -420,11 +420,11 @@ USA. (spar-elt spar-push-open-classified-form)) (define-deferred spar-push-id-elt - (spar-elt (spar-require-form identifier?) + (spar-elt (spar-match-form identifier?) spar-push-form)) (define (spar-push-id-elt= id) - (spar-elt (spar-require-full + (spar-elt (spar-match-full (lambda (form senv) (and (identifier? form) (identifier=? senv form senv id)))) @@ -486,4 +486,4 @@ USA. (map-in-order (lambda (elt) (elt body-senv)) elts)))) (spar+ spar-push-open-classified-elt) - spar-require-null)) \ No newline at end of file + spar-match-null)) \ No newline at end of file