home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
windows
/
winlisp.zip
/
OOPL.LZH
/
SAMPLE.GRM
< prev
next >
Wrap
Text File
|
1989-07-30
|
5KB
|
226 lines
;===============================================================================
;
; A S A M P L E G R A M M A R
;
; Ex. given by David S. Touretzky in "How Lisp Has Changed" - Byte Feb. 1988
;
; In order to parse some sentences, you must evaluate:
;
; (load "oopl.wl")
; (load "stream.wl")
; (load "collection.wl")
; (load "grammar.wl")
; (load "parser.wl")
; (setq aParser [{TopDownParser} new "sample.grm"])
;
; and then you may evaluate, for example:
;
; (setq aStream
; [{Stream} on '#["the" "boy" "ate" "a" "tasty" "little" "pizza"]])
; [aParser parse aStream 's]
; [aStream reset]
; [aParser parse aStream 'np]
; [aStream peek]
; [aParser parse aStream 'vp]
; . . .
; or:
;
; (setq anotherStream
; [{Stream} on '(john said that mary kicked the ball)])
; [aParser parse anotherStream 's]
;===============================================================================
(defun np-action l (cons 'np l))
(defun nprop-action l (cons 'nprop l))
(defun pro-action l (cons 'pro l))
(defun art-action l (cons 'art l))
(defun adj-action l (cons 'adj l))
(defun n-action l (cons 'n l))
(defun vp-action l (cons 'vp l))
(defun vi-action l (cons 'vi l))
(defun vt-action l (cons 'vt l))
(defun vrel-action l (cons 'vrel l))
%%
s : np vp
( (lambda l (cons 's l)) )
| np %error
( (lambda ( _ tokenStream)
(error "syntax error"
" expected a 'vp', got "
[tokenStream next 3])) )
;
np : nprop
( np-action )
| pro
( np-action )
| art adjlist n
( np-action )
| art n
( np-action )
| art %error
( (lambda ( _ tokenStream)
(error "syntax error"
" expected a 'n' or 'adjlist n', got "
[tokenStream next 3])) )
;
nprop : %john
( nprop-action )
| %mary
( nprop-action )
;
pro : %he
( pro-action )
| %she
( pro-action )
| %it
( pro-action )
;
art : %the
( art-action )
| %a
( art-action )
;
adjlist : adj adjlist
| adj
;
adj : %big
( adj-action )
| %little
( adj-action )
| %red
( adj-action )
| %tasty
( adj-action )
;
n : %boy
( n-action )
| %girl
( n-action )
| %ball
( n-action )
| %pizza
( n-action )
| %stick
( n-action )
;
vp : vi
( vp-action )
| vt np
( vp-action )
| vt %error
( (lambda ( _ tokenStream)
(error "syntax error"
" expected a 'np', got "
[tokenStream next 3])) )
| vrel relc
( vp-action )
| vrel %error
( (lambda ( _ tokenStream)
(error "syntax error"
" expected a 'relc', got "
[tokenStream next 3])) )
;
vi : %laughed
( vi-action )
| %sang
( vi-action )
;
vt : %threw
( vt-action )
| %kicked
( vt-action )
| %ate
( vt-action )
;
vrel : %saw
( vrel-action )
| %said
( vrel-action )
| %thought
( vrel-action )
;
relc : %that s
( (lambda l (cons 'relc l)) )
| %that %error
( (lambda ( _ tokenStream)
(error "syntax error"
" expected a 's', got "
[tokenStream next 3])) )
;
%%
;;; GIVE symbol A Token BEHAVIOR
[{symbol} addMethod 'name '(() self)]
[{symbol} addMethod 'value '(() self)]
;;; GIVE string A Token BEHAVIOR
[{string} addMethod 'name '(() [{symbol} new () self])]
[{string} addMethod 'value '(() self)]
;;; GIVE cons A IndexedCollection BEHAVIOR
[{cons} primitiveAllocator
'(lambda inits
(when inits
(let ( (inits (car inits)) )
(if (consp inits)
inits
;;ELSE
(error "{cons}:primitiveAllocator"
"not a list"
inits)))))]
[{cons} addMethod 'at '((index) (nth index self))]
[{cons} addMethod 'size '(() (length self))]
;;; GIVE vector A IndexedCollection BEHAVIOR
[{vector} primitiveAllocator
'(lambda inits
(if inits
(let ( (inits (car inits)) )
(if (consp inits)
(apply 'vector inits)
;;ELSE
(error "{vector}:primitiveAllocator"
"not a list"
inits)))
;;ELSE
(makevector 0 ())))]
[{vector} addMethod 'at '((index) (vref self index))]
[{vector} addMethod 'size '(() (vlength self))]