Posted By

timmenzies on 03/23/11


Tagged


Versions (?)

OO-based grammar


 / Published in: Lisp
 

at runtime, there are no if statements. everything gets sent "act" and instances sort themselves out whether or not to recurse or just return their head.

one bug kept me busy for a while- while adding terminals, i was traversing the cache while at the same time adding in new items. this lead to no end of bother.

but once i separated that out into 2 pass (one to find terminal symbols, one to add in a terminal for each such symbol) it was all pretty straight forward

  1. #|
  2.  
  3. 2b, OO-based grammer
  4. Tim Menzies
  5.  
  6. |#
  7.  
  8. (defparameter *phrase* (klass (*object*) register act head cache))
  9. (defparameter *rule* (klass (*phrase*) body))
  10. (defparameter *terminal* (klass (*phrase*)))
  11.  
  12. ;;;; cache management facilities
  13. (let (cache)
  14. ; globally, everyone can zap the cache
  15. (defun zap ()
  16. (setf cache (make-hash-table)))
  17. ; inside each method, you can access the cache
  18. (defmeth cache *phrase* (self)
  19. cache)
  20. )
  21.  
  22. ;;;; methods for runtime generation
  23.  
  24. ; for "rules", call "act" recursively on
  25. ; one RHS item, selected at random
  26. (defmeth act *rule* (self)
  27. (labels ((recurse (one)
  28. (act (gethash one (cache self)))))
  29. (let ((one (random-elt (body self))))
  30. (if (atom one)
  31. (recurse one)
  32. (mapcar #'recurse one)))))
  33.  
  34. ; for "terminals" just return the head of your self
  35. (defmeth act *terminal* (self)
  36. (head self))
  37.  
  38. ;;;; instance creation methods
  39. ;; 1) insert yourself into the cache at your head
  40. ;; 2) remember your head
  41. ;; 3) also, if you are a "rule", also remember your body
  42. (defmeth register *terminal* (self lhs)
  43. (setf (gethash lhs (cache self)) self ; #1
  44. (head self) lhs) ; #2
  45. self)
  46.  
  47. (defmeth register *rule* (self lhs rhs)
  48. (setf (gethash lhs (cache self)) self ; #1
  49. (head self) lhs ; #2
  50. (body self) rhs) ; #3
  51. self)
  52.  
  53. ;;;; instance creation functions
  54. (defun phrases->instances (phrases)
  55. (mapcar #'phrase->instance phrases))
  56.  
  57. (defun phrase->instance (phrase)
  58. (register (inst *rule*) (car phrase) (cddr phrase)))
  59.  
  60. ;;;; add terminals
  61. ;; pass 1: find rhs symbols which are not heads
  62. ;; pass 2: create one "terminal" for everything found in pass 1
  63. ;; note: this was *fiendishy* complex till i remembered "visit-r"
  64. (defun add-terminals (cache)
  65. (let (terminals)
  66. (labels ((worker (lhs rule)
  67. (declare (ignore lhs))
  68. (visit-r (body rule) #'collect))
  69. (collect (one)
  70. (unless (gethash one cache)
  71. (push one terminals))))
  72. ; pass 1
  73. (maphash #'worker cache)
  74. ; pass 2
  75. (dolist (terminal (delete-duplicates terminals))
  76. (register (inst *terminal*) terminal)))))
  77.  
  78. ;;;;; utils
  79. ;; not you again!
  80. (defun visit-r (thing fn)
  81. (if (atom thing)
  82. (funcall fn thing)
  83. (dolist (one thing)
  84. (visit-r one fn))))
  85.  
  86. (defun list! (x)
  87. (if (listp x)
  88. x
  89. (list x)))
  90.  
  91. (defun random-elt (choices)
  92. (elt choices (randi (length choices))))
  93.  
  94. (defmeth init *phrase* (self) self)
  95.  
  96. ;;;; main
  97. ;; assume that the first lhs is the start of the grammar
  98. (defun main (phrases)
  99. (zap)
  100. (let ((first (phrase->instance (car phrases))))
  101. (phrases->instances (cdr phrases))
  102. (add-terminals (cache first))
  103. (flatten (act first))
  104. ))
  105.  
  106. (deftest !main ()
  107. (reset-seed)
  108. (let ((g '((sentence -> (noun-phrase verb-phrase))
  109. (noun-phrase -> (Article Noun))
  110. (verb-phrase -> (Verb noun-phrase))
  111. (Article -> the a)
  112. (Noun -> man ball woman table)
  113. (Verb -> hit took saw liked)
  114. )))
  115. (dotimes (i 10)
  116. (print (main g)))))
  117. #|
  118. (THE WOMAN SAW A MAN)
  119. (THE WOMAN SAW A TABLE)
  120. (A BALL SAW A MAN)
  121. (A TABLE HIT A BALL)
  122. (A TABLE SAW A BALL)
  123. (THE BALL HIT THE BALL)
  124. (A TABLE SAW THE BALL)
  125. (A MAN HIT THE WOMAN)
  126. (A WOMAN SAW A MAN)
  127. (THE MAN HIT THE WOMAN)
  128. |#

Report this snippet  

You need to login to post a comment.