author  Tony GarnockJones <tonygarnockjones@gmail.com> 
Wed, 16 Jan 2019 17:15:58 +0000  
changeset 438  1fe179d53161 
parent 340  d95fab2e4b8d 
permissions  rwrr 
340
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

1 
#lang racket 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

2 
;; 20180709 14:05:49 Racket translation of August 2009's precedenceparsing.scm. 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

3 

d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

4 
(define table '((== non 4) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

5 
(: right 5) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

6 
(++ right 5) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

7 
(+ left 6) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

8 
( left 6) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

9 
(* left 7) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

10 
(/ left 7))) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

11 

d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

12 
(define (parse exp) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

13 
(define (pop lhs exp minprecedence k) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

14 
(match exp 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

15 
['() (k lhs exp)] 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

16 
[(cons op rest0) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

17 
(match (assq op table) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

18 
[(list _op fixity prec) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

19 
(if (>= prec minprecedence) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

20 
(matchlet ([(cons rhs rest) rest0]) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

21 
(let loop ((rhs rhs) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

22 
(rest rest)) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

23 
(match rest 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

24 
['() (k `(,op ,lhs ,rhs) rest)] 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

25 
[(cons lookahead rest1) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

26 
(match (assq lookahead table) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

27 
[(list _lookahead lfixity lprec) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

28 
(if (or (and (eq? lfixity 'right) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

29 
(= lprec prec)) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

30 
(> lprec prec)) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

31 
(pop rhs rest lprec loop) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

32 
(pop `(,op ,lhs ,rhs) rest minprecedence k))] 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

33 
[#f (loop `(app ,rhs ,lookahead) rest1)])]))) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

34 
(k lhs exp))] 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

35 
[#f (pop `(app ,lhs ,op) rest0 minprecedence k)])])) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

36 

d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

37 
(matchlet ([(cons lhs rest) exp]) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

38 
(pop lhs rest 0 (lambda (result rest) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

39 
(list 'result! result rest))))) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

40 

d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

41 
(write (parse '(1 + 2 + 2.5 : 3 * 4 y z * 6 : a : b : c))) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

42 
;;(write (parse '(1 + 2 : 3 * 4 * 6 : foo))) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

43 
(newline) 
d95fab2e4b8d
Racket translation of August 2009's precedenceparsing.scm
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

44 