home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
windows
/
winlisp.zip
/
OOPL.LZH
/
PARSER.WL
< prev
next >
Wrap
Lisp/Scheme
|
1989-03-12
|
4KB
|
92 lines
;===============================================================================
;
; T O P D O W N P A R S I N G
;
; Let's give the grammar objects a behavior so we can use them to perform
; top-down parsing on a token stream.
;===============================================================================
[{Class} new 'name 'MetaParser
'superClass {Class}
'methods '(
new ((grammarFileName) [[super new] initialize grammarFileName])
)]
[{AbstractClass} new 'name 'Parser
'superClass {Object}
'instanceVariables '(grammar)
'methods '(
initialize ((grammarFileName)
(setf #Igrammar [{Grammar} new grammarFileName])
self)
parse ((aTokenStream grammarElementName)
(or [#Igrammar element grammarElementName]
(error "{Parser}:parse"
"not a grammar element" grammarElementName))
;; ACTUAL PARSING IS TO BE IMPLEMENTED BY SUBCLASSES
)
)]
[{MetaParser} new 'name 'TopDownParser
'superClass {Parser}
'methods '(
parse ((aTokenStream grammarElementName)
[[super parse aTokenStream grammarElementName]
match aTokenStream])
)]
[{AbstractNonTerminal} addMethod
'match '((tokenStream)
(let ( (savedPosition [tokenStream position]) )
(tag {AbstractNonTerminal}:productionsLoop
(mapc '(lambda (production)
(let ( (value [production match tokenStream]) )
(if (eq value '#:match:fail)
[tokenStream position savedPosition]
;;ELSE
(exit {AbstractNonTerminal}:productionsLoop
value))))
#Iproductions)
'#:match:fail)))]
[{AbstractProduction} addMethod
'match '((tokenStream)
(let ( (grammar #Cgrammar) )
(if #Ibody
(tag {AbstractProduction}:match
(apply (or #Iaction '(lambda x x))
(mapcar '(lambda (x)
(let ((value [[grammar element x]
match tokenStream]))
(if (eq value '#:match:fail)
(exit
{AbstractProduction}:match
'#:match:fail)
;;ELSE
value)))
#Ibody)))
;;ELSE
(when #Iaction (apply #Iaction ())))))]
[{AbstractToken} addMethod
'match '((tokenStream)
(let ( (nextToken [tokenStream next 1]) )
(if (eq nextToken 'STREAMATEND)
'#:match:fail
;;ELSE
(setq nextToken [nextToken at 0])
(if (eq #Iname [nextToken name])
[nextToken value]
;;ELSE
'#:match:fail))))]
[{AbstractErrorToken} addMethod
'match '((tokenStream)
;; ALWAYS SUCCEEDS, THE TOKEN STREAM IS RETURNED TO LET THE USER
;; PERFORM ERROR RECOVERY IN ITS ACTION FUNCTION BY SKIPPING BAD
;; TOKENS IN THE STREAM AND THEN RETURNING A VOID VALUE IN ORDER
;; TO RESUME PARSING IN A CLEAN STATE.
tokenStream)]