-
Notifications
You must be signed in to change notification settings - Fork 0
/
common.lisp
69 lines (57 loc) · 1.85 KB
/
common.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
;;;; Štar: some common things
;;;
#+org.tfeb.tools.require-module
(org.tfeb.tools.require-module:needs
("pkg" :compile t))
(in-package :org.tfeb.star/common)
;;;; Conditions
;;;
;;; I am not sure the classification here is right
(define-condition star-error (simple-error)
;; Any of these are not our fault
()
(:documentation
"Condition type for Štar's errors"))
(defun star-error (control &rest arguments)
(error 'star-error
:format-control control
:format-arguments arguments))
(define-condition syntax-error (star-error program-error)
((form :initform nil
:initarg :form
:reader syntax-error-form))
(:report
(lambda (se stream)
(format stream "syntax error~@[ in ~S~]: ~A"
(syntax-error-form se)
(apply #'format nil
(simple-condition-format-control se)
(simple-condition-format-arguments se))))))
(defun syntax-error (form control &rest arguments)
(error 'syntax-error
:form form
:format-control control
:format-arguments arguments))
(define-condition catastrophe (simple-error)
;; These definitely are our fault
())
(defun catastrophe (control &rest arguments)
(error 'catastrophe
:format-control control
:format-arguments arguments))
(define-condition star-note (simple-condition)
()
(:documentation
"Condition type for Štar compilation notes"))
(defun note (format &rest arguments)
(signal 'star-note
:format-control format
:format-arguments arguments))
(defmacro reporting-star-notes ((&optional (to '*debug-io*)) &body forms)
"Report any Štar notes to TO"
(with-names (<to>)
`(let ((,<to> ,to))
(handler-bind ((star-note
(lambda (note)
(format ,<to> "~&Note: ~A~%" note))))
,@forms))))