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 module Polymorph
23
24 class Abstract < Case::Abstract
25 alias opt_body_type_sym obj
26
27 def initialize(loc, opt_body_type_sym)
28 ASSERT.opt_kind_of opt_body_type_sym, ::Symbol
29
30 super
31 end
32
33
34 def desugar_for_rule(env, case_expr)
35 ASSERT.kind_of case_expr, Branch::Case
36
37 opt_nil_rule,
38 opt_cons_rule,
39 opt_body_type_sym,
40 opt_head_type_sym = __fold_rules__ case_expr.rules
41
42
43
44 then_rule,
45 else_rule,
46 has_cons = __classify_pattern__(
47 self.loc,
48 opt_nil_rule, opt_cons_rule,
49 opt_body_type_sym, opt_head_type_sym ,
50
51 if case_expr.opt_else_expr
52 Rule::Case.make_poly_otherwise(
53 case_expr.opt_else_expr.loc,
54 case_expr.opt_else_expr
55 )
56 else
57 nil
58 end,
59
60 Rule::Case.make_poly_unmatch(case_expr.loc)
61 )
62
63 result = __make_expression__(
64 env, case_expr, then_rule, else_rule,
65 has_cons, opt_body_type_sym,
66 opt_cons_rule, opt_head_type_sym
67 )
68
69 ASSERT.kind_of result, ASCE::Abstract
70 end
71
72
73 private
74
75 def __fold_rules__(rules)
76 ASSERT.kind_of rules, ::Array
77
78 rules.inject(
79 [nil, nil, nil, nil]
80 ) { |(
81 opt_nil_rule,
82 opt_cons_rule,
83 opt_body_type_sym,
84 opt_head_type_sym
85 ),
86 rule
87 |
88 ASSERT.opt_kind_of opt_nil_rule, Rule::Abstraction::Abstract
89 ASSERT.opt_kind_of opt_cons_rule, Rule::Abstraction::Abstract
90 ASSERT.opt_kind_of opt_body_type_sym, ::Symbol
91 ASSERT.opt_kind_of opt_head_type_sym, ::Symbol
92 ASSERT.kind_of rule, Rule::Abstraction::Abstract
93
94 head = rule.head
95 ASSERT.kind_of head, Rule::Case::Abstract
96 unless head.kind_of? Rule::Case::Polymorph::Abstract
97 raise X::SyntaxError.new(
98 rule.loc,
99 format("Inconsistent rule categories " +
100 "in case-expression, " +
101 "1st is %s : %s(#%d), " +
102 "but another is %s : %s(#%d)",
103 __escape_string_format__(self.to_s),
104 self.type_sym.to_s,
105 self.loc.line_num + 1,
106 __escape_string_format__(head.to_s),
107 head.type_sym.to_s,
108 head.loc.line_num + 1
109 )
110 )
111 end
112
113 case head
114 when Rule::Case::Polymorph::Nil
115 if opt_nil_rule
116 raise X::SyntaxError.new(
117 rule.loc,
118 format("Duplicated empty morph patterns " +
119 "in case-expression: %s : %s",
120 __escape_string_format__(head.to_s),
121 head.type_sym.to_s
122 )
123 )
124 end
125
126 [
127 rule,
128 opt_cons_rule,
129 head.opt_body_type_sym,
130 opt_head_type_sym
131 ]
132 when Rule::Case::Polymorph::Cons
133 if opt_cons_rule
134 raise X::SyntaxError.new(
135 rule.loc,
136 format("Duplicated not empty morph patterns " +
137 "in case-expression: %s : %s",
138 __escape_string_format__(head.to_s),
139 head.type_sym.to_s
140 )
141 )
142 end
143
144 [
145 opt_nil_rule,
146 rule,
147 head.opt_body_type_sym,
148 head.head_pat.opt_type_sym
149 ]
150 else
151 ASSERT.abort "No case: %s", head.inspect
152 end
153 }
154 end
155
156
157 def __classify_pattern__(
158 loc,
159 opt_nil_rule, opt_cons_rule,
160 opt_head_type_sym , opt_body_type_sym,
161 opt_otherwise_rule,
162 unmatch_rule
163 )
164 ASSERT.opt_kind_of opt_nil_rule, Rule::Abstraction::Abstract
165 ASSERT.opt_kind_of opt_cons_rule, Rule::Abstraction::Abstract
166 ASSERT.opt_kind_of opt_head_type_sym, ::Symbol
167 ASSERT.opt_kind_of opt_body_type_sym, ::Symbol
168 ASSERT.opt_kind_of opt_otherwise_rule, Rule::Abstraction::Abstract
169 ASSERT.kind_of unmatch_rule, Rule::Abstraction::Abstract
170
171 # N: Nil, !N: not Nil
172 # C: Cons, !C: not Cons
173 # O: Otherwise, !O: not Otherwise
174 # *: Don't care
175 result = (
176 if opt_nil_rule
177 nil_rule = opt_nil_rule
178
179 if opt_cons_rule
180 cons_rule = opt_cons_rule
181
182 if opt_otherwise_rule # 1. (N, C, O)
183 raise X::SyntaxError.new(
184 opt_otherwise_rule.loc,
185 "case: Never reached 'else' expression"
186 )
187 else # 2. (N, C, !O)
188 [nil_rule, cons_rule, true]
189 end
190 else
191 if opt_otherwise_rule # 3. (N, !C, O)
192 otherwise_rule = opt_otherwise_rule
193
194 [nil_rule, otherwise_rule, false]
195 else # 4. (N, !C, !O)
196 [nil_rule, unmatch_rule, false]
197 end
198 end
199 else
200 if opt_cons_rule
201 cons_rule = opt_cons_rule
202
203 if opt_otherwise_rule # 5. (!N, C, O)
204 otherwise_rule = opt_otherwise_rule
205
206 [otherwise_rule, cons_rule, true]
207 else # 6. (!N, C, !O)
208 [unmatch_rule, cons_rule, true]
209 end
210 else # 7. (!N, !C, *)
211 ASSERT.abort "No case -- empty rule set"
212 end
213 end
214 )
215
216 ASSERT.tuple_of result, [
217 Branch::Rule::Abstraction::Abstract,
218 Branch::Rule::Abstraction::Abstract,
219 ::Object
220 ]
221 ASSERT.bool result[2]
222
223 result
224 end
225
226
227 def __make_expression__(
228 env, case_expr, then_rule, else_rule,
229 has_cons, opt_body_type_sym,
230 opt_cons_rule, opt_head_type_sym
231 )
232 ASSERT.kind_of case_expr, Branch::Case
233 ASSERT.kind_of then_rule, Branch::Rule::Abstraction::Abstract
234 ASSERT.kind_of else_rule, Branch::Rule::Abstraction::Abstract
235 ASSERT.bool has_cons
236 ASSERT.opt_kind_of opt_body_type_sym, ::Symbol
237 ASSERT.opt_kind_of opt_cons_rule,
238 Branch::Rule::Abstraction::Abstract
239 ASSERT.opt_kind_of opt_head_type_sym, ::Symbol
240
241 then_expr = then_rule.desugar_poly_rule env
242 else_expr = else_rule.desugar_poly_rule env
243 body_expr = case_expr.expr.desugar env
244
245 if has_cons
246 cons_head = opt_cons_rule.head
247
248 __make_expression_has_cons__(
249 case_expr, then_expr, else_expr, body_expr,
250 cons_head.head_pat.var_sym, opt_head_type_sym,
251 cons_head.tail_pat.var_sym, opt_body_type_sym
252 )
253 else
254 __make_expression_has_not_cons__(
255 case_expr, then_expr, else_expr, body_expr,
256 opt_body_type_sym
257 )
258 end
259 end
260
261
262 def __make_expression_has_cons__(
263 case_expr, then_expr, else_expr, body_expr,
264 head_var_sym, opt_head_type_sym,
265 tail_var_sym, opt_body_type_sym
266 )
267 ASSERT.kind_of case_expr, Branch::Case
268 ASSERT.kind_of then_expr, ASCE::Abstract
269 ASSERT.kind_of else_expr, ASCE::Abstract
270 ASSERT.kind_of body_expr, ASCE::Abstract
271 ASSERT.kind_of head_var_sym, ::Symbol
272 ASSERT.opt_kind_of opt_head_type_sym, ::Symbol
273 ASSERT.kind_of tail_var_sym, ::Symbol
274 ASSERT.opt_kind_of opt_body_type_sym, ::Symbol
275
276 # <S> : Source type
277 # <H> : Head type
278 # <B> : Body type
279 #
280 # Concrete Syntax
281 #
282 # %CASE <xs> %OF {
283 # | %[] -> <then-expr>
284 # | %[ <x> | <xs'> : <B> ] -> <else-expr>
285 # }
286 #
287 # Abstract Syntax
288 #
289 # %LET {
290 # %VAL %o : Option = <xs : <S>>.dest
291 # %IN
292 # %IF %o kind-of? None %THEN
293 # <then-expr>
294 # %ELSE %LET {
295 # %VAL %t : Tuple = %o.contents
296 # %VAL <x> : <H> = %t$1
297 # %VAL <xs'> : <xs'> = %t$2
298 # %IN
299 # <else-expr>
300 # }
301 # }
302 #
303 # where type <xs'> = case <B> of { NONE -> <S> | Some _ -> <B> }
304 #
305
306 test_expr = ASCE.make_test_kind_of(
307 body_expr.loc,
308
309 ASCE.make_identifier(body_expr.loc, :'%o'),
310
311 ASCE.make_identifier(body_expr.loc, :None),
312
313 :Option
314 )
315
316 let_expr = ASCE.make_let(
317 case_expr.loc,
318
319 ASCD.make_seq_of_declaration(
320 case_expr.loc,
321 [
322 ASCD.make_value(
323 case_expr.loc,
324
325 :'%p',
326
327 ASCE.make_send(
328 case_expr.loc,
329 ASCE.make_identifier(case_expr.loc, :'%o'),
330 ASCE.make_message(case_expr.loc, :contents)
331 ),
332
333 :Product
334 ),
335
336 __make_value_morph__(
337 loc,
338 head_var_sym,
339 1,
340 opt_head_type_sym
341 ),
342
343 __make_value_morph__(
344 loc,
345 tail_var_sym,
346 2,
347 opt_body_type_sym
348 )
349 ]
350 ),
351
352 else_expr
353 )
354
355 ASCE.make_let(
356 case_expr.loc,
357
358 ASCD.make_seq_of_declaration(
359 case_expr.loc,
360 [
361 ASCD.make_value(
362 body_expr.loc,
363
364 :'%o',
365
366 ASCE.make_send(
367 body_expr.loc,
368 body_expr,
369 ASCE.make_message(body_expr.loc, :dest),
370 [],
371 opt_body_type_sym
372 )
373 )
374 ]
375 ),
376
377 ASCE.make_if(
378 case_expr.loc,
379 [
380 ASCE.make_rule(case_expr.loc, test_expr, then_expr)
381 ],
382 let_expr
383 )
384 )
385 end
386
387
388 def __make_expression_has_not_cons__(
389 case_expr, then_expr, else_expr, body_expr,
390 opt_body_type_sym
391 )
392 ASSERT.kind_of case_expr, Branch::Case
393 ASSERT.kind_of then_expr, ASCE::Abstract
394 ASSERT.kind_of else_expr, ASCE::Abstract
395 ASSERT.kind_of body_expr, ASCE::Abstract
396 ASSERT.opt_kind_of opt_body_type_sym, ::Symbol
397
398 # <S> : Source type
399 # <B> : Body type
400 #
401 # Concrete Syntax
402 #
403 # %CASE <xs> %OF {
404 # | %[] : <B> -> <then-expr>
405 # | %ELSE -> <else-expr>
406 # }
407 #
408 # Abstract Syntax
409 #
410 # %IF <xs : <S>>.dest kind-of? None
411 # %THEN <then-expr>
412 # %ELSE <else-expr>
413
414 test_expr = ASCE.make_test_kind_of(
415 body_expr.loc,
416
417 ASCE.make_send(
418 body_expr.loc,
419 body_expr,
420 ASCE.make_message(body_expr.loc, :dest),
421 [],
422 opt_body_type_sym
423 ),
424
425 ASCE.make_identifier(body_expr.loc, :None),
426
427 :Option
428 )
429
430 ASCE.make_if(
431 case_expr.loc,
432 [
433 ASCE.make_rule(
434 case_expr.loc,
435 test_expr,
436 then_expr,
437 )
438 ],
439 else_expr
440 )
441 end
442
443
444 private
445
446 def __make_value_morph__(loc, var_sym, num, opt_body_type_sym = nil)
447 ASSERT.kind_of loc, LOC::Entry
448 ASSERT.kind_of var_sym, ::Symbol
449 ASSERT.kind_of num, ::Integer
450 ASSERT.opt_kind_of opt_body_type_sym, ::Symbol
451
452 ASCD.make_value(
453 loc,
454
455 var_sym,
456
457 ASCE.make_product(
458 loc,
459 ASCE.make_identifier(loc, :'%p'),
460 ASCE.make_number_selector(loc, num)
461 ),
462
463 opt_body_type_sym
464 )
465 end
466 end
467
468
469
470 class Nil < Abstract
471 def type_sym
472 :PolyNil
473 end
474
475
476 def to_s
477 format("%%[]%s",
478 if self.opt_body_type_sym
479 format " : %s", self.opt_body_type_sym
480 else
481 ''
482 end
483 )
484 end
485
486
487 def pretty_print(q)
488 q.text self.to_s
489 end
490 end
491
492
493
494 class Cons < Abstract
495 attr_reader :head_pat, :tail_pat
496
497 def initialize(loc, head_pat, tail_pat, opt_body_type_sym)
498 ASSERT.kind_of head_pat, CSCP::Abstract
499 ASSERT.kind_of tail_pat, CSCP::Abstract
500 ASSERT.opt_kind_of opt_body_type_sym, ::Symbol
501
502 super(loc, opt_body_type_sym)
503 @head_pat = head_pat
504 @tail_pat = tail_pat
505 end
506
507
508 def type_sym
509 :PolyCons
510 end
511
512
513 def to_s
514 format("%%[%s%s]",
515 self.head_pat.to_s,
516
517 format(" | %s", self.tail_pat.to_s)
518 )
519 end
520
521
522 def pretty_print(q)
523 PRT.group q, bb:'%[', eb:']' do
524 q.pp self.head_pat
525
526 if self.tail_pat
527 q.breakable
528
529 q.text '|'
530
531 q.breakable
532
533 q.pp self.tail_pat
534 end
535 end
536 end
537 end
538
539
540
541 class Otherwise < Abstraction::Abstract
542 attr_reader :expr
543
544 def initialize(loc, expr)
545 ASSERT.kind_of expr, CSCE::Abstract
546
547 super(loc)
548
549 @expr = expr
550 end
551
552
553 def desugar_poly_rule(env)
554 self.expr.desugar env
555 end
556 end
557
558
559
560 class Unmatch < Abstraction::Abstract
561 def desugar_poly_rule(_env)
562 ASCE.make_raise(
563 self.loc,
564 X::UnmatchError,
565 ASCE.make_string(self.loc, "No rules matched")
566 )
567 end
568 end
569
570 end # Umu::ConcreteSyntax::Core::Expression::Nary::Branch::Rule::Case::Polymorph
571
572
573 module_function
574
575 def make_poly_otherwise(loc, expr)
576 ASSERT.kind_of loc, LOC::Entry
577 ASSERT.kind_of expr, CSCE::Abstract
578
579 Nary::Branch::Rule::Case::Polymorph::Otherwise.new(
580 loc, expr
581 ).freeze
582 end
583
584
585 def make_poly_unmatch(loc)
586 ASSERT.kind_of loc, LOC::Entry
587
588 Nary::Branch::Rule::Case::Polymorph::Unmatch.new(
589 loc
590 ).freeze
591 end
592
593 end # Umu::ConcreteSyntax::Core::Expression::Nary::Branch::Rule::Case
594
595 end # Umu::ConcreteSyntax::Core::Expression::Nary::Branch::Rule
596
597 end # Umu::ConcreteSyntax::Core::Expression::Nary::Branch
598
599 end # Umu::ConcreteSyntax::Core::Expression::Nary
600
601
602 module_function
603
604 def make_case_rule_poly_nil(loc, opt_body_type_sym = nil)
605 ASSERT.kind_of loc, LOC::Entry
606 ASSERT.opt_kind_of opt_body_type_sym, ::Symbol
607
608 Nary::Branch::Rule::Case::Polymorph::Nil.new(
609 loc, opt_body_type_sym,
610 ).freeze
611 end
612
613
614 def make_case_rule_poly_cons(
615 loc, head_pat, tail_pat, opt_body_type_sym = nil
616 )
617 ASSERT.kind_of loc, LOC::Entry
618 ASSERT.kind_of head_pat, CSCP::Abstract
619 ASSERT.kind_of tail_pat, CSCP::Abstract
620 ASSERT.opt_kind_of opt_body_type_sym, ::Symbol
621
622 Nary::Branch::Rule::Case::Polymorph::Cons.new(
623 loc, head_pat, tail_pat, opt_body_type_sym
624 ).freeze
625 end
626
627 end # Umu::ConcreteSyntax::Core::Expression
628
629 end # Umu::ConcreteSyntax::Core
630
631 end # Umu::ConcreteSyntax
632
633 end # Umu