home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / windows / winlisp.zip / OOPL.LZH / GRAMMAR.WL < prev    next >
Text File  |  1989-08-29  |  15KB  |  310 lines
  1. (dmd desetq (l1 l2) `(deset ',l1 ,l2))
  2.     
  3. ;===============================================================================
  4. ;
  5. ;                      G R A M M A R    O B J E C T S
  6. ;
  7. ; This example is given to demonstrate some object modeling techniques using
  8. ; metaclasses. The problem chosen for this purpose is to have an object 
  9. ; representation of a grammar with its tokens, non-terminals, ... and then
  10. ; to use all these objects in order to build a parser.
  11. ;
  12. ; See also parser.wl for parser creation and sample.grm for having an 
  13. ; executable example.
  14. ;===============================================================================
  15.  
  16. ; -----------------------------------------------------------------------------
  17. ; The problem can be stated as:
  18. ;     a grammar element is an object that shares the grammar object G
  19. ;     with all the other grammar elements referenced within the same 
  20. ;    grammar G.
  21. ;
  22. ; A simple solution for implementing this is to have an instance variable 
  23. ; that contains G in all kinds of grammar element:
  24. ;
  25. ;    [{AbstractClass} new 'name 'GrammarElement
  26. ;        'superClass        {Object}
  27. ;            'instanceVariables    '(grammar)]
  28. ; 
  29. ;    [{Class} new 'name 'NonTerminal
  30. ;        'superClass        {GrammarElement}
  31. ;            'instanceVariables    '(name productions)]
  32. ;
  33. ;    [{Class} new 'name 'Production
  34. ;                . . .
  35. ;
  36. ; But that means duplicating the information G and not really sharing it.     
  37. ;
  38. ; To avoid this drawback, all the elements of the same grammar G will
  39. ; be created as instances of some classes inside which G will be wired.
  40. ; Let's call these classes the grammar element classes PRIVATE TO G:
  41. ;             How this could be done ?
  42. ; For these private classes considered as some objects, G will be stored 
  43. ; in their instance variable called <grammar>. 
  44. ; Thus for the instances of these private classes, G is available through 
  45. ; the CLASS VARIABLE called <grammar>.
  46. ; -----------------------------------------------------------------------------
  47.  
  48. [{Class} new 'name 'MetaGrammarElement
  49.     'superClass        {Class}
  50.         'instanceVariables    '(grammar)]
  51.         
  52. ; -----------------------------------------------------------------------------
  53. ; The following classes define the structure end behavior of all kinds of
  54. ; grammar elements but can't be used directly to create grammar elements
  55. ; since they don't hold any grammar object that can be shared by their
  56. ; instances.
  57. ;
  58. ; Notice here that we would like to let <MetaAbstractGrammarElement> inherits
  59. ; from <MetaGrammarElement> to get the instance variable <grammar> AND from
  60. ; <AbstractClass> to have the method for <new> redefined as an error.
  61. ; -----------------------------------------------------------------------------
  62.  
  63. [{Class} new 'name 'MetaAbstractGrammarElement
  64.     'superClass        {MetaGrammarElement}
  65.         'methods        '(
  66. new ( inits
  67.       (error "{MetaAbstractGrammarElement}:new" 
  68.              "abstract grammar element classes cannot be instantiated" self))
  69. )]
  70.  
  71. [{MetaAbstractGrammarElement} new 'name 'AbstractGrammarElement
  72.     'superClass        {Object}
  73.         'grammar        ()
  74.         'methods        '(
  75. grammar (()        #Cgrammar)
  76. )]                                   
  77.  
  78. [{MetaAbstractGrammarElement} new 'name 'AbstractNonTerminal
  79.     'superClass        {AbstractGrammarElement}
  80.         'instanceVariables    '(name productions)
  81.         'grammar        ()]
  82.  
  83. [{MetaAbstractGrammarElement} new 'name 'AbstractProduction
  84.     'superClass        {AbstractGrammarElement}
  85.         'instanceVariables    '(body action)
  86.         'grammar        ()]
  87.  
  88. [{MetaAbstractGrammarElement} new 'name 'AbstractToken
  89.     'superClass        {AbstractGrammarElement}
  90.         'instanceVariables    '(name value)
  91.         'grammar        ()]
  92.  
  93. [{MetaAbstractGrammarElement} new 'name 'AbstractErrorToken
  94.     'superClass        {AbstractGrammarElement}
  95.         'grammar        ()]
  96.  
  97. ; -----------------------------------------------------------------------------
  98. ; Notice here the 'private to <newGrammar>' grammar element classes creation 
  99. ; with:
  100. ;
  101. ;    [{MetaGrammarElement} new 
  102. ;              'name       (concat 'NonTerminal newSymbol)
  103. ;           'superClass {AbstractNonTerminal}
  104. ;               'grammar    newGrammar]
  105. ;
  106. ; and their storage in the nonTerminalClass, productionClass, ... instance
  107. ; variables of <newGrammar>, the newly created instance of Grammar.
  108. ; -----------------------------------------------------------------------------
  109.  
  110. [{Class} new 'name 'MetaGrammar
  111.     'superClass        {Class}
  112.         'methods        '(
  113. new ((grammarFileName)    [[super new] initialize grammarFileName])
  114. )]
  115.  
  116. [{MetaGrammar} new 'name 'Grammar
  117.     'superClass        {Object}
  118.         'instanceVariables    '(nonTerminalClass productionClass tokenClass
  119.                                   errorTokenClass dictionary)
  120.         'methods        '(
  121. initialize ((grammarFileName)                                   
  122.         (let ( (newSymbol  [{symbol} new]) )
  123.              (setf #InonTerminalClass
  124.                        [{MetaGrammarElement} new 
  125.                     'name       (concat 'NonTerminal newSymbol)
  126.                                 'superClass {AbstractNonTerminal}
  127.                                 'grammar    self]
  128.                        #IproductionClass
  129.                        [{MetaGrammarElement} new 
  130.                     'name       (concat 'Production newSymbol)
  131.                                 'superClass {AbstractProduction}
  132.                                 'grammar    self]
  133.                        #ItokenClass
  134.                        [{MetaGrammarElement} new 
  135.                     'name       (concat 'Token newSymbol)
  136.                                 'superClass {AbstractToken}
  137.                                 'grammar    self]
  138.                        #IerrorTokenClass
  139.                        [{MetaGrammarElement} new 
  140.                     'name       (concat 'ErrorToken newSymbol)
  141.                                 'superClass {AbstractErrorToken}
  142.                                 'grammar    self]
  143.                        #Idictionary    [{Dictionary} new])
  144.                  [self buildDictionary grammarFileName]
  145.                  self))
  146.  
  147. buildDictionary ((grammarFileName)
  148.                  ;; ------------------------------------------------------------
  149.                  ;; In order to build the grammar elements dictionary, a grammar
  150.                  ;; file is parsed (with a hand coded recursive descent parser)
  151.                  ;; the format of a grammar file is:
  152.                  ;;
  153.                  ;; grammarFile -> [lispCode] '%%' 
  154.                  ;;                {grammarRule}+          ;1 or more rules...
  155.                  ;;                ['%%' lispCode]
  156.                  ;;
  157.                  ;; grammarRule -> nonTerminalSymbol ':' productions ';'
  158.                  ;;
  159.                  ;; productions -> production '|' productions
  160.                  ;;             -> production
  161.                  ;;
  162.                  ;; production -> body [action]
  163.                  ;;
  164.                  ;; body -> {grammarSymbol}*              ;0 or more symbols...
  165.                  ;;
  166.                  ;; grammarSymbol -> nonTerminalSymbol 
  167.                  ;;               -> '%'tokenSymbol
  168.                  ;;               -> '%error'
  169.                  ;;
  170.                  ;; action -> '(' lambdaFunctionOrLispFunctionName ')'
  171.                  ;; ------------------------------------------------------------
  172.                   (unless (probefile grammarFileName)
  173.                                 (error "{Grammar}:buildDictionary" 
  174.                                        "unknown file" grammarFileName))
  175.                         (with ( (inchan (openi grammarFileName)) )
  176.                               (untilexit eof 
  177.                                          (let ( (x (read)) )
  178.                                               (if (eq x '%%) 
  179.                                                   (untilexit grammarRules
  180.                                                           [self addNonTerminal])
  181.                                                   ;;ELSE
  182.                                                   (eval x)))))
  183.                         [self checkDictionary]
  184.                         self)
  185.  
  186. addNonTerminal (()
  187.                (let ( ((type1 . name)   [self scan])
  188.                        ((type2 . sep)    [self scan]) 
  189.                        (productions) )
  190.                      (unless (and (eq type1 'symbol) 
  191.                                   (eq type2 'first-body-sep))
  192.                              (error "{Grammar}:addNonTerminal"
  193.                                     "expected <non-terminal name> ':', got"
  194.                                     (cons name sep)))
  195.                      ;; grammarRule AND NO OTHER TAG MUST BE EXITED FROM HERE...
  196.                      (newl productions 
  197.                            (lock '(lambda (tag lastProduction)
  198.                                           (if (eq tag 'grammarRule)
  199.                                               lastProduction
  200.                                               ;;ELSE
  201.                                               (error "{Grammar}:addNonTerminal"
  202.                                                      "unexpected end of rule"
  203.                                                      ())))
  204.                                  (while t    
  205.                              (newl productions 
  206.                                    [self addProduction]))))
  207.                      [#Idictionary at name 
  208.                                        [#InonTerminalClass new
  209.                                        'name        name 
  210.                                         'productions (nreverse productions)]]))
  211.                      
  212. addProduction (()
  213.                (let ( (dictionary      #Idictionary)
  214.                        (tokenClass      #ItokenClass)
  215.                        (errorTokenClass #IerrorTokenClass)
  216.                        (type) (val) (body) (action) (production) ) 
  217.                      (untilexit body
  218.                                 (desetq (type . val) [self scan])
  219.                                 (cond ( (eq type 'symbol)
  220.                                         (newl body val)
  221.                                         (unless [dictionary at val]
  222.                                                 [dictionary at val ()]) )
  223.                                       ( (eq type 'token)
  224.                                         (newl body val)
  225.                                         (unless [dictionary at val]
  226.                                                 [dictionary at val
  227.                                                                [tokenClass new 
  228.                                                                 'name   val
  229.                                                                  'value  ()]]) )
  230.                                       ( (eq type 'error)
  231.                                         (newl body val)
  232.                                         (unless [dictionary at val]
  233.                                                 [dictionary at val
  234.                                                        [errorTokenClass new]]) )
  235.                                       ( t    (exit body t) )))
  236.                      (when (eq type 'cons)
  237.                            (setq   action       (car val))
  238.                            (desetq (type . val) [self scan]))
  239.                      (setq production [#IproductionClass new 
  240.                                        'body (nreverse body) 
  241.                                                 'action action])
  242.                      (cond ( (eq type 'body-sep)    production )
  243.                            ( (eq type 'rule-sep)    (exit grammarRule 
  244.                                                               production) )
  245.                            ( t
  246.                              (error "{Grammar}:addProduction"
  247.                                     "expected '|' or ';', got"
  248.                                     val) ))))
  249.                   
  250. scan (()
  251.        (let ( (c (peekcn)) )
  252.             (selectq c
  253.                      ( #/:
  254.                        (cons 'first-body-sep (readcn)) )
  255.                      ( #/|
  256.                        (cons 'body-sep (readcn)) )
  257.                      ( #/;
  258.                        (cons 'rule-sep (readcn)) )
  259.                      ( #/%
  260.                        (readcn)
  261.                        (when (eq (peekcn) #/%)
  262.                              (exit grammarRules (readcn) t))
  263.                        (let ( (x (read)) )
  264.                             (unless (variablep x)
  265.                                     (error "{Grammar}:scan"
  266.                                            "expected '%'<token name>, got '%'"
  267.                                            x))
  268.                             (if (eq x 'error) 
  269.                                 '(error . error) 
  270.                                 ;;ELSE
  271.                                 (cons 'token x))) )
  272.                      ( t
  273.                        (cond ( (member (typecn c) '(csep cecom))
  274.                                (readcn)
  275.                                [self scan] )
  276.                              ( t
  277.                                (let ( (x (read)) ) (cons (type-of x) x)) )) ))))
  278.                   
  279. checkDictionary (()
  280.             (let ( (dictionary #Idictionary)
  281.                                (missingElements) )
  282.                              (when [dictionary isEmpty]
  283.                                    (error "{Grammar}:checkDictionary" 
  284.                                           "grammar elements not found" ()))
  285.                              [dictionary do '(lambda (name element)
  286.                                                 (unless element
  287.                                                         (newl missingElements 
  288.                                                               name)))]
  289.                              (when missingElements
  290.                                    (error "{Grammar}:checkDictionary"
  291.                                           "undefined non terminals" 
  292.                                           missingElements))
  293.                              self))
  294.  
  295. element ((name)        [#Idictionary at name])
  296.  
  297. prin (()
  298.       ;; -------------------------------------------------------------------
  299.       ;; circular structures ...
  300.       ;; Without this method, the standard lisp printer will loop while
  301.       ;; trying to print a Grammar Object (because its private classes
  302.       ;; contains some references to itself).
  303.       ;; -------------------------------------------------------------------
  304.     (prin "aGrammar"))
  305. )]
  306.  
  307.  
  308.  
  309.  
  310.