From 3b3353a6e0d8e96bf9e49087d07634ed3d5763e2 Mon Sep 17 00:00:00 2001 From: Joe Marshall Date: Tue, 9 Feb 2010 15:55:03 -0800 Subject: [PATCH] Create constructor stubs for combination, conditional, and disjunction. --- src/sf/copy.scm | 2 +- src/sf/object.scm | 50 ++++++++++++++++++++++++++++++++++------------- src/sf/xform.scm | 8 ++++---- 3 files changed, 41 insertions(+), 19 deletions(-) diff --git a/src/sf/copy.scm b/src/sf/copy.scm index f296ec5d1..5f778f8b7 100644 --- a/src/sf/copy.scm +++ b/src/sf/copy.scm @@ -187,7 +187,7 @@ USA. (define-method/copy 'COMBINATION (lambda (block environment expression) - (combination/make + (combination/%make (combination/scode expression) block (copy/expression block environment (combination/operator expression)) diff --git a/src/sf/object.scm b/src/sf/object.scm index 9aba78a58..fc4226a54 100644 --- a/src/sf/object.scm +++ b/src/sf/object.scm @@ -187,7 +187,7 @@ USA. (named variable/enumerand) (type-descriptor rtd:variable) (conc-name variable/) - (constructor variable/make) + (constructor variable/make (block name flags)) (print-procedure (standard-unparser-method 'variable @@ -196,24 +196,46 @@ USA. (write (variable/name var) port))))) block name + ;; A count of how many times in the block that the variable + ;; is invoked as an operator. + (invocation-count 0) flags) (define-guarantee variable "variable") ;;; Expressions -(define-simple-type access #f (environment name)) -(define-simple-type assignment #f (block variable value)) -(define-simple-type combination #f (block operator operands)) -(define-simple-type conditional #f (predicate consequent alternative)) -(define-simple-type constant #f (value)) -(define-simple-type declaration #f (declarations expression)) -(define-simple-type delay #f (expression)) -(define-simple-type disjunction #f (predicate alternative)) -(define-simple-type open-block #f (block variables values actions)) -(define-simple-type procedure #f (block name required optional rest body)) -(define-simple-type quotation #f (block expression)) -(define-simple-type sequence #f (actions)) -(define-simple-type the-environment #f (block)) +(define-simple-type access #f (environment name)) +(define-simple-type assignment #f (block variable value)) +(define-simple-type combination combination/%%make (block operator operands)) +(define-simple-type conditional conditional/%make (predicate consequent alternative)) +(define-simple-type constant #f (value)) +(define-simple-type declaration #f (declarations expression)) +(define-simple-type delay #f (expression)) +(define-simple-type disjunction disjunction/%make (predicate alternative)) +(define-simple-type open-block #f (block variables values actions)) +(define-simple-type procedure #f (block name required optional rest body)) +(define-simple-type quotation #f (block expression)) +(define-simple-type sequence #f (actions)) +(define-simple-type the-environment #f (block)) + +;;; Constructors that need to do work. + +(define (combination/%make scode block operator operands) + ;; Keep track of how many times a reference appears as an operator. + (if (reference? operator) + (let ((variable (reference/variable operator))) + (set-variable/invocation-count! variable + (1+ (variable/invocation-count variable))))) + (combination/%%make scode block operator operands)) + +(define (combination/make expression block operator operands) + (combination/%make expression block operator operands)) + +(define (conditional/make scode predicate consequent alternative) + (conditional/%make scode predicate consequent alternative)) + +(define (disjunction/make scode predicate alternative) + (disjunction/%make scode predicate alternative)) ;; Done specially so we can tweak the print method. ;; This makes debugging an awful lot easier. diff --git a/src/sf/xform.scm b/src/sf/xform.scm index a200c8044..4d28f379e 100644 --- a/src/sf/xform.scm +++ b/src/sf/xform.scm @@ -232,10 +232,10 @@ USA. (define (transform/combination* expression block environment expression*) (combination-components expression* (lambda (operator operands) - (combination/make expression - block - (transform/expression block environment operator) - (transform/expressions block environment operands))))) + (combination/%make expression + block + (transform/expression block environment operator) + (transform/expressions block environment operands))))) (define (transform/comment block environment expression) (transform/expression block environment (comment-expression expression))) -- 2.25.1