1 # coding: utf-8
2 # frozen_string_literal: true
3
4
5
6 module Umu
7
8 module ConcreteSyntax
9
10 module Core
11
12 module Expression
13
14 module Nary
15
16 module Branch
17
18 module Rule
19
20 module Case
21
22 class Class < Abstract
23 alias class_ident obj
24
25 attr_reader :opt_contents_pat
26 attr_reader :opt_superclass_ident
27
28 def initialize(
29 loc, class_ident, opt_contents_pat, opt_superclass_ident
30 )
31 ASSERT.kind_of class_ident, CSCEU::Identifier::Short
32 ASSERT.opt_kind_of opt_contents_pat, CSCP::Abstract
33 ASSERT.opt_kind_of opt_superclass_ident, CSCEU::Identifier::Short
34
35 super(loc, class_ident)
36
37 @opt_contents_pat = opt_contents_pat
38 @opt_superclass_ident = opt_superclass_ident
39 end
40
41
42 def type_sym
43 :Class
44 end
45
46
47 def to_s
48 format("&%s%s",
49 if self.opt_superclass_ident
50 format("(%s < %s)",
51 self.class_ident.to_s,
52 self.opt_superclass_ident.to_s
53 )
54 else
55 self.class_ident.to_s
56 end,
57
58 if self.opt_contents_pat
59 ' ' + self.opt_contents_pat.to_s
60 else
61 ''
62 end
63 )
64 end
65
66
67 def pretty_print(q)
68 q.text '&'
69 if self.opt_superclass_ident
70 q.text format("(%s < %s)",
71 self.class_ident.to_s,
72 self.opt_superclass_ident.to_s
73 )
74 else
75 q.text self.class_ident.to_s
76 end
77
78 if self.opt_contents_pat
79 q.text ' '
80 q.pp self.opt_contents_pat
81 end
82 end
83
84
85 def desugar_for_rule(env, case_expr)
86 ASSERT.kind_of case_expr, Branch::Case
87
88 source_expr = case_expr.expr.desugar env
89 ASSERT.kind_of source_expr, ASCE::Abstract
90 if source_expr.simple?
91 rules = __desugar_rules__(env, case_expr) {
92 |_| source_expr
93 }
94
95 ASCE.make_if(
96 case_expr.loc, rules, case_expr.desugar_else_expr(env)
97 )
98 else
99 ASCE.make_let(
100 case_expr.loc,
101
102 ASCD.make_seq_of_declaration(
103 source_expr.loc,
104 [ASCD.make_value(source_expr.loc, :'%x', source_expr)]
105 ),
106
107 ASCE.make_if(
108 case_expr.loc,
109 __desugar_rules__(env, case_expr) {
110 |loc|
111
112 ASCE.make_identifier loc, :'%x'
113 },
114 case_expr.desugar_else_expr(env)
115 )
116 )
117 end
118 end
119
120
121 private
122
123 def __desugar_rules__(env, case_expr, &fn)
124 ASSERT.kind_of case_expr, Branch::Case
125
126 source_expr = case_expr.expr.desugar env
127
128 case_expr.rules.map { |rule|
129 ASSERT.kind_of rule, Rule::Abstraction::Abstract
130
131 head = rule.head
132 ASSERT.kind_of head, Rule::Case::Abstract
133 unless head.kind_of? Rule::Case::Class
134 raise X::SyntaxError.new(
135 rule.loc,
136 format("Inconsistent rule categories " +
137 "in case-expression, " +
138 "1st is %s : %s(#%d), " +
139 "but another is %s : %s(#%d)",
140 self.to_s,
141 self.type_sym.to_s,
142 self.loc.line_num + 1,
143 __escape_string_format__(head.to_s),
144 head.type_sym.to_s,
145 head.loc.line_num + 1
146 )
147 )
148 end
149
150 head_expr = ASCE.make_test_kind_of(
151 head.loc,
152
153 fn.call(head.loc),
154
155 head.class_ident.desugar(env),
156
157 if head.opt_superclass_ident
158 head.opt_superclass_ident.sym
159 else
160 nil
161 end
162 )
163 body_expr = if head.opt_contents_pat
164 contents_decl = head.opt_contents_pat.desugar_value(
165 ASCE.make_send(
166 case_expr.expr.loc,
167
168 if source_expr.simple?
169 source_expr
170 else
171 ASCE.make_identifier(
172 source_expr.loc, :'%x'
173 )
174 end,
175
176 ASCE.make_message(
177 case_expr.expr.loc, :contents
178 )
179 ),
180 env
181 )
182 ASSERT.kind_of contents_decl, ASCD::Abstract
183
184 ASCE.make_let(
185 rule.loc,
186
187 ASCD.make_seq_of_declaration(
188 rule.loc,
189 [contents_decl]
190 ),
191
192 rule.body_expr.desugar(env)
193 )
194 else
195 case_expr.desugar_body_expr env, rule
196 end
197
198 ASCE.make_rule rule.loc, head_expr, body_expr
199 }
200 end
201 end
202
203
204 end # Umu::ConcreteSyntax::Core::Expression::Nary::Branch::Rule::Case
205
206 end # Umu::ConcreteSyntax::Core::Expression::Nary::Branch::Rule
207
208 end # Umu::ConcreteSyntax::Core::Expression::Nary::Branch
209
210 end # Umu::ConcreteSyntax::Core::Expression::Nary
211
212
213 module_function
214
215 def make_case_rule_class(
216 loc, class_ident, opt_contents_pat, opt_superclass_ident = nil
217 )
218 ASSERT.kind_of loc, LOC::Entry
219 ASSERT.kind_of class_ident, CSCEU::Identifier::Short
220 ASSERT.opt_kind_of opt_contents_pat, CSCP::Abstract
221 ASSERT.opt_kind_of opt_superclass_ident, CSCEU::Identifier::Short
222
223 Nary::Branch::Rule::Case::Class.new(
224 loc, class_ident, opt_contents_pat, opt_superclass_ident
225 ).freeze
226 end
227
228 end # Umu::ConcreteSyntax::Core::Expression
229
230 end # Umu::ConcreteSyntax::Core
231
232 end # Umu::ConcreteSyntax
233
234 end # Umu