(defpackage :my.parser
(:use :common-lisp)
(:export :run))
(in-package :my.parser)
;;; package vars
(defvar *characters* (make-hash-table))
(defvar *words* (make-hash-table))
(defvar *fname* "infile.txt")
(defvar *f-processor*)
;;; CLASSes
(defclass token ()
((cnt
:initform 0
:accessor cnt)))
(defclass gramma (token)
((symb
:initarg :symb
:initform (error "empty symb init")
:accessor symb)))
;;; MACROses
(defmacro insert-hash (element hashtable)
`(multiple-value-bind (val result) (gethash ,element ,hashtable)
(if result
(incf (cnt val) 1)
(setf (gethash ,element ,hashtable)
(make-instance 'gramma :symb ,element)))))
(defmacro show-sorted-hash (hashtable)
`(let ((lst nil))
(maphash #'(lambda (k v)
(push (cons k (cnt v)) lst))
,hashtable)
(sort lst #'(lambda (a b)
(< (cdr a) (cdr b))))
(mapcar #'(lambda (a)
(format t "~a = ~a~%" (car a) (cdr a)))
lst)))
;;; METHODs
(defgeneric processor (character) ; generic
(:documentation "abstract processor"))
(defmethod processor (character)
(insert-hash character *characters*))
(let ((ws nil)) ; lexical closure
(defmethod processor :before (character) ; before combinator
(if (not (eql character #\Space))
(push character ws)
(let ((word (concatenate 'string (reverse ws))))
(insert-hash word *words*)
(setf ws nil)))))
;;; EXPORTs
(defun run (&optional
(fname "infile.txt")
(f-processor #'processor))
(clrhash *characters*)
(clrhash *words*)
(setf *fname* fname)
(setf *f-processor* f-processor)
(with-open-file (file-stream *fname*)
(loop
(let ((character (read-char file-stream nil)))
(if character
(funcall *f-processor* character) ; high order method (+ combinator of methods)
(return)))))
(show-sorted-hash *characters*)
(show-sorted-hash *words*)
(setf *flag-prepared* nil)
'done)