experiments/precedence-parsing.rkt
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
Wed, 16 Jan 2019 17:15:58 +0000
changeset 438 1fe179d53161
parent 340 d95fab2e4b8d
permissions -rw-r--r--
Add missing primitive implementation for the plain interpreter.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
340
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     1
#lang racket
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     2
;; 2018-07-09 14:05:49 Racket translation of August 2009's precedence-parsing.scm.
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     3
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     4
(define table '((== non 4)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     5
		(: right 5)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     6
		(++ right 5)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     7
		(+ left 6)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     8
		(- left 6)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
     9
		(* left 7)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    10
		(/ left 7)))
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    11
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    12
(define (parse exp)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    13
  (define (p-op lhs exp min-precedence k)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    14
    (match exp
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    15
      ['() (k lhs exp)]
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    16
      [(cons op rest0)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    17
       (match (assq op table)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    18
         [(list _op fixity prec)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    19
          (if (>= prec min-precedence)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    20
              (match-let ([(cons rhs rest) rest0])
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    21
                (let loop ((rhs rhs)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    22
                           (rest rest))
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    23
                  (match rest
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    24
                    ['() (k `(,op ,lhs ,rhs) rest)]
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    25
                    [(cons lookahead rest1)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    26
                     (match (assq lookahead table)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    27
                       [(list _lookahead lfixity lprec)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    28
                        (if (or (and (eq? lfixity 'right)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    29
                                     (= lprec prec))
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    30
                                (> lprec prec))
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    31
                            (p-op rhs rest lprec loop)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    32
                            (p-op `(,op ,lhs ,rhs) rest min-precedence k))]
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    33
                       [#f (loop `(app ,rhs ,lookahead) rest1)])])))
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    34
              (k lhs exp))]
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    35
         [#f (p-op `(app ,lhs ,op) rest0 min-precedence k)])]))
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    36
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    37
  (match-let ([(cons lhs rest) exp])
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    38
    (p-op lhs rest 0 (lambda (result rest)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    39
                       (list 'result! result rest)))))
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    40
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <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 precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    42
;;(write (parse '(1 + 2 : 3 * 4 * 6 : foo)))
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    43
(newline)
d95fab2e4b8d Racket translation of August 2009's precedence-parsing.scm
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff changeset
    44