Improve error handling

diff --git a/common_lisp/core.lisp b/common_lisp/core.lisp
index d475590..8659aed 100644 (file)
--- a/common_lisp/core.lisp
+++ b/common_lisp/core.lisp
@@ -8,6 +8,17 @@
 
 (in-package :core)
 
+(define-condition index-error (types:mal-error)
+  ((size :initarg :size :reader size)
+   (index :initarg :index :reader index)
+   (sequence :initarg :sequence :reader sequence))
+  (:report (lambda (condition stream)
+             (format stream
+                     "Index out of range (~a), length is ~a but index given was ~a"
+                     (printer:pr-str (sequence condition))
+                     (size condition)
+                     (index condition)))))
+
 (defun get-file-contents (filename)
   (with-open-file (stream filename)
     (let ((data (make-string (file-length stream))))
@@ -29,7 +40,7 @@
                                       (types:apply-unwrapped-values '* value1 value2))))
 
    (cons (types:make-mal-symbol '/)
-         (types:make-mal-builtin-fn (lambda (value1 value2)
+         (types:make-mal-builtin-fn (   lambda (value1 value2)
                                       (types:apply-unwrapped-values '/ value1 value2))))
 
    (cons (types:make-mal-symbol '|prn|)
@@ -156,7 +167,10 @@
          (types:make-mal-builtin-fn (lambda (sequence index)
                                       (or (nth (mal-value index)
                                                (map 'list #'identity (mal-value sequence)))
-                                          (error "Index out of range")))))
+                                          (error 'index-error
+                                                 :size (length (mal-value sequence))
+                                                 :index (mal-value index)
+                                                 :sequence sequence)))))
 
    (cons (types:make-mal-symbol '|first|)
          (types:make-mal-builtin-fn (lambda (sequence)

diff --git a/common_lisp/env.lisp b/common_lisp/env.lisp
index 0b7a035..59aa3f2 100644 (file)
--- a/common_lisp/env.lisp
+++ b/common_lisp/env.lisp
@@ -9,14 +9,14 @@
 
 (in-package :env)
 
-(define-condition undefined-symbol (error)
+(define-condition undefined-symbol (types:mal-error)
   ((symbol :initarg :symbol :reader symbol))
   (:report (lambda (condition stream)
              (format stream
                      "Symbol ~a is undefined"
                      (symbol condition)))))
 
-(define-condition arity-mismatch (error)
+(define-condition arity-mismatch (types:mal-error)
   ((required :initarg :required :reader required)
    (provided :initarg :provided :reader provided))
   (:report (lambda (condition stream)

diff --git a/common_lisp/reader.lisp b/common_lisp/reader.lisp
index 5ca9ed2..9a90bcd 100644 (file)
--- a/common_lisp/reader.lisp
+++ b/common_lisp/reader.lisp
@@ -17,7 +17,7 @@
 ]*\\|[^][[:space:]~{}()@^`'\";]*\\)"
   "RE")
 
-(define-condition eof (error)
+(define-condition eof (types:mal-error)
   ((context :initarg :context :reader context))
   (:report (lambda (condition stream)
              (format stream

diff --git a/common_lisp/step8_macros.lisp b/common_lisp/step8_macros.lisp
index da2b183..ae67284 100644 (file)
--- a/common_lisp/step8_macros.lisp
+++ b/common_lisp/step8_macros.lisp
@@ -14,6 +14,17 @@
 
 (in-package :mal)
 
+(define-condition invalid-function (types:mal-error)
+  ((form :initarg :form :reader form)
+   (context :initarg :context :reader context))
+  (:report (lambda (condition stream)
+             (format stream
+                     "Invalid function '~a' provided while ~a"
+                     (printer:pr-str (form condition))
+                     (if (string= (context condition) "apply")
+                         "applying"
+                         "defining macro")))))
+
 (defvar *repl-env* (make-instance 'env:mal-environment))
 
 (dolist (binding core:ns)
@@ -116,11 +127,14 @@
                  ((mal-value= (make-mal-symbol '|defmacro!|) (first forms))
                   (let ((value (mal-eval (third forms) env)))
                     (return (if (types:mal-fn-p value)
-                                (env:set-env env (second forms)
+                                (env:set-env env
+                                             (second forms)
                                              (progn
                                                (setf (cdr (assoc 'is-macro (types:mal-attrs value))) t)
                                                value))
-                                (error "Not a function")))))
+                                (error 'invalid-function
+                                       :form value
+                                       :context "macro")))))
 
                  ((mal-value= (make-mal-symbol '|let*|) (first forms))
                   (let ((new-env (make-instance 'env:mal-environment
@@ -173,17 +187,21 @@
                  (t (let* ((evaluated-list (eval-ast ast env))
                            (function (car evaluated-list)))
                       ;; If first element is a mal function unwrap it
-                      (if (not (types:mal-fn-p function))
-                          (return (apply (mal-value function)
-                                         (cdr evaluated-list)))
-                          (let* ((attrs (types:mal-attrs function)))
-                            (setf ast (cdr (assoc 'ast attrs))
-                                  env (make-instance 'env:mal-environment
-                                                     :parent (cdr (assoc 'env attrs))
-                                                     :binds (map 'list
-                                                                 #'identity
-                                                                 (mal-value (cdr (assoc 'params attrs))))
-                                                     :exprs (cdr evaluated-list)))))))))))))
+                      (cond ((types:mal-fn-p function)
+                             (let* ((attrs (types:mal-attrs function)))
+                               (setf ast (cdr (assoc 'ast attrs))
+                                     env (make-instance 'env:mal-environment
+                                                        :parent (cdr (assoc 'env attrs))
+                                                        :binds (map 'list
+                                                                    #'identity
+                                                                    (mal-value (cdr (assoc 'params attrs))))
+                                                        :exprs (cdr evaluated-list)))))
+                            ((types:mal-builtin-fn-p function)
+                             (return (apply (mal-value function)
+                                            (cdr evaluated-list))))
+                            (t (error 'invalid-function
+                                      :form function
+                                      :context "apply")))))))))))
 
 (defun mal-read (string)
   (reader:read-str string))
@@ -195,17 +213,13 @@
   (handler-case
       (mal-print (mal-eval (mal-read string)
                            *repl-env*))
-    (reader:eof (condition)
-      (format nil
-              "~a"
-              condition))
-    (env:undefined-symbol (condition)
+    (types:mal-error (condition)
       (format nil
               "~a"
               condition))
     (error (condition)
       (format nil
-              "~a"
+              "Internal error: ~a"
               condition))))
 
 (rep "(def! not (fn* (a) (if a false true)))")

diff --git a/common_lisp/types.lisp b/common_lisp/types.lisp
index 6e0855c..9a4a83b 100644 (file)
--- a/common_lisp/types.lisp
+++ b/common_lisp/types.lisp
@@ -20,6 +20,8 @@
            :fn
            :builtin-fn
            :any
+           ;; Error
+           :mal-error
            ;; Helpers
            :wrap-value
            :apply-unwrapped-values
@@ -28,6 +30,9 @@
 
 (in-package :types)
 
+(define-condition mal-error (error)
+  nil)
+
 (defclass mal-type ()
   ((value :accessor mal-value :initarg :value)
    (meta :accessor mal-meta :initarg :meta :initform nil)