;;; Alef Lazily Evaluates Functions
;;; (C) 2008-2009 Dr. Gergo ERDI <http://gergo.erdi.hu/>

(in-package :alef)

(define-condition typecheck-error () ())

(define-condition typecheck-error/arity (typecheck-error)
  ((fun-name :initarg :fun-name :reader fun-name :type symbol))
  (:report (lambda (condition stream)
             (format stream "Patterns of ~A with varying arity" (fun-name condition)))))

(define-condition typecheck-error/pattern (typecheck-error)
  ((pattern :initarg :pattern :reader pattern :type pnode))
  (:report (lambda (condition stream)
             (format stream "Invalid pattern ~A in " (pnode-symbol (pattern condition)))
             (print-pnode (pattern condition) stream))))

(define-condition typecheck-error/formal-conflict (typecheck-error/pattern)
  ()
  (:report (lambda (condition stream)
             (format stream "Formal ~A is used more than once in pattern" (pnode-symbol (pattern condition))))))

(define-condition typecheck-error/wildcard (typecheck-error)
  ((expr :initarg :expr :reader expr :type pnode))
  (:report (lambda (condition stream)
             (declare (ignorable condition))
             (format stream "Wildcard in expression"))))

(define-condition typecheck-error/unify (typecheck-error)
  ((type/left :initarg :left :reader type/left :type typedesc)
   (type/right :initarg :right :reader type/right :type typedesc))
  (:report (lambda (condition stream)
             (format stream "Cannot unify types ~A and ~A"
                     (show-type (type/left condition))
                     (show-type (type/right condition))))))

(define-condition typecheck-error/occur (typecheck-error)
  ((typevar :initarg :typevar :reader typevar :type atom)
   (typeexpr :initarg :typeexpr :reader typeexpr :type typedesc))
  (:report (lambda (condition stream)
             (format stream "Occur check: Infinte type ~A = ~A"
                     (show-type (typevar condition))
                     (show-type (typeexpr condition))))))

(define-condition typecheck-error/untyped (typecheck-error)
  ((expr :initarg :expr :reader expr :type pnode))
  (:report (lambda (condition stream)
             (format stream "Untyped expression ~A in" (pnode-symbol (expr condition)))
             (print-pnode (expr condition) stream))))

(define-condition typecheck-error/overload (typecheck-error)
  ((requirement :initarg :requirement :reader requirement :type requirement))
  (:report (lambda (condition stream)
             (destructuring-bind (fun discr) (requirement condition)
               (format stream "No overload of ~A found for ~:*(~A ~A)" fun discr)))))