head	1.1;
access;
symbols;
locks
	keithp:1.1; strict;
comment	@# @;


1.1
date	94.12.13.17.49.30;	author keithp;	state Exp;
branches;
next	;


desc
@@


1.1
log
@Initial revision
@
text
@#!/usr/local/klisp
;
; parser - test a parse table
;


;
; data abstraction
;
; a non terminal is a symbol bound to a list of lists
; a terminal is a symbol not bound to a list
; an action is a string
;

(defun non-terminalp (item)
  (and (symbolp item) 
       (boundp item)
       (listp (eval item))
       )
  )

(defun terminalp (item)
  (or (null item)
      (and (symbolp item)
	   (not (non-terminalp item))
	   )
      )
  )

(defun actionp (item)
  (stringp item)
  )

(defun null-production (p)
  (if (null p)
      t
   elseif (stringp (car p))
      (null-production (cdr p))
   else
      nil
      )
  )

(defun start-symbolp (item) (equal item start-symbol))
(defun parser (parse-table start-symbol end-token)
  (patom "starting\n")
  (let ((stack (list start-symbol end-token))
	(input-token (lex))
	(table-entry)
	(tos)
	)
    (while stack

;	   (patom "stack is ")
;	   (print stack)

	   (setq tos (car stack)) (setq stack (cdr stack))
	   (if (non-terminalp tos)
	       (setq table-entry (dictionary-lookup parse-table
 	       					    (list input-token tos))
		     )
	       (if (null table-entry)
	       	   (error (strcat "parser: error on " (sprint input-token)))
	       	   )

;	       (patom " pushing production ") (print (cadr table-entry)) (terpr)

	       (cond ((cadr table-entry)
	       	      (setq stack (conc (cadr table-entry) stack))
		      )
		     )
	    elseif (actionp tos)
	       (patom "token is ") (print input-token)
	       (patom " performing action ") (print tos) (terpr)
	    elseif (terminalp tos)
	       (if (= tos input-token)

		   (patom " matching token ") (print tos) (terpr)

		   (if (not (= tos end-token))
		       (setq input-token (lex))
		       )
		else
		   (error (strcat "parser error on " (sprint input-token)))
		   )
	       )
	   )
    )
  )

(defun lex ()
  (let ((char (getchar)))
    (symbol (scons char nil) parse-dictionary)
    )
  )
	       
(defun init ()
  (setq parse-dictionary (new-dictionary))
  (setq parse-table (new-dictionary))
  (setq end-token (symbol "$" parse-dictionary))
  )

(defun cadaar (l) (car (cdr (car (car l)))))

(defun bind-to-lists (atoms)
  (cond (atoms (set (car atoms) '(foo)) (bind-to-lists (cdr atoms)))
	(t nil)
	)
  )

(defun put-lists-into-parse-table (lists parse-table)
  (cond (lists
	 (dictionary-insert parse-table (caar lists) (car lists))
	 (put-lists-into-parse-table (cdr lists) parse-table)
	 )
	(t nil)
	)
  )

(defun process-file (file-in)
  (init)
  (setq terminals (fread-dictionary file-in parse-dictionary))
  (setq non-terminals (fread-dictionary file-in parse-dictionary))
  (bind-to-lists non-terminals)
  (setq table (fread-dictionary file-in parse-dictionary))
  (setq start-symbol (cadaar table))
  (put-lists-into-parse-table table parse-table)
  (parser parse-table (cadaar table) end-token)
  )      

(defun main-parser ()
  (setq file-in stdin)
  (if argv
      (setq file-in (fopen (car argv) 'r))
      (if (null file-in)
	  (error (strcat "parser: can't open " (sprint (car argv))))
	  )
      )
  (process-file file-in)
  (fclose file-in)
  )

(main-parser)
@
