;; Simple type checker -- adapted from section 6.2 in the Dragon book

(def-jyacc simple-lang

  (P    -> vars E                (%1))
  (vars -> vars var \;)
  (vars -> )

  (var  -> id \: type            ((setf (gethash %0 *vars*) %2)))
  (type -> char                  ('char))
  (type -> integer               ('int))
  (type -> array [ num ] of type (`(array   . ,%5)))
  (type -> ^ type                (`(pointer . ,%1)))

  (E    -> E1)
  (E1   -> E1 mod E2            ((unless (and (eq %0 'int)
                                              (eq %2 'int))
                                   (error "Type error: ~s mod ~s" %0 %2))
                                 'int))
  (E1   -> E2)
  (E2   -> ^ E3                 ((unless (and (listp %1)
                                              (eq (car %1) 'pointer))
                                   (error "Cannot dereference ~s" %1))
                                 (cdr %1)))
                                 
  (E2   -> E3)
  (E3   -> E3 [ E ]             ((unless (and (listp %0)
                                              (eq (car %0) 'array))
                                   (error "Cannot index ~s" %0))
                                 (unless (eq %2 'int)
                                   (error "Index cannot be ~s" %2))
                                 (cdr %0)))
  (E3   -> E4)
  (E4   -> literal              ('char))
  (E4   -> num                  ('int))
  (E4   -> id                   ((let ((type (gethash %0 *vars*)))
                                   (unless type (error "Unknown var ~s" %0))
                                   type))))

(defun week8-tc (tokens)
  (setf *vars* (make-hash-table))
  (labels 
      ((next () (let ((h (pop tokens)))
                  (print 
                   (cond ((null h)        '(*eof* . *eof*))
                         ((numberp h)     `(num . ,h))
                         ((stringp h)     `(literal . ,h))
                         ((member h '(\; \: char integer array of
                                      ^ * [ ] mod =))
                          `(,h . ,h))
                         (t               `(id . ,h))))))
       (err ()  (format t "Error at ~s~%" tokens)))
    (simple-lang #'next #'err)))


;; Examples:
#|

;; Correct examples:

(week8-tc '(
  key \: integer \;
  key mod 1999))

(week8-tc '(
  table \: array [ 255 ] of char \;
  key   \: integer \;
  table [ key mod 255 ]))

(week8-tc '(
  table \: array [ 255 ] of array [ 255 ] of char \;
  table [ 100 ] [ 200 ]))

(week8-tc '(
  ref \: ^ array [ 100 ] of char \;
  ^ ref))

(week8-tc '(
  ref \: array [ 100 ] of ^ char \;
  ^ ref [ 100 ]))

(week8-tc '( "f" ))

;; Incorrect examples

(week8-tc '(
  foo \: array [ 100 ] of integer \;
  100 mod foo))

(week8-tc '(
  foo \: array [ 100 ] of integer \;
  ^ foo ))

(week8-tc '(
  foo \: integer \;
  bar \: char \;
  foo mod bar))

|#