| rev |
line source |
|
tonyg@281
|
1 (define table '((== non 4)
|
|
tonyg@281
|
2 (: right 5)
|
|
tonyg@281
|
3 (++ right 5)
|
|
tonyg@281
|
4 (+ left 6)
|
|
tonyg@281
|
5 (- left 6)
|
|
tonyg@281
|
6 (* left 7)
|
|
tonyg@281
|
7 (/ left 7)))
|
|
tonyg@281
|
8
|
|
tonyg@281
|
9 (define (parse exp)
|
|
tonyg@281
|
10 (define (p-op lhs exp min-precedence k)
|
|
tonyg@281
|
11 ;;(write `(p-op ,lhs ,exp ,min-precedence)) (newline)
|
|
tonyg@281
|
12 (if (null? exp)
|
|
tonyg@281
|
13 (k lhs exp)
|
|
tonyg@281
|
14 (let ((op (car exp))
|
|
tonyg@281
|
15 (rest0 (cdr exp)))
|
|
tonyg@281
|
16 (cond
|
|
tonyg@281
|
17 ((assq op table) =>
|
|
tonyg@281
|
18 (lambda (entry)
|
|
tonyg@281
|
19 (let ((fixity (cadr entry))
|
|
tonyg@281
|
20 (prec (caddr entry)))
|
|
tonyg@281
|
21 (if (>= prec min-precedence)
|
|
tonyg@281
|
22 (p-val rest0
|
|
tonyg@281
|
23 (lambda (rhs rest)
|
|
tonyg@281
|
24 (let loop ((rhs rhs)
|
|
tonyg@281
|
25 (rest rest))
|
|
tonyg@281
|
26 ;;(write `(loop ,rhs ,rest)) (newline)
|
|
tonyg@281
|
27 (if (null? rest)
|
|
tonyg@281
|
28 (k `(,op ,lhs ,rhs) rest)
|
|
tonyg@281
|
29 (let ((lookahead (car rest)))
|
|
tonyg@281
|
30 (cond
|
|
tonyg@281
|
31 ((assq lookahead table) =>
|
|
tonyg@281
|
32 (lambda (lentry)
|
|
tonyg@281
|
33 (let ((lfixity (cadr lentry))
|
|
tonyg@281
|
34 (lprec (caddr lentry)))
|
|
tonyg@281
|
35 (if (or (and (eq? lfixity 'right) (= lprec prec))
|
|
tonyg@281
|
36 (> lprec prec))
|
|
tonyg@281
|
37 (p-op rhs rest lprec loop)
|
|
tonyg@281
|
38 (p-op `(,op ,lhs ,rhs) rest min-precedence k)))))
|
|
tonyg@281
|
39 (else (loop `(app ,rhs ,lookahead) (cdr rest))
|
|
tonyg@281
|
40 ;; (p-op rhs rest min-precedence
|
|
tonyg@281
|
41 ;; (lambda (v r)
|
|
tonyg@281
|
42 ;; ;;(write `(loop-n ,v ,r)) (newline)
|
|
tonyg@281
|
43 ;; (k `(,op ,lhs ,v) r)))
|
|
tonyg@281
|
44 )))))))
|
|
tonyg@281
|
45 (k lhs exp)))))
|
|
tonyg@281
|
46 (else (p-op `(app ,lhs ,op) rest0 min-precedence k))))))
|
|
tonyg@281
|
47
|
|
tonyg@281
|
48 (define (p-val exp k)
|
|
tonyg@281
|
49 (k (car exp) (cdr exp)))
|
|
tonyg@281
|
50
|
|
tonyg@281
|
51 (p-val exp (lambda (lhs rest)
|
|
tonyg@281
|
52 (p-op lhs rest 0 (lambda (result rest)
|
|
tonyg@281
|
53 (list 'result! result rest))))))
|
|
tonyg@281
|
54
|
|
tonyg@281
|
55 (write (parse '(1 + 2 + 2.5 : 3 * 4 y z * 6 : a : b : c)))
|
|
tonyg@281
|
56 ;;(write (parse '(1 + 2 : 3 * 4 * 6 : foo)))
|
|
tonyg@281
|
57 (newline)
|
|
tonyg@281
|
58
|
