From 9759580bfa84461c1b98cc44655f20493ddd9558 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Wed, 11 May 1988 04:19:27 +0000 Subject: [PATCH] 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. --- v7/src/sf/make.scm | 9 +++++---- v7/src/sf/pardec.scm | 24 ++++++++++++++++++++++-- v7/src/sf/subst.scm | 6 +++--- v7/src/sf/usiexp.scm | 6 +++++- v8/src/sf/make.scm | 9 +++++---- 5 files changed, 40 insertions(+), 14 deletions(-) diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm index ca9d3b75c..6163f5207 100644 --- 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 b3fccffc7..a8d7718f4 100644 --- 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 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)))))) -;;;; 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 a0d11d31d..8be34813e 100644 --- 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 88bdb32c0..cf772693c 100644 --- 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)) + +;;;; 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 519a6cd55..08c8b0891 100644 --- 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 -- 2.25.1