blob: a402e63ffbb123e8b870cbb60707830bbda3cd81 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
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)
|
