This bottom-up recogniser follows a shift-reduce strategy: substrings derived from the input are compared with the right-hand side of grammar rules and, if they match, are replaced by the left-hand side of the matching rule; the resulting strings are further reduced until the input is empty and only the initial symbol of the grammar is left.
; cf_bu_lr_recursive_descent.lm
; shift-reduce recogniser and parse counter
; (cf_srrec.lm)
; D. Gibbon
; 17 Nov 2001
; shift reduce recogniser, logical style
(define *count* 0)
(define *initial* 's)
(define *eg1* '(man saw woman))
(define *eg2* '(man saw woman near park))
(define *eg3* '(the man saw the woman near this park))
(define *productions*
'( (s np vp)
(s np vp pp)
(np n)
(np det n)
(np n pp)
(np det n pp)
(vp v)
(vp v np)
(vp v pp)
(vp v np pp)
(pp p np)
(det the)
(det this)
(n man)
(n woman)
(n park)
(v visits)
(v saw)
(p near)
(p in)
))
(define (srpars-init input)
(set! *count* 0)
(srpars input '())
*count*)
(define (srpars words stack)
(define temp '())
(or
(accept
words
stack)
(reduce words stack *productions*)
(and
(pair? words)
(shift
words
stack))))
(define (accept words stack)
(and
(null? words)
(equal?
(list *initial*)
stack)
(display "*")
(set! *count* (+ 1 *count*)))
#f)
(define (shift words stack)
(srpars
(cdr words)
(cons
(car words)
stack)))
(define (reduce words stack rules)
(define temp '())
(and
(pair? rules)
(or
(reduce-0
words
(reduce-1
(caar rules)
(reverse (cdar rules))
stack))
(reduce
words
stack
(cdr rules)))))
(define (reduce-0 words reduction)
(and
(pair? reduction)
(srpars
words
reduction)))
(define (reduce-1 mother daughters stack)
(cond
((null? daughters) (cons mother stack))
((and
(pair? stack)
(equal?
(car daughters)
(car stack)))
(reduce-1
mother
(cdr daughters)
(cdr stack)))
(#t #f)))