Posted By

timmenzies on 03/23/11

Tagged

Versions (?)

Last Edited at 03/23/11 06:26am

Statistics

Viewed 127 times

Favorited by 0 user(s)

Related snippets

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

Highlighted TextExpand

2b, OO-based grammer
Tim Menzies

(defparameter *phrase* (klass (*object*) register act head cache))
(defparameter *rule* (klass (*phrase*) body))
(defparameter *terminal* (klass (*phrase*)))

;;;; cache management facilities
(let (cache)
  ; globally, everyone can zap the cache
  (defun zap  () 
    (setf cache (make-hash-table)))
  ; inside each method, you can access the cache
  (defmeth cache *phrase* (self)
	   cache)
)

;;;; methods for runtime generation

; for "rules", call "act" recursively on
; one RHS item, selected at random
(defmeth act *rule* (self)
	 (labels ((recurse (one)
		    (act (gethash one (cache self)))))
	   (let ((one (random-elt (body self))))
	     (if (atom one)
		 (recurse one)
		 (mapcar #'recurse one)))))

; for "terminals" just return the head of your self
(defmeth act *terminal* (self)
	 (head self))

;;;; instance creation methods
;; 1) insert yourself into the cache at your head
;; 2) remember your head
;; 3) also, if you are a "rule", also remember your body
(defmeth register *terminal* (self lhs)
	 (setf (gethash lhs (cache self)) self ; #1
	       (head self) lhs)                ; #2
	 self)

(defmeth register *rule* (self lhs rhs)
	 (setf (gethash lhs (cache self)) self ; #1
	       (head self) lhs                 ; #2
	       (body self) rhs)                ; #3
	 self)

;;;; instance creation functions
(defun phrases->instances (phrases)
  (mapcar #'phrase->instance phrases))

(defun phrase->instance (phrase)
  (register (inst *rule*) (car phrase) (cddr phrase)))

;;;; add terminals
;; pass 1: find rhs symbols which are not heads
;; pass 2: create one "terminal" for everything found in pass 1
;; note: this was *fiendishy* complex till i remembered "visit-r"
(defun add-terminals (cache)
  (let (terminals)
    (labels ((worker (lhs rule)
	       (declare (ignore lhs))
	       (visit-r (body rule) #'collect))
	     (collect (one)
	       (unless (gethash one cache)
		 (push one terminals))))
      ; pass 1
      (maphash #'worker cache)
      ; pass 2
      (dolist (terminal (delete-duplicates terminals))
	(register (inst  *terminal*) terminal)))))

;;;;; utils
;; not you again!
(defun visit-r (thing fn)
  (if (atom thing)
      (funcall fn thing)
      (dolist (one thing)
	(visit-r one fn))))

(defun list! (x)
  (if (listp x)
      x
      (list x)))

(defun random-elt (choices)
  (elt choices (randi (length choices))))

(defmeth init *phrase* (self) self)
 
;;;; main
;; assume that the first lhs is the start of the grammar
(defun main (phrases)
  (zap)
  (let ((first (phrase->instance (car phrases))))
    (phrases->instances (cdr phrases))
    (add-terminals (cache first))
    (flatten (act first))
    ))

(deftest !main ()
  (reset-seed)
  (let ((g '((sentence -> (noun-phrase verb-phrase))
	     (noun-phrase -> (Article Noun))
	     (verb-phrase -> (Verb noun-phrase))
	     (Article -> the a)
	     (Noun -> man ball woman table)
	     (Verb -> hit took saw liked)
	     )))
    (dotimes (i 10)
      (print (main g)))))
#|
(THE WOMAN SAW A MAN) 
(THE WOMAN SAW A TABLE) 
(A BALL SAW A MAN) 
(A TABLE HIT A BALL) 
(A TABLE SAW A BALL) 
(THE BALL HIT THE BALL) 
(A TABLE SAW THE BALL) 
(A MAN HIT THE WOMAN) 
(A WOMAN SAW A MAN) 
(THE MAN HIT THE WOMAN)
|#

Report this snippet Tweet

Comments

Subscribe to comments

Comment:

You need to login to post a comment.