blob: 60b1a657ef774c16073c2ffd971d52fb0293cc71 (
plain) (
blame)
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
|
(defpackage #:cabs-syn
(:use #:common-lisp #:cutil)
(:export
#:<exp-int>
#:<exp-var>
#:<exp-str>
#:<exp-unr>
#:<exp-bin>
#:<cmd-rem>
#:<cmd-goto>
#:<cmd-print>
#:<cmd-input>
#:<cmd-if>
#:<cmd-let>
#:<phrase-line>
#:<phrase-list>
#:<phrase-run>
#:<phrase-p-end>
#:priority-uop
#:priority-binop))
(in-package #:cabs-syn)
;; If these were only C enums, without any payload, I'd just use symbols and (error) in the t case.
;; But classes seem better for the associated data, in discriminated unions.
(defclass <expression> () () (:metaclass <abstract-class>))
(defclass <exp-int> (<expression>) ((my-int :accessor my-int)))
;; TODO: need another closer-mop:validate-superclass call here
(defclass <exp-var> (<expression>) ((var :accessor var)))
(defclass <exp-str> (<expression>) ((str :accessor str)))
(defclass <exp-unr> (<expression>) ((op :accessor op) (expr :accessor expr)))
(defclass <exp-bin> (<expression>) ((exp1 :accessor exp1) (op :accessor op) (exp2 :accessor exp2)))
(defclass <command> () () (:metaclass <abstract-class>))
(defclass <cmd-rem> (<command>) ((remark :accessor remark)))
(defclass <cmd-goto> (<command>) ((goto :accessor goto)))
(defclass <cmd-print> (<command>) ((expr :accessor expr)))
(defclass <cmd-input> (<command>) ((var :accessor var)))
(defclass <cmd-if> (<command>) ((expr :accessor expr) (num :accessor num)))
(defclass <cmd-let> (<command>) ((var :accessor var) (expr :accessor expr)))
(defclass <line> () ((num :initarg n :accessor num) (cmd :initarg c :accessor cmd)))
(defclass <phrase> () () (:metaclass <abstract-class>))
(defclass <phrase-line> (<phrase>) ((line :accessor line)))
(defclass <phrase-list> (<phrase>) ())
(defclass <phrase-run> (<phrase>) ())
(defclass <phrase-p-end> (<phrase>) ())
(defun priority-uop (unr-op)
(case unr-op
((not) 1)
((uminus) 7)))
(defun priority-binop (bin-op)
(cond ((member bin-op '(mult div)) 6)
((member bin-op '(plus minus)) 5)
((eql bin-op 'mod) 4)
((member bin-op '(equal less lesseq great greateq diff)) 3)
((member bin-op '(and or)) 2)))
(provide "cabs-syn")
|