1 files changed, 53 insertions, 0 deletions
diff --git a/ps06_rule_systems/rule-simplifier.scm b/ps06_rule_systems/rule-simplifier.scm
new file mode 100644
index 0000000..a402e63
--- /dev/null
+++ b/ps06_rule_systems/rule-simplifier.scm
@@ -0,0 +1,53 @@
+;;;;         Match and Substitution Language Interpreter
+
+(declare (usual-integrations))
+
+;;;   This is a descendent of the infamous 6.001 rule interpreter,
+;;; originally written by GJS for a lecture in the faculty course held
+;;; at MIT in the summer of 1983, and subsequently used and tweaked
+;;; from time to time.  This subsystem has been a serious pain in the
+;;; ass, because of its expressive limitations, but I have not had the
+;;; guts to seriously improve it since its first appearance. -- GJS
+
+;;; January 2006.  I have the guts now! The new matcher is based on
+;;; combinators and is in matcher.scm.  -- GJS
+
+
+(define (rule-simplifier the-rules)
+  (define (simplify-expression expression)
+    (let ((ssubs
+	   (if (list? expression)
+	       (map simplify-expression expression)
+	       expression)))
+      (let ((result (try-rules ssubs the-rules)))
+	(if result
+	    (simplify-expression result)
+	    ssubs))))
+  (rule-memoize simplify-expression))
+
+(define (try-rules expression the-rules)
+  (define (scan rules)
+    (if (null? rules)
+	#f
+	(or ((car rules) expression)
+	    (scan (cdr rules)))))
+  (scan the-rules))
+
+
+
+
+
+;;;;  Rule applicator, using combinator-based matcher.
+
+(define (rule:make matcher restriction instantiator)
+  (define (the-rule expression)
+    (matcher (list expression)
+	     '()
+	     (lambda (dictionary n)
+	       (and (= n 1)
+		    (let ((args (map match:value dictionary)))
+		      (and (or (not restriction)
+			       (apply restriction args))
+			   (apply instantiator args)))))))
+    the-rule)
+