Linux GNU 11.4.0 Code Coverage Report


Directory: ./
Coverage: low: ≥ 0% medium: ≥ 75.0% high: ≥ 90.0%
Coverage Exec / Excl / Total
Lines: 0.0% 0 / 0 / 1142
Functions: -% 0 / 1 / 1
Branches: 0.0% 0 / 0 / 662

OMCompiler/Compiler/Template/TplAbsyn.mo
Line Branch Exec Source
1 /*
2 * This file is part of OpenModelica.
3 *
4 * Copyright (c) 1998-2026, Open Source Modelica Consortium (OSMC),
5 * c/o Linköpings universitet, Department of Computer and Information Science,
6 * SE-58183 Linköping, Sweden.
7 *
8 * All rights reserved.
9 *
10 * THIS PROGRAM IS PROVIDED UNDER THE TERMS OF AGPL VERSION 3 LICENSE OR
11 * THIS OSMC PUBLIC LICENSE (OSMC-PL) VERSION 1.8.
12 * ANY USE, REPRODUCTION OR DISTRIBUTION OF THIS PROGRAM CONSTITUTES
13 * RECIPIENT'S ACCEPTANCE OF THE OSMC PUBLIC LICENSE OR THE GNU AGPL
14 * VERSION 3, ACCORDING TO RECIPIENTS CHOICE.
15 *
16 * The OpenModelica software and the OSMC (Open Source Modelica Consortium)
17 * Public License (OSMC-PL) are obtained from OSMC, either from the above
18 * address, from the URLs:
19 * http://www.openmodelica.org or
20 * https://github.com/OpenModelica/ or
21 * http://www.ida.liu.se/projects/OpenModelica,
22 * and in the OpenModelica distribution.
23 *
24 * GNU AGPL version 3 is obtained from:
25 * https://www.gnu.org/licenses/licenses.html#GPL
26 *
27 * This program is distributed WITHOUT ANY WARRANTY; without
28 * even the implied warranty of MERCHANTABILITY or FITNESS
29 * FOR A PARTICULAR PURPOSE, EXCEPT AS EXPRESSLY SET FORTH
30 * IN THE BY RECIPIENT SELECTED SUBSIDIARY LICENSE CONDITIONS OF OSMC-PL.
31 *
32 * See the full OSMC Public License conditions for more details.
33 *
34 */
35
36 encapsulated package TplAbsyn
37 "
38 file: TplAbsyn.mo
39 package: TplAbsyn
40 description: Susan abstract syntax
41
42 $Id$
43 "
44
45 import Tpl;
46
47 protected
48
49 import AvlSetString;
50 import Debug;
51 import Error;
52 import Flags;
53 import List;
54 import MetaModelica.Dangerous.listReverseInPlace;
55 import System;
56 import TplCodegen;
57 import Util;
58
59 /* Input AST */
60 public type Ident = String;
61 public type TypedIdents = list<tuple<Ident, TypeSignature>>;
62 public type EscOption = tuple<Ident, Option<Expression>>;
63 public type StringToken = Tpl.StringToken;
64 public type Tokens = Tpl.Tokens;
65
66 constant SourceInfo dummySourceInfo = SOURCEINFO("NoFileName.xxx", false, 0, 0, 0, 0, 0.0);
67
68 public
69 uniontype PathIdent
70 record IDENT
71 Ident ident;
72 end IDENT;
73
74 record PATH_IDENT
75 Ident ident;
76 PathIdent path;
77 end PATH_IDENT;
78 end PathIdent;
79
80 public
81 uniontype TypeSignature
82 record LIST_TYPE
83 TypeSignature ofType;
84 end LIST_TYPE;
85
86 record ARRAY_TYPE // one-dimensional arrays --> with only (safe) list behaviour
87 TypeSignature ofType;
88 end ARRAY_TYPE;
89
90 record OPTION_TYPE
91 TypeSignature ofType;
92 end OPTION_TYPE;
93
94 record TUPLE_TYPE
95 list<TypeSignature> ofTypes;
96 end TUPLE_TYPE;
97
98 record NAMED_TYPE "key/path to a TypeInfo list from an AST definition"
99 PathIdent name;
100 end NAMED_TYPE;
101
102 record STRING_TYPE end STRING_TYPE;
103 record TEXT_TYPE end TEXT_TYPE;
104 record STRING_TOKEN_TYPE "Used only for internal string constants." end STRING_TOKEN_TYPE;
105
106 record INTEGER_TYPE end INTEGER_TYPE;
107 record REAL_TYPE end REAL_TYPE;
108 record BOOLEAN_TYPE end BOOLEAN_TYPE;
109
110 record UNRESOLVED_TYPE "Errorneous resolving type. Only used during elaboration phase."
111 String reason;
112 end UNRESOLVED_TYPE;
113 end TypeSignature;
114
115 public
116 type Expression = tuple<ExpressionBase, SourceInfo>;
117
118 public
119 uniontype ExpressionBase
120 record TEMPLATE
121 list<Expression> items;
122 String lquote; // just preserved for effective quoted dump
123 String rquote;
124 end TEMPLATE;
125
126 record STR_TOKEN
127 StringToken value; //only one of ST_STRING, ST_NEW_LINE or ST_STRING_LIST
128 end STR_TOKEN;
129
130 record LITERAL
131 String value;
132 TypeSignature litType; // only INTEGER_TYPE, REAL_TYPE or BOOLEAN_TYPE
133 end LITERAL;
134
135 record SOFT_NEW_LINE end SOFT_NEW_LINE; //appears only in a TEMPLATE
136
137 record BOUND_VALUE
138 PathIdent boundPath;
139 end BOUND_VALUE;
140
141 record FUN_CALL
142 PathIdent name;
143 list<Expression> args;
144 end FUN_CALL;
145
146 record CONDITION
147 Boolean isNot "Is not or inequal";
148 Expression lhsExp;
149 Option<MatchingExp> rhsValue "always NONE() for now; it is a residuum from the form 'if exp is PATTERN then ...'";
150 Expression trueBranch;
151 Option<Expression> elseBranch;
152 end CONDITION;
153
154 record MATCH
155 Expression matchExp;
156 list<tuple<MatchingExp,Expression>> cases;
157 end MATCH;
158
159 record MAP
160 //list<tuple<Expression, MatchingExp>> bindings; // default/empty MatchingExp is 'it'
161 //only 1 argument allowed in the first impl
162 Expression argExp;
163 MatchingExp ofBinding; // default/empty MatchingExp is 'it'
164 Expression mapExp;
165 Option<Ident> hasIndexIdentOpt;
166 end MAP;
167
168 record MAP_ARG_LIST
169 list<Expression> parts; // a part is a scalar or a list
170 end MAP_ARG_LIST;
171
172 record ESCAPED
173 Expression exp;
174 //Option<Expression> separator;
175 list<EscOption> options;
176 end ESCAPED;
177
178 record INDENTATION "Indented block."
179 Integer width;
180 list<Expression> items;
181 end INDENTATION;
182
183 record LET
184 Expression letExp;
185 Expression exp;
186 end LET;
187 /*
188 record LET_BINDING
189 Ident name;
190 Expression exp;
191 end LET_BINDING;
192 */
193 record TEXT_CREATE
194 Ident name;
195 Expression exp;
196 end TEXT_CREATE;
197
198 record TEXT_ADD
199 Ident name;
200 Expression exp;
201 end TEXT_ADD;
202
203 record NORET_CALL
204 PathIdent name;
205 list<Expression> args;
206 end NORET_CALL;
207
208
209 record ERROR_EXP "Parse error expression used when parser error occured."
210 end ERROR_EXP;
211
212 end ExpressionBase;
213
214 public
215 uniontype MatchingExp
216 record BIND_AS_MATCH
217 Ident bindIdent;
218 MatchingExp matchingExp;
219 end BIND_AS_MATCH;
220
221 record BIND_MATCH
222 Ident bindIdent;
223 end BIND_MATCH;
224
225 record RECORD_MATCH
226 PathIdent tagName;
227 list<tuple<Ident, MatchingExp>> fieldMatchings;
228 end RECORD_MATCH;
229
230 record SOME_MATCH
231 MatchingExp value;
232 end SOME_MATCH;
233
234 record NONE_MATCH end NONE_MATCH;
235
236 record TUPLE_MATCH
237 list<MatchingExp> tupleArgs;
238 end TUPLE_MATCH;
239
240 record LIST_MATCH
241 list<MatchingExp> listElts; //empty list included
242 end LIST_MATCH;
243
244 record LIST_CONS_MATCH
245 MatchingExp head;
246 MatchingExp rest;
247 end LIST_CONS_MATCH;
248
249 record STRING_MATCH
250 String value;
251 end STRING_MATCH;
252
253 record LITERAL_MATCH
254 String value;
255 TypeSignature litType "only INTEGER_TYPE, REAL_TYPE or BOOLEAN_TYPE";
256 end LITERAL_MATCH;
257
258 record REST_MATCH end REST_MATCH;
259 end MatchingExp;
260
261
262 public
263 uniontype TypeInfo
264 record TI_UNION_TYPE
265 list<tuple<Ident, TypedIdents>> recTags;
266 end TI_UNION_TYPE;
267
268 record TI_RECORD_TYPE
269 TypedIdents fields;
270 end TI_RECORD_TYPE;
271
272 record TI_ALIAS_TYPE
273 TypeSignature aliasType;
274 end TI_ALIAS_TYPE;
275
276 record TI_FUN_TYPE "Imported AST/builtin functions."
277 TypedIdents inArgs;
278 TypedIdents outArgs;
279 list<Ident> tyVars;
280 //Ident callName; ... can be made as direct/wrapper calls
281 end TI_FUN_TYPE;
282
283 record TI_CONST_TYPE "Imported AST constants."
284 TypeSignature constType;
285 end TI_CONST_TYPE;
286 end TypeInfo;
287
288 public
289 uniontype ASTDef
290 record AST_DEF
291 PathIdent importPackage;
292 Boolean isDefault "names can be used unqualified";
293 Boolean isInterface "from an interface file, always imported publicly";
294 list<tuple<Ident, TypeInfo>> types;
295 end AST_DEF;
296 end ASTDef;
297
298
299 public
300 uniontype TemplPackage
301 record TEMPL_PACKAGE
302 PathIdent name;
303 //list<PathIdent> extendsList;
304 list<ASTDef> astDefs;
305 list<tuple<Ident,TemplateDef>> templateDefs;
306 String annotationFooter;
307 end TEMPL_PACKAGE;
308 end TemplPackage;
309
310 public
311 uniontype TemplateDef
312 record STR_TOKEN_DEF
313 StringToken value; //only one of ST_STRING, ST_NEW_LINE, ST_LINE or ST_STRING_LIST
314 end STR_TOKEN_DEF;
315
316 record LITERAL_DEF
317 String value;
318 TypeSignature litType; // only INTEGER_TYPE, REAL_TYPE or BOOLEAN_TYPE
319 end LITERAL_DEF;
320
321 record TEMPLATE_DEF
322 TypedIdents args;
323 String lesc; // just preserved for original-like quoted dump
324 String resc;
325 Expression exp;
326 end TEMPLATE_DEF;
327 end TemplateDef;
328
329 /* Output AST */
330 //type MMPublic = Boolean;
331 public
332 uniontype MMPackage
333 record MM_PACKAGE
334 PathIdent name;
335 list<MMDeclaration> mmDeclarations;
336 String annotationFooter;
337 end MM_PACKAGE;
338 end MMPackage;
339
340 public
341 uniontype MMDeclaration
342 record MM_IMPORT
343 Boolean isPublic;
344 PathIdent packageName;
345 end MM_IMPORT;
346
347 record MM_STR_TOKEN_DECL
348 Boolean isPublic;
349 Ident name;
350 StringToken value;
351 end MM_STR_TOKEN_DECL;
352
353 record MM_LITERAL_DECL
354 Boolean isPublic;
355 Ident name;
356 String value;
357 TypeSignature litType;
358 end MM_LITERAL_DECL;
359
360
361 record MM_FUN
362 Boolean isPublic;
363 Ident name;
364 TypedIdents inArgs; //inTxt inclusive
365 TypedIdents outArgs; // outTxt + extra Texts
366 TypedIdents locals;
367 list<MMExp> statements;
368
369 GenInfo genInfoOpt "internal use only - a type of elaboration of the funtion.";
370 end MM_FUN;
371 end MMDeclaration;
372
373 public
374 uniontype MMExp
375 record MM_ASSIGN
376 list<Ident> lhsArgs;
377 MMExp rhs;
378 end MM_ASSIGN;
379
380 record MM_FN_CALL
381 PathIdent fnName;
382 list<MMExp> args;
383 end MM_FN_CALL;
384
385 record MM_IDENT
386 PathIdent ident;
387 end MM_IDENT;
388
389 record MM_STR_TOKEN "constructor of type StringToken"
390 StringToken value;
391 end MM_STR_TOKEN;
392
393 record MM_STRING "to pass a string constant as parameter of type String"
394 String value;
395 end MM_STRING;
396
397 record MM_LITERAL "to pass a literal constant as parameter of type Integer, Real or Boolean"
398 String value;
399 end MM_LITERAL;
400
401 record MM_MATCH
402 list<MMMatchCase> matchCases;
403 end MM_MATCH;
404
405 record MM_FOR_LOOP
406 Ident idxName;
407 Ident arrName;
408 Ident eltName;
409 list<MMExp> statements;
410 end MM_FOR_LOOP;
411
412 record MM_LIST_FOR_LOOP "iterative list map: for eltName in listName loop match eltName ... end for;"
413 Ident eltName;
414 Ident listName;
415 TypedIdents matchLocals "pattern and body locals of the per-element match";
416 list<MMMatchCase> matchCases "the matched case plus an optional skip (else) case";
417 end MM_LIST_FOR_LOOP;
418 end MMExp;
419
420 public type MMMatchCase = tuple<list<MatchingExp>, list<MMExp>>;
421
422 constant Ident imlicitTxt = "txt";
423 constant Ident inPrefix = "in_";
424 constant Ident outPrefix = "out_";
425 //constant Ident imlicitInTxt = "intxt"; //not used ... there can be the same names for in/ou values
426 //constant Ident imlicitOutTxt = "outtxt";
427
428 constant Ident funArgNamePrefix = "a_";
429 constant Ident extArgNamePrefix = "e_";
430 constant Ident letValueNamePrefix = "l_";
431 constant Ident indexNamePrefix = "x_";
432 constant Ident caseBindingNamePrefix = "i_";
433 constant Ident returnTempVarNamePrefix = "ret_";
434 constant Ident constantNamePrefix = "c_";
435 constant Ident textTempVarNamePrefix = "txt_";
436 constant Ident textToStringNamePrefix = "str_";
437
438 constant Ident matchFunPrefix = "fun_";
439 constant Ident listMapFunPrefix = "lm_";
440 constant Ident arrayMapFunPrefix = "am_";
441 constant Ident scalarMapFunPrefix = "smf_";
442
443 //constant Ident implicitTxtInArgName = "inTxt";
444 constant Ident matchDefaultArgName = "mArg";
445
446
447 constant Ident impossibleIdent = "*none*";
448
449 constant tuple<Ident,TypeSignature> imlicitTxtArg = (imlicitTxt, TEXT_TYPE());
450 //constant tuple<Ident,TypeSignature> imlicitTxtInputArg = (implicitTxtInArgName, TEXT_TYPE());
451
452 /* internal types */
453 protected
454
455 constant MatchingExp imlicitTxtMExp = BIND_MATCH(imlicitTxt);
456 constant Expression emptyExpression = (STR_TOKEN(Tpl.ST_STRING("")), dummySourceInfo) ;
457
458 constant Ident emptyTxt = "Tpl.emptyTxt";
459 constant Ident errorIdent = "!error!";
460
461 constant Tpl.IterOptions defaultIterOptions
462 = Tpl.ITER_OPTIONS(0, NONE(), NONE(), 0, 0, Tpl.ST_NEW_LINE(), 0, Tpl.ST_NEW_LINE());
463
464
465 public //only achievable by the 'from' clause
466 constant Ident indexOffsetOptionId = "$indexOffset";
467
468 protected
469
470 constant Ident emptyOptionId = "empty";
471 constant Ident separatorOptionId = "separator";
472 constant Ident alignNumOptionId = "align";
473 constant Ident alignNumOffsetOptionId = "alignOffset";
474 constant Ident alignSeparatorOptionId = "alignSeparator";
475 constant Ident wrapWidthOptionId = "wrap";
476 constant Ident wrapSeparatorOptionId = "wrapSeparator";
477
478 constant Ident indentOptionId = "indent";
479 constant Ident absIndentOptionId = "absIndent";
480 constant Ident relIndentOptionId = "relIndent";
481 constant Ident anchorOptionId = "anchor";
482
483 //constant defaultMMOptions
484 constant list<MMEscOption> defaultEscOptions = {
485 (indexOffsetOptionId, (MM_LITERAL("0"), INTEGER_TYPE()) ),
486 (emptyOptionId, (MM_FN_CALL(IDENT("SOME"), {MM_STR_TOKEN(Tpl.ST_STRING(""))}), OPTION_TYPE(STRING_TOKEN_TYPE())) ),
487 (separatorOptionId, (MM_LITERAL("NONE()"), OPTION_TYPE(STRING_TOKEN_TYPE())) ),
488
489 (alignNumOptionId, (MM_LITERAL("10"), INTEGER_TYPE()) ),
490 (alignNumOffsetOptionId, (MM_LITERAL("0"), INTEGER_TYPE()) ),
491 (alignSeparatorOptionId, (MM_STR_TOKEN(Tpl.ST_NEW_LINE()), STRING_TOKEN_TYPE()) ),
492
493 (wrapWidthOptionId, (MM_LITERAL("100"), INTEGER_TYPE()) ),
494 (wrapSeparatorOptionId, (MM_STR_TOKEN(Tpl.ST_NEW_LINE()), STRING_TOKEN_TYPE())),
495
496 (indentOptionId, (MM_LITERAL("0"), INTEGER_TYPE()) ),
497 (absIndentOptionId, (MM_LITERAL("0"), INTEGER_TYPE()) ),
498 (relIndentOptionId, (MM_LITERAL("0"), INTEGER_TYPE()) ),
499 (anchorOptionId, (MM_LITERAL("0"), INTEGER_TYPE()) )
500
501 //("noIndent", (MM_LITERAL("true"),BOOLEAN_TYPE()) ),
502
503 //("parseNewLine", (MM_LITERAL("true"), UNRESOLVED_TYPE("No value - only compile time option.")) )
504 };
505
506
507
508 constant list<MMEscOption> nonSpecifiedIterOptions = {
509 (indexOffsetOptionId, (MM_LITERAL("0"), INTEGER_TYPE()) ),
510 (emptyOptionId, (MM_LITERAL("NONE()"), OPTION_TYPE(STRING_TOKEN_TYPE())) ),
511 (separatorOptionId, (MM_LITERAL("NONE()"), OPTION_TYPE(STRING_TOKEN_TYPE())) ),
512
513 (alignNumOptionId, (MM_LITERAL("0"), INTEGER_TYPE()) ),
514 (alignNumOffsetOptionId, (MM_LITERAL("0"), INTEGER_TYPE()) ),
515 (alignSeparatorOptionId, (MM_STR_TOKEN(Tpl.ST_NEW_LINE()), STRING_TOKEN_TYPE()) ),
516
517 (wrapWidthOptionId, (MM_LITERAL("0"), INTEGER_TYPE()) ),
518 (wrapSeparatorOptionId, (MM_STR_TOKEN(Tpl.ST_NEW_LINE()), STRING_TOKEN_TYPE()))
519 };
520
521
522 public
523
524 type MMEscOption = tuple<Ident,tuple<MMExp, TypeSignature>>;
525 type ScopeEnv = list<Scope>;
526
527
528 uniontype Scope
529 record FUN_SCOPE
530 TypedIdents args;
531 TypedIdents localArgs "local encoded args; used to elaborate the actual args of closures";
532 //TypedIdents usedArgs; ... will be derived from MMExp
533 //TypedIdents outArgs; ... will be derived from MMExp
534 end FUN_SCOPE;
535
536 record CASE_SCOPE
537 MatchingExp mExp;
538 TypeSignature mType;
539 list<tuple<Ident,Ident>> localNames "source name -> local declaration name table";
540 TypedIdents accLocals "accumulated locals used by the cases in this match elaborated level";
541 TypedIdents extArgs "local args from the upper scope - all of them are from their upper FUN_SCOPE()";
542 Ident matchArgName "local name of the match argument";
543 Boolean hasImplicitScope "true for 'match' or 'map', false for 'if' elaborated cases; desides if the implicit record fields' lookup can continue upwards the scope stack.";
544 end CASE_SCOPE;
545
546 record LET_SCOPE
547 Ident ident "original ident";
548 TypeSignature idType;
549 Ident freshIdent "encoded ident with prefix and suffix unique for the local scope";
550 Boolean isUsed "true when found by resolveBoundPath()";
551 end LET_SCOPE;
552
553 record RECURSIVE_SCOPE
554 "forbidden access - scope of a text add ident; to prevent recursive usage of texts;
555 or scope of an elaborated let binding; to force a fresh local ident to be created when the same name is re-bound inside the let expression."
556 Ident recIdent;
557 Ident freshIdent "local name";
558 end RECURSIVE_SCOPE;
559
560 end Scope;
561
562
563 uniontype MapContext
564 record MAP_CONTEXT
565 //list<TypeSignature, MMDeclaration> mapFunctions;
566 MatchingExp ofBinding;
567 Expression mapExp;
568 list<MMEscOption> iterMMExpOptions;
569 Option<Ident> hasIndexIdentOpt "used index variable";
570 Boolean useIter "Whether PushIter/NextIter/PopIter is necessary.";
571 end MAP_CONTEXT;
572 end MapContext;
573
574
575 uniontype GenInfo
576 record GI_TEMPL_FUN end GI_TEMPL_FUN;
577 record GI_MATCH_FUN end GI_MATCH_FUN;
578 record GI_MAP_FUN
579 TypeSignature mapType;
580 MapContext mapContext;
581 end GI_MAP_FUN;
582 end GenInfo;
583
584
585 // *** functions ***
586
587 public function transformAST
588 input TemplPackage inTplPackage;
589 output MMPackage outMMPackage;
590 algorithm
591 outMMPackage := match inTplPackage
592 local
593 PathIdent name;
594 list<tuple<Ident,TemplateDef>> templateDefs;
595 list<MMDeclaration> mmDeclarations;
596 TemplPackage tp;
597 list<ASTDef> astDefs;
598 String annotationFooter;
599
600 case _
601 algorithm
602 ✗ tp := fullyQualifyTemplatePackage(inTplPackage);
603 ✗ TEMPL_PACKAGE(name, astDefs, templateDefs, annotationFooter) := tp;
604 ✗ mmDeclarations := importDeclarations(astDefs);
605 ✗ mmDeclarations
606 := transformTemplateDefs(templateDefs, tp, mmDeclarations);
607 ✗ mmDeclarations := listReverse(mmDeclarations);
608 ✗ then
609 MM_PACKAGE(name, mmDeclarations, annotationFooter);
610 end match;
611 end transformAST;
612
613 public function fullyQualifyTemplatePackage
614 input TemplPackage inTplPackage;
615 output TemplPackage outTplPackage;
616 algorithm
617 outTplPackage := match inTplPackage
618 local
619 PathIdent name;
620 list<tuple<Ident,TemplateDef>> templateDefs;
621 list<ASTDef> astDefs;
622 String ann;
623
624 case TEMPL_PACKAGE(name,astDefs,templateDefs,ann)
625 algorithm
626 ✗ astDefs := fullyQualifyASTDefs(astDefs);
627 ✗ templateDefs := listMap1Tuple22(templateDefs, fullyQualifyTemplateDef, astDefs);
628 ✗ then
629 TEMPL_PACKAGE(name, astDefs, templateDefs,ann);
630 end match;
631 end fullyQualifyTemplatePackage;
632
633
634 public function importDeclarations
635 input list<ASTDef> inASTDefs;
636 output list<MMDeclaration> outMMDecls = {};
637 algorithm
638 ✗ for astDef in inASTDefs loop
639 ✗ outMMDecls := MM_IMPORT(astDef.isDefault or astDef.isInterface, astDef.importPackage) :: outMMDecls;
640 end for;
641 end importDeclarations;
642
643 public function transformTemplateDefs
644 input list<tuple<Ident,TemplateDef>> inTemplateDefsRest;
645 input TemplPackage inTplPackage;
646 input list<MMDeclaration> inAccMMDecls;
647
648 output list<MMDeclaration> outMMDecls;
649 algorithm
650 outMMDecls := match (inTemplateDefsRest, inTplPackage, inAccMMDecls)
651 local
652 Ident tplname;
653 list<tuple<Ident,TemplateDef>> restTDefs;
654 TemplPackage tplPackage;
655 list<MMDeclaration> mmDecls, accMMDecls;
656 StringToken stvalue;
657 TypedIdents targs, encArgs, locals, iargs, oargs;
658 Expression texp;
659 list<MMExp> stmts;
660 MMDeclaration mmFun;
661 String svalue;
662 TypeSignature litType;
663
664 case ( {} , _, accMMDecls )
665 then accMMDecls;
666
667 case ( (tplname, STR_TOKEN_DEF(value = stvalue)) :: restTDefs, tplPackage, accMMDecls )
668 algorithm
669 ✗ tplname := constantNamePrefix + tplname; //no encoding needed, just denoting it is a constant (only for readibility)
670 ✗ mmDecls := transformTemplateDefs(restTDefs, tplPackage,
671 (MM_STR_TOKEN_DECL(true, tplname, stvalue) :: accMMDecls));
672 then mmDecls;
673
674 case ( (tplname, LITERAL_DEF(value = svalue, litType = litType)) :: restTDefs, tplPackage, accMMDecls )
675 algorithm
676 ✗ tplname := constantNamePrefix + tplname; //actually, literals are inlined, so this is just for presence of the constant in the source
677 ✗ mmDecls := transformTemplateDefs(restTDefs, tplPackage,
678 (MM_LITERAL_DECL(true, tplname, svalue, litType) :: accMMDecls));
679 then mmDecls;
680
681 case ( (tplname, TEMPLATE_DEF(args = targs, exp = texp)) :: restTDefs, tplPackage, accMMDecls )
682 algorithm
683
684 ✗ encArgs := List.map1(targs, encodeTypedIdent, funArgNamePrefix);
685
686 //only out parameters (all are Texts only) in the assignments ':=' will have the "out_" prefix in the statements
687 //the rest is tailored into templates
688 //... but function signatures have no prefixes in their AST representations (iargs, oargs, ...)
689 ✗ (stmts, locals, _, accMMDecls,_)
690 := statementsFromExp(texp, {}, {}, imlicitTxt, /*outPrefix +*/ imlicitTxt, {},
691 { FUN_SCOPE(targs, encArgs) }, tplPackage, accMMDecls);
692
693
694 //template functions will have unencoded original names
695 //TODO: should be done some checks for uniqueness / keywords collisions ...
696 //tplname = encodeIdent(tplname);
697 iargs := imlicitTxtArg :: encArgs;
698 ✗ oargs := List.filterOnTrue(iargs, isText);
699 ✗ stmts := listReverse(stmts);
700 ✗ stmts := addOutPrefixes(stmts, oargs, {});
701 ✗ (stmts, locals, accMMDecls) := inlineLastFunIfSingleCall(iargs, oargs, stmts, locals, accMMDecls);
702 ✗ mmFun := MM_FUN(true, tplname, iargs, oargs, locals, stmts, GI_TEMPL_FUN());
703 ✗ then
704 transformTemplateDefs(restTDefs, tplPackage, mmFun :: accMMDecls);
705
706 end match;
707 end transformTemplateDefs;
708
709
710 public function inlineLastFunIfSingleCall
711 input TypedIdents inInArgs;
712 input TypedIdents inOutArgs;
713 input list<MMExp> inStmts;
714 input TypedIdents inLocals;
715 input list<MMDeclaration> inAccMMDecls;
716 output list<MMExp> outStmts;
717 output TypedIdents outLocals;
718 output list<MMDeclaration> outMMDecls;
719 algorithm
720 (outStmts, outLocals, outMMDecls) := matchcontinue (inInArgs, inOutArgs, inStmts, inLocals, inAccMMDecls)
721 local
722 list<MMExp> stmts;
723 Ident fidCalled, fidLast;
724 TypedIdents locals, iargs, oargs, iargsL, oargsL;
725 list<MMDeclaration> accMMDecls;
726 GenInfo genInfo;
727
728 // the last call is the only call of the last elaborated function (from makeMatchFun)
729 case ( iargs, oargs,
730 { MM_ASSIGN(rhs = MM_FN_CALL(fnName = IDENT(fidCalled)) ) },
731 {},
732 MM_FUN(_, fidLast, iargsL, oargsL, locals, stmts, genInfo) :: accMMDecls)
733 algorithm
734 ✗ true := stringEq(fidCalled, fidLast);
735 ✗ failure(GI_TEMPL_FUN() := genInfo); //we can inline only generated helper functions, not regular template functions
736 ✗ true := valueEq(iargs, iargsL);
737 ✗ true := valueEq(oargs, oargsL);
738 ✗ then ( stmts, locals, accMMDecls );
739
740 // otherwise nothing
741 case ( _, _, stmts, locals, accMMDecls)
742 then ( stmts, locals, accMMDecls );
743 end matchcontinue;
744 end inlineLastFunIfSingleCall;
745
746 //prepend "i" in front of the ident to obey the MM rule that no identifier can start with "_"
747 public function encodeIdent
748 input Ident inIdent;
749 input Ident prefix;
750 output Ident outIdent;
751 algorithm
752 ✗ outIdent := prefix + encodeIdentNoPrefix(inIdent);
753 end encodeIdent;
754
755 //every ident to be encoded as ".ident"
756 //where "." is encoded as "_" or "_0" in the case it is followed with "_" (idents starting with _)
757 protected function encodeIdentNoPrefix
758 input Ident inIdent "original ident; it can be sringified dot path, too";
759 output Ident outIdent "unambiguous,ono-one back-convertible legal ident; can start with '_' ";
760 algorithm
761 outIdent := matchcontinue inIdent
762 local
763 Ident ident;
764
765 //to prevent ambiguity when prefixing the encoded ident,
766 //when the first character is "_", encode it as "_0" (although this is not relevant for MM yet)
767 case ident
768 algorithm
769 ✗ true := (stringLength(ident) > 0) and (stringGetStringChar(ident,1) == "_");
770 ✗ ident := System.stringReplace(ident, "_", "__");
771 ✗ ident := System.stringReplace(ident, "._", "_0");
772 ✗ ident := System.stringReplace(ident, ".", "_");
773 ✗ ident := "0" + ident;
774 then
775 ( ident );
776
777 case ident
778 algorithm
779 //false = (stringLength(ident) > 0) and (stringGetStringChar(ident,1) == "_");
780
781 ✗ ident := System.stringReplace(ident, "_", "__");
782 ✗ ident := System.stringReplace(ident, "._", "_0");
783 ✗ ident := System.stringReplace(ident, ".", "_");
784 then
785 ( ident );
786
787 else
788 algorithm
789 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!encodeIdentNoPrefix failed\n");
790 ✗ then
791 fail();
792 end matchcontinue;
793 end encodeIdentNoPrefix;
794
795 public function encodePathIdent
796 input PathIdent inPath;
797 input Ident prefix;
798 output Ident outEncIdent;
799 algorithm
800 ✗ outEncIdent := encodeIdent(pathIdentString(inPath), prefix);
801 end encodePathIdent;
802
803
804 public function encodeTypedIdent
805 input tuple<Ident,TypeSignature> inTypedIdent;
806 input Ident prefix;
807 output tuple<Ident,TypeSignature> outTypedIdent;
808 algorithm
809 outTypedIdent := matchcontinue inTypedIdent
810 local
811 Ident ident;
812 TypeSignature ts;
813
814 case (ident,ts)
815 algorithm
816 ✗ ident := encodeIdent(ident, prefix);
817 ✗ then
818 ((ident,ts));
819
820 //should not ever happen
821 else
822 algorithm
823 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!encodeTypedIdent failed\n");
824 ✗ then
825 fail();
826 end matchcontinue;
827 end encodeTypedIdent;
828
829
830 public function addOutPrefixes
831 input list<MMExp> inStmts;
832 input TypedIdents inTextArgs;
833 input list<tuple<Ident,Ident>> inTranslatedTextArgs;
834
835 output list<MMExp> outStmts;
836 algorithm
837 outStmts := matchcontinue (inStmts, inTextArgs, inTranslatedTextArgs)
838 local
839 list<MMExp> stmts;
840 MMExp stmt, rhs;
841 TypedIdents txtargs;
842 list<Ident> largs;
843 list<tuple<Ident,Ident>> trIdents;
844
845 case ( {}, txtargs, trIdents)
846 algorithm
847 ✗ stmts := addOutTextAssigns(txtargs, trIdents);
848 then ( stmts );
849
850 case ( MM_ASSIGN(lhsArgs = largs, rhs = rhs) :: stmts, txtargs, trIdents)
851 algorithm
852 ✗ rhs := addOutPrefixesRhs(rhs, trIdents);
853 ✗ (largs, trIdents) := addOutPrefixesLhs(largs, txtargs, trIdents);
854 ✗ stmts := addOutPrefixes(stmts, txtargs, trIdents);
855 ✗ then ( MM_ASSIGN(largs, rhs) :: stmts );
856
857 case ( stmt :: stmts, txtargs, trIdents)
858 algorithm
859 ✗ stmts := addOutPrefixes(stmts, txtargs, trIdents);
860 then ( stmt :: stmts );
861
862 else
863 algorithm
864 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!addOutPrefixes failed\n");
865 ✗ then
866 fail();
867 end matchcontinue;
868 end addOutPrefixes;
869
870 public function addOutPrefixesRhs
871 input MMExp inStmt;
872 input list<tuple<Ident,Ident>> inTranslatedTextArgs;
873
874 output MMExp outStmt;
875 algorithm
876 outStmt := matchcontinue (inStmt, inTranslatedTextArgs)
877 local
878 list<MMExp> fargs;
879 Ident ident, outident;
880 PathIdent fpath;
881 list<tuple<Ident,Ident>> trIdents;
882
883 case ( MM_IDENT(IDENT(ident = ident)), trIdents)
884 algorithm
885 ✗ outident := lookupTupleList(trIdents, ident);
886 ✗ then ( MM_IDENT(IDENT(outident)) );
887
888 case ( MM_FN_CALL(fnName = fpath, args = fargs), trIdents)
889 algorithm
890 ✗ fargs := List.map1(fargs, addOutPrefixesRhs, trIdents);
891 ✗ then ( MM_FN_CALL(fpath, fargs) );
892
893 else inStmt;
894
895 end matchcontinue;
896 end addOutPrefixesRhs;
897
898
899 public function addOutPrefixesLhs
900 input list<Ident> inLhsArgs;
901 input TypedIdents inTextArgs;
902 input list<tuple<Ident,Ident>> inTranslatedTextArgs;
903
904 output list<Ident> outLhsArgs;
905 output list<tuple<Ident,Ident>> outTranslatedTextArgs;
906 algorithm
907 (outLhsArgs, outTranslatedTextArgs) := matchcontinue (inLhsArgs, inTextArgs, inTranslatedTextArgs)
908 local
909 Ident ident;
910 TypedIdents txtargs;
911 list<Ident> largs;
912 String outident;
913 list<tuple<Ident,Ident>> trIdents;
914
915 case ( {},_, trIdents)
916 then ( {}, trIdents );
917
918 case ( ident :: largs, txtargs, trIdents)
919 algorithm
920 ✗ lookupTupleList(txtargs, ident);
921 ✗ outident := outPrefix + ident;
922 ✗ trIdents := updateTupleList(trIdents, (ident,outident) );
923 ✗ (largs, trIdents) := addOutPrefixesLhs(largs, txtargs, trIdents);
924 ✗ then ( outident :: largs, trIdents );
925
926 case ( ident :: largs, txtargs, trIdents)
927 algorithm
928 ✗ failure(lookupTupleList(txtargs, ident));
929 ✗ (largs, trIdents) := addOutPrefixesLhs(largs, txtargs, trIdents);
930 ✗ then ( ident :: largs, trIdents );
931
932 else
933 algorithm
934 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!addOutPrefixesLhs failed\n");
935 ✗ then
936 fail();
937 end matchcontinue;
938 end addOutPrefixesLhs;
939
940
941 public function addOutTextAssigns
942 input TypedIdents inTextArgs;
943 input list<tuple<Ident,Ident>> inTranslatedTextArgs;
944
945 output list<MMExp> outStmts = {};
946 protected
947 String outident;
948 tuple<Ident, TypeSignature> id;
949 Ident ident;
950 algorithm
951 ✗ for id in inTextArgs loop
952 ✗ (ident,_) := id;
953 try
954 ✗ lookupTupleList(inTranslatedTextArgs, ident);
955 else
956 ✗ outident := outPrefix + ident;
957 ✗ outStmts := MM_ASSIGN({outident},MM_IDENT(IDENT(ident))) :: outStmts;
958 end try;
959 end for;
960 ✗ outStmts := listReverseInPlace(outStmts);
961 end addOutTextAssigns;
962
963
964 public function isAssignedIdent
965 input list<MMExp> inStatementList;
966 input Ident inIdent;
967
968 output Boolean outIsAssigned;
969 protected
970 list<Ident> largs;
971 algorithm
972 ✗ for st in inStatementList loop
973 ✗ MM_ASSIGN(lhsArgs = largs) := st;
974 ✗ if listMember(inIdent, largs) then
975 outIsAssigned := true;
976 ✗ return;
977 end if;
978 end for;
979 outIsAssigned := false;
980 end isAssignedIdent;
981
982
983 public function statementsFromExp
984 input Expression inExp;
985 input list<MMEscOption> inMMEscOptions;
986 input list<MMExp> inStmts;
987 input Ident inInText;
988 input Ident inOutText;
989 input TypedIdents inLocals;
990 input ScopeEnv inScopeEnv;
991 input TemplPackage inTplPackage;
992 input list<MMDeclaration> inAccMMDecls;
993
994 output list<MMExp> outStmts;
995 output TypedIdents outLocals;
996 output ScopeEnv outScopeEnv;
997 output list<MMDeclaration> outMMDecls;
998 output Ident outInText;
999 algorithm
1000 (outStmts, outLocals, outScopeEnv, outMMDecls, outInText)
1001 := matchcontinue (inExp, inMMEscOptions, inStmts, inInText, inOutText,
1002 inLocals, inScopeEnv, inTplPackage, inAccMMDecls)
1003 local
1004 list<MMExp> stmts, popstmts;
1005 MMExp stmt, mmexp;
1006 ScopeEnv scEnv;
1007 Ident intxt, outtxt, ident, encIdent, letOuttxt, freshIdent;
1008 list<Ident> tyVars;
1009 PathIdent path, fname;
1010 TypedIdents locals, iargs, oargs;
1011 TypeSignature idtype, exptype, rettype;
1012 tuple<MMExp, TypeSignature, SourceInfo> argval;
1013 list<tuple<MMExp, TypeSignature, SourceInfo>> argvals;
1014 Expression exp, tbranch, argexp, mapexp, txtexp;
1015 list<Expression> explst;
1016 Option<Expression> ebranch;
1017 SourceInfo sinfo, sinfo2;
1018 list<tuple<MatchingExp,Expression>> mcases;
1019 MatchingExp ofbind;
1020 Option<MatchingExp> rhsval;
1021 list<EscOption> opts;
1022 list<MMEscOption> mmopts;
1023 Boolean hasretval, isnot;
1024 Integer n;
1025 StringToken st;
1026 list<ASTDef> astDefs;
1027 String litvalue, istr;
1028 MapContext mapctx;
1029 Option<Ident> idxNmOpt;
1030
1031 TemplPackage tplPackage;
1032 list<MMDeclaration> accMMDecls;
1033
1034 case ( (TEMPLATE(items = explst), _), mmopts,
1035 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls )
1036 algorithm
1037 ✗ warnIfSomeOptions(mmopts);
1038 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1039 := statementsFromExpList(explst, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1040 then ( stmts, locals, scEnv, accMMDecls, intxt);
1041
1042 //inline a literal in its string-token form
1043 case ( (LITERAL(value = litvalue), _), mmopts,
1044 stmts, intxt, outtxt, locals, scEnv, _, accMMDecls )
1045 algorithm
1046 ✗ warnIfSomeOptions(mmopts);
1047 ✗ stmt := tplStatement("writeTok", { MM_STR_TOKEN(Tpl.ST_STRING(litvalue)) }, intxt, outtxt);
1048 ✗ then ( stmt :: stmts, locals, scEnv, accMMDecls, outtxt);
1049
1050 case ( (SOFT_NEW_LINE(), _), mmopts,
1051 stmts, intxt, outtxt, locals, scEnv, _, accMMDecls )
1052 algorithm
1053 ✗ warnIfSomeOptions(mmopts);
1054 ✗ stmt := tplStatement("softNewLine", { }, intxt, outtxt);
1055 ✗ then ( stmt :: stmts, locals, scEnv, accMMDecls, outtxt);
1056
1057 //empty string -> nothing
1058 case ( (STR_TOKEN(value = Tpl.ST_STRING("")), _), mmopts,
1059 stmts, intxt, _, locals, scEnv, _, accMMDecls )
1060 algorithm
1061 ✗ warnIfSomeOptions(mmopts);
1062 ✗ then ( stmts, locals, scEnv, accMMDecls, intxt);
1063
1064 case ( (STR_TOKEN(value = st), _), mmopts,
1065 stmts, intxt, outtxt, locals, scEnv, _, accMMDecls )
1066 algorithm
1067 ✗ warnIfSomeOptions(mmopts);
1068 ✗ stmt := tplStatement("writeTok", { MM_STR_TOKEN(st) }, intxt, outtxt);
1069 ✗ then ( stmt :: stmts, locals, scEnv, accMMDecls, outtxt);
1070
1071 case ( (BOUND_VALUE(boundPath = path), sinfo), mmopts,
1072 stmts, intxt, outtxt, locals, scEnv, tplPackage as TEMPL_PACKAGE(astDefs = astDefs), accMMDecls )
1073 algorithm
1074 ✗ if Flags.isSet(Flags.FAILTRACE) then
1075 ✗ Debug.traceln("\n BOUND_VALUE resolving boundPath = " + pathIdentString(path));
1076 end if;
1077 ✗ (mmexp, idtype, scEnv) := resolveBoundPath(path, scEnv, tplPackage);
1078 //Debug.fprint(Flags.FAILTRACE,"\n BEFORE boundPath = " + pathIdentString(path) + "\n");
1079 ✗ checkResolvedType(path, idtype, "bound value", sinfo);
1080 //Debug.fprint(Flags.FAILTRACE,"\n AFTER boundPath = " + pathIdentString(path) + "\n");
1081 //ensure non-recursive Text evaluation - only this level ...
1082 //TODO: for indirect reference, too, like <# buf += templ(buf) #>
1083 //true = ensureNotUsingTheSameText(path, mmexp, idtype, outtxt);
1084 ✗ exptype := deAliasedType(idtype, astDefs);
1085 ✗ if Flags.isSet(Flags.FAILTRACE) then
1086 ✗ Debug.traceln("\n BOUND_VALUE resolved mmexp = " + mmExpString(mmexp) + " : "
1087 + typeSignatureString(idtype) + " (dealiased: "
1088 + typeSignatureString(exptype) + ")");
1089 end if;
1090 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1091 := addWriteCallFromMMExp(true, mmexp, exptype, sinfo, mmopts, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1092 // fprint(Flags.FAILTRACE," BOUND_VALUE after writeCall stmts (in reverse order) =\n" + stmtsString(stmts) + "\n");
1093 then ( stmts, locals, scEnv, accMMDecls, intxt);
1094
1095
1096 case ( (FUN_CALL(name = fname, args = explst), sinfo), mmopts,
1097 stmts, intxt, outtxt, locals, scEnv, tplPackage as TEMPL_PACKAGE(astDefs = astDefs), accMMDecls )
1098 algorithm
1099 ✗ if Flags.isSet(Flags.FAILTRACE) then
1100 ✗ Debug.traceln("\n FUN_CALL fname = " + pathIdentString(fname));
1101 end if;
1102 ✗ (fname, iargs, oargs, tyVars) := getFunSignature(fname, sinfo, tplPackage);
1103 // fprint(Flags.FAILTRACE," after fname = " + pathIdentString(fname) + "\n");
1104
1105 //explst = addImplicitArgument(explst, iargs, oargs, tplPackage);
1106 ✗ (argvals, stmts, locals, scEnv, accMMDecls)
1107 := statementsFromArgList(explst, stmts, locals, scEnv, tplPackage, accMMDecls);
1108
1109 ✗ if Flags.isSet(Flags.FAILTRACE) then
1110 ✗ Debug.trace(" FUN_CALL argList stmts generation passed\n");
1111 end if;
1112 //fprint(Flags.FAILTRACE," FUN_CALL after argList stmts (in reverse order) =\n" + stmtsString(stmts) + "\n");
1113
1114 ✗ (hasretval, stmt, mmexp, rettype, locals, intxt)
1115 := statementFromFun(argvals, fname, iargs, oargs, tyVars, intxt, outtxt, locals, tplPackage, sinfo);
1116 ✗ if Flags.isSet(Flags.FAILTRACE) then
1117 ✗ Debug.trace(" FUN_CALL stmt =\n" + stmtsString({stmt}) + "\n");
1118 end if;
1119
1120 ✗ rettype := deAliasedType(rettype, astDefs);
1121 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1122 := addWriteCallFromMMExp(hasretval, mmexp, rettype, sinfo, mmopts, stmt::stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1123 then ( stmts, locals, scEnv, accMMDecls, intxt);
1124
1125 //previous fail on error, just go on .. TODO: after bootstrapping, the logic --> match
1126 //case ( (FUN_CALL(name = fname, args = explst), sinfo), mmopts,
1127 // stmts, intxt, outtxt, locals, scEnv, tplPackage as TEMPL_PACKAGE(astDefs = astDefs), accMMDecls )
1128 // equation
1129 // //TODO: make this nicer ..
1130 // stmt = MM_FN_CALL(IDENT("#ERROR#"), {});
1131 // then ( stmt :: stmts, locals, scEnv, accMMDecls, intxt);
1132
1133
1134 case ( (MATCH(matchExp = exp, cases = mcases), sinfo), mmopts,
1135 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls )
1136 algorithm
1137 ✗ warnIfSomeOptions(mmopts);
1138 ✗ (argval, stmts, locals, scEnv, accMMDecls)
1139 := statementsFromArg(exp, stmts, locals, scEnv, tplPackage, accMMDecls);
1140 ✗ (argval, exp, stmts, locals)
1141 := adaptTextToString(argval, exp, stmts, locals, tplPackage);
1142 ✗ (argvals, fname, iargs, oargs, scEnv, accMMDecls)
1143 := makeMatchFun(argval, mcases, exp, true, scEnv, tplPackage, accMMDecls);
1144 ✗ (_, stmt, _, _, locals, intxt)
1145 := statementFromFun(argvals, fname, iargs, oargs, {}, intxt, outtxt, locals, tplPackage, sinfo);
1146 ✗ then ( (stmt :: stmts), locals, scEnv, accMMDecls, intxt);
1147
1148 case ( (CONDITION( isNot = isnot, lhsExp = exp,
1149 rhsValue = rhsval, trueBranch = tbranch, elseBranch = ebranch), sinfo), mmopts,
1150 stmts, intxt, outtxt, locals, scEnv, tplPackage as TEMPL_PACKAGE(astDefs = astDefs), accMMDecls )
1151 algorithm
1152 ✗ warnIfSomeOptions(mmopts);
1153 ✗ (argval, stmts, locals, scEnv, accMMDecls)
1154 := statementsFromArg(exp, stmts, locals, scEnv, tplPackage, accMMDecls);
1155 //(argval, stmts, locals)
1156 // = adaptTextToString(argval, stmts, locals, tplPackage);
1157 ✗ (_,exptype,_) := argval;
1158 ✗ exptype := deAliasedType(exptype, astDefs);
1159 ✗ if isTextType(exptype) then
1160 ✗ (stmts, locals, argval) := textConditionToIsEmpty(argval, stmts, locals);
1161 ✗ exp := emptyExpression;
1162 end if;
1163 ✗ mcases
1164 := elabCasesFromCondition(exptype, isnot, rhsval, tbranch, ebranch, tplPackage);
1165 ✗ ( argvals, fname, iargs, oargs, scEnv, accMMDecls)
1166 := makeMatchFun(argval, mcases, exp, false, scEnv, tplPackage, accMMDecls);
1167 ✗ (_, stmt, _, _, locals, intxt)
1168 := statementFromFun(argvals, fname, iargs, oargs, {}, intxt, outtxt, locals, tplPackage, sinfo);
1169 ✗ then ( (stmt :: stmts), locals, scEnv, accMMDecls, intxt);
1170
1171 case ( (MAP(argExp = argexp, ofBinding = ofbind, mapExp = mapexp, hasIndexIdentOpt = idxNmOpt), _), mmopts,
1172 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls )
1173 algorithm
1174 ✗ explst := getExpListForMap(argexp);
1175 ✗ (argvals, stmts, locals, scEnv, accMMDecls)
1176 := statementsFromArgList(explst, stmts, locals, scEnv, tplPackage, accMMDecls);
1177 ✗ mapctx := MAP_CONTEXT(ofbind, mapexp, mmopts, idxNmOpt, false);
1178 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1179 := statementsFromMapExp(true, argvals, mapctx,
1180 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1181
1182 /*(stmts, locals, scEnv, accMMDecls, intxt)
1183 = statementsFromEscapedExp(exp, {},
1184 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);*/
1185 then ( stmts, locals, scEnv, accMMDecls, intxt);
1186
1187 case ( (MAP_ARG_LIST(parts = explst), _), mmopts,
1188 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls )
1189 algorithm
1190 ✗ (argvals, stmts, locals, scEnv, accMMDecls)
1191 := statementsFromArgList(explst, stmts, locals, scEnv, tplPackage, accMMDecls);
1192 ✗ mapctx := MAP_CONTEXT(BIND_MATCH("it"), (BOUND_VALUE(IDENT("it")), dummySourceInfo), mmopts, NONE(), false);
1193 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1194 := statementsFromMapExp(true, argvals, mapctx,
1195 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1196 /*
1197 //when no options, MAP_ARG_LIST is identical to TEMPLATE
1198 (stmts, locals, scEnv, accMMDecls, intxt)
1199 = statementsFromExpList(explst, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);*/
1200 then ( stmts, locals, scEnv, accMMDecls, intxt);
1201
1202 case ( (ESCAPED(exp = exp, options = opts), _), mmopts,
1203 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls )
1204 algorithm
1205 ✗ warnIfSomeOptions(mmopts); // new options will be elaborated
1206 ✗ (mmopts, stmts, locals, scEnv, accMMDecls)
1207 := statementsFromEscOptions(opts, {}, stmts, locals, scEnv, tplPackage, accMMDecls);
1208
1209 ✗ (mmopts, stmts, popstmts, intxt)
1210 := pushPopBlock(mmopts, absIndentOptionId, "BT_ABS_INDENT", stmts, {}, intxt, outtxt);
1211 ✗ (mmopts, stmts, popstmts, intxt)
1212 := pushPopBlock(mmopts, indentOptionId, "BT_INDENT", stmts, popstmts, intxt, outtxt);
1213 ✗ (mmopts, stmts, popstmts, intxt)
1214 := pushPopBlock(mmopts, relIndentOptionId, "BT_REL_INDENT", stmts, popstmts, intxt, outtxt);
1215 ✗ (mmopts, stmts, popstmts, intxt)
1216 := pushPopBlock(mmopts, anchorOptionId, "BT_ANCHOR", stmts, popstmts, intxt, outtxt);
1217
1218 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1219 := statementsFromExp(exp, mmopts,
1220 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1221
1222 ✗ stmts := listAppend(popstmts, stmts);
1223 ✗ then ( stmts, locals, scEnv, accMMDecls, intxt);
1224
1225 case ( (INDENTATION(width = n, items = explst), _), mmopts,
1226 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls )
1227 algorithm
1228 ✗ warnIfSomeOptions(mmopts);
1229 ✗ istr := intString(n);
1230 ✗ stmt := pushBlockStatement("BT_INDENT", MM_LITERAL(istr), intxt, outtxt);
1231 ✗ (stmts, locals, scEnv, accMMDecls, _)
1232 := statementsFromExpList(explst, stmt::stmts, outtxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1233 //(stmts, locals, scEnv, accMMDecls, _)
1234 // = statementsFromExp(exp, (stmt :: stmts), outtxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1235 ✗ stmt := tplStatement("popBlock", {}, outtxt, outtxt);
1236 ✗ then ( (stmt :: stmts), locals, scEnv, accMMDecls, outtxt);
1237
1238 //TODO: let _ = ....
1239 case ( (LET(letExp = (TEXT_CREATE(name = ident, exp = txtexp), _),
1240 exp = exp), _),
1241 mmopts, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls )
1242 algorithm
1243 ✗ warnIfSomeOptions(mmopts);
1244 //allowing hiddening of let bindings
1245 //(_, UNRESOLVED_TYPE(reason), scEnv)
1246 // = resolveBoundPath(IDENT(ident), scEnv, tplPackage);
1247 //fprint(Flags.FAILTRACE,"\n TEXT_CREATE ident = " + ident + " is fresh (reason = " + reason + ")\n");
1248 ✗ if Flags.isSet(Flags.FAILTRACE) then
1249 ✗ Debug.traceln("\n TEXT_CREATE ident = " + ident);
1250 end if;
1251
1252 ✗ encIdent := encodeIdent(ident, letValueNamePrefix);
1253 ✗ (freshIdent, locals) := updateLocalsForLetExp(ident, encIdent, 0, TEXT_TYPE(), locals, scEnv);
1254
1255 ✗ (stmts, locals, _ :: scEnv, accMMDecls, letOuttxt)
1256 := statementsFromExp(txtexp, {}, stmts, emptyTxt, freshIdent, locals,
1257 RECURSIVE_SCOPE(ident, freshIdent) :: scEnv, tplPackage, accMMDecls);
1258 //explicitly initialize when let &ident = buffer ""
1259 ✗ stmts := if letOuttxt == emptyTxt then
1260 MM_ASSIGN({freshIdent}, MM_IDENT(IDENT(emptyTxt))) :: stmts else
1261 stmts;
1262 //push the ident in the let scope
1263 ✗ scEnv := LET_SCOPE(ident, TEXT_TYPE(), freshIdent, false) :: scEnv;
1264 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1265 := statementsFromExp(exp, {}, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1266 //pop the let scope
1267 ✗ LET_SCOPE() :: scEnv := scEnv;
1268 //TODO: worn when not used
1269 ✗ then ( stmts, locals, scEnv, accMMDecls, intxt);
1270
1271 //TODO: make this warning only, and only when the hidden binding is not used
1272 /*
1273 case ( LET(letExp = TEXT_CREATE(name = ident, exp = txtexp),
1274 exp = exp),
1275 mmopts, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls )
1276 algorithm
1277 true = Flags.isSet(Flags.FAILTRACE);
1278 (_, idtype, _)
1279 = resolveBoundPath(IDENT(ident), scEnv, tplPackage);
1280 failure(UNRESOLVED_TYPE(_) = idtype);
1281 fprint(Flags.FAILTRACE,"\nError - TEXT_CREATE ident = '" + ident + "' is NOT fresh (type = " + typeSignatureString(idtype) + ")\n Only new (fresh) variable can be used in a Text assignment (creation).\n");
1282 then fail();
1283 */
1284
1285 case ( (LET(letExp = (TEXT_ADD(name = ident, exp = txtexp),sinfo2),
1286 exp = exp), _),
1287 mmopts, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls )
1288 algorithm
1289 ✗ warnIfSomeOptions(mmopts);
1290 ✗ path := IDENT(ident);
1291 ✗ (mmexp, idtype, scEnv) := resolveBoundPath(path, scEnv, tplPackage);
1292 ✗ checkResolvedType(path, idtype, "let +=", sinfo2);
1293 ✗ idtype := checkTextType(idtype, ident, "let +=", sinfo2);
1294 ✗ MM_IDENT(IDENT(encIdent)) := mmexp;
1295 //TEXT_TYPE() = idtype;
1296 //prevent recursive usage of the ident iside of the addition
1297 //error will be caught when BOUND_VALUE with the ident occur in the txtexp
1298 ✗ scEnv := RECURSIVE_SCOPE(ident, encIdent) :: scEnv;
1299 ✗ (stmts, locals, scEnv, accMMDecls, _)
1300 := statementsFromExp(txtexp, {}, stmts, encIdent, encIdent, locals, scEnv, tplPackage, accMMDecls);
1301 ✗ RECURSIVE_SCOPE() :: scEnv := scEnv;
1302
1303 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1304 := statementsFromExp(exp, {}, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1305 then ( stmts, locals, scEnv, accMMDecls, intxt);
1306
1307 /*
1308 case ( (LET(letExp = (TEXT_ADD(name = ident, exp = txtexp),_),
1309 exp = exp), sinfo),
1310 mmopts, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls )
1311 algorithm
1312 path = IDENT(ident);
1313 (_, idtype, _) = resolveBoundPath(path, scEnv, tplPackage);
1314 failure(UNRESOLVED_TYPE(_) = idtype);
1315 failure(TEXT_TYPE() = idtype);
1316 fprint(Flags.FAILTRACE,"\nError - TEXT_ADD ident = '" + ident + "' is NOT of Text& type but " + typeSignatureString(idtype) + ")\n Only Text& typed variables can be appended to.\n");
1317 then fail();
1318 */
1319
1320 case ( (LET(letExp = (NORET_CALL(name = fname, args = explst),sinfo2),
1321 exp = exp), _),
1322 mmopts, stmts, intxt, outtxt, locals, scEnv, tplPackage as TEMPL_PACKAGE(), accMMDecls )
1323 algorithm
1324 ✗ warnIfSomeOptions(mmopts);
1325 ✗ if Flags.isSet(Flags.FAILTRACE) then
1326 ✗ Debug.traceln("\n NORET_CALL fname = " + pathIdentString(fname));
1327 end if;
1328 ✗ (fname, iargs, oargs, tyVars) := getFunSignature(fname, sinfo2, tplPackage);
1329 //fprint(Flags.FAILTRACE," after fname = " + pathIdentString(fname) + "\n");
1330
1331 ✗ {} := oargs;
1332 //explst = addImplicitArgument(explst, iargs, oargs, tplPackage);
1333 ✗ (argvals, stmts, locals, scEnv, accMMDecls)
1334 := statementsFromArgList(explst, stmts, locals, scEnv, tplPackage, accMMDecls);
1335
1336 ✗ if Flags.isSet(Flags.FAILTRACE) then
1337 ✗ Debug.trace(" NORET_CALL argList stmts generation passed.\n");
1338 end if;
1339 //fprint(Flags.FAILTRACE," NORET_CALL after argList stmts (in reverse order) =\n" + stmtsString(stmts) + "\n");
1340
1341 ✗ (_, stmt,_,_, locals, intxt)
1342 := statementFromFun(argvals, fname, iargs, oargs, tyVars, intxt, outtxt, locals, tplPackage, sinfo2);
1343 ✗ if Flags.isSet(Flags.FAILTRACE) then
1344 ✗ Debug.traceln(" NORET_CALL stmt =\n" + stmtsString({stmt}));
1345 end if;
1346 ✗ stmts := stmt::stmts;
1347
1348 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1349 := statementsFromExp(exp, {}, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1350
1351 then ( stmts, locals, scEnv, accMMDecls, intxt);
1352
1353 case ( (LET(letExp = (NORET_CALL(name = fname),sinfo2)), _),
1354 _, _, _, _, _, _, tplPackage as TEMPL_PACKAGE(), _ )
1355 algorithm
1356 ✗ (fname,_, oargs,_) := getFunSignature(fname, sinfo2, tplPackage);
1357 //fprint(Flags.FAILTRACE," after fname = " + pathIdentString(fname) + "\n");
1358 ✗ _::_ := oargs;
1359
1360 ✗ if Flags.isSet(Flags.FAILTRACE) then
1361 ✗ Debug.trace("Error - NORET_CALL with a '" + pathIdentString(fname) + "' template or function that has output argument(s).\n");
1362 end if;
1363 ✗ then fail();
1364
1365 else
1366 algorithm
1367 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!statementsFromExp failed\n");
1368 ✗ then
1369 fail();
1370 end matchcontinue;
1371 end statementsFromExp;
1372
1373
1374 public function statementsFromExpList
1375 input list<Expression> inExpLst;
1376 input list<MMExp> inStmts;
1377 input Ident inInText;
1378 input Ident inOutText;
1379 input TypedIdents inLocals;
1380 input ScopeEnv inScopeEnv;
1381 input TemplPackage inTplPackage;
1382 input list<MMDeclaration> inAccMMDecls;
1383
1384 output list<MMExp> outStmts;
1385 output TypedIdents outLocals;
1386 output ScopeEnv outScopeEnv;
1387 output list<MMDeclaration> outMMDecls;
1388 output Ident outInText;
1389
1390 algorithm
1391 (outStmts, outLocals, outScopeEnv, outMMDecls, outInText)
1392 := matchcontinue (inExpLst, inStmts, inInText, inOutText, inLocals, inScopeEnv, inTplPackage, inAccMMDecls)
1393 local
1394 list<MMExp> stmts;
1395 ScopeEnv scEnv;
1396 Ident intxt, outtxt;
1397 TypedIdents locals;
1398 list<Expression> explst;
1399 TemplPackage tplPackage;
1400 list<MMDeclaration> accMMDecls;
1401 Expression exp;
1402
1403 case ( {}, stmts, intxt, _, locals, scEnv, _, accMMDecls )
1404 ✗ then ( stmts, locals, scEnv, accMMDecls, intxt);
1405
1406 case ( (exp :: explst ),
1407 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls )
1408 algorithm
1409 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1410 := statementsFromExp(exp, {}, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1411 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1412 := statementsFromExpList(explst, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1413 then ( stmts, locals, scEnv, accMMDecls, intxt);
1414
1415 else
1416 algorithm
1417 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!statementsFromExpList failed\n");
1418 ✗ then
1419 fail();
1420 end matchcontinue;
1421 end statementsFromExpList;
1422
1423
1424 public function warnIfSomeOptions
1425 input list<MMEscOption> inMMEscOptions;
1426
1427 algorithm
1428 () :=
1429 matchcontinue inMMEscOptions
1430 local
1431 Ident optid;
1432
1433 //ok, no options
1434 case {} then ();
1435
1436 //warning - more options than expected
1437 case (optid,_) ::_
1438 algorithm
1439 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - more options specified than expected for an expression (first option is '" + optid + "').\n");
1440 ✗ then fail();
1441
1442 //cannot happen
1443 else
1444 algorithm
1445 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("- warnIfSomeOptions failed.\n");
1446 ✗ then fail();
1447 end matchcontinue;
1448 end warnIfSomeOptions;
1449
1450
1451
1452 public function statementsFromEscOptions
1453 input list<EscOption> inOptions;
1454 input list<MMEscOption> inAccMMEscOptions;
1455 input list<MMExp> inStmts;
1456 input TypedIdents inLocals;
1457 input ScopeEnv inScopeEnv;
1458 input TemplPackage inTplPackage;
1459 input list<MMDeclaration> inAccMMDecls;
1460
1461 output list<MMEscOption> outAccMMEscOptions;
1462 output list<MMExp> outStmts;
1463 output TypedIdents outLocals;
1464 output ScopeEnv outScopeEnv;
1465 output list<MMDeclaration> outMMDecls;
1466 algorithm
1467 (outAccMMEscOptions, outStmts, outLocals, outScopeEnv, outMMDecls)
1468 := matchcontinue (inOptions, inAccMMEscOptions, inStmts, inLocals, inScopeEnv, inTplPackage, inAccMMDecls)
1469 local
1470 list<MMExp> stmts;
1471 ScopeEnv scEnv;
1472 TypedIdents locals;
1473 tuple<MMExp, TypeSignature> defoptval;
1474 MMExp mmarg;
1475 TypeSignature exptype, opttype;
1476 SourceInfo sinfo;
1477 Expression optexp;
1478 list<EscOption> opts;
1479 Ident optid;
1480 list<MMEscOption> accMMEscOpts;
1481 list<ASTDef> astdefs;
1482
1483 TemplPackage tplPackage;
1484 list<MMDeclaration> accMMDecls;
1485
1486
1487 case ( {}, accMMEscOpts, stmts, locals, scEnv, _, accMMDecls )
1488 ✗ then
1489 (accMMEscOpts, stmts, locals, scEnv, accMMDecls);
1490
1491 //option without "="
1492 case ( (optid,NONE()) :: opts, accMMEscOpts,
1493 stmts, locals, scEnv, tplPackage, accMMDecls )
1494 algorithm
1495 ✗ defoptval := lookupTupleList(defaultEscOptions, optid);
1496 ✗ failure(lookupTupleList(accMMEscOpts, optid)); //no duplicity
1497 ✗ (accMMEscOpts, stmts, locals, scEnv, accMMDecls)
1498 := statementsFromEscOptions(opts, (optid, defoptval) :: accMMEscOpts,
1499 stmts, locals, scEnv, tplPackage, accMMDecls);
1500 then
1501 (accMMEscOpts, stmts, locals, scEnv, accMMDecls);
1502
1503 //option = exp
1504 case ( (optid, SOME(optexp)) :: opts, accMMEscOpts,
1505 stmts, locals, scEnv, tplPackage as TEMPL_PACKAGE(astDefs = astdefs), accMMDecls )
1506 algorithm
1507 ✗ (_, opttype) := lookupTupleList(defaultEscOptions, optid);
1508 ✗ failure(lookupTupleList(accMMEscOpts, optid)); //no duplicity
1509 ✗ ((mmarg,exptype,sinfo), stmts, locals, scEnv, accMMDecls)
1510 := statementsFromArg(optexp, stmts, locals, scEnv, tplPackage, accMMDecls);
1511 ✗ (mmarg, stmts, locals) := typeAdaptMMOption(mmarg, exptype, sinfo, opttype, stmts, locals, astdefs);
1512 ✗ (accMMEscOpts, stmts, locals, scEnv, accMMDecls)
1513 := statementsFromEscOptions(opts, (optid, (mmarg,opttype)) :: accMMEscOpts,
1514 stmts, locals, scEnv, tplPackage, accMMDecls);
1515 then
1516 (accMMEscOpts, stmts, locals, scEnv, accMMDecls);
1517
1518 //warning - unknown option
1519 case ( (optid, _) :: opts, accMMEscOpts,
1520 stmts, locals, scEnv, tplPackage, accMMDecls )
1521 algorithm
1522 ✗ failure(lookupTupleList(defaultEscOptions, optid));
1523 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - an unknown option'" + optid + "' was specified. \n");
1524 ✗ (accMMEscOpts, stmts, locals, scEnv, accMMDecls)
1525 := statementsFromEscOptions(opts, accMMEscOpts, stmts, locals, scEnv, tplPackage, accMMDecls);
1526 ✗ then
1527 fail();
1528 //(accMMEscOpts, stmts, locals, scEnv, accMMDecls);
1529
1530 //warning - duplicit option
1531 case ( (optid, _) :: opts, accMMEscOpts,
1532 stmts, locals, scEnv, tplPackage, accMMDecls )
1533 algorithm
1534 ✗ lookupTupleList(defaultEscOptions, optid);
1535 ✗ lookupTupleList(accMMEscOpts, optid);
1536 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Warning - a duplicit option'" + optid + "' was specified. It will be ignored (not evaluated).\n");
1537 ✗ (accMMEscOpts, stmts, locals, scEnv, accMMDecls)
1538 := statementsFromEscOptions(opts, accMMEscOpts, stmts, locals, scEnv, tplPackage, accMMDecls);
1539 then
1540 (accMMEscOpts, stmts, locals, scEnv, accMMDecls);
1541
1542 //can fail on error
1543 else
1544 algorithm
1545 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace(" -statementsFromEscOptions failed\n");
1546 ✗ then
1547 fail();
1548 end matchcontinue;
1549 end statementsFromEscOptions;
1550
1551
1552 public function getExpListForMap
1553 input Expression inExp;
1554 output list<Expression> outExpsForMap;
1555 algorithm
1556 outExpsForMap := match inExp
1557 local
1558 list<Expression> explst;
1559
1560 case (MAP_ARG_LIST(parts = explst), _) then explst;
1561 else {inExp};
1562 end match;
1563 end getExpListForMap;
1564
1565
1566 public function pushPopBlock
1567 input list<MMEscOption> inMMEscOptions;
1568 input Ident inOptionIdent;
1569 input Ident inBlockTypeIdent;
1570 input list<MMExp> inStmts;
1571 input list<MMExp> inPopBlockStmts;
1572 input Ident inInText;
1573 input Ident inOutText;
1574
1575 output list<MMEscOption> outMMEscOptions;
1576 output list<MMExp> outStmts;
1577 output list<MMExp> outPopBlockStmts;
1578 output Ident outInText;
1579 algorithm
1580 (outMMEscOptions, outStmts, outPopBlockStmts, outInText)
1581 := matchcontinue (inMMEscOptions, inOptionIdent, inBlockTypeIdent, inStmts, inPopBlockStmts, inInText, inOutText)
1582 local
1583 list<MMExp> stmts, popstmts;
1584 MMExp stmt, pstmt, mmexp;
1585 Ident intxt, outtxt, optid, btid;
1586 list<MMEscOption> mmopts;
1587
1588 case ( mmopts, optid, btid, stmts, popstmts, intxt, outtxt)
1589 algorithm
1590 ✗ ((mmexp,_), mmopts) := lookupDeleteTupleList(mmopts, optid);
1591 ✗ stmt := pushBlockStatement(btid, mmexp, intxt, outtxt);
1592 ✗ pstmt := tplStatement("popBlock", {}, outtxt, outtxt);
1593 ✗ popstmts := List.appendElt(pstmt, popstmts);
1594 then ( mmopts, (stmt :: stmts), popstmts, outtxt);
1595
1596 case ( mmopts, _, _, stmts, popstmts, intxt, _)
1597 //equation
1598 //failure(((mmexp,_), mmopts) = lookupDeleteTupleList(mmopts, optid));
1599 then ( mmopts, stmts, popstmts, intxt);
1600
1601 //cannot happen
1602 else
1603 algorithm
1604 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!pushPopBlock failed\n");
1605 ✗ then
1606 fail();
1607 end matchcontinue;
1608 end pushPopBlock;
1609
1610 /*
1611 public function addImplicitArgument
1612 input list<Expression> inArgLst;
1613 input TypedIdents inInArgs;
1614 input TypedIdents inOutArgs;
1615 input TemplPackage inTplPackage;
1616
1617 output list<Expression> outArgLst;
1618 algorithm
1619 outArgLst := matchcontinue (inArgLst, inInArgs, inOutArgs, inTplPackage)
1620 local
1621 list<Expression> explst;
1622 tuple<Ident,TypeSignature> iarg, oarg;
1623 TemplPackage tplPackage;
1624
1625 //when the function is a template function
1626 //and the signature has the only one argument and none is specified on call
1627 // assume the 'it'
1628 case ( {}, { iarg, _ }, oarg :: _ , tplPackage)
1629 algorithm
1630 areTextInOutArgs(iarg, oarg, tplPackage);
1631 then { BOUND_VALUE(IDENT("it")) };
1632
1633 //when the function is a non-template function
1634 //and the signature has the only one argument and none is specified on the call
1635 // assume the 'it'
1636 //- case with an output argument (check if it is not a template function with no argument - i.e. only one text input argument)
1637 case ( {}, { iarg }, oarg :: _ , tplPackage)
1638 algorithm
1639 failure(areTextInOutArgs(iarg, oarg, tplPackage));
1640 then { BOUND_VALUE(IDENT("it")) };
1641
1642 //when the function is a non-template function
1643 //and the signature has the only one argument and none is specified on the call
1644 // assume the 'it'
1645 //- case with no output argument (evidently a no-ret non-template function)
1646 case ( {}, { iarg }, {} , tplPackage)
1647 then { BOUND_VALUE(IDENT("it")) };
1648
1649
1650 //otherwise no change
1651 else inArgLst;
1652
1653 end matchcontinue;
1654 end addImplicitArgument;
1655 */
1656
1657 public function statementsFromArg
1658 input Expression inExp;
1659 input list<MMExp> inStmts;
1660 input TypedIdents inLocals;
1661 input ScopeEnv inScopeEnv;
1662 input TemplPackage inTplPackage;
1663 input list<MMDeclaration> inAccMMDecls;
1664
1665 output tuple<MMExp, TypeSignature, SourceInfo> outArgValue;
1666 output list<MMExp> outStmts;
1667 output TypedIdents outLocals;
1668 output ScopeEnv outScopeEnv;
1669 output list<MMDeclaration> outMMDecls;
1670 algorithm
1671 (outArgValue, outStmts, outLocals, outScopeEnv, outMMDecls)
1672 := matchcontinue (inExp, inStmts, inLocals, inScopeEnv, inTplPackage, inAccMMDecls)
1673 local
1674 list<MMExp> stmts;
1675 MMExp stmt;
1676 ScopeEnv scEnv;
1677 Ident outtxt;
1678 list<Ident> tyVars;
1679 TypedIdents locals;
1680 list<tuple<MMExp, TypeSignature, SourceInfo>> argvals;
1681 MMExp mmexp;
1682 PathIdent path, fname;
1683 TypeSignature idtype, rettype, littype;
1684 list<Expression> explst;
1685 SourceInfo sinfo;
1686 TypedIdents iargs, oargs;
1687 Expression exp;
1688 String litvalue, fileName, lineStr, colStr;
1689 StringToken st;
1690 Integer lineNumberStart, columnNumberStart;
1691
1692 TemplPackage tplPackage;
1693 list<MMDeclaration> accMMDecls;
1694
1695 case ( (LITERAL(value = litvalue, litType = littype), sinfo),
1696 stmts, locals, scEnv, _, accMMDecls )
1697 ✗ then ( (MM_LITERAL(litvalue),littype,sinfo), stmts, locals, scEnv, accMMDecls);
1698
1699 case ( (STR_TOKEN(value = st), sinfo),
1700 stmts, locals, scEnv, _, accMMDecls )
1701 ✗ then ( (MM_STR_TOKEN(st),STRING_TOKEN_TYPE(),sinfo), stmts, locals, scEnv, accMMDecls);
1702
1703 case ( (BOUND_VALUE(boundPath = path), sinfo),
1704 stmts, locals, scEnv, tplPackage, accMMDecls )
1705 algorithm
1706 //Debug.fprint(Flags.FAILTRACE,"\n arg BOUND_VALUE resolving boundPath = " + pathIdentString(path) + "\n");
1707 ✗ (mmexp, idtype, scEnv) := resolveBoundPath(path, scEnv, tplPackage);
1708 ✗ checkResolvedType(path, idtype, "argument", sinfo);
1709 //Debug.fprint(Flags.FAILTRACE," arg BOUND_VALUE resolved mmexp = " + mmExpString(mmexp) + " : "
1710 // + typeSignatureString(idtype) + "\n");
1711 ✗ then ( (mmexp,idtype,sinfo), stmts, locals, scEnv, accMMDecls);
1712
1713 //or embed it into the FUN_CALL ??... --> match
1714 case ( (FUN_CALL(name = IDENT("sourceInfo"), args = {}),
1715 sinfo as SOURCEINFO(fileName = fileName, lineNumberStart = lineNumberStart, columnNumberStart = columnNumberStart)),
1716 stmts, locals, scEnv, _, accMMDecls )
1717 algorithm
1718 ✗ if Flags.isSet(Flags.FAILTRACE) then
1719 ✗ Debug.trace(" arg sourceInfo \n");
1720 end if;
1721 fname := PATH_IDENT("Tpl", IDENT("sourceInfo"));
1722 ✗ rettype := NAMED_TYPE(PATH_IDENT("builtin", IDENT("SourceInfo")));
1723 ✗ lineStr := intString(lineNumberStart);
1724 ✗ colStr := intString(columnNumberStart);
1725 ✗ mmexp := MM_FN_CALL(fname, { MM_STRING(fileName), MM_LITERAL(lineStr), MM_LITERAL(colStr) });
1726 ✗ then ( (mmexp, rettype, sinfo), stmts, locals, scEnv, accMMDecls);
1727
1728
1729 case ( (FUN_CALL(name = fname, args = explst), sinfo),
1730 stmts, locals, scEnv, tplPackage, accMMDecls )
1731 algorithm
1732 ✗ (fname, iargs, oargs, tyVars) := getFunSignature(fname, sinfo, tplPackage);
1733 //explst = addImplicitArgument(explst, iargs, oargs, tplPackage);
1734 ✗ (argvals, stmts, locals, scEnv, accMMDecls)
1735 := statementsFromArgList(explst, stmts, locals, scEnv, tplPackage, accMMDecls);
1736 ✗ outtxt := textTempVarNamePrefix + intString(listLength(locals));
1737 ✗ (_, stmt, mmexp, rettype, locals, outtxt)
1738 := statementFromFun(argvals, fname, iargs, oargs, tyVars, emptyTxt, outtxt, locals, tplPackage, sinfo);
1739 ✗ if Flags.isSet(Flags.FAILTRACE) then
1740 ✗ Debug.traceln(" arg FUN_CALL stmt =\n" + stmtsString({stmt}));
1741 end if;
1742 //if emptyList in case of non-template function, not to be included to locals
1743 ✗ locals := addLocalValue(outtxt, TEXT_TYPE(), locals);
1744 ✗ then ( (mmexp, rettype, sinfo), stmt :: stmts, locals, scEnv, accMMDecls);
1745
1746 //previous fail on error, go on
1747 //case ( (FUN_CALL(name = fname, args = explst), sinfo),
1748 // stmts, locals, scEnv, tplPackage, accMMDecls )
1749 // equation
1750 // //TODO: make this nicer ?
1751 // mmexp = MM_FN_CALL(IDENT("#ERROR#"), {});
1752 // rettype = UNRESOLVED_TYPE("#ERROR#");
1753 // then ( (mmexp, rettype, sinfo), stmts, locals, scEnv, accMMDecls);
1754
1755 // all the other are texts:
1756 // TEMPLATE, CONDITION, MATCH, MAP, MAP_ARG_LIST (forced MV separation - cannot construct true lists),
1757 // ESCAPED and INDENTATION
1758 case ( exp as (_,sinfo), stmts, locals, scEnv, tplPackage, accMMDecls )
1759 algorithm
1760 ✗ outtxt := textTempVarNamePrefix + intString(listLength(locals));
1761 ✗ (stmts, locals, scEnv, accMMDecls, outtxt)
1762 := statementsFromExp(exp, {}, stmts, emptyTxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1763 ✗ locals := addLocalValue(outtxt, TEXT_TYPE(), locals); //if emptyList, not to be included to locals
1764 ✗ mmexp := MM_IDENT(IDENT(outtxt));
1765 ✗ then ( (mmexp, TEXT_TYPE(),sinfo), stmts, locals, scEnv, accMMDecls);
1766
1767 //should not ever happen
1768 else
1769 algorithm
1770 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!statementsFromArg failed\n");
1771 ✗ then
1772 fail();
1773 end matchcontinue;
1774 end statementsFromArg;
1775
1776
1777 public function statementsFromArgList
1778 input list<Expression> inExpLst;
1779 input list<MMExp> inStmts;
1780 input TypedIdents inLocals;
1781 input ScopeEnv inScopeEnv;
1782 input TemplPackage inTplPackage;
1783 input list<MMDeclaration> inAccMMDecls;
1784
1785 output list<tuple<MMExp, TypeSignature, SourceInfo>> outArgValues;
1786 output list<MMExp> outStmts;
1787 output TypedIdents outLocals;
1788 output ScopeEnv outScopeEnv;
1789 output list<MMDeclaration> outMMDecls;
1790
1791 algorithm
1792 (outArgValues, outStmts, outLocals, outScopeEnv, outMMDecls)
1793 := matchcontinue (inExpLst, inStmts, inLocals, inScopeEnv, inTplPackage, inAccMMDecls)
1794 local
1795 list<MMExp> stmts;
1796 ScopeEnv scEnv;
1797 TypedIdents locals;
1798 list<Expression> explst;
1799 TemplPackage tplPackage;
1800 list<MMDeclaration> accMMDecls;
1801 tuple<MMExp, TypeSignature, SourceInfo> argval;
1802 list<tuple<MMExp, TypeSignature, SourceInfo>> argvals;
1803 Expression exp;
1804
1805 case ( {}, stmts, locals, scEnv, _, accMMDecls )
1806 then ( {}, stmts, locals, scEnv, accMMDecls);
1807
1808 case ( (exp :: explst ),
1809 stmts, locals, scEnv, tplPackage, accMMDecls )
1810 algorithm
1811 ✗ (argval, stmts, locals, scEnv, accMMDecls)
1812 := statementsFromArg(exp, stmts, locals, scEnv, tplPackage, accMMDecls);
1813 ✗ (argvals, stmts, locals, scEnv, accMMDecls)
1814 := statementsFromArgList(explst, stmts, locals, scEnv, tplPackage, accMMDecls);
1815 ✗ then ( (argval :: argvals), stmts, locals, scEnv, accMMDecls);
1816
1817 else
1818 algorithm
1819 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!statementsFromArgList failed\n");
1820 ✗ then
1821 fail();
1822 end matchcontinue;
1823 end statementsFromArgList;
1824
1825
1826 public function tplStatement
1827 input Ident inFunName;
1828 input list<MMExp> inArgs;
1829 input Ident inInText;
1830 input Ident inOutArg;
1831
1832 output MMExp outStmt;
1833 annotation(__OpenModelica_EarlyInline = true);
1834 algorithm
1835 ✗ outStmt := MM_ASSIGN( {inOutArg},
1836 MM_FN_CALL( PATH_IDENT("Tpl",IDENT(inFunName)),
1837 MM_IDENT(IDENT(inInText)) :: inArgs ));
1838 end tplStatement;
1839
1840 public function pushBlockStatement
1841 input Ident inBlockType;
1842 input MMExp inArg;
1843 input Ident inInText;
1844 input Ident inOutArg;
1845
1846 output MMExp outStmt;
1847 annotation(__OpenModelica_EarlyInline = true);
1848 algorithm
1849 ✗ outStmt :=
1850 MM_ASSIGN(
1851 {inOutArg},
1852 MM_FN_CALL(
1853 PATH_IDENT("Tpl",IDENT("pushBlock")),
1854 { MM_IDENT(IDENT(inInText)),
1855 MM_FN_CALL(
1856 PATH_IDENT("Tpl",IDENT(inBlockType)),
1857 { inArg }) } ));
1858 end pushBlockStatement;
1859
1860
1861 public function addWriteCallFromMMExp
1862 input Boolean inHasRetValue;
1863 input MMExp inMMExp;
1864 input TypeSignature inType;
1865 input SourceInfo inSourceInfo;
1866 input list<MMEscOption> inMMEscOptions;
1867 input list<MMExp> inStmts;
1868 input Ident inInText;
1869 input Ident inOutText;
1870 input TypedIdents inLocals;
1871 input ScopeEnv inScopeEnv;
1872 input TemplPackage inTplPackage;
1873 input list<MMDeclaration> inAccMMDecls;
1874
1875 output list<MMExp> outStmts;
1876 output TypedIdents outLocals;
1877 output ScopeEnv outScopeEnv;
1878 output list<MMDeclaration> outMMDecls;
1879 output Ident outInText;
1880 algorithm
1881 (outStmts, outLocals, outScopeEnv, outMMDecls, outInText)
1882 := matchcontinue (inHasRetValue, inMMExp, inType, inMMEscOptions, inStmts, inInText, inOutText, inLocals, inScopeEnv, inTplPackage, inAccMMDecls)
1883 local
1884 Ident intxt, outtxt;
1885 PathIdent fname;
1886 TypeSignature exptype;
1887 MMExp mmexp, stmt;
1888 list<MMExp> stmts;
1889 TypedIdents locals, iargs, oargs;
1890 ScopeEnv scEnv;
1891 TemplPackage tplPackage;
1892 list<MMDeclaration> accMMDecls;
1893 list<tuple<MMExp, TypeSignature, SourceInfo>> argvals;
1894 MapContext mapctx;
1895 list<MMEscOption> mmopts;
1896
1897 //it is not a ret value,
1898 //if it is from a temlate call or a non-template call without a return value,
1899 //the statement is already added, nothing to do here
1900 case (false, _, _, _, stmts, intxt, _, locals, scEnv, _, accMMDecls)
1901 ✗ then
1902 ( stmts, locals, scEnv, accMMDecls, intxt);
1903
1904 //an option -> match it case SOME(val) then val // if exp = SOME(val) then val
1905 case (_, mmexp, exptype as OPTION_TYPE(), mmopts, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls)
1906 algorithm
1907 ✗ warnIfSomeOptions(mmopts);
1908 //internal encodeing of val is not needed as the val is bound tightly, it hides possible val from upper scope
1909 // /* encode the val as "val." that will be encoded as _val_ that is impossible to create from a source code -> no name collision */
1910 ✗ (argvals, fname, iargs, oargs, scEnv, accMMDecls)
1911 := makeMatchFun((mmexp, exptype, inSourceInfo),
1912 {(SOME_MATCH(BIND_MATCH("val")), (BOUND_VALUE(IDENT("val")),dummySourceInfo) ) },
1913 emptyExpression, //ignore the argument
1914 true, scEnv, tplPackage, accMMDecls);
1915 ✗ (_, stmt, _, _, locals, intxt)
1916 := statementFromFun(argvals, fname, iargs, oargs, {}, intxt, outtxt, locals, tplPackage, inSourceInfo);
1917 ✗ then
1918 ( (stmt :: stmts), locals, scEnv, accMMDecls, intxt);
1919
1920 //a list expression -> concat
1921 case (_, mmexp, exptype as LIST_TYPE(), mmopts, stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls)
1922 algorithm
1923 ✗ mapctx := MAP_CONTEXT(BIND_MATCH("it"), (BOUND_VALUE(IDENT("it")),dummySourceInfo) , mmopts, NONE(), false);
1924 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
1925 := statementsFromMapExp(true, {(mmexp, exptype,inSourceInfo)}, mapctx,
1926 stmts, intxt, outtxt, locals, scEnv, tplPackage, accMMDecls);
1927 then
1928 ( stmts, locals, scEnv, accMMDecls, intxt);
1929
1930 //string const - inline or defined by the user as an ident
1931 case (_, mmexp, STRING_TOKEN_TYPE(), mmopts, stmts, intxt, outtxt, locals, scEnv, _, accMMDecls)
1932 algorithm
1933 ✗ warnIfSomeOptions(mmopts);
1934 ✗ stmt := tplStatement("writeTok", {mmexp}, intxt, outtxt);
1935 ✗ then
1936 ( (stmt :: stmts), locals, scEnv, accMMDecls, outtxt);
1937
1938 //text -> writeText
1939 case (_, mmexp, TEXT_TYPE(), mmopts, stmts, intxt, outtxt, locals, scEnv, _, accMMDecls)
1940 algorithm
1941 ✗ warnIfSomeOptions(mmopts);
1942 ✗ stmt := tplStatement("writeText", {mmexp}, intxt, outtxt);
1943 ✗ then
1944 ( (stmt :: stmts), locals, scEnv, accMMDecls, outtxt);
1945
1946 //try to-string conversion
1947 case (_, mmexp, exptype, mmopts, stmts, intxt, outtxt, locals, scEnv, _, accMMDecls)
1948 algorithm
1949 ✗ warnIfSomeOptions(mmopts);
1950 ✗ mmexp := mmExpToString(mmexp, exptype, inSourceInfo);
1951 ✗ stmt := tplStatement("writeStr", {mmexp}, intxt, outtxt);
1952 ✗ then
1953 ( (stmt :: stmts), locals, scEnv, accMMDecls, outtxt);
1954
1955 //fail / error - is in mmExpToString
1956 else
1957 algorithm
1958 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!addWriteCallFromMMExp failed\n");
1959 ✗ then
1960 fail();
1961 end matchcontinue;
1962 end addWriteCallFromMMExp;
1963
1964 //no fail
1965 public function mmExpToString
1966 input MMExp inMMExp;
1967 input TypeSignature inType;
1968 input SourceInfo inSourceInfo;
1969
1970 output MMExp outMMExp;
1971 algorithm
1972 outMMExp := matchcontinue (inMMExp, inType)
1973 local
1974 MMExp mmexp;
1975 String reason, str;
1976 StringToken st;
1977 TypeSignature ts;
1978
1979 case (mmexp, STRING_TYPE())
1980 then
1981 mmexp;
1982
1983 //a literal constant to string - inline it as a special MM_STRING
1984 case (MM_LITERAL(value = str), _)
1985 ✗ then
1986 MM_STRING(str);
1987
1988 //an inlined string constant, can be inlined as MM_STRING
1989 case (MM_STR_TOKEN(value = st), _)
1990 algorithm
1991 ✗ str := Tpl.strTokString(st);
1992 ✗ then
1993 MM_STRING(str);
1994
1995 //runtime strTokString
1996 case (mmexp, STRING_TOKEN_TYPE())
1997 ✗ then
1998 MM_FN_CALL(PATH_IDENT("Tpl",IDENT("strTokString")), { mmexp });
1999
2000 //runtime textString
2001 case (mmexp, TEXT_TYPE())
2002 ✗ then
2003 MM_FN_CALL(PATH_IDENT("Tpl",IDENT("textString")), { mmexp });
2004
2005 //runtime integer type conversion
2006 case (mmexp, INTEGER_TYPE())
2007 ✗ then
2008 MM_FN_CALL(IDENT("intString"),{ mmexp });
2009
2010 //runtime real type conversion
2011 case (mmexp, REAL_TYPE())
2012 ✗ then
2013 MM_FN_CALL(IDENT("realString"),{ mmexp });
2014
2015 //runtime boolean type conversion
2016 case (mmexp, BOOLEAN_TYPE())
2017 ✗ then
2018 MM_FN_CALL(PATH_IDENT("Tpl", IDENT("booleanString")),{ mmexp });
2019
2020
2021 //trying to convert an unresolved value
2022 //it is already reported as an error, just embed and continue
2023 //or it is an illegal no-ret fun call (to be auto-converted to "" in the future??)
2024 case (mmexp, UNRESOLVED_TYPE(reason = reason))
2025 algorithm
2026 ✗ reason := "#UnresType# " + reason + " #";
2027 ✗ if Flags.isSet(Flags.FAILTRACE) then
2028 ✗ Debug.trace("Error - an unresolved value trying to convert to string. Unresolution reason:\n " + reason);
2029 end if;
2030 ✗ then
2031 MM_FN_CALL(IDENT(reason),{ mmexp });
2032
2033 //trying to convert a value when there is no conversion for its type
2034 case (mmexp, ts)
2035 algorithm
2036 ✗ str := "Elaborated expression '" + mmExpString(mmexp) + "' of type '"
2037 + typeSignatureString(ts) + "' has no automatic to-string conversion.";
2038 ✗ addSusanError(str, inSourceInfo);
2039 ✗ reason := "Error# " + str + " #";
2040 ✗ then
2041 MM_FN_CALL(IDENT(reason),{ mmexp });
2042
2043 //should not ever happen
2044 else
2045 algorithm
2046 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!mmExpToString failed\n");
2047 ✗ then
2048 fail();
2049 end matchcontinue;
2050 end mmExpToString;
2051
2052
2053 public function statementFromFun
2054 input list<tuple<MMExp, TypeSignature, SourceInfo>> inArgValues;
2055 input PathIdent inFunName;
2056 input TypedIdents inInArgs;
2057 input TypedIdents inOutArgs;
2058 input list<Ident> inTypeVars;
2059 input Ident inInText;
2060 input Ident inOutText;
2061 input TypedIdents inLocals;
2062 input TemplPackage inTplPackage;
2063 input SourceInfo inInfo;
2064
2065 output Boolean outHasRetValue;
2066 output MMExp outStmt;
2067 output MMExp outRetMMExp;
2068 output TypeSignature outRetType;
2069 output TypedIdents outLocals;
2070 output Ident outOutText;
2071 algorithm
2072 (outHasRetValue, outStmt, outRetMMExp, outRetType, outLocals, outOutText)
2073 := matchcontinue (inArgValues, inFunName, inInArgs, inOutArgs, inTypeVars, inInText, inOutText, inLocals, inTplPackage)
2074 local
2075
2076 PathIdent fname;
2077 TypedIdents iargs, oargs, locals, setTyVars;
2078 tuple<Ident,TypeSignature> iarg, oarg;
2079 list<tuple<MMExp, TypeSignature, SourceInfo>> argvals;
2080 list<tuple<MMExp, TypeSignature>> errArgVals;
2081 list<MMExp> mmargs;
2082
2083 Ident intxt, outtxt, retval;
2084 list<Ident> lhsArgs, tyVars;
2085 TypeSignature outtype;
2086 TemplPackage tplPackage;
2087 list<ASTDef> astDefs;
2088 MMExp mmexp, mmtxt;
2089 String str;
2090
2091
2092 //simple template function - one implicit text argument
2093 //- make a template call statement and return the out argument
2094 case (argvals, fname, ( iarg :: iargs ), { oarg }, tyVars, intxt, outtxt, locals, tplPackage as TEMPL_PACKAGE(astDefs = astDefs))
2095 algorithm
2096 ✗ areTextInOutArgs(iarg, oarg, tplPackage); //texts and equal or equal without conventional prefixes in/out, i.e. inId = outId
2097 //equality(listLength(argvals) = listLength(iargs));
2098 ✗ (mmargs,_) := typeAdaptMMArgsForFun(argvals, iargs, tyVars, {}, astDefs);
2099 ✗ mmtxt := MM_IDENT(IDENT(outtxt));
2100 ✗ mmexp := MM_FN_CALL(fname, MM_IDENT(IDENT(intxt)) :: mmargs);
2101 ✗ then
2102 (false, MM_ASSIGN({outtxt}, mmexp), mmtxt, TEXT_TYPE(), locals, outtxt );
2103
2104 //multi output template function - one implicit text argument + extra text in/out arguments
2105 //- make a template call statement and return only the first out argument
2106 case (argvals, fname, ( iarg :: iargs ), ( oarg :: (oargs as (_::_)) ), tyVars, intxt, outtxt, locals, tplPackage as TEMPL_PACKAGE(astDefs = astDefs))
2107 algorithm
2108 ✗ areTextInOutArgs(iarg, oarg, tplPackage); //texts and equal or equal without conventional prefixes in/out, i.e. inId = outId
2109 //equality(listLength(argvals) = listLength(iargs));
2110 ✗ (mmargs,_) := typeAdaptMMArgsForFun(argvals, iargs, tyVars, {}, astDefs);
2111 ✗ lhsArgs := elabOutTextArgs(mmargs, iargs, oargs, tplPackage); //assuming the same lengths (from above typeAdaptMMArgsForFun)
2112 lhsArgs := outtxt :: lhsArgs;
2113 ✗ mmtxt := MM_IDENT(IDENT(outtxt));
2114 ✗ mmexp := MM_FN_CALL(fname, (MM_IDENT(IDENT(intxt)) :: mmargs) );
2115 ✗ then
2116 (false, MM_ASSIGN(lhsArgs, mmexp), mmtxt, TEXT_TYPE(), locals, outtxt );
2117
2118 //a non-template function - no implicit text argument
2119 //one return value
2120 //- make a locally bound return value and assign the function to it
2121 case (argvals, fname, iargs, { (_, outtype) }, tyVars, intxt, _, locals, TEMPL_PACKAGE(astDefs = astDefs))
2122 algorithm
2123 //equality(listLength(argvals) = listLength(iargs));
2124 ✗ (mmargs, setTyVars) := typeAdaptMMArgsForFun(argvals, iargs, tyVars, {}, astDefs);
2125 ✗ outtype := specializeType(outtype, tyVars, setTyVars);
2126 //make a separate locally bound return value
2127 ✗ retval := returnTempVarNamePrefix + intString(listLength(locals));
2128 ✗ locals := addLocalValue(retval, outtype, locals);
2129 ✗ mmexp := MM_FN_CALL(fname, mmargs);
2130 ✗ then
2131 ( true, MM_ASSIGN({retval}, mmexp), MM_IDENT(IDENT(retval)), outtype, locals, intxt );
2132
2133 //---no--- TODO: move this to be available only for # context
2134 //TODO: lagalize this to be convertible to string, so that an effective result is ""
2135 //a non-template function - no implicit text argument
2136 //no return value - i.e. an intrinsic call like <# fun(arg) #>
2137 //- inline it as it is
2138 case (argvals, fname, iargs, {}, tyVars, intxt, _, locals, TEMPL_PACKAGE(astDefs = astDefs))
2139 algorithm
2140 //equality(listLength(argvals) = listLength(iargs));
2141 ✗ (mmargs,_) := typeAdaptMMArgsForFun(argvals, iargs, tyVars, {}, astDefs);
2142 ✗ mmexp := MM_FN_CALL(fname, mmargs);
2143 then
2144 //perhaps, UNIT_TYPE() or VOID_TYPE will fit here better
2145 ( false, mmexp, mmexp, UNRESOLVED_TYPE("No return value."), locals, intxt );
2146
2147 case (argvals, fname, iargs, oargs, _, _, _, _, _)
2148 algorithm
2149 ✗ errArgVals := List.map(argvals, Util.tuple312);
2150 ✗ str := "Cannot elaborate function\n "
2151 + Tpl.tplString3(TplCodegen.sFunSignature, fname, iargs, oargs)
2152 + "\n for actual parameters "
2153 + Tpl.tplString(TplCodegen.sActualMMParams, errArgVals)
2154 + "\n --> Invalid types (cannot convert) or number of in/out arguments (text in/out arguments must match by order and name equality where prefixes 'in' and 'out' can be used; A function has valid template signature only if all text out params have corresponding in text arguments.).\n";
2155 ✗ addSusanError(str,inInfo);
2156 ✗ then
2157 fail();
2158
2159 end matchcontinue;
2160 end statementFromFun;
2161
2162
2163 public function areTextInOutArgs
2164 input tuple<Ident,TypeSignature> inInArg;
2165 input tuple<Ident,TypeSignature> inOutArg;
2166 input TemplPackage inTplPackage;
2167 algorithm
2168 () := matchcontinue (inInArg, inOutArg, inTplPackage)
2169 local
2170 Ident inid, outid;
2171 TypeSignature itype, otype;
2172 list<String> inlst, outlst;
2173 list<ASTDef> astdefs;
2174
2175 // equals with no prefix ... internal only for defined tempates
2176 case ((inid,itype), (outid,otype), TEMPL_PACKAGE(astDefs = astdefs))
2177 algorithm
2178 ✗ true := stringEq(inid, outid);
2179 ✗ TEXT_TYPE() := deAliasedType(itype, astdefs);
2180 ✗ TEXT_TYPE() := deAliasedType(otype, astdefs);
2181 then
2182 ();
2183
2184 // equals with usage of in/out prefixes ... for external templates from an ast definition
2185 case ((inid,itype), (outid,otype), TEMPL_PACKAGE(astDefs = astdefs))
2186 algorithm
2187 ✗ "i" :: "n" :: inlst := stringListStringChar(inid);
2188 ✗ "o" :: "u" :: "t" :: outlst := stringListStringChar(outid);
2189 ✗ true := valueEq(inlst, outlst);
2190 ✗ TEXT_TYPE() := deAliasedType(itype, astdefs);
2191 ✗ TEXT_TYPE() := deAliasedType(otype, astdefs);
2192 then
2193 ();
2194
2195 //otherwise fail
2196 end matchcontinue;
2197 end areTextInOutArgs;
2198
2199 public function typeAdaptMMArgsForFun
2200 input list<tuple<MMExp, TypeSignature, SourceInfo>> inArgValues;
2201 input TypedIdents inInArgs;
2202 input list<Ident> inTypeVars;
2203 input TypedIdents inSetTypeVars;
2204 input list<ASTDef> inASTDefs;
2205
2206 output list<MMExp> outMMArguments;
2207 output TypedIdents outSetTypeVars;
2208 algorithm
2209 (outMMArguments,outSetTypeVars)
2210 := matchcontinue (inArgValues, inInArgs, inTypeVars, inSetTypeVars, inASTDefs)
2211 local
2212 TypedIdents iargs, setTyVars;
2213 list<tuple<MMExp, TypeSignature, SourceInfo>> argvals;
2214 SourceInfo sinfo;
2215 MMExp mmarg;
2216 list<MMExp> mmargs;
2217 TypeSignature argtype, sigArgtype;
2218 list<ASTDef> astdefs;
2219 list<Ident> tyVars;
2220
2221 case ( {}, {}, _,setTyVars, _)
2222 then
2223 ({}, setTyVars);
2224
2225 case ( (mmarg, argtype, sinfo) :: argvals, (_, sigArgtype) :: iargs, tyVars, setTyVars, astdefs)
2226 algorithm
2227 ✗ argtype := deAliasedType(argtype, astdefs);
2228 ✗ (mmarg, setTyVars) := typeAdaptMMArg(mmarg, argtype, sinfo, true, sigArgtype, tyVars, setTyVars, astdefs);
2229 ✗ (mmargs, setTyVars) := typeAdaptMMArgsForFun(argvals, iargs, tyVars, setTyVars, astdefs);
2230 ✗ then
2231 ( mmarg :: mmargs, setTyVars );
2232
2233 case ( {}, (_ :: _), _,_,_)
2234 algorithm
2235 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - more arguments expected for a function.\n");
2236 ✗ then
2237 fail();
2238
2239 case ( (_ :: _), {}, _,_,_)
2240 algorithm
2241 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - less number of arguments expected for a function.\n");
2242 ✗ then
2243 fail();
2244
2245 else
2246 algorithm
2247 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("!!! - typeAdaptMMArgsForFun failed\n");
2248 ✗ then
2249 fail();
2250 end matchcontinue;
2251 end typeAdaptMMArgsForFun;
2252
2253
2254 public function typeAdaptMMArg
2255 input MMExp inMMArg;
2256 input TypeSignature inArgType "assumed to be dealiased";
2257 input SourceInfo inSourceInfo;
2258 input Boolean errorWhenFail;
2259 input TypeSignature inTargetType "not dealiased - must check for type vars first";
2260 input list<Ident> inTypeVars;
2261 input TypedIdents inSetTypeVars;
2262 input list<ASTDef> inASTDefs;
2263
2264 output MMExp outMMArg;
2265 output TypedIdents outSetTypeVars;
2266 algorithm
2267 (outMMArg, outSetTypeVars)
2268 := matchcontinue (inMMArg, inArgType, inSourceInfo, errorWhenFail, inTargetType, inTypeVars, inSetTypeVars, inASTDefs)
2269 local
2270 TypedIdents setTyVars;
2271 MMExp mmarg, mmexp;
2272 TypeSignature argtype, targettype;
2273 list<ASTDef> astdefs;
2274 list<Ident> tyVars;
2275 SourceInfo sinfo;
2276 String msg;
2277
2278
2279 //special case when argtype is STRING_TOKEN_TYPE()
2280 //to-string conversion will take precedence (is default) when targettype is an unbound type variable
2281 //this is to prevent the surprise when imported function with type variable has a template expression as argument (the result is converted to string by default as user would expect intuitively)
2282 case ( mmexp, argtype as STRING_TOKEN_TYPE(), sinfo, _, targettype, tyVars, setTyVars, astdefs)
2283 algorithm
2284 ✗ setTyVars := typesEqual(targettype, STRING_TYPE(), tyVars, setTyVars, astdefs);
2285 ✗ mmarg := mmExpToString(mmexp, argtype, sinfo);
2286 then
2287 (mmarg, setTyVars);
2288
2289 //special case when argtype is TEXT_TYPE()
2290 //to-string conversion will take precedence (is default) when targettype is an unbound type variable
2291 //this is to prevent the surprise when imported function with type variable has a template expression as argument (the result is converted to string by default as user would expect intuitively)
2292 case ( mmexp, argtype as TEXT_TYPE(), sinfo, _,targettype, tyVars, setTyVars, astdefs)
2293 algorithm
2294 ✗ setTyVars := typesEqual(targettype, STRING_TYPE(), tyVars, setTyVars, astdefs);
2295 ✗ mmarg := mmExpToString(mmexp, argtype, sinfo);
2296 then
2297 (mmarg, setTyVars);
2298
2299
2300 //no conversion when equal ...
2301 case ( mmarg, argtype, _, _, targettype, tyVars, setTyVars, astdefs)
2302 algorithm
2303 ✗ setTyVars := typesEqual(targettype, argtype, tyVars, setTyVars, astdefs);
2304 then
2305 (mmarg, setTyVars);
2306
2307 //convert to string when tagettype = STRING_TYPE()
2308 case ( mmexp, argtype, sinfo, _, targettype, tyVars, setTyVars, astdefs)
2309 algorithm
2310 ✗ setTyVars := typesEqual(targettype, STRING_TYPE(), tyVars, setTyVars, astdefs);
2311 ✗ mmarg := mmExpToString(mmexp, argtype, sinfo);
2312 then
2313 (mmarg, setTyVars);
2314
2315
2316 ////when target type is TEXT_TYPE() ... special case
2317 //strTokText -> directly TEXT_TYPE()
2318 case ( mmarg, STRING_TOKEN_TYPE(), _, _, targettype, tyVars, setTyVars, astdefs)
2319 algorithm
2320 ✗ setTyVars := typesEqual(targettype, TEXT_TYPE(), tyVars, setTyVars, astdefs);
2321 ✗ then
2322 ( MM_FN_CALL(PATH_IDENT("Tpl",IDENT("strTokText")), { mmarg }), setTyVars);
2323
2324
2325
2326
2327 /* no convertion to stringtoken yet, ... every string will be stringtoken then
2328 //textStrTok - useful for options when from a template
2329 case ( mmarg, TEXT_TYPE(), STRING_TOKEN_TYPE(), _)
2330 then
2331 MM_FN_CALL(PATH_IDENT("Tpl",IDENT("textStrTok")), { mmarg });
2332
2333
2334 //stringStrTok - useful for options when from a value of type string
2335 case ( mmarg, STRING_TYPE(), STRING_TOKEN_TYPE(), _)
2336 then
2337 MM_FN_CALL(PATH_IDENT("Tpl",IDENT("ST_STRING")), { mmarg });
2338 */
2339
2340 //when target type is TEXT_TYPE()
2341 // _ -> text ... to string and -> text
2342 case ( mmarg, argtype, sinfo, _, targettype, tyVars, setTyVars, astdefs)
2343 algorithm
2344 ✗ setTyVars := typesEqual(targettype, TEXT_TYPE(), tyVars, setTyVars, astdefs);
2345 ✗ mmarg := mmExpToString(mmarg, argtype, sinfo);
2346 ✗ then
2347 ( MM_FN_CALL(PATH_IDENT("Tpl",IDENT("stringText")), { mmarg }), setTyVars);
2348
2349 //no fail branch
2350 case ( mmarg, argtype, sinfo, true, targettype,_,setTyVars,_)
2351 algorithm
2352 ✗ msg := "Elaborated expression '" + mmExpString(mmarg) + "' of type '"
2353 + typeSignatureString(argtype)
2354 + "' failed to type adapt to its inferred type '"
2355 + typeSignatureString(targettype) + "'.";
2356 ✗ addSusanError(msg, sinfo);
2357 //true = Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - typeAdaptMMArg failed\n");
2358 ✗ msg := "#Error# " + msg + " #";
2359 ✗ then
2360 ( MM_FN_CALL(IDENT(msg),{ mmarg }), setTyVars);
2361
2362 //fail when no case is useful and no error shoud be reported
2363 case ( _, _, _, false, _,_,_,_)
2364 algorithm
2365 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Fail branch- typeAdaptMMArg failed\n");
2366 ✗ then
2367 fail();
2368 end matchcontinue;
2369 end typeAdaptMMArg;
2370
2371
2372 public function typeAdaptMMOption
2373 input MMExp inMMArg;
2374 input TypeSignature inArgType;
2375 input SourceInfo sinfo;
2376 input TypeSignature inTargetType;
2377 input list<MMExp> inStmts;
2378 input TypedIdents inLocals;
2379 input list<ASTDef> inASTDefs;
2380
2381 output MMExp outMMArg;
2382 output list<MMExp> outStmts;
2383 output TypedIdents outLocals;
2384 algorithm
2385 (outMMArg, outStmts, outLocals) :=
2386 matchcontinue (inMMArg, inArgType, inTargetType, inStmts, inLocals, inASTDefs)
2387 local
2388 MMExp mmarg;
2389 TypeSignature argtype, targettype;
2390 list<ASTDef> astdefs;
2391 list<MMExp> stmts;
2392 TypedIdents locals;
2393
2394 //concrete type to its option SOME - when from a value of the concrete type
2395 case (mmarg, argtype, OPTION_TYPE(ofType = targettype), stmts, locals, astdefs)
2396 algorithm
2397 ✗ targettype := deAliasedType(targettype, astdefs);
2398 ✗ (mmarg, stmts, locals) := typeAdaptMMOption(mmarg, argtype, sinfo, targettype, stmts, locals, astdefs);
2399 ✗ mmarg := MM_FN_CALL(IDENT("SOME"), { mmarg });
2400 ✗ then
2401 (mmarg, stmts, locals);
2402
2403 case (mmarg, argtype, targettype, stmts, locals, astdefs)
2404 algorithm
2405 ✗ argtype := deAliasedType(argtype, astdefs);
2406 ✗ (mmarg,_) := typeAdaptMMArg(mmarg, argtype, sinfo, false, targettype, {}, {}, astdefs);
2407 ✗ (mmarg, stmts, locals) := mmEnsureNonFunctionArg(mmarg, targettype, stmts, locals);
2408 then
2409 (mmarg, stmts, locals);
2410
2411 //textStrTok - when from a template
2412 case (mmarg, TEXT_TYPE(), STRING_TOKEN_TYPE(), stmts, locals, _)
2413 algorithm
2414 ✗ mmarg := MM_FN_CALL(PATH_IDENT("Tpl",IDENT("textStrTok")), { mmarg });
2415 ✗ (mmarg, stmts, locals) := mmEnsureNonFunctionArg(mmarg, STRING_TOKEN_TYPE(), stmts, locals);
2416 then
2417 (mmarg, stmts, locals);
2418
2419 //stringStrTok - when from a value of type string or others (int, real, bool)
2420 case (mmarg, argtype, STRING_TOKEN_TYPE(), stmts, locals, _)
2421 algorithm
2422 ✗ mmarg := mmExpToString(mmarg, argtype, sinfo);
2423 ✗ (mmarg, stmts, locals) := mmEnsureNonFunctionArg(mmarg, STRING_TYPE(), stmts, locals);
2424 ✗ mmarg := MM_FN_CALL(PATH_IDENT("Tpl",IDENT("ST_STRING")), { mmarg });
2425 ✗ then
2426 (mmarg, stmts, locals);
2427
2428 /*
2429 //stringStrTok - useful for options when from a value of type string
2430 case ( mmarg, STRING_TYPE(), STRING_TOKEN_TYPE(), _)
2431 then
2432 MM_FN_CALL(PATH_IDENT("Tpl",IDENT("ST_STRING")), { mmarg });
2433 */
2434
2435 else
2436 algorithm
2437 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - typeAdaptMMOption failed\n");
2438 ✗ then
2439 fail();
2440 end matchcontinue;
2441 end typeAdaptMMOption;
2442
2443
2444 public function mmEnsureNonFunctionArg
2445 input MMExp inMMArg;
2446 input TypeSignature inTargetType;
2447 //input SourceInfo sinfo;
2448 input list<MMExp> inStmts;
2449 input TypedIdents inLocals;
2450
2451 output MMExp outMMArg;
2452 output list<MMExp> outStmts;
2453 output TypedIdents outLocals;
2454 algorithm
2455 (outMMArg, outStmts, outLocals) :=
2456 matchcontinue (inMMArg, inTargetType, inStmts, inLocals)
2457 local
2458 MMExp mmarg;
2459 TypeSignature targettype;
2460 String retval;
2461 list<MMExp> stmts;
2462 TypedIdents locals;
2463
2464 case ( mmarg as MM_FN_CALL(), targettype, stmts, locals)
2465 algorithm
2466 //make a separate locally bound return value
2467 ✗ retval := returnTempVarNamePrefix + intString(listLength(locals));
2468 ✗ locals := addLocalValue(retval, targettype, locals);
2469 ✗ stmts := MM_ASSIGN({retval}, mmarg) :: stmts;
2470 ✗ then
2471 (MM_IDENT(IDENT(retval)), stmts, locals);
2472
2473 case ( mmarg, _, stmts, locals)
2474 algorithm
2475 ✗ failure(MM_FN_CALL() := mmarg);
2476 ✗ then
2477 (mmarg, stmts, locals);
2478
2479 //may fail, when addLocalValue fails
2480 else
2481 algorithm
2482 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("!!!- mmEnsureNonFunctionArg failed\n");
2483 ✗ then
2484 fail();
2485 end matchcontinue;
2486 end mmEnsureNonFunctionArg;
2487
2488
2489 public function elabOutTextArgs
2490 input list<MMExp> inMMArguments;
2491 input TypedIdents inInArgs;
2492 input TypedIdents inOutArgs;
2493 input TemplPackage inTplPackage;
2494
2495 output list<Ident> outLhsArgs;
2496 algorithm
2497 outLhsArgs := matchcontinue (inMMArguments, inInArgs, inOutArgs, inTplPackage)
2498 local
2499 Ident txtarg;
2500 TypedIdents iargs, oargs;
2501 tuple<Ident, TypeSignature> iarg, oarg;
2502 list<MMExp> mmargs;
2503 list<Ident> lhsArgs;
2504 TemplPackage tplPackage;
2505 MMExp exp;
2506
2507 case ( _, _, {}, _)
2508 then
2509 {};
2510
2511 //not a text in/out parameter, search on
2512 case ( _ :: mmargs, iarg :: iargs, oargs as (oarg :: _), tplPackage)
2513 algorithm
2514 ✗ failure(areTextInOutArgs(iarg , oarg, tplPackage));
2515 ✗ lhsArgs := elabOutTextArgs(mmargs, iargs, oargs, tplPackage);
2516 then
2517 lhsArgs;
2518
2519 //a text argument that is input and output
2520 //an actual parameter ident ... non-internal idents all starts with "_"
2521 //- put it out
2522 case ((exp as MM_IDENT(IDENT(txtarg))) :: mmargs, _ :: iargs, _ :: oargs, tplPackage)
2523 algorithm
2524 // obsolete ... "_" = stringGetStringChar(txtarg, 1);
2525 //areEqualInOutArgs(iarg , oarg);
2526 ✗ false := listMember(exp, mmargs); // This makes only the last Text argument be cached, but it is the simplest solution
2527 ✗ lhsArgs := elabOutTextArgs(mmargs, iargs, oargs, tplPackage);
2528 then
2529 ( txtarg :: lhsArgs );
2530
2531 //a text argument that is input and output
2532 //an actual parameter is not a local text value (it is a constant/function) - put it as '_'
2533 case ( _ :: mmargs, _ :: iargs, _ :: oargs, tplPackage)
2534 algorithm
2535 //failure(MM_IDENT(IDENT()) = mmarg);
2536 //failure("_" = stringGetStringChar(txtarg, 1));
2537 //areEqualInOutArgs(iarg , oarg);
2538 ✗ lhsArgs := elabOutTextArgs(mmargs, iargs, oargs, tplPackage);
2539 then
2540 ( "_" :: lhsArgs );
2541
2542 case ( {}, {}, _::_, _)
2543 algorithm
2544 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - inconsistent in/out Text arguments for a template function (Output texts are not a subset of input texts).\n");
2545 ✗ then
2546 fail();
2547
2548 //should not ever happen
2549 else
2550 algorithm
2551 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("!!!- elabOutTextArgs failed\n");
2552 ✗ then
2553 fail();
2554 end matchcontinue;
2555 end elabOutTextArgs;
2556
2557
2558 public function statementsFromMapExp
2559 input Boolean inIsFirstArgToMap;
2560 input list<tuple<MMExp, TypeSignature,SourceInfo>> inArgValuesToMap;
2561 input MapContext inMapContext;
2562 input list<MMExp> inStmts;
2563 input Ident inInText;
2564 input Ident inOutText;
2565 input TypedIdents inLocals;
2566 input ScopeEnv inScopeEnv;
2567 input TemplPackage inTplPackage;
2568 input list<MMDeclaration> inAccMMDecls;
2569
2570 output list<MMExp> outStmts;
2571 output TypedIdents outLocals;
2572 output ScopeEnv outScopeEnv;
2573 output list<MMDeclaration> outMMDecls;
2574 output Ident outInText;
2575
2576 algorithm
2577 (outStmts, outLocals, outScopeEnv, outMMDecls, outInText)
2578 := matchcontinue (inIsFirstArgToMap, inArgValuesToMap, inMapContext, inStmts, inInText, inOutText, inLocals, inScopeEnv, inTplPackage, inAccMMDecls)
2579 local
2580 list<MMExp> stmts, mapstmts, rhsMMArgs;
2581 MMExp stmt, mmRecCall;
2582 TypeSignature argtype, oftype;
2583 ScopeEnv scEnv;
2584 Ident intxt, outtxt, fname, idxName, freshIdxName, arrName, eltName;
2585 TypedIdents locals, localArgs, encodedExtargs, maplocals, caseLocals, iargs, oargs, matchLocals;
2586 MapContext mapctx;
2587 TemplPackage tplPackage;
2588 list<MMDeclaration> accMMDecls;
2589 tuple<MMExp, TypeSignature, SourceInfo> argtomap;
2590 list<tuple<MMExp, TypeSignature, SourceInfo>> extargvals, inMapExtargvals, restargs;
2591 MatchingExp ofbind, ofbindEnc, mexp;
2592 Expression mapexp;
2593 list<MMEscOption> iopts;
2594 list<ASTDef> astDefs;
2595 MMMatchCase mmmcEmptyList, mmmcCons, mmFailCons, mmmcMatched;
2596 Boolean isfirst, useiter, isUsed;
2597 MMDeclaration mmFun;
2598 list<tuple<MatchingExp, TypedIdents, list<MMExp>>> elabcases;
2599 list<MMMatchCase> mmmcases;
2600 list<Ident> lhsArgs, assignedIdents;
2601 Option <Ident> hasIndexIdentOpt;
2602 list<tuple<Ident, Ident>> localNames;
2603 SourceInfo sinfo;
2604
2605 //all args was mapped, the popIter() at last
2606 case ( _, {}, MAP_CONTEXT( useIter = true ),
2607 stmts, intxt, outtxt, locals, scEnv, _, accMMDecls )
2608 algorithm
2609 ✗ stmt := tplStatement("popIter", {}, intxt, outtxt);
2610 ✗ then ( stmt :: stmts, locals, scEnv, accMMDecls, outtxt);
2611
2612 //all args was mapped (or there were no exps to map), the iter functions was not used
2613 case ( _, {}, MAP_CONTEXT( useIter = false ),
2614 stmts, intxt, _, locals, scEnv, _, accMMDecls )
2615 ✗ then ( stmts, locals, scEnv, accMMDecls, intxt);
2616
2617 //List map - elaborate the list-mapping function
2618 case ( isfirst, (argtomap as (_,argtype,_)) :: restargs,
2619 MAP_CONTEXT(ofBinding = ofbind,
2620 mapExp = mapexp as (_,sinfo),
2621 iterMMExpOptions = iopts,
2622 hasIndexIdentOpt = hasIndexIdentOpt,
2623 useIter = useiter),
2624 stmts, intxt, outtxt, locals, scEnv, tplPackage as TEMPL_PACKAGE(astDefs = astDefs), accMMDecls )
2625 algorithm
2626 ✗ LIST_TYPE(ofType = oftype) := deAliasedType(argtype, astDefs);
2627
2628 ✗ ofbindEnc := typeCheckMatchingExp(ofbind, oftype, astDefs);
2629 //ofbindEnc = encodeMatchingExp(ofbindEnc);
2630 ✗ idxName := Util.getOptionOrDefault(hasIndexIdentOpt, impossibleIdent);
2631 ✗ freshIdxName := indexNamePrefix + idxName;// + "_" + intString(listLength(locals));
2632
2633 //i0ti = ("i_i0",INTEGER_TYPE());
2634 //i1ti = ("i_i1",INTEGER_TYPE());
2635 //elaborate statemennts and gather extra arguments and usage of i0 and i1
2636 ✗ (mapstmts, maplocals, scEnv, accMMDecls, _)
2637 := statementsFromExp(mapexp,{}, {}, imlicitTxt, imlicitTxt, {},
2638 LET_SCOPE(idxName, INTEGER_TYPE(), freshIdxName, false)
2639 :: CASE_SCOPE(ofbindEnc, oftype, {}, {}, {}, impossibleIdent, true)
2640 :: FUN_SCOPE({},{})
2641 :: scEnv,
2642 tplPackage, accMMDecls);
2643 ✗ LET_SCOPE(_, _, _, isUsed)
2644 :: CASE_SCOPE(mexp, _, localNames, caseLocals, encodedExtargs, _, _)
2645 :: FUN_SCOPE(_,localArgs)
2646 :: scEnv := scEnv; //releaseImmediateLocalScope(scEnv);
2647
2648 ✗ (mexp,_) := rewriteMatchExpByLocalNames(mexp, oftype, localNames,{}, astDefs);
2649 ✗ maplocals := listAppend(caseLocals, maplocals);
2650
2651 //put nextIter() if needed
2652 ✗ useiter := shouldUseIterFunctions(isfirst, useiter, true, isUsed, iopts, restargs);
2653 //add nextIter() if needed
2654 ✗ stmt := tplStatement("nextIter", {}, imlicitTxt, imlicitTxt);
2655 ✗ mapstmts := if useiter then stmt :: mapstmts else mapstmts;
2656 //(mapstmts,_) = addNextIter(useiter, mapstmts, imlicitTxt, imlicitTxt);
2657 //create a new list-map function
2658 ✗ fname := listMapFunPrefix + intString(listLength(accMMDecls));
2659 ✗ iargs := imlicitTxtArg :: ("items",argtype) :: encodedExtargs;
2660 ✗ assignedIdents := getAssignedIdents(mapstmts, {});
2661 //oargs = List.filterOnTrue(extargs, isText);
2662 ✗ oargs := List.filter1OnTrue(encodedExtargs, isAssignedText, assignedIdents);
2663 oargs := imlicitTxtArg :: oargs;
2664 //reverse the per-element statements into source order
2665 ✗ mapstmts := listReverse(mapstmts);
2666 //add indexed value if needed
2667 ✗ (mapstmts, maplocals)
2668 := addGetIndex(isUsed, freshIdxName, mapstmts, imlicitTxt, maplocals);
2669
2670 // The element-pattern bindings and per-element temporaries become the
2671 // locals of the per-element match; the threaded text accumulators stay
2672 // as the function's input/output arguments (iargs/oargs above).
2673 ✗ matchLocals := maplocals;
2674
2675 // fresh loop variable bound to each list element (the match scrutinee)
2676 ✗ eltName := "lstElt_" + intString(listLength(accMMDecls));
2677
2678 // The matched case runs the per-element body; the empty list is handled
2679 // by the for-loop itself. When the element pattern may fail to match,
2680 // add a skip case that leaves the accumulators unchanged.
2681 ✗ mmmcMatched := ({mexp}, mapstmts);
2682 ✗ mmmcases := if isAlwaysMatchedBool(mexp) then { mmmcMatched }
2683 else { mmmcMatched, ({REST_MATCH()}, {}) };
2684
2685 ✗ mapctx := MAP_CONTEXT(ofbind, mapexp, iopts, hasIndexIdentOpt, useiter);
2686
2687 // make fun: an iterative for-loop over the list rather than a
2688 // self-recursive helper. The recursion is a tail call (the C backend
2689 // tail-call-optimises it), but a straight loop avoids deep call stacks
2690 // for large models in every backend.
2691 ✗ mmFun := MM_FUN(false, fname, iargs, oargs, {},
2692 { MM_LIST_FOR_LOOP(eltName, "items", matchLocals, mmmcases) },
2693 GI_MAP_FUN(argtype, mapctx)
2694 );
2695
2696 //add pushIter() if it is the first element of MAP_ARG_LIST (like <[exp1,exp2,...] : mapexp> ) or a simple one (list)exp to be mapped (like <exp of mexp: mapexp>)
2697 ✗ (stmts, intxt) := addPushIter((isfirst and useiter), iopts, stmts, intxt, outtxt);
2698 ✗ extargvals := List.map(localArgs, makeMMArgValue);
2699 //call the elaborated function
2700 ✗ (_, stmt, _, _, locals, intxt)
2701 := statementFromFun(argtomap :: extargvals, IDENT(fname), iargs, oargs, {}, intxt, outtxt, locals, tplPackage, sinfo);
2702
2703 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
2704 := statementsFromMapExp(false, restargs, mapctx, stmt::stmts, intxt, outtxt, locals, scEnv, tplPackage, mmFun :: accMMDecls);
2705 then ( stmts, locals, scEnv, accMMDecls, intxt);
2706
2707 //Array map - elaborate the array-mapping function
2708 case ( isfirst, (argtomap as (_,argtype,_)) :: restargs,
2709 MAP_CONTEXT(ofBinding = ofbind,
2710 mapExp = mapexp as (_,sinfo),
2711 iterMMExpOptions = iopts,
2712 hasIndexIdentOpt = hasIndexIdentOpt,
2713 useIter = useiter),
2714 stmts, intxt, outtxt, locals, scEnv, tplPackage as TEMPL_PACKAGE(astDefs = astDefs), accMMDecls )
2715 algorithm
2716 ✗ ARRAY_TYPE(ofType = oftype) := deAliasedType(argtype, astDefs);
2717
2718 ✗ ofbindEnc := typeCheckMatchingExp(ofbind, oftype, astDefs);
2719 //ofbindEnc = encodeMatchingExp(ofbindEnc);
2720 ✗ idxName := Util.getOptionOrDefault(hasIndexIdentOpt, impossibleIdent);
2721 ✗ freshIdxName := indexNamePrefix + idxName;// + "_" + intString(listLength(locals));
2722
2723 //i0ti = ("i_i0",INTEGER_TYPE());
2724 //i1ti = ("i_i1",INTEGER_TYPE());
2725 //elaborate statemennts and gather extra arguments and usage of i0 and i1
2726 ✗ (mapstmts, maplocals, scEnv, accMMDecls, _)
2727 := statementsFromExp(mapexp,{}, {}, imlicitTxt, imlicitTxt, {},
2728 LET_SCOPE(idxName, INTEGER_TYPE(), freshIdxName, false)
2729 :: CASE_SCOPE(ofbindEnc, oftype, {}, {}, {}, impossibleIdent, true)
2730 :: FUN_SCOPE({},{})
2731 :: scEnv,
2732 tplPackage, accMMDecls);
2733 ✗ LET_SCOPE(_, _, _, isUsed)
2734 :: CASE_SCOPE(mexp, _, localNames, caseLocals, encodedExtargs, _, _)
2735 :: FUN_SCOPE(_,localArgs)
2736 :: scEnv := scEnv; //releaseImmediateLocalScope(scEnv);
2737
2738 ✗ (mexp,_) := rewriteMatchExpByLocalNames(mexp, oftype, localNames,{}, astDefs);
2739 ✗ maplocals := listAppend(caseLocals, maplocals);
2740
2741 //put nextIter() if needed
2742 ✗ useiter := shouldUseIterFunctions(isfirst, useiter, true, isUsed, iopts, restargs);
2743 //add nextIter() if needed
2744 ✗ stmt := tplStatement("nextIter", {}, imlicitTxt, imlicitTxt);
2745 ✗ mapstmts := if useiter then stmt :: mapstmts else mapstmts;
2746 //(mapstmts,_) = addNextIter(useiter, mapstmts, imlicitTxt, imlicitTxt);
2747
2748 //create a new array-map function
2749 ✗ fname := arrayMapFunPrefix + intString(listLength(accMMDecls));
2750 ✗ iargs := imlicitTxtArg :: ("items",argtype) :: encodedExtargs;
2751 ✗ assignedIdents := getAssignedIdents(mapstmts, {});
2752 //oargs = List.filterOnTrue(extargs, isText);
2753 ✗ oargs := List.filter1OnTrue(encodedExtargs, isAssignedText, assignedIdents);
2754 oargs := imlicitTxtArg :: oargs;
2755 ✗ mapstmts := listReverse(mapstmts);
2756 //add indexed value if needed
2757 ✗ (mapstmts, maplocals)
2758 := addGetIndex(isUsed, freshIdxName, mapstmts, imlicitTxt, maplocals);
2759
2760 //define identifiers for array traversal
2761 idxName := "i";
2762 arrName := "items";
2763 eltName := match mexp
2764 case BIND_MATCH(eltName)
2765 then eltName;
2766 case REST_MATCH()
2767 then "";
2768 end match;
2769
2770 ✗ mapctx := MAP_CONTEXT(ofbind, mapexp, iopts, hasIndexIdentOpt, useiter);
2771
2772 // make fun
2773 ✗ mmFun := MM_FUN(false,fname, iargs, oargs, maplocals,
2774 { MM_FOR_LOOP( idxName, arrName, eltName, mapstmts ) },
2775 GI_MAP_FUN(argtype, mapctx)
2776 );
2777
2778 //add pushIter() if it is the first element of MAP_ARG_LIST (like <[exp1,exp2,...] : mapexp> ) or a simple one (list)exp to be mapped (like <exp of mexp: mapexp>)
2779 ✗ (stmts, intxt) := addPushIter((isfirst and useiter), iopts, stmts, intxt, outtxt);
2780 ✗ extargvals := List.map(localArgs, makeMMArgValue);
2781 //call the elaborated function
2782 ✗ (_, stmt, _, _, locals, intxt)
2783 := statementFromFun(argtomap :: extargvals, IDENT(fname), iargs, oargs, {}, intxt, outtxt, locals, tplPackage, sinfo);
2784
2785 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
2786 := statementsFromMapExp(false, restargs, mapctx, stmt::stmts, intxt, outtxt, locals, scEnv, tplPackage, mmFun :: accMMDecls);
2787 then ( stmts, locals, scEnv, accMMDecls, intxt);
2788
2789 //scalar map - <argtomap of ofbind: mapexp; iopts>
2790 //TODO: try to inline or eliminate this at all ... design problems with mixed list/scalar arguments in { }, i.e. MAP_ARG_LIST
2791 case ( isfirst, (argtomap as (_,argtype,_)) :: restargs,
2792 MAP_CONTEXT(ofBinding = ofbind,
2793 mapExp = mapexp as (_,sinfo),
2794 iterMMExpOptions = iopts,
2795 hasIndexIdentOpt = hasIndexIdentOpt,
2796 useIter = useiter),
2797 stmts, intxt, outtxt, locals, scEnv, tplPackage as TEMPL_PACKAGE(astDefs = astDefs), accMMDecls )
2798 algorithm
2799 ✗ failure(LIST_TYPE() := deAliasedType(argtype, astDefs));
2800 ✗ failure(ARRAY_TYPE() := deAliasedType(argtype, astDefs));
2801
2802 ✗ ofbindEnc := typeCheckMatchingExp(ofbind, argtype, astDefs);
2803 //ofbindEnc = encodeMatchingExp(ofbindEnc);
2804 ✗ idxName := Util.getOptionOrDefault(hasIndexIdentOpt, impossibleIdent);
2805 ✗ freshIdxName := indexNamePrefix + idxName;// + "_" + intString(listLength(locals));
2806
2807 //i0ti = ("i_i0",INTEGER_TYPE());
2808 //i1ti = ("i_i1",INTEGER_TYPE());
2809 //matchArgName = getMatchArgName(inArgExp);//getItNameFromArg(argmmexp, argtype, ofbindEnc, astDefs);
2810
2811 //elaborate statemennts and gather extra arguments and usage of i0 and i1
2812 ✗ (mapstmts, maplocals, scEnv, accMMDecls, _)
2813 := statementsFromExp(mapexp,{}, {}, imlicitTxt, imlicitTxt, {},
2814 LET_SCOPE(idxName, INTEGER_TYPE(), freshIdxName, false)
2815 :: CASE_SCOPE(ofbindEnc, argtype, {}, {}, {}, impossibleIdent, true)
2816 :: FUN_SCOPE({},{})
2817 :: scEnv,
2818 tplPackage, accMMDecls);
2819 ✗ LET_SCOPE(_, _, _, isUsed)
2820 :: CASE_SCOPE(mexp, _, localNames, caseLocals, encodedExtargs, _, _)
2821 :: FUN_SCOPE(_,localArgs)
2822 :: scEnv := scEnv; //releaseImmediateLocalScope(scEnv);
2823
2824 ✗ (mexp,_) := rewriteMatchExpByLocalNames(mexp, argtype, localNames,{}, astDefs);
2825 ✗ maplocals := listAppend(caseLocals, maplocals);
2826
2827 //put nextIter() if needed
2828 ✗ useiter := shouldUseIterFunctions(isfirst, useiter, false, isUsed, iopts, restargs);
2829
2830 //make scalar map
2831
2832 //add nextIter() if needed
2833 ✗ stmt := tplStatement("nextIter", {}, imlicitTxt, imlicitTxt);
2834 ✗ mapstmts := if useiter then stmt :: mapstmts else mapstmts;
2835 //(mapstmts,_) = addNextIter(useiter, mapstmts, imlicitTxt, imlicitTxt);
2836
2837 //create a new scalar-map function,
2838 //where ofbind is not a simple BIND_MATCH -> it must be a match fun
2839 ✗ fname := scalarMapFunPrefix + intString(listLength(accMMDecls));
2840 ✗ iargs := imlicitTxtArg :: ("it",argtype) :: encodedExtargs;
2841 ✗ assignedIdents := getAssignedIdents(mapstmts, {});
2842 //oargs = List.filterOnTrue(extargs, isText); //it can be actually Text, but not to be as output stream
2843 ✗ oargs := List.filter1OnTrue(encodedExtargs, isAssignedText, assignedIdents);
2844 oargs := imlicitTxtArg :: oargs;
2845 ✗ mapstmts := listReverse(mapstmts);
2846 //add indexed value if needed
2847 ✗ (mapstmts, maplocals)
2848 := addGetIndex(isUsed, freshIdxName, mapstmts, imlicitTxt, maplocals);
2849
2850 ✗ elabcases := addRestElabCase({(mexp, encodedExtargs, mapstmts)});
2851 ✗ mmmcases := List.map2(elabcases, makeMMMatchCase, encodedExtargs, oargs);
2852 ✗ mapctx := MAP_CONTEXT(ofbind, mapexp, iopts, hasIndexIdentOpt, useiter);
2853 ✗ maplocals := listAppend(encodedExtargs, maplocals);
2854 ✗ maplocals := imlicitTxtArg :: maplocals;
2855 // make fun
2856 ✗ mmFun := MM_FUN(false, fname, iargs, oargs,
2857 maplocals,
2858 { MM_MATCH( mmmcases ) },
2859 GI_MAP_FUN(argtype, mapctx)
2860 );
2861
2862 //add pushIter() if it is the first element of MAP_ARG_LIST (like <[exp1,exp2,...] : mapexp> ) or a simple one (list)exp to be mapped (like <exp of mexp: mapexp>)
2863 ✗ (stmts, intxt) := addPushIter((isfirst and useiter), iopts, stmts, intxt, outtxt);
2864 ✗ extargvals := List.map(localArgs, makeMMArgValue);
2865 //call the elaborated function
2866 ✗ (_, stmt, _, _, locals, intxt)
2867 := statementFromFun(argtomap :: extargvals, IDENT(fname), iargs, oargs, {}, intxt, outtxt, locals, tplPackage, sinfo);
2868
2869 ✗ (stmts, locals, scEnv, accMMDecls, intxt)
2870 := statementsFromMapExp(false, restargs, mapctx, stmt::stmts, intxt, outtxt, locals, scEnv, tplPackage, mmFun :: accMMDecls);
2871 then ( stmts, locals, scEnv, accMMDecls, intxt);
2872
2873 //may fail on error
2874 else
2875 algorithm
2876 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!statementsFromMapExp failed\n");
2877 ✗ then
2878 fail();
2879 end matchcontinue;
2880 end statementsFromMapExp;
2881
2882 public function intersectInOutArgs
2883 input TypedIdents inList1;
2884 input TypedIdents inList2;
2885 output tuple<TypedIdents, TypedIdents, TypedIdents> outIntersectionAndRests;
2886 function areTypedIdentsEqual
2887 input tuple<Ident, TypeSignature> inTypedIdent1;
2888 input tuple<Ident, TypeSignature> inTypedIdent2;
2889 output Boolean equal;
2890 protected
2891 Ident ident1;
2892 Ident ident2;
2893 algorithm
2894 ✗ (ident1, _) := inTypedIdent1;
2895 ✗ (ident2, _) := inTypedIdent2;
2896 ✗ equal := stringEq(ident1, ident2);
2897 end areTypedIdentsEqual;
2898 protected
2899 TypedIdents outIntersection;
2900 TypedIdents outList1Rest;
2901 TypedIdents outList2Rest;
2902 algorithm
2903 ✗ (outIntersection, outList1Rest, outList2Rest) := List.intersection1OnTrue(inList1, inList2, areTypedIdentsEqual);
2904 ✗ outIntersectionAndRests := (outIntersection, outList1Rest, outList2Rest);
2905 end intersectInOutArgs;
2906
2907 public function isTupleListMember "True when an identifier names one of the typed idents in the list."
2908 input Ident inId;
2909 input TypedIdents inList;
2910 output Boolean outIsMember;
2911 algorithm
2912 outIsMember := matchcontinue ()
2913 ✗ case () algorithm lookupTupleList(inList, inId); then true;
2914 else false;
2915 end matchcontinue;
2916 end isTupleListMember;
2917
2918 /*
2919 function isIndexArg
2920 input tuple<Ident, TypeSignature> inArg;
2921 output Boolean outIsIndexArg;
2922 algorithm
2923 outIsIndexArg := match inArg
2924 case ( ("i_i0" , _) ) then true;
2925 case ( ("i_i1" , _) ) then true;
2926 case ( _ ) then false;
2927 end match;
2928 end isIndexArg;
2929 */
2930
2931 public function shouldUseIterFunctions
2932 input Boolean inIsFirstArgToMap;
2933 input Boolean inUseIterLast;
2934 input Boolean inIsListArgToMap;
2935 input Boolean wasIndexVarUsed;
2936 input list<MMEscOption> inIterOptions;
2937 input list<tuple<MMExp, TypeSignature, SourceInfo>> inRestArgValsToMap;
2938
2939 output Boolean outUseIterFuns;
2940 algorithm
2941 outUseIterFuns
2942 := matchcontinue (inIsFirstArgToMap, inUseIterLast, inIsListArgToMap, wasIndexVarUsed, inIterOptions, inRestArgValsToMap)
2943 local
2944 Boolean useiter;
2945 list<MMEscOption> iopts;
2946
2947 //already decided by the first argval to be mapped
2948 case (false, useiter, _, _, _, _)
2949 then useiter;
2950
2951 //- list argument to be mapped,
2952 //- no index var was used,
2953 //- iter options are like these
2954 //then there is no usage of the iteration environment from the user expression
2955 case (true, _, true, false, iopts, _)
2956 algorithm
2957 ✗ iopts := listAppend(iopts, nonSpecifiedIterOptions) annotation(__OpenModelica_DisableListAppendWarning=true);
2958 ✗ (MM_LITERAL("NONE()"),_) := lookupTupleList(iopts, emptyOptionId);
2959 ✗ (MM_LITERAL("NONE()"),_) := lookupTupleList(iopts, separatorOptionId);
2960 ✗ (MM_LITERAL("0"),_) := lookupTupleList(iopts, alignNumOptionId);
2961 ✗ (MM_LITERAL("0"),_) := lookupTupleList(iopts, wrapWidthOptionId);
2962 then false;
2963
2964 //- scalar argument to be mapped,
2965 //- no index var was used,
2966 //- no empty option specified
2967 //- this is the only argument to be mapped
2968 //then there is no usage of the iteration environment from the user expression
2969 case (true, _, false, false, iopts, {})
2970 algorithm
2971 ✗ iopts := listAppend(iopts, nonSpecifiedIterOptions) annotation(__OpenModelica_DisableListAppendWarning=true);
2972 ✗ (MM_LITERAL("NONE()"),_) := lookupTupleList(iopts, emptyOptionId);
2973 then false;
2974
2975 //otherwise use it
2976 else true;
2977
2978 end matchcontinue;
2979 end shouldUseIterFunctions;
2980
2981 /*
2982 public function addNextIter
2983 input Boolean inUseIterFun;
2984 input list<MMExp> inStmts;
2985 input Ident inInText;
2986 input Ident inOutText;
2987
2988 output list<MMExp> outStmts;
2989 output Ident outInText;
2990 algorithm
2991 (outStmts, outInText)
2992 := matchcontinue (inUseIterFun, inStmts, inInText, inOutText)
2993 local
2994 list<MMExp> stmts;
2995 MMExp stmt;
2996 Ident intxt, outtxt;
2997
2998 case ( true, stmts, intxt, outtxt)
2999 algorithm
3000 stmt = tplStatement("nextIter", {}, intxt, outtxt);
3001 then ( stmt :: stmts, outtxt );
3002
3003 case ( false, stmts, intxt, _)
3004 then ( stmts, intxt );
3005
3006 //cannot happen
3007 else
3008 algorithm
3009 true = Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!addNextIter failed\n");
3010 then
3011 fail();
3012 end matchcontinue;
3013 end addNextIter;
3014 */
3015
3016 public function addGetIndex
3017 input Boolean wasIndexUsed;
3018 input Ident inLocalIdxValIdent;
3019 input list<MMExp> inStmts;
3020 input Ident inInText;
3021 input TypedIdents inLocals;
3022
3023 output list<MMExp> outStmts;
3024 output TypedIdents outLocals;
3025 algorithm
3026 (outStmts, outLocals)
3027 := matchcontinue (wasIndexUsed, inLocalIdxValIdent, inStmts, inInText, inLocals)
3028 local
3029 list<MMExp> stmts;
3030 MMExp stmt;
3031 Ident localidxid, intxt;
3032 TypedIdents locals;
3033
3034 // add the getIter_ix() when the ixti is used by mapexp
3035 case ( true, localidxid, stmts, intxt, locals)
3036 algorithm
3037 //true = listMember(ixti, foundIdxArgs);
3038 ✗ stmt := tplStatement("getIteri_i0", {}, intxt, localidxid);
3039 ✗ locals := addLocalValue(localidxid, INTEGER_TYPE(), locals);
3040 then ( stmt :: stmts, locals );
3041
3042 case ( false, _, stmts, _, locals)
3043 then ( stmts, locals);
3044
3045 //should not happen
3046 else
3047 algorithm
3048 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!addGetIndex failed\n");
3049 ✗ then
3050 fail();
3051 end matchcontinue;
3052 end addGetIndex;
3053
3054 public function addPushIter
3055 input Boolean inDoAddPushIter;
3056 input list<MMEscOption> inMMEscOptions;
3057 input list<MMExp> inStmts;
3058 input Ident inInText;
3059 input Ident inOutText;
3060
3061 output list<MMExp> outStmts;
3062 output Ident outInText;
3063 algorithm
3064 (outStmts, outInText)
3065 := matchcontinue (inDoAddPushIter, inMMEscOptions, inStmts, inInText, inOutText)
3066 local
3067 list<MMExp> stmts, mmopts;
3068 MMExp stmt;
3069 Ident intxt, outtxt;
3070 list<MMEscOption> opts;
3071
3072 case ( false, _, stmts, intxt, _)
3073 then ( stmts, intxt );
3074
3075 case ( true, opts, stmts, intxt, outtxt)
3076 algorithm
3077 ✗ (mmopts,_) := makeMMExpOptions(nonSpecifiedIterOptions, opts);
3078 ✗ stmt := tplStatement("pushIter",
3079 { MM_FN_CALL(PATH_IDENT("Tpl", IDENT("ITER_OPTIONS")), mmopts)},
3080 intxt, outtxt);
3081 then ( stmt :: stmts, outtxt );
3082
3083 //cannot happen
3084 else
3085 algorithm
3086 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!addNextIter failed\n");
3087 ✗ then
3088 fail();
3089 end matchcontinue;
3090 end addPushIter;
3091
3092
3093 public function makeMMExpOptions
3094 input list<MMEscOption> inMMEscOptions;
3095 input list<MMEscOption> inSpecifiedMMEscOptions;
3096
3097 output list<MMExp> outMMExpOpts;
3098 output list<MMEscOption> outRestSpecifiedMMExpOpts;
3099 algorithm
3100 (outMMExpOpts, outRestSpecifiedMMExpOpts)
3101 := matchcontinue (inMMEscOptions, inSpecifiedMMEscOptions)
3102 local
3103 list<MMEscOption> rest, specopts;
3104 list<MMExp> mexpOpts;
3105 MMExp mexpopt;
3106 Ident optid;
3107
3108 case ( {}, specopts )
3109 algorithm
3110 ✗ warnIfSomeOptions(specopts);
3111 ✗ then ({}, specopts);
3112
3113 case ( (optid, _) :: rest, specopts )
3114 algorithm
3115 ✗ ((mexpopt,_), specopts) := lookupDeleteTupleList(specopts, optid);
3116 ✗ (mexpOpts, specopts) := makeMMExpOptions(rest, specopts);
3117 ✗ then ((mexpopt :: mexpOpts), specopts);
3118
3119 case ( (_, (mexpopt,_)) :: rest, specopts )
3120 algorithm
3121 //failure( _ = lookupTupleList(specopts, optid));
3122 ✗ (mexpOpts, specopts) := makeMMExpOptions(rest, specopts);
3123 ✗ then ((mexpopt :: mexpOpts), specopts);
3124
3125 //cannot happen
3126 else
3127 algorithm
3128 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!makeMMExpOptions failed\n");
3129 ✗ then
3130 fail();
3131 end matchcontinue;
3132 end makeMMExpOptions;
3133
3134 /*
3135 public function mmexpFromStrTokOption
3136 input Option<StringToken> inStrTokOption;
3137 output MMExp outMMExp;
3138 algorithm
3139 outMMExp := match inStrTokOption
3140 local
3141 StringToken st;
3142
3143 case NONE()
3144 then MM_LITERAL("NONE()");
3145
3146 case ( SOME(st) )
3147 then MM_FN_CALL(IDENT("SOME"), { MM_STR_TOKEN(st) });
3148
3149 end match;
3150 end mmexpFromStrTokOption;
3151 */
3152
3153 //fail and error
3154 public function makeMatchFun
3155 input tuple<MMExp, TypeSignature, SourceInfo> inArgval;
3156 input list<tuple<MatchingExp,Expression>> inMCases;
3157 input Expression inArgExp "only to identify the original argument name when argument is a bound value";
3158 input Boolean hasImplicitLookup;
3159 input ScopeEnv inScopeEnv;
3160 input TemplPackage inTplPackage;
3161 input list<MMDeclaration> inAccMMDecls;
3162
3163 output list<tuple<MMExp, TypeSignature, SourceInfo>> outArgvals;
3164 output PathIdent outFunName;
3165 output TypedIdents outInArgs;
3166 output TypedIdents outOutArgs;
3167 output ScopeEnv outScopeEnv;
3168 output list<MMDeclaration> outMMDecls;
3169
3170 algorithm
3171 (outArgvals, outFunName, outInArgs, outOutArgs, outScopeEnv, outMMDecls)
3172 := matchcontinue (inArgval, inMCases, inScopeEnv, inTplPackage, inAccMMDecls)
3173 local
3174 ScopeEnv scEnv;
3175 tuple<MMExp, TypeSignature, SourceInfo> argval;
3176 list<tuple<MMExp, TypeSignature, SourceInfo>> argvals;
3177 MMExp mmexp;
3178 TypeSignature exptype;
3179 TypedIdents iargs, oargs, extargs, localArgs, encodedExtargs, funLocals;
3180 list<tuple<MatchingExp,Expression>> mcases;
3181 list<tuple<MatchingExp, TypedIdents, list<MMExp>>> elabcases;
3182 list<MMMatchCase> mmmcases;
3183 TemplPackage tplPackage;
3184 list<MMDeclaration> accMMDecls;
3185 MMDeclaration mmFun;
3186 Ident fname, matchArgName, implicitValueName;
3187 list<Ident> assignedIdents;
3188
3189 case (argval as (mmexp, exptype, _), mcases, scEnv, tplPackage, accMMDecls)
3190 algorithm
3191 //TODO: when mmexp is an identifier, it should be made available through implicit context
3192 //so we will prepend it before each mexp in every case (instead 'it')
3193 //then, mexps should be cleaned off the unused bindings ??....
3194 //this is not critical, the value will be now passed as another parameter (a duplicity value)
3195 ✗ (implicitValueName, matchArgName) := getMatchArgName(inArgExp); //path -> pathString encoded ident
3196 ✗ (elabcases, funLocals, (FUN_SCOPE(extargs,localArgs) :: scEnv), accMMDecls, assignedIdents)
3197 := elabMatchCases((mmexp, exptype) /*argval*/, implicitValueName, mcases, hasImplicitLookup, {}, {}, (FUN_SCOPE( {},{} ) :: scEnv), tplPackage, accMMDecls);
3198 ✗ elabcases := addRestElabCase(elabcases);
3199 ✗ (extargs, localArgs) := alignExtArgsToScopeEnv(extargs, localArgs, scEnv); //order the args by the upper scope -> when the match function will be pulled to the top-level, the arguments must be ordered the same way ... MM stuff
3200
3201 ✗ encodedExtargs := List.map1(extargs, encodeTypedIdent, funArgNamePrefix);
3202
3203 ✗ iargs := imlicitTxtArg :: (matchArgName, exptype) :: encodedExtargs;
3204
3205 ✗ oargs := List.filter1OnTrue(encodedExtargs, isAssignedText, assignedIdents);
3206 oargs := imlicitTxtArg :: oargs;
3207
3208 ✗ funLocals := listAppend(encodedExtargs, funLocals);
3209
3210 ✗ mmmcases := List.map2(elabcases, makeMMMatchCase, encodedExtargs, oargs);
3211 ✗ fname := stringAppend(matchFunPrefix, intString(listLength(accMMDecls)));
3212 ✗ mmFun := MM_FUN(false, fname, iargs, oargs,
3213 imlicitTxtArg :: funLocals,
3214 { MM_MATCH(mmmcases) },
3215 GI_MATCH_FUN()
3216 );
3217 ✗ argvals := List.map(localArgs, makeMMArgValue);
3218 argvals := argval :: argvals;
3219 ✗ then ( argvals, IDENT(fname), iargs, oargs, scEnv, (mmFun :: accMMDecls));
3220
3221 else
3222 algorithm
3223 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!makeMatchFun failed\n");
3224 ✗ then
3225 fail();
3226 end matchcontinue;
3227 end makeMatchFun;
3228
3229 //no fail
3230 public function alignExtArgsToScopeEnv
3231 input TypedIdents inExtraArgs;
3232 input TypedIdents inEncExtraArgs;
3233 input ScopeEnv inScopeEnv;
3234
3235 output TypedIdents outExtraArgs;
3236 output TypedIdents outEncExtraArgs;
3237 algorithm
3238 (outExtraArgs,outEncExtraArgs) :=
3239 matchcontinue (inExtraArgs, inEncExtraArgs, inScopeEnv)
3240 local
3241 TypedIdents extargs, encExtargs, extargsAligned, encExtargsAligned, fargs, localArgs;
3242
3243 case ( extargs, encExtargs,
3244 FUN_SCOPE(args = fargs, localArgs = localArgs) :: _)
3245 algorithm
3246 ✗ extargsAligned := alignTupleList(extargs, fargs);
3247 ✗ encExtargsAligned := alignTupleList(encExtargs, localArgs);
3248 //assure no lost of arguments, all extra args must come from the function call that takes the args from its args
3249 ✗ true := (listLength(extargsAligned) == listLength(extargs));
3250 ✗ true := (listLength(encExtargsAligned) == listLength(encExtargs));
3251 then (extargsAligned, encExtargsAligned);
3252
3253 else (inExtraArgs,inEncExtraArgs);
3254
3255 end matchcontinue;
3256 end alignExtArgsToScopeEnv;
3257
3258 //no fail
3259 public function getMatchArgName "to enable 'routing' of values via match function argument - preventing unnecessary additional extra arguments"
3260 input Expression inArgExp;
3261 output Ident outInputValueName;
3262 output Ident outMatchArgName;
3263 algorithm
3264 (outInputValueName, outMatchArgName)
3265 := matchcontinue inArgExp
3266 local
3267 PathIdent path;
3268 case (BOUND_VALUE(path), _)
3269 algorithm
3270 ✗ outInputValueName := pathIdentString(path);
3271 ✗ outMatchArgName := encodeIdent(outInputValueName, funArgNamePrefix);
3272 then (outInputValueName, outMatchArgName);
3273 else
3274 (impossibleIdent, matchDefaultArgName);
3275 end matchcontinue;
3276 end getMatchArgName;
3277
3278 //no fail
3279 public function makeMMArgValue
3280 input tuple<Ident,TypeSignature> inTypedIdent;
3281 output tuple<MMExp, TypeSignature, SourceInfo> outArgValue;
3282 algorithm
3283 outArgValue := match inTypedIdent
3284 local
3285 Ident argname;
3286 TypeSignature ts;
3287
3288 ✗ case (argname, ts) then ( (MM_IDENT(IDENT(argname)) , ts, dummySourceInfo) );
3289
3290 end match;
3291 end makeMMArgValue;
3292
3293
3294 public function isText
3295 input tuple<Ident, TypeSignature> inArg;
3296 output Boolean outB;
3297 algorithm
3298 outB := match inArg
3299 case (_ , TEXT_TYPE())
3300 then true;
3301 else false;
3302 end match;
3303 end isText;
3304
3305 protected function isAssignedText
3306 input tuple<Ident, TypeSignature> inArg;
3307 input list<Ident> inAssignedTexts;
3308 output Boolean outB;
3309 algorithm
3310 outB := match(inArg, inAssignedTexts)
3311 local
3312 Ident ident;
3313 list<Ident> assignedTexts;
3314 case ( (ident , TEXT_TYPE()), assignedTexts )
3315 guard
3316 listMember(ident,assignedTexts)
3317 then true;
3318 else false;
3319 end match;
3320 end isAssignedText;
3321
3322
3323 public function elabMatchCases
3324 input tuple<MMExp, TypeSignature> inItArgVal;
3325 input Ident inImplicitValueName;
3326 input list<tuple<MatchingExp,Expression>> inMCases;
3327 input Boolean hasImplicitLookup;
3328 input TypedIdents inLocals;
3329 input TypedIdents inAccCaseLocals;
3330 input ScopeEnv inScopeEnv;
3331 input TemplPackage inTplPackage;
3332 input list<MMDeclaration> inAccMMDecls;
3333
3334 output list<tuple<MatchingExp, TypedIdents, list<MMExp>>> outMMMCases;
3335 output TypedIdents outLocals;
3336 output ScopeEnv outScopeEnv;
3337 output list<MMDeclaration> outMMDecls;
3338 output list<Ident> outAssignedIdents;
3339 algorithm
3340 (outMMMCases, outLocals, outScopeEnv, outMMDecls, outAssignedIdents)
3341 := matchcontinue (inItArgVal, inMCases, inLocals, inAccCaseLocals, inScopeEnv, inTplPackage, inAccMMDecls)
3342 local
3343 ScopeEnv scEnv;
3344 TypedIdents locals, accCaseLocals;
3345 TypeSignature exptype;
3346 TypedIdents extargs;
3347 list<tuple<MatchingExp,Expression>> mcases;
3348 MatchingExp mexp;
3349 Expression exp;
3350 list<tuple<MatchingExp, TypedIdents, list<MMExp>>> elabcases;
3351 TemplPackage tplPackage;
3352 list<ASTDef> astdefs;
3353 list<MMDeclaration> accMMDecls;
3354 list<MMExp> stmts;
3355 tuple<MMExp, TypeSignature> argval;
3356 list<Ident> assignedIdents;
3357 list<tuple<Ident, Ident>> localNames;
3358
3359 case (_, {}, locals, _, scEnv, _, accMMDecls)
3360 algorithm
3361 ✗ locals := listAppend(inAccCaseLocals, locals);
3362 ✗ then
3363 ( {}, locals, scEnv, accMMDecls, {});
3364
3365 case (argval as (_, exptype), (mexp,exp) :: mcases, locals, accCaseLocals, scEnv, tplPackage as TEMPL_PACKAGE(astDefs = astdefs), accMMDecls)
3366 algorithm
3367 ✗ mexp := typeCheckMatchingExp(mexp, exptype, astdefs);
3368 //mexp = encodeMatchingExp(mexp);
3369 //matchLocalArgName = getMatchArgName(mmexp);
3370 ✗ (stmts, locals, scEnv, accMMDecls, _)
3371 := statementsFromExp(exp,{}, {}, imlicitTxt, imlicitTxt, locals,
3372 (CASE_SCOPE(mexp, exptype, {}, accCaseLocals, {}, inImplicitValueName, hasImplicitLookup) :: scEnv), tplPackage, accMMDecls);
3373 ✗ CASE_SCOPE(mexp, _, localNames, accCaseLocals, extargs, _, _) :: scEnv := scEnv; //releaseImmediateLocalScope(scEnv);
3374 ✗ stmts := listReverse(stmts);
3375 //TODO: locals can be gathered with introduction of another function scope
3376 //and then to see what was used, the rest can be eliminated with the typecheck function
3377 //--->
3378 ✗ (mexp, _) := rewriteMatchExpByLocalNames(mexp, exptype, localNames, {}, astdefs);
3379 //(locals, mexp) = localsFromMatchExp(mexp, exptype, locals, astdefs);
3380 ✗ (elabcases, locals, scEnv, accMMDecls, assignedIdents)
3381 := elabMatchCases(argval, inImplicitValueName, mcases, hasImplicitLookup, locals, accCaseLocals, scEnv, tplPackage, accMMDecls );
3382 ✗ assignedIdents := getAssignedIdents(stmts, assignedIdents);
3383 ✗ then
3384 ( (mexp, extargs, stmts) :: elabcases, locals, scEnv, accMMDecls, assignedIdents);
3385
3386 else
3387 algorithm
3388 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!elabMatchCases failed\n");
3389 ✗ then
3390 fail();
3391 end matchcontinue;
3392 end elabMatchCases;
3393
3394
3395 public function getAssignedIdents
3396 input list<MMExp> inStatements;
3397 input list<Ident> inAssignedIdents;
3398
3399 output list<Ident> outAssignedIdents;
3400 algorithm
3401 outAssignedIdents
3402 := matchcontinue (inStatements, inAssignedIdents)
3403 local
3404 list<MMExp> stmts;
3405 list<Ident> assignedIdents, largs;
3406
3407 case ( {}, assignedIdents)
3408 then
3409 ( assignedIdents);
3410
3411 case ( MM_ASSIGN(lhsArgs = largs) :: stmts, assignedIdents)
3412 algorithm
3413 ✗ assignedIdents := List.fold(largs, List.unionElt, assignedIdents);
3414 ✗ then
3415 getAssignedIdents(stmts, assignedIdents);
3416
3417 case ( _ :: stmts, assignedIdents)
3418 ✗ then
3419 getAssignedIdents(stmts, assignedIdents);
3420
3421 else
3422 algorithm
3423 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!getAssignedTexts failed\n");
3424 ✗ then
3425 fail();
3426 end matchcontinue;
3427 end getAssignedIdents;
3428
3429 /*
3430 public function getItNameFromArg
3431 input MMExp inItArgMMExp;
3432 input TypeSignature inMType;
3433 input MatchingExp inMatchingExp;
3434 input list<ASTDef> inASTDefs;
3435
3436 output Ident outItName;
3437 algorithm
3438 outItName := matchcontinue (inItArgMMExp, inMType, inMatchingExp, inASTDefs)
3439 local
3440 TypeSignature exptype;
3441 MatchingExp mexp;
3442 list<ASTDef> astdefs;
3443 MMExp mmexp;
3444 PathIdent path;
3445 Ident argid;
3446
3447 //name it by the arg name if the name is not bound
3448 case ( MM_IDENT(path as IDENT(argid)), exptype, mexp, astdefs)
3449 algorithm
3450 //only when the argid is not yet bound by the user to do it explicit or hide the name from the upper scope
3451 failure( (_,_) = lookupUpdateMatchingExp(argid, path, mexp, exptype, astdefs) );
3452 then
3453 argid;
3454
3455 //otherwise return "it" as the name
3456 else "it";
3457
3458 end matchcontinue;
3459 end getItNameFromArg;
3460 */
3461
3462 //fail and error
3463 public function typeCheckMatchingExp
3464 input MatchingExp inMatchingExp;
3465 input TypeSignature inMType;
3466 input list<ASTDef> inASTDefs;
3467
3468 output MatchingExp outTransformedMatchingExp;
3469 algorithm
3470 outTransformedMatchingExp
3471 := matchcontinue (inMatchingExp, inMType, inASTDefs)
3472 local
3473 Ident bid;
3474 PathIdent tagpath;
3475 TypeSignature mtype, ot;
3476 list<TypeSignature> otLst;
3477 MatchingExp mexp, restmexp;
3478 list<MatchingExp> mexpLst;
3479 list<tuple<String, MatchingExp>> fms;
3480 TypedIdents fields;
3481 list<ASTDef> astDefs;
3482
3483 case ( BIND_AS_MATCH(
3484 bindIdent = bid,
3485 matchingExp = mexp ), mtype, astDefs)
3486 algorithm
3487 ✗ mexp := typeCheckMatchingExp(mexp, mtype, astDefs);
3488 ✗ then
3489 (BIND_AS_MATCH(bid, mexp));
3490
3491 //try if it is a record ident
3492 //-> convert to RECORD_MATCH()
3493 /*
3494 case ( BIND_MATCH(bindIdent = bid), mtype, astDefs)
3495 algorithm
3496 NAMED_TYPE(typepath) = deAliasedType(mtype, astDefs);
3497 (typepckgOpt, typeident) = splitPackageAndIdent(typepath);
3498 (typepckg, typeinfo) = getTypeInfo(typepckgOpt, typeident, astDefs);
3499 isRecordTag(bid, typeinfo, typeident);
3500 tagpath = makePathIdent(typepckg, bid);
3501 then
3502 (RECORD_MATCH(tagpath, {} ));
3503 */
3504
3505 //otherwise it is like REST_MATCH ... nothing to check
3506 case ( mexp as BIND_MATCH(), _, _)
3507 then
3508 mexp;
3509
3510 //TODO: a HACK!!; this only can happen for "if" condition with a TEXT argument to be tested for emptiness
3511 case ( mexp as RECORD_MATCH(), TEXT_TYPE(), _ )
3512 then
3513 mexp;
3514
3515 case ( RECORD_MATCH(
3516 tagName = tagpath,
3517 fieldMatchings = fms ),
3518 mtype, astDefs )
3519 algorithm
3520 ✗ mtype := deAliasedType(mtype, astDefs);
3521 ✗ (fields, tagpath) := getFieldsForRecord(mtype, tagpath, astDefs);
3522 ✗ fms := typeCheckMatchingExpRecord(fms, fields, astDefs);
3523 ✗ then
3524 RECORD_MATCH(tagpath, fms);
3525
3526 case ( SOME_MATCH(
3527 value = mexp ), mtype, astDefs)
3528 algorithm
3529 ✗ OPTION_TYPE(ofType = mtype) := deAliasedType(mtype, astDefs);
3530 ✗ mexp := typeCheckMatchingExp(mexp, mtype, astDefs);
3531 ✗ then
3532 SOME_MATCH(mexp);
3533
3534 // TODO - failure message when not Option
3535 case ( mexp as NONE_MATCH(), mtype, astDefs)
3536 algorithm
3537 ✗ OPTION_TYPE() := deAliasedType(mtype, astDefs);
3538 then
3539 mexp;
3540
3541 // TODO - failure message when not Tuple / not the same length
3542 case ( TUPLE_MATCH(
3543 tupleArgs = mexpLst),
3544 mtype, astDefs )
3545 algorithm
3546 ✗ TUPLE_TYPE(ofTypes = otLst) := deAliasedType(mtype, astDefs);
3547 //equality( listLength(mexpLst) = listLength(otLst) );
3548 ✗ mexpLst := typeCheckMatchingExpList(mexpLst, otLst, astDefs);
3549 ✗ then
3550 TUPLE_MATCH(mexpLst);
3551
3552 // TODO - failure message when not List
3553 case ( LIST_MATCH(
3554 listElts = mexpLst),
3555 mtype, astDefs )
3556 algorithm
3557 ✗ LIST_TYPE(ofType = ot) := deAliasedType(mtype, astDefs);
3558 ✗ otLst := List.fill(ot, listLength(mexpLst));
3559 ✗ mexpLst := typeCheckMatchingExpList(mexpLst, otLst, astDefs);
3560 ✗ then
3561 LIST_MATCH(mexpLst);
3562
3563 // TODO - failure message when not List
3564 case ( LIST_CONS_MATCH(
3565 head = mexp,
3566 rest = restmexp),
3567 mtype, astDefs )
3568 algorithm
3569 ✗ mtype := deAliasedType(mtype, astDefs);
3570 ✗ LIST_TYPE(ofType = ot) := mtype;
3571 ✗ mexp := typeCheckMatchingExp(mexp, ot, astDefs);
3572 ✗ restmexp := typeCheckMatchingExp(restmexp, mtype, astDefs);
3573 ✗ then
3574 LIST_CONS_MATCH(mexp, restmexp);
3575
3576 // TODO - failure message when not equal types
3577 case ( mexp as STRING_MATCH(),
3578 mtype, astDefs )
3579 algorithm
3580 ✗ STRING_TYPE() := deAliasedType(mtype, astDefs);
3581 then
3582 mexp;
3583
3584 // TODO - failure message when not equal types
3585 case ( mexp as LITERAL_MATCH(litType = ot),
3586 mtype, astDefs )
3587 algorithm
3588 ✗ typesEqualConcrete(deAliasedType(ot, astDefs), deAliasedType(mtype, astDefs), astDefs);
3589 then
3590 mexp;
3591
3592 case ( mexp as REST_MATCH(), _, _)
3593 then
3594 mexp;
3595
3596
3597 // ** failures ***
3598 //TODO: will be concrete with output message
3599
3600 else
3601 algorithm
3602 //locals = addLocalValue("#Error - type check#", mtype, locals);
3603 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - typeCheckMatchingExp failed\n");
3604 ✗ then
3605 fail();
3606
3607 end matchcontinue;
3608 end typeCheckMatchingExp;
3609
3610
3611 public function typeCheckMatchingExpRecord
3612 input list<tuple<Ident, MatchingExp>> inFieldMatchings;
3613 input TypedIdents fields;
3614 input list<ASTDef> inASTDefs;
3615
3616 output list<tuple<Ident, MatchingExp>> outTransformedMatchingExp;
3617 algorithm
3618 outTransformedMatchingExp
3619 := matchcontinue (inFieldMatchings, inASTDefs)
3620 local
3621 Ident ident;
3622 MatchingExp mexp;
3623 TypeSignature mtype;
3624 list<tuple<Ident, MatchingExp>> fms;
3625 list<ASTDef> astDefs;
3626
3627 case ({}, _)
3628 then
3629 {};
3630
3631 case ((ident, mexp) :: fms, astDefs)
3632 algorithm
3633 ✗ mtype := lookupTupleList(fields, ident);
3634 ✗ mexp := typeCheckMatchingExp(mexp, mtype, astDefs);
3635 ✗ fms := typeCheckMatchingExpRecord(fms, fields, astDefs);
3636 ✗ then
3637 ((ident, mexp) :: fms);
3638
3639 case ((ident, _) :: _, _)
3640 algorithm
3641 ✗ true := Flags.isSet(Flags.FAILTRACE);
3642 ✗ failure( lookupTupleList(fields, ident) );
3643 //reason = "#Error - unresolved type - cannot find field '" + ident + "'#";
3644 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - typeCheckMatchingExpRecord failed to find field '" + ident + "'\n");
3645 //(locals, fms) = localsFromMatchExpAndTypeCheckRecord(fms, fields, locals, astDefs);
3646 ✗ then
3647 fail();
3648 //(locals, (ident, mexp) :: fms);
3649
3650 // can fail on error
3651 /*
3652 case (_,_,_)
3653 algorithm
3654 true = Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!localsFromMatchExpAndTypeCheckRecord failed\n");
3655 then
3656 fail();
3657 */
3658 end matchcontinue;
3659 end typeCheckMatchingExpRecord;
3660
3661
3662 public function typeCheckMatchingExpList
3663 input list<MatchingExp> inMatchingExpLst;
3664 input list<TypeSignature> inTypeLst;
3665 input list<ASTDef> inASTDefs;
3666
3667 output list<MatchingExp> outTransformedMatchingExp;
3668 algorithm
3669 outTransformedMatchingExp
3670 := match (inMatchingExpLst, inTypeLst, inASTDefs)
3671 local
3672 MatchingExp mexp;
3673 list<MatchingExp> mexpLst;
3674 TypeSignature mtype;
3675 list<TypeSignature> tsLst;
3676
3677 list<ASTDef> astDefs;
3678
3679 case ( {}, {}, _)
3680 then
3681 {};
3682
3683 case ( mexp :: mexpLst, mtype :: tsLst, astDefs)
3684 algorithm
3685 ✗ mexp := typeCheckMatchingExp(mexp, mtype, astDefs);
3686 ✗ mexpLst := typeCheckMatchingExpList(mexpLst, tsLst, astDefs);
3687 then
3688 (mexp :: mexpLst);
3689
3690 case ( (_ :: _), {}, _)
3691 algorithm
3692 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - typeCheckMatchingExpList more expressions to chceck than required (a tuple type has less arguments than provided?).\n");
3693 ✗ then
3694 fail();
3695
3696 case ( {}, _ :: _, _)
3697 algorithm
3698 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - typeCheckMatchingExpList more arguments expected (the tuple type has more arguments than provided).\n");
3699 ✗ then
3700 fail();
3701
3702 // can fail on error
3703 /*
3704 case (_,_,_,_)
3705 algorithm
3706 true = Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!localsFromMatchExpAndTypeCheckList failed\n");
3707 then
3708 fail();
3709 */
3710 end match;
3711 end typeCheckMatchingExpList;
3712
3713 public function eliminateWildAs
3714 input MatchingExp inMatchingExp;
3715
3716 output MatchingExp outRewrittenMatchingExp;
3717 algorithm
3718 outRewrittenMatchingExp := match inMatchingExp
3719 local
3720 Ident bid;
3721
3722 ✗ case BIND_AS_MATCH(bid, REST_MATCH()) then BIND_MATCH(bid);
3723 else inMatchingExp;
3724
3725 end match;
3726 end eliminateWildAs;
3727
3728 public function rewriteMatchExpByLocalNames
3729 input MatchingExp inMatchingExp;
3730 input TypeSignature inMType;
3731 input list<tuple<Ident, Ident>> inLocalNames;
3732 input TypedIdents inUsedLocals "accumulated list of already rewrited locals - to check duplicitly bound names";
3733 input list<ASTDef> inASTDefs;
3734
3735 output MatchingExp outRewrittenMatchingExp;
3736 output TypedIdents outUsedLocals;
3737 algorithm
3738 (outRewrittenMatchingExp, outUsedLocals)
3739 := matchcontinue (inMatchingExp, inMType, inUsedLocals, inASTDefs)
3740 local
3741 Ident bid, fldId, localIdent;
3742 PathIdent tagpath;
3743 TypeSignature mtype, ot;
3744 list<TypeSignature> otLst;
3745 MatchingExp mexp, restmexp;
3746 list<MatchingExp> mexpLst;
3747 list<tuple<String, MatchingExp>> fms;
3748 TypedIdents fields, usedLocals;
3749 list<ASTDef> astDefs;
3750
3751 case (BIND_AS_MATCH(
3752 bindIdent = bid,
3753 matchingExp = mexp ), mtype, usedLocals, astDefs)
3754 algorithm
3755 ✗ localIdent := lookupTupleList(inLocalNames, bid);
3756 //TODO: a better error report - non stopping one here
3757 ✗ usedLocals := addLocalValue(bid, mtype, usedLocals);
3758 ✗ (mexp, usedLocals) := rewriteMatchExpByLocalNames(mexp, mtype, inLocalNames, usedLocals, astDefs);
3759 ✗ mexp := eliminateWildAs( BIND_AS_MATCH(localIdent, mexp) );
3760 ✗ then
3761 (mexp, usedLocals);
3762
3763 //eliminate the non-used binding
3764 case (BIND_AS_MATCH(
3765 bindIdent = bid,
3766 matchingExp = mexp ), mtype, usedLocals, astDefs)
3767 algorithm
3768 ✗ failure(lookupTupleList(inLocalNames, bid));
3769 ✗ (mexp, usedLocals) := rewriteMatchExpByLocalNames(mexp, mtype, inLocalNames, usedLocals, astDefs);
3770 then
3771 (mexp, usedLocals);
3772
3773 case (BIND_MATCH(bindIdent = bid), mtype, usedLocals, _)
3774 algorithm
3775 ✗ localIdent := lookupTupleList(inLocalNames, bid);
3776 //TODO: a better error report - use match expression source info
3777 ✗ usedLocals := addLocalValue(bid, mtype, usedLocals);
3778 ✗ then
3779 (BIND_MATCH(localIdent), usedLocals);
3780
3781 //eliminate the non-used binding
3782 case (BIND_MATCH(bindIdent = bid), _, usedLocals, _)
3783 algorithm
3784 ✗ failure(lookupTupleList(inLocalNames, bid));
3785 ✗ then
3786 (REST_MATCH(), usedLocals);
3787
3788 // a record with some fields is matched but no fields were used
3789 //-> adjust it to match the first field with "_" to obey MM semantics
3790 //TODO: when bootstrapped MM, make it (__) matching
3791 case (RECORD_MATCH(
3792 tagName = tagpath,
3793 fieldMatchings = {} ), mtype, usedLocals, astDefs)
3794 algorithm
3795 ✗ mtype := deAliasedType(mtype, astDefs);
3796 ✗ ((fldId,_)::_, tagpath) := getFieldsForRecord(mtype, tagpath, astDefs);
3797 ✗ then
3798 (RECORD_MATCH(tagpath, {(fldId, REST_MATCH())} ), usedLocals);
3799
3800 case (RECORD_MATCH(
3801 tagName = tagpath,
3802 fieldMatchings = fms ), mtype, usedLocals, astDefs)
3803 algorithm
3804 ✗ mtype := deAliasedType(mtype, astDefs);
3805 ✗ (fields, tagpath) := getFieldsForRecord(mtype, tagpath, astDefs);
3806 ✗ (fms, usedLocals) := rewriteMatchExpByLocalNamesRecord(fms, fields, inLocalNames, usedLocals, astDefs);
3807 ✗ then
3808 (RECORD_MATCH(tagpath, fms ), usedLocals);
3809
3810 case (SOME_MATCH(
3811 value = mexp ), mtype, usedLocals, astDefs)
3812 algorithm
3813 ✗ OPTION_TYPE(ofType = mtype) := deAliasedType(mtype, astDefs);
3814 ✗ (mexp, usedLocals) := rewriteMatchExpByLocalNames(mexp, mtype, inLocalNames, usedLocals, astDefs);
3815 ✗ then
3816 (SOME_MATCH(mexp), usedLocals);
3817
3818 case (TUPLE_MATCH(
3819 tupleArgs = mexpLst), mtype, usedLocals, astDefs)
3820 algorithm
3821 ✗ TUPLE_TYPE(ofTypes = otLst) := deAliasedType(mtype, astDefs);
3822 //equality( listLength(mexpLst) = listLength(otLst) );
3823 ✗ (mexpLst, usedLocals) := rewriteMatchExpByLocalNamesList(mexpLst, otLst, inLocalNames, usedLocals, astDefs);
3824 ✗ then
3825 (TUPLE_MATCH(mexpLst), usedLocals);
3826
3827 case (LIST_MATCH(
3828 listElts = mexpLst), mtype, usedLocals, astDefs)
3829 algorithm
3830 ✗ LIST_TYPE(ofType = ot) := deAliasedType(mtype, astDefs);
3831 ✗ otLst := List.fill(ot, listLength(mexpLst));
3832 ✗ (mexpLst, usedLocals) := rewriteMatchExpByLocalNamesList(mexpLst, otLst, inLocalNames, usedLocals, astDefs);
3833 ✗ then
3834 (LIST_MATCH(mexpLst), usedLocals);
3835
3836 case (LIST_CONS_MATCH(
3837 head = mexp,
3838 rest = restmexp), mtype, usedLocals, astDefs)
3839 algorithm
3840 ✗ mtype := deAliasedType(mtype, astDefs);
3841 ✗ LIST_TYPE(ofType = ot) := mtype;
3842 ✗ (mexp, usedLocals) := rewriteMatchExpByLocalNames(mexp, ot, inLocalNames, usedLocals, astDefs);
3843 ✗ (restmexp, usedLocals) := rewriteMatchExpByLocalNames(restmexp, mtype, inLocalNames, usedLocals, astDefs);
3844 ✗ then
3845 (LIST_CONS_MATCH(mexp, restmexp), usedLocals);
3846
3847 // the rest - NONE_MATCH, STRING_MATCH, LITERAL_MATCH, REST_MATCH
3848 case (mexp, _, usedLocals, _)
3849 ✗ then
3850 (mexp, usedLocals);
3851
3852 //TODO: error reporting is not complete here
3853 //-> it must be done through Error to actually catch the duplicity errors
3854
3855
3856 end matchcontinue;
3857 end rewriteMatchExpByLocalNames;
3858
3859
3860 public function rewriteMatchExpByLocalNamesRecord
3861 input list<tuple<Ident, MatchingExp>> inFieldMatchings;
3862 input TypedIdents fields;
3863 input list<tuple<Ident, Ident>> inLocalNames;
3864 input TypedIdents inUsedLocals "accumulated list of already rewrited locals - to check duplicitly bound names";
3865 input list<ASTDef> inASTDefs;
3866
3867 output list<tuple<Ident, MatchingExp>> outRewrittenMatchingExp;
3868 output TypedIdents outUsedLocals;
3869 algorithm
3870 (outRewrittenMatchingExp, outUsedLocals)
3871 := matchcontinue (inFieldMatchings, inUsedLocals, inASTDefs)
3872 local
3873 Ident ident;
3874 MatchingExp mexp;
3875 TypeSignature mtype;
3876 list<tuple<Ident, MatchingExp>> fms;
3877 TypedIdents usedLocals;
3878 list<ASTDef> astDefs;
3879
3880 case ({}, _, _)
3881 then
3882 ({}, inUsedLocals);
3883
3884 case ((ident, mexp) :: fms, usedLocals, astDefs)
3885 algorithm
3886 ✗ mtype := lookupTupleList(fields, ident);
3887 ✗ (mexp, usedLocals) := rewriteMatchExpByLocalNames(mexp, mtype, inLocalNames, usedLocals, astDefs);
3888 ✗ (fms, usedLocals) := rewriteMatchExpByLocalNamesRecord(fms, fields, inLocalNames, usedLocals, astDefs);
3889 ✗ then
3890 ((ident, mexp) :: fms, usedLocals);
3891
3892 //TODO: should we report an error here? ... perhaps, only internal as the mexp shpuld be already checked
3893 case ((ident, mexp) :: fms, usedLocals, astDefs)
3894 algorithm
3895 ✗ failure( lookupTupleList(fields, ident) );
3896 //locals = addLocalValue(ident, UNRESOLVED_TYPE(reason), locals);
3897 ✗ if Flags.isSet(Flags.FAILTRACE) then
3898 ✗ Debug.trace("Error - rewriteMatchExpByLocalNamesRecord failed to find field '" + ident + "'\n");
3899 end if;
3900 ✗ (fms, usedLocals) := rewriteMatchExpByLocalNamesRecord(fms, fields, inLocalNames, usedLocals, astDefs);
3901 ✗ then
3902 ((ident, mexp) :: fms, usedLocals);
3903
3904 // should not ever happen
3905 else
3906 algorithm
3907 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!rewriteMatchExpByLocalNamesRecord failed\n");
3908 ✗ then
3909 fail();
3910
3911 end matchcontinue;
3912 end rewriteMatchExpByLocalNamesRecord;
3913
3914
3915 public function rewriteMatchExpByLocalNamesList
3916 input list<MatchingExp> inMatchingExpLst;
3917 input list<TypeSignature> inTypeLst;
3918 input list<tuple<Ident, Ident>> inLocalNames;
3919 input TypedIdents inUsedLocals "accumulated list of already rewrited locals - to check duplicitly bound names";
3920 input list<ASTDef> inASTDefs;
3921
3922 output list<MatchingExp> outRewrittenMatchingExp;
3923 output TypedIdents outUsedLocals;
3924 algorithm
3925 (outRewrittenMatchingExp, outUsedLocals)
3926 := matchcontinue (inMatchingExpLst, inTypeLst, inUsedLocals, inASTDefs)
3927 local
3928 MatchingExp mexp;
3929 list<MatchingExp> mexpLst;
3930 TypeSignature mtype;
3931 list<TypeSignature> tsLst;
3932
3933 TypedIdents usedLocals;
3934 list<ASTDef> astDefs;
3935
3936 case ({}, {}, usedLocals, _)
3937 then
3938 ({}, usedLocals);
3939
3940 case (mexp :: mexpLst, mtype :: tsLst, usedLocals, astDefs)
3941 algorithm
3942 ✗ (mexp, usedLocals) := rewriteMatchExpByLocalNames(mexp, mtype, inLocalNames, usedLocals, astDefs);
3943 ✗ (mexpLst, usedLocals) := rewriteMatchExpByLocalNamesList(mexpLst, tsLst, inLocalNames, usedLocals, astDefs);
3944 ✗ then
3945 (mexp :: mexpLst, usedLocals);
3946
3947 // should not ever happen - when type check was successful
3948 else
3949 algorithm
3950 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!localsFromMatchExpList failed\n");
3951 ✗ then
3952 fail();
3953
3954 end matchcontinue;
3955 end rewriteMatchExpByLocalNamesList;
3956
3957
3958 public function addLocalValue
3959 input Ident inIdent;
3960 input TypeSignature inMType;
3961 //input SourceInfo sinfo;
3962 input TypedIdents inLocals;
3963
3964 output TypedIdents outLocals;
3965 algorithm
3966 outLocals := matchcontinue (inIdent, inMType, inLocals)
3967 local
3968 Ident ident;
3969 TypeSignature mtype;
3970 TypedIdents locals;
3971 String msg;
3972
3973 // special case when no local statement where added to an empty text
3974 case ( ident, TEXT_TYPE(), locals)
3975 algorithm
3976 ✗ true := stringEq(ident, emptyTxt);
3977 ✗ then
3978 locals;
3979
3980 case ( ident, mtype, locals)
3981 algorithm
3982 ✗ failure( lookupTupleList(locals, ident) );
3983 ✗ then
3984 ((ident, mtype) :: locals);
3985
3986 case ( ident, mtype, locals)
3987 algorithm
3988 ✗ lookupTupleList(locals, ident);
3989 ✗ msg := "A duplicite identifier '" + ident + "' bound in a matching expression.";
3990 ✗ addSusanError(msg, dummySourceInfo); //TODO: Match expressions source info here
3991 //true = Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - (addLocalValue) a duplicite identifier '" + ident + "' bound in a matching expression. \n");
3992 ✗ then
3993 ((ident, mtype) :: locals);
3994
3995 end matchcontinue;
3996 end addLocalValue;
3997
3998
3999 public function makeMMMatchCase
4000 input tuple<MatchingExp, TypedIdents, list<MMExp>> inElabCase "(Mexp, extargs, mexp list)";
4001 input TypedIdents inExtraArgs;
4002 input TypedIdents inOutArgs;
4003
4004 output MMMatchCase outMMMCase;
4005 algorithm
4006 outMMMCase
4007 := matchcontinue (inElabCase, inExtraArgs, inOutArgs)
4008 local
4009 MatchingExp mexp;
4010 TypedIdents caseargs, extargs, oargs;
4011 MMMatchCase mmmcase;
4012 list<MMExp> stmts;
4013 list<MatchingExp> mexpLst;
4014
4015 case ( (mexp, caseargs, stmts), extargs, oargs)
4016 algorithm
4017 ✗ mexpLst := List.map2(extargs, makeExtraArgBinding, caseargs, oargs);
4018 ✗ mmmcase := (imlicitTxtMExp :: mexp :: mexpLst, stmts);
4019 then mmmcase;
4020
4021 else
4022 algorithm
4023 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!makeMMMatchCase failed\n");
4024 ✗ then
4025 fail();
4026 end matchcontinue;
4027 end makeMMMatchCase;
4028
4029
4030 public function makeExtraArgBinding
4031 input tuple<Ident,TypeSignature> inExtraArg;
4032 input TypedIdents inCaseArgs;
4033 input TypedIdents inOutArgs;
4034
4035 output MatchingExp outExtraArgBinding;
4036 algorithm
4037 outExtraArgBinding := matchcontinue (inExtraArg, inCaseArgs, inOutArgs)
4038 local
4039 Ident argname;
4040 TypedIdents caseargs, oargs;
4041
4042 //out args are always passed through
4043 case ( (argname, _), _, oargs)
4044 algorithm
4045 ✗ lookupTupleList(oargs, argname);
4046 ✗ then
4047 BIND_MATCH(argname);
4048
4049 case ( (argname, _), caseargs, _)
4050 algorithm
4051 ✗ lookupTupleList(caseargs, argname);
4052 ✗ then
4053 BIND_MATCH(argname);
4054
4055 case ( _, _, _)
4056 //equation
4057 // failure(_ = lookupTupleList(inCaseArgs, argname));
4058 then
4059 REST_MATCH();
4060
4061 else
4062 algorithm
4063 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!makeExtraArgBinding failed\n");
4064 ✗ then
4065 fail();
4066 end matchcontinue;
4067 end makeExtraArgBinding;
4068
4069
4070 public function addRestElabCase
4071 input list<tuple<MatchingExp, TypedIdents, list<MMExp>>> inElabCases;
4072
4073 output list<tuple<MatchingExp, TypedIdents, list<MMExp>>> outElabCases;
4074 algorithm
4075 outElabCases := matchcontinue inElabCases
4076 local
4077 MatchingExp mexp;
4078 tuple<MatchingExp, TypedIdents, list<MMExp>> elabcase;
4079 list<tuple<MatchingExp, TypedIdents, list<MMExp>>> restcases;
4080
4081 case {}
4082 then
4083 ( { (REST_MATCH(),{},{}) } );
4084
4085 case restcases as ( (mexp, _, _) :: _)
4086 algorithm
4087 ✗ isAlwaysMatched(mexp);
4088 then
4089 ( restcases );
4090
4091 case (elabcase as _) :: restcases
4092 algorithm
4093 //failure(isAlwaysMatched(mexp));
4094 ✗ restcases := addRestElabCase(restcases);
4095 then
4096 ( elabcase :: restcases );
4097
4098 else
4099 algorithm
4100 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!addRestElabCase failed\n");
4101 ✗ then
4102 fail();
4103 end matchcontinue;
4104 end addRestElabCase;
4105
4106
4107 public function isAlwaysMatched "Takes a MatchingExp and fails when it is not a rest case for sure (statically tested)."
4108 //TODO: evaluation when there are two cases with {} and (always :: _) ... or NONE() and SOME(always)
4109 input MatchingExp inMatchingExp;
4110
4111 algorithm
4112 () := match inMatchingExp
4113 local
4114 MatchingExp mexp;
4115 list<MatchingExp> mexplst;
4116
4117 case BIND_AS_MATCH(matchingExp = mexp)
4118 algorithm
4119 ✗ isAlwaysMatched(mexp);
4120 then ();
4121
4122 case BIND_MATCH()
4123 then ();
4124
4125 case TUPLE_MATCH(tupleArgs = mexplst)
4126 algorithm
4127 ✗ List.map_0(mexplst, isAlwaysMatched);
4128 then ();
4129
4130 case REST_MATCH()
4131 then ();
4132 end match;
4133 end isAlwaysMatched;
4134
4135 public function isAlwaysMatchedBool "Takes a MatchingExp and fails when it is not a rest case for sure (statically tested)."
4136 //TODO: evaluation when there are two cases with {} and (always :: _) ... or NONE() and SOME(always)
4137 input MatchingExp inMatchingExp;
4138 output Boolean isAlwaysMatched;
4139 algorithm
4140 isAlwaysMatched := matchcontinue inMatchingExp
4141 local
4142 MatchingExp mexp;
4143 case mexp
4144 algorithm
4145 ✗ isAlwaysMatched(mexp);
4146 then true;
4147
4148 else false;
4149 end matchcontinue;
4150 end isAlwaysMatchedBool;
4151
4152 protected function isTextType
4153 input TypeSignature ts;
4154 output Boolean b;
4155 algorithm
4156 b := match ts
4157 case TEXT_TYPE() then true;
4158 else false;
4159 end match;
4160 end isTextType;
4161
4162 protected function textConditionToIsEmpty
4163 "A Text condition tests emptiness through Tpl.isEmpty, so the generated
4164 code does not depend on the representation of Text."
4165 input tuple<MMExp, TypeSignature, SourceInfo> inArgValue;
4166 input output list<MMExp> stmts;
4167 input output TypedIdents locals;
4168 output tuple<MMExp, TypeSignature, SourceInfo> outArgValue;
4169 protected
4170 MMExp mmexp;
4171 SourceInfo sinfo;
4172 Ident retid;
4173 algorithm
4174 ✗ (mmexp, _, sinfo) := inArgValue;
4175 ✗ retid := returnTempVarNamePrefix + intString(listLength(locals));
4176 ✗ locals := addLocalValue(retid, BOOLEAN_TYPE(), locals);
4177 ✗ stmts := MM_ASSIGN({retid}, MM_FN_CALL(PATH_IDENT("Tpl", IDENT("isEmpty")), {mmexp})) :: stmts;
4178 ✗ outArgValue := (MM_IDENT(IDENT(retid)), BOOLEAN_TYPE(), sinfo);
4179 end textConditionToIsEmpty;
4180
4181 public function adaptTextToString
4182 input tuple<MMExp, TypeSignature, SourceInfo> inArgValue;
4183 input Expression inArgExp;
4184 input list<MMExp> inStmts;
4185 input TypedIdents inLocals;
4186 input TemplPackage inTplPackage;
4187
4188 output tuple<MMExp, TypeSignature, SourceInfo> outArgValue;
4189 output Expression outArgExp;
4190 output list<MMExp> outStmts;
4191 output TypedIdents outLocals;
4192 algorithm
4193 (outArgValue, outArgExp, outStmts, outLocals)
4194 := matchcontinue (inArgValue, inStmts, inLocals, inTplPackage)
4195 local
4196 list<MMExp> stmts;
4197 MMExp stmt, mmexp;
4198 Ident strid;
4199 TypedIdents locals;
4200 tuple<MMExp, TypeSignature, SourceInfo> argval;
4201 SourceInfo sinfo;
4202 TypeSignature exptype;
4203 list<ASTDef> astdefs;
4204
4205 //every Text value is converted/rendered to string when it is a matching argument (match and map exps)
4206 //if it is needed to match against the Text structure, a simple deconstruction functions can be used,
4207 //one of type Text -> list<StringToken>, the second of type Text -> list<tuple<Tokens,BlockType>> for the stack
4208 //but who will need this, anyway ? (maybe for debugging of Susan it can help)
4209 case ((mmexp, exptype, sinfo), stmts, locals, TEMPL_PACKAGE(astDefs = astdefs))
4210 algorithm
4211 ✗ TEXT_TYPE() := deAliasedType(exptype, astdefs);
4212 ✗ strid := textToStringNamePrefix + intString(listLength(locals));
4213 ✗ locals := addLocalValue(strid, STRING_TYPE(), locals);
4214 ✗ mmexp := mmExpToString(mmexp, TEXT_TYPE(), sinfo);
4215 ✗ stmt := MM_ASSIGN({strid}, mmexp);
4216 ✗ then
4217 ( (MM_IDENT(IDENT(strid)), STRING_TYPE(), sinfo), emptyExpression, stmt::stmts, locals);
4218
4219 //other types are ok for the match statement
4220 case (argval, stmts, locals, _)
4221 then
4222 ( argval, inArgExp, stmts, locals);
4223
4224 //cannot happen
4225 else
4226 algorithm
4227 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!adaptTextToString failed\n");
4228 ✗ then
4229 fail();
4230 end matchcontinue;
4231 end adaptTextToString;
4232
4233
4234 public function elabCasesFromCondition
4235 input TypeSignature inArgType "deAliasedType";
4236 input Boolean inIsNot;
4237 input Option<MatchingExp> inRhsValue;
4238 input Expression inTrueBranch;
4239 input Option<Expression> inElseBranchOpt;
4240 input TemplPackage inTplPackage;
4241
4242 output list<tuple<MatchingExp,Expression>> outMCases;
4243 algorithm
4244 outMCases := matchcontinue (inArgType, inIsNot, inRhsValue, inTrueBranch, inElseBranchOpt)
4245 local
4246 Boolean isnot;
4247 Expression tbranch;
4248 Option<Expression> ebranchOpt;
4249
4250 /* from the "if EXP is PATTERN then ..." form
4251 // if exp = mexp then
4252 case ( _, false, SOME(rhsMExp), tbranch, ebranchOpt, tplPackage)
4253 algorithm
4254 ebranch = getElseBranch(ebranchOpt);
4255 then
4256 { (rhsMExp,tbranch), (REST_MATCH(),ebranch) };
4257
4258 // if exp <> mexp then
4259 case ( _, true, SOME(rhsMExp), tbranch, ebranchOpt, tplPackage)
4260 algorithm
4261 ebranch = getElseBranch(ebranchOpt);
4262 then
4263 { (rhsMExp,ebranch), (REST_MATCH(),tbranch) };
4264 */
4265
4266 // List ... if valLst then / if not valLst then
4267 case (LIST_TYPE(), isnot, NONE(), tbranch, ebranchOpt)
4268 ✗ then
4269 casesForTrueFalseCondition(isnot, LIST_MATCH({}), tbranch, ebranchOpt);
4270 // Option
4271 case (OPTION_TYPE(), isnot, NONE(), tbranch, ebranchOpt)
4272 ✗ then
4273 casesForTrueFalseCondition(isnot, NONE_MATCH(), tbranch, ebranchOpt);
4274 // String and Text (auto-converted to String)
4275 case (STRING_TYPE(), isnot, NONE(), tbranch, ebranchOpt)
4276 ✗ then
4277 casesForTrueFalseCondition(isnot, STRING_MATCH(""), tbranch, ebranchOpt);
4278 //Integer
4279 case (INTEGER_TYPE(), isnot, NONE(), tbranch, ebranchOpt)
4280 ✗ then
4281 casesForTrueFalseCondition(isnot, LITERAL_MATCH("0", INTEGER_TYPE()), tbranch, ebranchOpt);
4282 //Real
4283 case (REAL_TYPE(), isnot, NONE(), tbranch, ebranchOpt)
4284 ✗ then
4285 casesForTrueFalseCondition(isnot, LITERAL_MATCH("0.0", REAL_TYPE()), tbranch, ebranchOpt);
4286 //Boolean
4287 case (BOOLEAN_TYPE(), isnot, NONE(), tbranch, ebranchOpt)
4288 ✗ then
4289 casesForTrueFalseCondition(isnot, LITERAL_MATCH("false", BOOLEAN_TYPE()), tbranch, ebranchOpt);
4290
4291 // the condition value is Tpl.isEmpty(text), see textConditionToIsEmpty
4292 case (TEXT_TYPE(), isnot, NONE(), tbranch, ebranchOpt)
4293 ✗ then
4294 casesForTrueFalseCondition(isnot, LITERAL_MATCH("true", BOOLEAN_TYPE()), tbranch, ebranchOpt);
4295
4296 else
4297 algorithm
4298 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!elabCasesFromCondition failed\n");
4299 ✗ then
4300 fail();
4301 end matchcontinue;
4302 end elabCasesFromCondition;
4303
4304
4305 public function casesForTrueFalseCondition
4306 input Boolean inIsNot;
4307 input MatchingExp inNotMatchingExp;
4308 input Expression inTrueBranch;
4309 input Option<Expression> inElseBranchOpt;
4310
4311 output list<tuple<MatchingExp,Expression>> outMCases;
4312 algorithm
4313 outMCases := matchcontinue (inIsNot, inNotMatchingExp, inTrueBranch, inElseBranchOpt)
4314 local
4315 MatchingExp notmexp;
4316 Expression tbranch, ebranch;
4317 Option<Expression> ebranchOpt;
4318
4319 // true condition, e.g. if exp then ...
4320 case ( false, notmexp, tbranch, ebranchOpt)
4321 algorithm
4322 ✗ ebranch := getElseBranch(ebranchOpt);
4323 ✗ then
4324 { (notmexp,ebranch), (REST_MATCH(),tbranch) };
4325
4326 // not condition, e.g. if not exp then ...
4327 case ( true, notmexp, tbranch, ebranchOpt)
4328 algorithm
4329 ✗ ebranch := getElseBranch(ebranchOpt);
4330 ✗ then
4331 { (notmexp,tbranch), (REST_MATCH(),ebranch) };
4332
4333 else
4334 algorithm
4335 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!casesForTrueFalseCondition failed\n");
4336 ✗ then
4337 fail();
4338 end matchcontinue;
4339 end casesForTrueFalseCondition;
4340
4341
4342 public function getElseBranch
4343 input Option<Expression> inElseBranchOpt;
4344 output Expression outElseBranch;
4345 algorithm
4346 outElseBranch := match inElseBranchOpt
4347 local
4348 Expression ebranch;
4349
4350 case SOME(ebranch) then ebranch;
4351
4352 //empty map-argument list will generate no code
4353 case NONE() then emptyExpression;
4354
4355 //cannot happen
4356 else
4357 algorithm
4358 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!getElseBranch failed\n");
4359 ✗ then
4360 fail();
4361 end match;
4362 end getElseBranch;
4363
4364 //does not fail, when not resolved ... UNRESOLVED_TYPE() is returned
4365 public function resolveBoundPath
4366 input PathIdent inPath;
4367 input ScopeEnv inScopeEnv;
4368 input TemplPackage inTplPackage;
4369
4370 output MMExp outMMExp;
4371 output TypeSignature outType;
4372 output ScopeEnv outScopeEnv;
4373 algorithm
4374 (outMMExp, outType, outScopeEnv) := matchcontinue (inPath, inScopeEnv, inTplPackage)
4375 local
4376
4377 PathIdent path, typepckg;
4378 Ident ident, typeident;
4379 TypeSignature idtype;
4380 ScopeEnv scEnv;
4381 list<ASTDef> astDefs;
4382 TemplateDef tpldef;
4383 list<tuple<Ident,TemplateDef>> tpldefs;
4384 Option<PathIdent> typepckgOpt;
4385 MMExp mmexp;
4386 String reason;
4387 //Boolean hasImplicitScope;
4388
4389
4390 // look up the scope
4391 case (path, scEnv, TEMPL_PACKAGE(astDefs = astDefs) )
4392 algorithm
4393 //(ident, _) = encodePathIdent(path);
4394 ✗ ident := pathIdentString(path);
4395 //Debug.fprint(Flags.FAILTRACE,"\n encoded path = " + pathIdentString(path) + ", ident = "+ ident + "\n");
4396 ✗ (ident, idtype, scEnv) := resolvePathInScopeEnv(ident, path, true, scEnv, astDefs);
4397 ✗ then
4398 (MM_IDENT(IDENT(ident)), idtype, scEnv);
4399
4400 // a defined constant ?
4401 case (IDENT(ident = ident), scEnv, TEMPL_PACKAGE(templateDefs = tpldefs) )
4402 algorithm
4403 ✗ tpldef := lookupTupleList(tpldefs, ident);
4404 ✗ (mmexp, idtype) := makeMMExpFromTemplateConstant(tpldef, ident);
4405 ✗ then
4406 (mmexp, idtype, scEnv);
4407
4408 // an imported constant ?
4409 case (path, scEnv, TEMPL_PACKAGE(astDefs = astDefs) )
4410 algorithm
4411 ✗ (typepckgOpt, typeident) := splitPackageAndIdent(path);
4412 ✗ (typepckg, TI_CONST_TYPE(constType = idtype))
4413 := getTypeInfo(typepckgOpt, typeident, astDefs);
4414 ✗ path := makePathIdent(typepckg, typeident);
4415 ✗ then
4416 (MM_IDENT(path), idtype, scEnv);
4417
4418
4419 // ** failure reasons ***
4420
4421 // an imported symbol other than constant ?
4422 case (path, scEnv, TEMPL_PACKAGE(astDefs = astDefs) )
4423 algorithm
4424 ✗ (typepckgOpt, typeident) := splitPackageAndIdent(path);
4425 ✗ (typepckg, _)
4426 := getTypeInfo(typepckgOpt, typeident, astDefs);
4427 ✗ reason := "Unresolved path - imported symbol '" + pathIdentString(path) + "' other than a constant used in a value context (missing parenthesis ?).";
4428 ✗ idtype := UNRESOLVED_TYPE(reason);
4429 ✗ path := makePathIdent(typepckg, typeident);
4430 ✗ then
4431 ( MM_IDENT(path), idtype, scEnv);
4432
4433
4434 // imlicit record lookup failed
4435 /*
4436 case (path,
4437 (scope as CASE_SCOPE(
4438 mExp = mexp,
4439 mType = mtype,
4440 extArgs = extargs)) :: scEnv, TEMPL_PACKAGE(astDefs = astDefs) )
4441 algorithm
4442 (ident, encpath) = encodePathIdent(path);
4443 failure( (_,_) = lookupUpdateMatchingExp(ident, encpath, mexp, mtype, astDefs) );
4444 (UNRESOLVED_TYPE(reason), mexp) = lookupUpdateMExpDotPath(ident, path, mexp, mtype, astDefs);
4445 reason = "Unresolved path '" + pathIdentString(path) + "'- after try of imlicit case lookup got:\n " + reason;
4446 idtype = UNRESOLVED_TYPE(reason);
4447 then
4448 ( MM_IDENT(IDENT(ident)), idtype, (scope :: scEnv));
4449 */
4450
4451 // all the rest
4452 case (path, scEnv, _ )
4453 algorithm
4454 ✗ reason := "Unresolved path '" + pathIdentString(path) + "'.";
4455 ✗ idtype := UNRESOLVED_TYPE(reason);
4456 ✗ then
4457 ( MM_IDENT(path), idtype, scEnv);
4458
4459 //should not ever happen
4460 else
4461 algorithm
4462 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!resolveBoundPath failed\n");
4463 ✗ then
4464 fail();
4465 end matchcontinue;
4466 end resolveBoundPath;
4467
4468
4469 public function checkResolvedType
4470 input PathIdent inPath;
4471 input TypeSignature inType;
4472 input String inUnresolvedMsg;
4473 input SourceInfo inInfo;
4474
4475 algorithm
4476 () := matchcontinue (inType, inUnresolvedMsg)
4477 local
4478 String reason, msg;
4479
4480 case (UNRESOLVED_TYPE(reason), msg)
4481 algorithm
4482
4483 //true = Flags.isSet(Flags.FAILTRACE);
4484 //msg = msg + " unresolved type of '" + pathIdentString(path) + "', reason = '" + reason + "'.\n";
4485 ✗ msg := "(" + msg + ") " + reason;
4486 //true = Flags.isSet(Flags.FAILTRACE); Debug.trace("ADD Error: " + msg + "\n"); //+ " unresolved path '" + pathIdentString(path) + "', reason = '" + reason + "'.\n");
4487 ✗ addSusanError(msg, inInfo);
4488 then
4489 ();
4490
4491 else ();
4492
4493 end matchcontinue;
4494 end checkResolvedType;
4495
4496
4497 public function checkTextType
4498 input TypeSignature inType;
4499 input Ident inIdent;
4500 input String inUnresolvedMsg;
4501 input SourceInfo inInfo;
4502 output TypeSignature outType;
4503 algorithm
4504 outType := match (inType, inUnresolvedMsg)
4505 local
4506 String msg;
4507 TypeSignature ts;
4508
4509 //OK
4510 case (TEXT_TYPE(), _) then inType;
4511
4512 //already handled by checkResolvedType
4513 case (UNRESOLVED_TYPE(), _) then inType;
4514
4515 case (ts, msg)
4516 algorithm
4517 ✗ msg := "(" + msg + ") identifier '" + inIdent + "' was expected to have Text& type but resolved to " + typeSignatureString(ts)
4518 + ".\n Only Text& typed variables can be appended to.";
4519 ✗ addSusanError(msg, inInfo);
4520 ✗ then
4521 UNRESOLVED_TYPE(msg);
4522
4523 end match;
4524 end checkTextType;
4525
4526
4527 public function makeMMExpFromTemplateConstant
4528 input TemplateDef inTplDef;
4529 input Ident inTemplIdent;
4530
4531 output MMExp outMMExp;
4532 output TypeSignature outConstType;
4533 algorithm
4534 (outMMExp, outConstType) := match (inTplDef, inTemplIdent)
4535 local
4536 Ident ident;
4537 TypeSignature idtype, lt;
4538 String litstr, reason;
4539
4540 // string constants are of StringToken type and does not involve a type conversion, use them through idents
4541 case ( STR_TOKEN_DEF(), ident)
4542 algorithm
4543 ✗ ident := constantNamePrefix + ident; //no encoding needed, just prefix, it is a constant
4544 ✗ then
4545 (MM_IDENT(IDENT(ident)), STRING_TOKEN_TYPE());
4546
4547 // literal constants of primitive types besides string : INTEGER_TYPE, REAL_TYPE or BOOLEAN_TYPE
4548 // make them inline
4549 case ( LITERAL_DEF(value = litstr, litType = lt), _)
4550 ✗ then
4551 (MM_LITERAL(litstr), lt);
4552
4553 // Error - a template in a value context ... maybe, this can be with lower priority, after of trying of imlicit record lookup
4554 case ( TEMPLATE_DEF(), ident)
4555 algorithm
4556 ✗ reason := "Unresolved identifier - the template '" + ident + "'in a value context found (missing parenthesis ?) .";
4557 ✗ idtype := UNRESOLVED_TYPE(reason);
4558 //ident = encodeIdent(ident);
4559 ✗ then
4560 ( MM_IDENT(IDENT(ident)), idtype);
4561
4562 // should not ever happen
4563 else
4564 algorithm
4565 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!makeMMExpFromTemplateConstant failed\n");
4566 ✗ then
4567 fail();
4568 end match;
4569 end makeMMExpFromTemplateConstant;
4570
4571 public function prepareMatchArgument
4572 input MatchingExp inMExp;
4573 input Ident inMatchArgName;
4574
4575 output Ident outIdent;
4576 output MatchingExp outMExp;
4577 algorithm
4578 (outIdent, outMExp) := match inMExp
4579 local
4580 MatchingExp mexp;
4581 Ident ident;
4582
4583 case mexp as BIND_MATCH(bindIdent = ident)
4584 then
4585 (ident, mexp);
4586
4587 case mexp as BIND_AS_MATCH(bindIdent = ident)
4588 then
4589 (ident, mexp);
4590
4591 //replace a wild match with the inMatchArgName
4592 case REST_MATCH()
4593 ✗ then
4594 (inMatchArgName, BIND_MATCH(inMatchArgName));
4595
4596 //all the rest cases creates an "as" binding of matchArgName
4597 //no need to addToLocals because it is already in the locals
4598 ✗ else (inMatchArgName, BIND_AS_MATCH(inMatchArgName, inMExp) );
4599
4600 end match;
4601 end prepareMatchArgument;
4602
4603
4604 public function resolvePathInScopeEnv
4605 input Ident inIdent "path string ident name of the looked up ident - to be a new bound name (internally)" ;
4606 input PathIdent inPath "path of the looked up ident";
4607 input Boolean canDoImplicitLookup;
4608 input ScopeEnv inScopeEnv;
4609 input list<ASTDef> inASTDefs;
4610
4611 output Ident outLocalIdent "resolved local name";
4612 output TypeSignature outType;
4613 output ScopeEnv outScopeEnv;
4614 algorithm
4615 (outLocalIdent, outType, outScopeEnv)
4616 := matchcontinue (inIdent, inPath, canDoImplicitLookup, inScopeEnv, inASTDefs)
4617 local
4618 MatchingExp mexp;
4619 TypedIdents extargs, fargs, accLocals, localArgs;
4620 PathIdent path;
4621 Ident ident, matchArgName, letIdent, freshIdent, encident, localIdent;
4622 TypeSignature idtype, mtype;
4623 Scope scope;
4624 ScopeEnv scEnv, restEnv;
4625 list<ASTDef> astdefs;
4626 Boolean hasImplicitScope;
4627 list<tuple<Ident,Ident>> localNames;
4628
4629 //Error - test recursive usage of TEXT_ADD ident or an actually elaborated let expression
4630 case (ident, _, _,
4631 (RECURSIVE_SCOPE(recIdent = letIdent) :: _), _)
4632 algorithm
4633 ✗ true := stringEq(ident, letIdent);
4634 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - trying to use '" + ident
4635 + "' recursively inside a let scope or text addition. Use an additional Text variable if a self addition/duplication is needed, like let b = a let &a += b ... \n");
4636 ✗ then
4637 fail();
4638
4639 //OK - no recursive usage, look up
4640 case (ident, path, _,
4641 (scope as RECURSIVE_SCOPE(recIdent = letIdent)) :: restEnv, astdefs)
4642 algorithm
4643 ✗ false := stringEq(ident, letIdent);
4644 ✗ (ident, idtype, restEnv)
4645 := resolvePathInScopeEnv(ident, path, canDoImplicitLookup, restEnv, astdefs);
4646 ✗ then
4647 (ident, idtype, scope :: restEnv);
4648
4649
4650 //let scope, found
4651 case (ident, _, _,
4652 LET_SCOPE(ident = letIdent, idType = idtype, freshIdent = freshIdent) :: restEnv, _)
4653 algorithm
4654 ✗ true := stringEq(ident, letIdent);
4655 ✗ then
4656 (freshIdent, idtype,
4657 LET_SCOPE(letIdent, idtype, freshIdent, true) :: restEnv);
4658
4659 //let scope failed - look up
4660 case (ident, path, _,
4661 (scope as LET_SCOPE()) :: restEnv, astdefs)
4662 algorithm
4663 // false = stringEq(ident, letIdent);
4664 ✗ (ident, idtype, restEnv)
4665 := resolvePathInScopeEnv(ident, path, canDoImplicitLookup, restEnv, astdefs);
4666 ✗ then
4667 (ident, idtype, scope :: restEnv);
4668
4669
4670 //found in the function scope
4671 case ( ident, path , _,
4672 scEnv as (FUN_SCOPE(args = fargs) :: _ ), _ )
4673 algorithm
4674 ✗ idtype := lookupTupleList(fargs, ident);
4675 //encode the ident ... a_ident
4676 ✗ ident := encodePathIdent(path, funArgNamePrefix);
4677 ✗ then
4678 (ident, idtype, scEnv);
4679
4680 //not in the function scope, look up
4681 case (ident, path, _,
4682 FUN_SCOPE(args = fargs, localArgs = localArgs)::restEnv, astdefs)
4683 algorithm
4684 //failure(_ = lookupTupleList(fargs, ident));
4685 //FUN_SCOPE hides the local names from the upper scope
4686 ✗ (localIdent, idtype, restEnv)
4687 := resolvePathInScopeEnv(ident, path, canDoImplicitLookup, restEnv, astdefs);
4688 //fargs = updateTupleList(fargs, (ident, idtype));
4689 ✗ fargs := (ident, idtype) :: fargs; //not there yet
4690 ✗ localArgs := (localIdent, idtype) :: localArgs;
4691 //encode the ident ... a_ident
4692 ✗ ident := encodeIdent(ident, funArgNamePrefix);
4693 ✗ then
4694 (ident, idtype, FUN_SCOPE(fargs, localArgs) :: restEnv);
4695
4696 //bound in the matching expression, update it with the ident if needed
4697 case ( ident, path, _,
4698 CASE_SCOPE(
4699 mExp = mexp,
4700 mType = mtype,
4701 localNames = localNames,
4702 accLocals = accLocals,
4703 extArgs = extargs,
4704 matchArgName = matchArgName,
4705 hasImplicitScope = hasImplicitScope) :: restEnv, astdefs )
4706 algorithm
4707 ✗ (idtype, mexp) := lookupUpdateMatchingExp(ident, path, mexp, mtype, astdefs);
4708 ✗ encident := encodeIdent(ident, caseBindingNamePrefix);
4709 ✗ (encident, localNames, accLocals) := updateLocalsForMatchingExp(ident, encident, 0, idtype, localNames, accLocals);
4710 ✗ then
4711 (encident, idtype,
4712 CASE_SCOPE(mexp, mtype, localNames, accLocals, extargs, matchArgName, hasImplicitScope) :: restEnv);
4713
4714 //try "implicit" record lookup ~ [it.]path
4715 //now, the implicit scoped fields can hide upper idents from upper scope when there is an overlap
4716 //TODO: a warning when the hidening has happen;
4717 //TODO: also warning when hidening of a binding that has the same name as a field but it is not the field(should it be hidden, too?, ... not now a name conflict would be there ...)
4718 case ( ident, path, true,
4719 CASE_SCOPE(
4720 mExp = mexp,
4721 mType = mtype,
4722 localNames = localNames,
4723 accLocals = accLocals,
4724 extArgs = extargs,
4725 matchArgName = matchArgName,
4726 hasImplicitScope = true) :: restEnv, astdefs )
4727 algorithm
4728 ✗ if Flags.isSet(Flags.FAILTRACE) then
4729 ✗ Debug.traceln("\n trying [it.]path for '" + ident + " / " + pathIdentString(path) + "' : "
4730 + typeSignatureString(mtype));
4731 end if;
4732 ✗ (idtype, mexp) := lookupUpdateMExpDotPath(ident, path, mexp, mtype, astdefs);
4733 ✗ failure(UNRESOLVED_TYPE() := idtype);
4734 ✗ if Flags.isSet(Flags.FAILTRACE) then
4735 ✗ Debug.traceln("\n [it.]path for '" + pathIdentString(path) + "' : "
4736 + typeSignatureString(idtype));
4737 end if;
4738
4739 ✗ encident := encodePathIdent(path, caseBindingNamePrefix);
4740 ✗ (encident, localNames, accLocals)
4741 := updateLocalsForMatchingExp(ident, encident, 0, idtype, localNames, accLocals);
4742 ✗ then
4743 (encident, idtype,
4744 CASE_SCOPE(mexp, mtype, localNames, accLocals, extargs, matchArgName, true) :: restEnv);
4745
4746
4747 //ident refers to the matched argument itself (originally to 'it')
4748 //avoid to look up --> find/create the binding of the whole pattern expression
4749 case ( ident, _, _,
4750 CASE_SCOPE(
4751 mExp = mexp,
4752 mType = mtype,
4753 localNames = localNames,
4754 accLocals = accLocals,
4755 extArgs = extargs,
4756 matchArgName = matchArgName,
4757 hasImplicitScope = hasImplicitScope) :: restEnv , _ )
4758 algorithm
4759 ✗ true := stringEq(ident, matchArgName);
4760 ✗ (ident, mexp) := prepareMatchArgument(mexp, matchArgName);
4761
4762 ✗ encident := encodeIdent(ident, caseBindingNamePrefix);
4763 ✗ (encident, localNames, accLocals)
4764 := updateLocalsForMatchingExp(ident, encident, 0, mtype, localNames, accLocals);
4765 ✗ then
4766 (encident, mtype,
4767 CASE_SCOPE(mexp, mtype, localNames, accLocals, extargs, matchArgName, hasImplicitScope) :: restEnv);
4768
4769 //already in the extra args
4770 /* do not check this as the extargs have local names from the upper FUN_SCOPE
4771 case ( ident, _, _,
4772 scEnv as (CASE_SCOPE(extArgs = extargs) :: _ ), _ )
4773 algorithm
4774 idtype = lookupTupleList(extargs, ident);
4775 then
4776 (ident, idtype, scEnv);
4777 */
4778
4779 //not in the case scope, look up
4780 case ( ident, path, _,
4781 CASE_SCOPE(
4782 mExp = mexp,
4783 mType = mtype,
4784 localNames = localNames,
4785 accLocals = accLocals,
4786 extArgs = extargs,
4787 matchArgName = matchArgName,
4788 hasImplicitScope = hasImplicitScope) :: restEnv, astdefs )
4789 algorithm
4790 //failure( (_,_) = lookupUpdateMatchingExp(ident, path, mexp, mtype, astdefs));
4791 ✗ (encident, idtype, restEnv) := resolvePathInScopeEnv(ident, path,
4792 (canDoImplicitLookup and not hasImplicitScope), restEnv, astdefs);
4793 //updating the the extra args with the encoded returned local ident ... it must belong to the immediate upper FUN_SCOPE
4794 ✗ extargs := updateTupleList(extargs, (encident, idtype));
4795 ✗ then
4796 (encident, idtype, CASE_SCOPE(mexp, mtype, localNames, accLocals, extargs, matchArgName, hasImplicitScope) :: restEnv);
4797
4798 // can normally fail for template or external constants
4799 //case ( ident, _, _, _ )
4800 // equation
4801 // true = Flags.isSet(Flags.FAILTRACE); Debug.trace("-resolvePathInScopeEnv failed for ident '" + ident + "'.\n");
4802 // then
4803 // fail();
4804 end matchcontinue;
4805 end resolvePathInScopeEnv;
4806
4807 public function addPostfixToIdent
4808 input Ident inIdent;
4809 input Integer inPostfix "postfix to be added; 0 -> no postfix";
4810
4811 output Ident outPostfixedIdent;
4812 algorithm
4813 outPostfixedIdent :=
4814 match (inIdent, inPostfix)
4815 local
4816 Ident ident;
4817
4818 case ( _, 0)
4819 then
4820 inIdent;
4821
4822 case ( ident, _)
4823 algorithm
4824 ✗ ident := ident + "_" + intString(inPostfix);
4825 then
4826 ident;
4827
4828 end match;
4829 end addPostfixToIdent;
4830
4831 public function updateLocalsForMatchingExp
4832 input Ident inIdent "path ident string - using dots, e.g. 'rec.field'";
4833 input Ident inEncIdent "encoded ident string as to be in locals";
4834 input Integer inPostfix "postfix used to make the created local name unique; 0->no postfix";
4835 input TypeSignature inType;
4836 input list<tuple<Ident,Ident>> inLocalNames;
4837 input TypedIdents inLocals;
4838
4839 output Ident outLocalIdent;
4840 output list<tuple<Ident,Ident>> outLocalNames;
4841 output TypedIdents outLocals;
4842 algorithm
4843 (outLocalIdent, outLocalNames, outLocals) :=
4844 matchcontinue (inIdent, inLocalNames, inLocals)
4845 local
4846 Ident ident, encIdent;
4847 TypeSignature loctype;
4848 TypedIdents locals;
4849 list<tuple<Ident,Ident>> localNames;
4850
4851 //already in localNames
4852 case (ident, localNames, locals)
4853 algorithm
4854 ✗ encIdent := lookupTupleList(localNames, ident);
4855 ✗ then
4856 (encIdent, localNames, locals);
4857
4858 //not yet in locals
4859 case (ident, localNames, locals)
4860 algorithm
4861 // already failed in first case: failure( _ = lookupTupleList(localNames, ident) );
4862 ✗ encIdent := addPostfixToIdent(inEncIdent, inPostfix);
4863 ✗ failure( lookupTupleList(locals, encIdent));
4864 ✗ then
4865 (encIdent,
4866 (ident, encIdent) :: localNames,
4867 (encIdent, inType) :: locals);
4868
4869 //re-use from locals
4870 case (ident, localNames, locals)
4871 algorithm
4872 // already failed in first case: failure( _ = lookupTupleList(localNames, ident) );
4873 ✗ encIdent := addPostfixToIdent(inEncIdent, inPostfix);
4874 ✗ loctype := lookupTupleList(locals, encIdent);
4875 ✗ true := valueEq(loctype, inType);
4876 ✗ then
4877 (encIdent, (ident, encIdent) :: localNames, locals);
4878
4879 //try the next postfix
4880 case (ident, localNames, locals)
4881 algorithm
4882 // already failed in first case: failure( _ = lookupTupleList(localNames, ident) );
4883 ✗ encIdent := addPostfixToIdent(inEncIdent, inPostfix);
4884 ✗ loctype := lookupTupleList(locals, encIdent);
4885 ✗ false := valueEq(loctype, inType);
4886 ✗ (encIdent, localNames, locals)
4887 := updateLocalsForMatchingExp(ident, inEncIdent, inPostfix + 1, inType, localNames, locals);
4888 then
4889 (encIdent, localNames, locals);
4890
4891
4892 // should not ever happen
4893 else
4894 algorithm
4895 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!updateLocalsForMatchingExp failed\n");
4896 ✗ then
4897 fail();
4898 end matchcontinue;
4899 end updateLocalsForMatchingExp;
4900
4901
4902 public function usedInImmediateLetScope
4903 input Ident inIdent ;
4904 input Ident inFreshIdent;
4905 input ScopeEnv inScopeEnv;
4906
4907 output Boolean outIsUsed;
4908 algorithm
4909 outIsUsed
4910 := match inScopeEnv
4911 local
4912 Ident letIdent, freshIdent;
4913 ScopeEnv restEnv;
4914
4915 case LET_SCOPE(ident = letIdent, freshIdent = freshIdent) :: _ guard stringEq(inIdent, letIdent) and stringEq(inFreshIdent, freshIdent)
4916 then
4917 true;
4918
4919 case LET_SCOPE() :: restEnv
4920 //equation
4921 //false = stringEq(_, letIdent) and stringEq(_, freshIdent);
4922 ✗ then
4923 usedInImmediateLetScope(inIdent, inFreshIdent, restEnv);
4924
4925 case RECURSIVE_SCOPE(recIdent = letIdent, freshIdent = freshIdent) :: _ guard stringEq(inIdent, letIdent) and stringEq(inFreshIdent, freshIdent)
4926 then
4927 true;
4928
4929 case RECURSIVE_SCOPE() :: restEnv
4930 //equation
4931 //false = stringEq(_, letIdent) and stringEq(_, freshIdent);
4932 ✗ then
4933 usedInImmediateLetScope(inIdent, inFreshIdent, restEnv);
4934
4935 else false;
4936
4937 end match;
4938 end usedInImmediateLetScope;
4939
4940
4941 public function updateLocalsForLetExp
4942 input Ident inIdent "original Susan ident";
4943 input Ident inEncIdent "encoded ident to be in locals";
4944 input Integer inPostfix "postfix used to make the created local name unique; 0->no postfix";
4945 input TypeSignature inType;
4946 input TypedIdents inLocals;
4947 input ScopeEnv inScopeEnv;
4948
4949 output Ident outLocalIdent;
4950 output TypedIdents outLocals;
4951 algorithm
4952 (outLocalIdent, outLocals) :=
4953 matchcontinue inScopeEnv
4954 local
4955 Ident encIdent;
4956 TypeSignature loctype;
4957 TypedIdents locals;
4958
4959 //not yet in locals, add
4960 case _
4961 algorithm
4962 ✗ encIdent := addPostfixToIdent(inEncIdent, inPostfix);
4963 ✗ failure( lookupTupleList(inLocals, encIdent));
4964 ✗ then
4965 (encIdent, (encIdent, inType) :: inLocals);
4966
4967 //already in locals, but not the same type, try postfix+1
4968 case _
4969 algorithm
4970 ✗ encIdent := addPostfixToIdent(inEncIdent, inPostfix);
4971 ✗ loctype := lookupTupleList(inLocals, encIdent);
4972 ✗ false := valueEq(loctype, inType);
4973 ✗ (encIdent, locals)
4974 := updateLocalsForLetExp(inIdent, inEncIdent, inPostfix + 1, inType, inLocals, inScopeEnv);
4975 then
4976 (encIdent, locals);
4977
4978 //already in locals, the same type, not used in the immediate scope, OK
4979 case _
4980 algorithm
4981 ✗ encIdent := addPostfixToIdent(inEncIdent, inPostfix);
4982 ✗ loctype := lookupTupleList(inLocals, encIdent);
4983 ✗ true := valueEq(loctype, inType);
4984 ✗ false := usedInImmediateLetScope(inIdent, encIdent, inScopeEnv);
4985 ✗ then
4986 (encIdent, inLocals);
4987
4988 //already in locals, the same type, but used in the immediate scope, try postfix+1
4989 case _
4990 algorithm
4991 ✗ encIdent := addPostfixToIdent(inEncIdent, inPostfix);
4992 ✗ loctype := lookupTupleList(inLocals, encIdent);
4993 ✗ true := valueEq(loctype, inType);
4994 ✗ true := usedInImmediateLetScope(inIdent, encIdent, inScopeEnv);
4995 ✗ (encIdent, locals)
4996 := updateLocalsForLetExp(inIdent, inEncIdent, inPostfix + 1, inType, inLocals, inScopeEnv);
4997 then
4998 (encIdent, locals);
4999
5000
5001 // should not ever happen
5002 else
5003 algorithm
5004 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!updateLocalsForLetExp failed\n");
5005 ✗ then
5006 fail();
5007 end matchcontinue;
5008 end updateLocalsForLetExp;
5009
5010
5011
5012 public function lookupUpdateMatchingExp
5013 input Ident inIdent "path string ident to be the temporary internal local value name";
5014 input PathIdent inPathIdent "original path";
5015 input MatchingExp inMatchingExp "matching expression";
5016 input TypeSignature inMType;
5017 input list<ASTDef> inASTDefs;
5018
5019 output TypeSignature outValueType;
5020 output MatchingExp outMatchingExp;
5021 algorithm
5022 (outValueType, outMatchingExp)
5023 := matchcontinue (inIdent, inPathIdent, inMatchingExp, inMType, inASTDefs)
5024 local
5025 Ident inid, id, bid;
5026 PathIdent path, tagpath;
5027 TypeSignature mtype, otype, valtype;
5028 list<TypeSignature> mtypeLst;
5029 list<ASTDef> astDefs;
5030
5031 String reason;
5032 list<tuple<String, MatchingExp>> fms;
5033 MatchingExp inmexp, mexp, restmexp;
5034 list<MatchingExp> mexpLst;
5035 TypedIdents fields;
5036
5037
5038 case ( _, IDENT(ident = id),
5039 inmexp as BIND_AS_MATCH(
5040 bindIdent = bid ), mtype, _ )
5041 algorithm
5042 ✗ true := stringEq(id, bid);
5043 then
5044 ( mtype, inmexp );
5045
5046 case ( inid, PATH_IDENT(ident = id, path = path ),
5047 BIND_AS_MATCH(
5048 bindIdent = bid,
5049 matchingExp = mexp ), mtype, astDefs )
5050 algorithm
5051 ✗ true := stringEq(id, bid);
5052 ✗ ( valtype, mexp ) := lookupUpdateMExpDotPath(inid, path, mexp, mtype, astDefs);
5053 ✗ then
5054 ( valtype, BIND_AS_MATCH(bid, mexp) );
5055
5056 case ( inid, path,
5057 BIND_AS_MATCH(
5058 bindIdent = bid,
5059 matchingExp = mexp ), mtype, astDefs )
5060 algorithm
5061 //failure(equality(id = bid));
5062 ✗ ( valtype, mexp ) := lookupUpdateMatchingExp(inid, path, mexp, mtype, astDefs);
5063 ✗ then
5064 ( valtype, BIND_AS_MATCH(bid, mexp) );
5065
5066
5067 case ( _, IDENT(ident = id),
5068 inmexp as BIND_MATCH(
5069 bindIdent = bid ), mtype, _ )
5070 algorithm
5071 ✗ true := stringEq(id, bid);
5072 then
5073 ( mtype, inmexp );
5074
5075 case ( inid, PATH_IDENT(ident = id),
5076 inmexp as BIND_MATCH(
5077 bindIdent = bid ), _, _ )
5078 algorithm
5079 ✗ true := stringEq(id, bid);
5080 ✗ reason := "Unresolved path '" + inid + "' after first dot - only the first part '" + id + "' resolved as a bind match.";
5081 ✗ valtype := UNRESOLVED_TYPE(reason);
5082 then
5083 (valtype , inmexp );
5084
5085 case ( inid, path,
5086 RECORD_MATCH(
5087 tagName = tagpath,
5088 fieldMatchings = fms ), mtype, astDefs )
5089 algorithm
5090 ✗ mtype := deAliasedType(mtype, astDefs);
5091 ✗ (fields,_) := getFieldsForRecord(mtype, tagpath, astDefs);
5092 ✗ ( valtype, fms ) := lookupUpdateMExpRecord(inid, path, fms, fields, astDefs);
5093 ✗ then
5094 ( valtype, RECORD_MATCH(tagpath, fms) );
5095
5096 case ( inid, path,
5097 SOME_MATCH(
5098 value = mexp ), mtype, astDefs )
5099 algorithm
5100 ✗ OPTION_TYPE(ofType = mtype) := deAliasedType(mtype, astDefs);
5101 ✗ ( valtype, mexp ) := lookupUpdateMatchingExp(inid, path, mexp, mtype, astDefs);
5102 ✗ then
5103 ( valtype, SOME_MATCH(mexp) );
5104
5105 case ( inid, path,
5106 TUPLE_MATCH(
5107 tupleArgs = mexpLst ), mtype, astDefs )
5108 algorithm
5109 ✗ TUPLE_TYPE(ofTypes = mtypeLst) := deAliasedType(mtype, astDefs);
5110 ✗ ( valtype, mexpLst ) := lookupUpdateMExpList(inid, path, mexpLst, mtypeLst, astDefs);
5111 ✗ then
5112 ( valtype, TUPLE_MATCH(mexpLst) );
5113
5114 case ( inid, path,
5115 LIST_MATCH(
5116 listElts = mexpLst ), mtype, astDefs )
5117 algorithm
5118 ✗ LIST_TYPE(ofType = mtype) := deAliasedType(mtype, astDefs);
5119 ✗ mtypeLst := List.fill(mtype, listLength(mexpLst));
5120 ✗ ( valtype, mexpLst ) := lookupUpdateMExpList(inid, path, mexpLst, mtypeLst, astDefs);
5121 ✗ then
5122 ( valtype, LIST_MATCH(mexpLst) );
5123
5124 case ( inid, path,
5125 LIST_CONS_MATCH(
5126 head = mexp,
5127 rest = restmexp ), mtype, astDefs )
5128 algorithm
5129 ✗ LIST_TYPE(ofType = otype) := deAliasedType(mtype, astDefs);
5130 ✗ ( valtype, {mexp, restmexp} ) := lookupUpdateMExpList(inid, path, { mexp, restmexp}, {otype, mtype}, astDefs);
5131 ✗ then
5132 ( valtype, LIST_CONS_MATCH(mexp, restmexp) );
5133
5134
5135 //otherwise fail
5136
5137 end matchcontinue;
5138 end lookupUpdateMatchingExp;
5139
5140
5141 public function lookupUpdateMExpDotPath
5142 input Ident inIdent;
5143 input PathIdent inPathIdent;
5144 input MatchingExp inMatchingExp;
5145 input TypeSignature inMType;
5146 input list<ASTDef> inASTDefs;
5147
5148 output TypeSignature outValueType;
5149 output MatchingExp outMatchingExp;
5150 algorithm
5151 (outValueType, outMatchingExp)
5152 := matchcontinue (inIdent, inPathIdent, inMatchingExp, inMType, inASTDefs)
5153 local
5154 Ident inid, id, bid, ident;
5155 PathIdent path, tagpath;
5156 TypeSignature mtype, valtype;
5157 list<ASTDef> astDefs;
5158
5159 list<tuple<String, MatchingExp>> fms;
5160 MatchingExp mexp;
5161 TypedIdents fields;
5162 String reason;
5163
5164 case ( inid, path,
5165 BIND_AS_MATCH(
5166 bindIdent = bid,
5167 matchingExp = mexp ), mtype, astDefs )
5168 algorithm
5169 ✗ ( valtype, mexp ) := lookupUpdateMExpDotPath(inid, path, mexp, mtype, astDefs);
5170 ✗ then
5171 ( valtype, BIND_AS_MATCH(bid, mexp) );
5172
5173 case ( inid, IDENT(ident = id),
5174 RECORD_MATCH(
5175 tagName = tagpath,
5176 fieldMatchings = fms ), mtype, astDefs )
5177 algorithm
5178 ✗ mtype := deAliasedType(mtype, astDefs);
5179 ✗ (fields, _) := getFieldsForRecord(mtype, tagpath, astDefs); // this should not fail as we have type-checked the matching expression
5180 ✗ valtype := lookupTupleList(fields, id);
5181 ✗ fms := updateFieldMatchingsForField(inid, id, fms);
5182 ✗ then
5183 ( valtype, RECORD_MATCH(tagpath, fms) );
5184
5185 case ( inid, IDENT(ident = id),
5186 RECORD_MATCH(
5187 tagName = tagpath,
5188 fieldMatchings = fms ), mtype, astDefs )
5189 algorithm
5190 ✗ mtype := deAliasedType(mtype, astDefs);
5191 ✗ (fields,tagpath) := getFieldsForRecord(mtype, tagpath, astDefs); // this should not fail as we have type-checked the matching expression
5192 ✗ failure( lookupTupleList(fields, id));
5193 ✗ reason := "Unresolved path - failed in lookup for field '" + id + "' at the end of the path '" + inid
5194 + "', no such field in '" + pathIdentString(tagpath) + "' record fields.\n";
5195 ✗ valtype := UNRESOLVED_TYPE(reason);
5196 ✗ then
5197 ( valtype, RECORD_MATCH(tagpath, fms) );
5198
5199 case ( inid, PATH_IDENT(ident = id, path = path),
5200 RECORD_MATCH(
5201 tagName = tagpath,
5202 fieldMatchings = fms ), mtype, astDefs )
5203 algorithm
5204 ✗ mtype := deAliasedType(mtype, astDefs);
5205 ✗ (fields,_) := getFieldsForRecord(mtype, tagpath, astDefs); // this should not fail as we have type-checked the matching expression
5206 ✗ mtype := lookupTupleList(fields, id);
5207 ✗ ( valtype, fms ) := lookupUpdateMExpDotPathRecord(inid, id, path, fms, mtype, astDefs);
5208 ✗ then
5209 ( valtype, RECORD_MATCH(tagpath, fms) );
5210
5211 case ( inid, PATH_IDENT(ident = id),
5212 RECORD_MATCH(
5213 tagName = tagpath,
5214 fieldMatchings = fms ), mtype, astDefs )
5215 algorithm
5216 ✗ mtype := deAliasedType(mtype, astDefs);
5217 ✗ (fields, tagpath) := getFieldsForRecord(mtype, tagpath, astDefs); // this should not fail as we have type-checked the matching expression
5218 ✗ failure( lookupTupleList(fields, id));
5219 ✗ reason := "Unresolved path - failed in lookup for field '" + id + "' inside the (encoded) path '" + inid
5220 + "', no such field in '" + pathIdentString(tagpath) + "' record fields.\n";
5221 ✗ valtype := UNRESOLVED_TYPE( reason );
5222 ✗ then
5223 ( valtype, RECORD_MATCH(tagpath, fms) );
5224
5225 // here we can insert an implicit resolution for pure record types (not embedded in a union)
5226 // just check the type if it is a pure record type and then expand the mexp with the record match
5227 case ( inid, path, mexp, _, _ )
5228 algorithm
5229 ✗ reason := "Unresolved path (encoded) '" + inid
5230 + "', cannot follow the rest path '" + pathIdentString(path) + "', no record match available to look down the path.";
5231 ✗ valtype := UNRESOLVED_TYPE(reason);
5232 ✗ then
5233 ( valtype, mexp );
5234
5235
5236 //should not ever happen
5237 else
5238 algorithm
5239 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!lookupUpdateMExpDotPath failed for ident '" + inIdent + "'.\n");
5240 ✗ then
5241 fail();
5242
5243 end matchcontinue;
5244 end lookupUpdateMExpDotPath;
5245
5246
5247 public function updateFieldMatchingsForField
5248 input Ident inIdent;
5249 input Ident inField;
5250 input list<tuple<Ident, MatchingExp>> inFieldMatchings;
5251
5252 output list<tuple<Ident, MatchingExp>> outFieldMatchings;
5253 algorithm
5254 outFieldMatchings := matchcontinue (inIdent, inField, inFieldMatchings)
5255 local
5256 Ident inid, fieldid, ident;
5257 list<tuple<Ident, MatchingExp>> fms;
5258 tuple<Ident, MatchingExp> fm;
5259 MatchingExp mexp;
5260
5261 case ( inid, fieldid, {} )
5262 ✗ then
5263 ( {(fieldid, BIND_MATCH(inid))} );
5264
5265 case ( inid, fieldid,(ident, mexp) :: fms)
5266 algorithm
5267 ✗ true := stringEq(fieldid, ident);
5268 ✗ mexp := makeBindAs(inid, mexp); // cannot fail
5269 ✗ then
5270 ( (fieldid, mexp) :: fms );
5271
5272 case ( inid, fieldid, fm :: fms )
5273 algorithm
5274 // failure(equation(fieldid = ident));
5275 ✗ fms := updateFieldMatchingsForField(inid, fieldid, fms);
5276 then
5277 ( fm :: fms );
5278
5279 // should not ever happen
5280 else
5281 algorithm
5282 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!updateFieldMatchingsForField failed.\n");
5283 ✗ then
5284 fail();
5285 end matchcontinue;
5286 end updateFieldMatchingsForField;
5287
5288 public function makeBindAs
5289 input Ident inIdent;
5290 input MatchingExp inMExp;
5291
5292 output MatchingExp outMExp;
5293 algorithm
5294 outMExp := matchcontinue (inIdent, inMExp)
5295 local
5296 Ident inid, bid;
5297 MatchingExp mexp, inmexp;
5298
5299 case ( inid, inmexp as BIND_AS_MATCH(bindIdent = bid) )
5300 algorithm
5301 ✗ true := stringEq(inid, bid);
5302 then
5303 inmexp;
5304
5305 case ( inid, BIND_AS_MATCH(
5306 bindIdent = bid,
5307 matchingExp = mexp ) )
5308 algorithm
5309 // false = stringEq(inid, bid);
5310 ✗ mexp := makeBindAs(inid, mexp); //we should do this to handle multiple path ambiguity ... i.e. when mexpr is (c as REC(fld = a as REC2(fld2 = b))) and c.fld.fl2, a.fld2 and b are used simultanosly, then we will get (c as REC(fld = a as REC2(fld2 = b as c_fld_fld2 as a_fld)))
5311 ✗ then
5312 BIND_AS_MATCH(bid, mexp);
5313
5314 case ( inid, inmexp as BIND_MATCH(
5315 bindIdent = bid ) )
5316 algorithm
5317 ✗ true := stringEq(inid, bid);
5318 then
5319 inmexp;
5320
5321 /* //can be here to "optimize" the "_"
5322 case ( inid, REST_MATCH())
5323 then
5324 BIND_MATCH(inid);
5325 */
5326 case ( inid, mexp )
5327 ✗ then
5328 BIND_AS_MATCH(inid, mexp);
5329
5330 //should not ever happen
5331 else
5332 algorithm
5333 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!makeBindAs failed.\n");
5334 ✗ then
5335 fail();
5336 end matchcontinue;
5337 end makeBindAs;
5338
5339
5340 public function lookupUpdateMExpDotPathRecord
5341 input Ident inIdent;
5342 input Ident inField;
5343 input PathIdent inPathIdent;
5344 input list<tuple<Ident, MatchingExp>> inFieldMatchings;
5345 input TypeSignature inMType;
5346 input list<ASTDef> inASTDefs;
5347
5348 output TypeSignature outValueType;
5349 output list<tuple<Ident, MatchingExp>> outFieldMatchings;
5350 algorithm
5351 (outValueType, outFieldMatchings) := matchcontinue (inIdent, inField, inPathIdent, inFieldMatchings, inMType, inASTDefs)
5352 local
5353 Ident inid, fieldid, ident;
5354 PathIdent path;
5355 TypeSignature mtype, valtype;
5356 list<ASTDef> astDefs;
5357
5358 list<tuple<Ident, MatchingExp>> fms;
5359 tuple<Ident, MatchingExp> fm;
5360 MatchingExp mexp;
5361 String reason;
5362
5363 case ( inid, fieldid, _, {}, _, _ )
5364 algorithm
5365 ✗ reason := "Unresolved path '" + inid + "', cannot follow the path after a dot, no record match available to look down the path after '" + fieldid + "'.\n";
5366 ✗ valtype := UNRESOLVED_TYPE(reason);
5367 then
5368 ( valtype, {} );
5369
5370 case ( inid, fieldid, path, (ident, mexp) :: fms, mtype, astDefs )
5371 algorithm
5372 ✗ true := stringEq(fieldid, ident);
5373 ✗ ( valtype, mexp ) := lookupUpdateMExpDotPath(inid, path, mexp, mtype, astDefs);
5374 ✗ then
5375 ( valtype, (ident, mexp) :: fms );
5376
5377 case ( inid, fieldid, path, fm :: fms, mtype, astDefs )
5378 algorithm
5379 // false = stringEq(fieldid, ident) );
5380 ✗ ( valtype, fms ) := lookupUpdateMExpDotPathRecord(inid, fieldid, path, fms, mtype, astDefs);
5381 ✗ then
5382 ( valtype, fm :: fms );
5383
5384 //shold not ever happen
5385 else
5386 algorithm
5387 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!lookupUpdateMExpDotPathRecord failed for ident '" + inIdent + "'.\n");
5388 ✗ then
5389 fail();
5390 end matchcontinue;
5391 end lookupUpdateMExpDotPathRecord;
5392
5393
5394 public function lookupUpdateMExpRecord
5395 input Ident inIdent;
5396 input PathIdent inPathIdent;
5397 input list<tuple<Ident, MatchingExp>> inFieldMatchings;
5398 input TypedIdents inFields;
5399 input list<ASTDef> inASTDefs;
5400
5401 output TypeSignature outValueType;
5402 output list<tuple<Ident, MatchingExp>> outFieldMatchings;
5403 algorithm
5404 (outValueType, outFieldMatchings)
5405 := matchcontinue (inIdent, inPathIdent, inFieldMatchings, inFields, inASTDefs)
5406 local
5407 Ident inid, ident;
5408 PathIdent path;
5409 TypeSignature mtype, valtype;
5410 list<ASTDef> astDefs;
5411
5412 list<tuple<Ident, MatchingExp>> fms;
5413 tuple<Ident, MatchingExp> fm;
5414 MatchingExp mexp;
5415 TypedIdents fields;
5416
5417 //case ( _, _, {}, _, _)
5418 // then
5419 // fail();
5420
5421 case ( inid, path, (ident, mexp) :: fms, fields, astDefs )
5422 algorithm
5423 ✗ mtype := lookupTupleList(fields, ident);
5424 ✗ ( valtype, mexp ) := lookupUpdateMatchingExp(inid, path, mexp, mtype, astDefs);
5425 ✗ then
5426 ( valtype, (ident, mexp) :: fms );
5427
5428 case ( _, _, (ident, _) :: _, fields, _ )
5429 algorithm
5430 ✗ true := Flags.isSet(Flags.FAILTRACE);
5431 ✗ failure( lookupTupleList(fields, ident) );
5432 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-Error!!!lookupUpdateMExpRecord failed in lookup for field (type) ident '" + ident + "'.\n");
5433 ✗ then
5434 fail(); //?? will fail the whole lookupUpdateMExpRecord or retry the next case ?
5435
5436 case ( inid, path, fm :: fms, fields, astDefs )
5437 algorithm
5438 ✗ ( valtype, fms ) := lookupUpdateMExpRecord(inid, path, fms, fields, astDefs);
5439 ✗ then
5440 ( valtype, fm :: fms );
5441
5442 end matchcontinue;
5443 end lookupUpdateMExpRecord;
5444
5445
5446 public function lookupUpdateMExpList
5447 input Ident inIdent;
5448 input PathIdent inPathIdent;
5449 input list<MatchingExp> inMExpList;
5450 input list<TypeSignature> inMTypeList;
5451 input list<ASTDef> inASTDefs;
5452
5453 output TypeSignature outValueType;
5454 output list<MatchingExp> outMExpList;
5455 algorithm
5456 (outValueType, outMExpList)
5457 := matchcontinue (inIdent, inPathIdent, inMExpList, inMTypeList, inASTDefs)
5458 local
5459 Ident inid;
5460 PathIdent path;
5461 TypeSignature mtype, valtype;
5462 list<TypeSignature> mtypeLst;
5463 list<ASTDef> astDefs;
5464 MatchingExp mexp;
5465 list<MatchingExp> mexpLst;
5466
5467 //case ( _, _, {}, _, _ )
5468 // then
5469 // fail();
5470
5471 case ( inid, path, (mexp :: mexpLst), (mtype :: _), astDefs )
5472 algorithm
5473 ✗ ( valtype, mexp ) := lookupUpdateMatchingExp(inid, path, mexp, mtype, astDefs);
5474 ✗ then
5475 ( valtype, (mexp :: mexpLst) );
5476
5477 case ( inid, path, (mexp :: mexpLst), (_ :: mtypeLst), astDefs )
5478 algorithm
5479 ✗ ( valtype, mexpLst ) := lookupUpdateMExpList(inid, path, mexpLst, mtypeLst, astDefs);
5480 ✗ then
5481 ( valtype, (mexp :: mexpLst) );
5482
5483 end matchcontinue;
5484 end lookupUpdateMExpList;
5485
5486
5487 public function getFieldsForRecord
5488 input TypeSignature inMType;
5489 input PathIdent inTagPath;
5490 input list<ASTDef> inASTDefs;
5491
5492 output TypedIdents outFields;
5493 output PathIdent inFullyQualifiedTagPath;
5494 algorithm
5495 (outFields, inFullyQualifiedTagPath)
5496 := matchcontinue (inMType, inTagPath, inASTDefs)
5497 local
5498 Ident typeident, tagident;
5499 PathIdent typepath, tagpath, typepckg;
5500 Option<PathIdent> typepckgOpt, tagpckgOpt;
5501 TypeInfo typeinfo;
5502 list<ASTDef> astDefs;
5503 TypedIdents fields;
5504
5505 case ( NAMED_TYPE(name = typepath), tagpath, astDefs )
5506 algorithm
5507 ✗ (typepckgOpt, typeident) := splitPackageAndIdent(typepath);
5508 ✗ (typepckg, typeinfo) := getTypeInfo(typepckgOpt, typeident, astDefs);
5509 ✗ (tagpckgOpt, tagident) := splitPackageAndIdent(tagpath);
5510 ✗ checkPackageOpt(typepckg, tagpckgOpt);
5511 ✗ fields := getFields(tagident, typeinfo, typeident);
5512 ✗ typepath := makePathIdent(typepckg, tagident);
5513 then
5514 (fields, typepath);
5515
5516 case ( NAMED_TYPE(), tagpath, _)
5517 algorithm
5518 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - (getFieldsForRecord) for case tag '" + pathIdentString(tagpath) + "' failed for reason above.\n");
5519 ✗ then
5520 fail();
5521
5522 case ( _, tagpath, _)
5523 algorithm
5524 //failure(NAMED_TYPE(_) = mtype);
5525 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - for case tag '" + pathIdentString(tagpath) + "' the input type is not a NAME_TYPE hence not a union/record type.\n");
5526 ✗ then
5527 fail();
5528
5529 end matchcontinue;
5530 end getFieldsForRecord;
5531
5532
5533 public function splitPackageAndIdent
5534 input PathIdent inTypePathIdent;
5535
5536 output Option<PathIdent> outPackagePath;
5537 output Ident outTypeIdent;
5538 algorithm
5539 (outPackagePath, outTypeIdent) := matchcontinue inTypePathIdent
5540 local
5541 Ident typeident, pckgident;
5542 PathIdent typepath, typepckg;
5543
5544 case IDENT(ident = typeident)
5545 then
5546 (NONE(), typeident );
5547
5548 case PATH_IDENT(ident = pckgident, path = IDENT(ident = typeident) )
5549 ✗ then
5550 ( SOME(IDENT(pckgident)), typeident);
5551
5552 case PATH_IDENT(ident = pckgident, path = typepath as PATH_IDENT() )
5553 algorithm
5554 ✗ (SOME(typepckg), typeident) := splitPackageAndIdent(typepath);
5555 ✗ then
5556 ( SOME(PATH_IDENT(pckgident, typepckg)), typeident) ;
5557
5558 //should not ever happen
5559 else
5560 algorithm
5561 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!splitPackageAndIdent failed.\n");
5562 ✗ then
5563 fail();
5564
5565 end matchcontinue;
5566 end splitPackageAndIdent;
5567
5568 protected function getPackageIdent
5569 input PathIdent inTypePathIdent;
5570
5571 output Ident outTypeIdent;
5572 algorithm
5573 ✗ (_, outTypeIdent) := splitPackageAndIdent(inTypePathIdent);
5574 end getPackageIdent;
5575
5576
5577 public function makePathIdent
5578 input PathIdent inPackage;
5579 input Ident inIdent;
5580
5581 output PathIdent outPathIdent;
5582 algorithm
5583 outPathIdent := matchcontinue (inPackage, inIdent)
5584 local
5585 Ident pckgident, ident;
5586 PathIdent pckgpath, path;
5587
5588 case ( IDENT(ident = pckgident), ident )
5589 ✗ then
5590 PATH_IDENT(pckgident, IDENT(ident));
5591
5592 case ( PATH_IDENT(ident = pckgident, path = pckgpath ), ident )
5593 algorithm
5594 ✗ path := makePathIdent(pckgpath, ident);
5595 ✗ then
5596 PATH_IDENT(pckgident, path);
5597
5598 //should not ever happen
5599 else
5600 algorithm
5601 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!makePathIdent failed.\n");
5602 ✗ then
5603 fail();
5604
5605 end matchcontinue;
5606 end makePathIdent;
5607
5608
5609 public function getTypeInfo
5610 input Option<PathIdent> inTypePackageOpt;
5611 input Ident inTypeIdent;
5612 input list<ASTDef> inASTDefs;
5613
5614 output PathIdent outTypePackage;
5615 output TypeInfo outTypeInfo;
5616 algorithm
5617 ✗ (outTypePackage, outTypeInfo) := lookupTypeInfo(inTypePackageOpt, inTypeIdent, inASTDefs);
5618 ✗ if isNone(inTypePackageOpt) then
5619 ✗ checkUnqualifiedAmbiguity(inTypeIdent, outTypePackage, inASTDefs);
5620 end if;
5621 end getTypeInfo;
5622
5623 protected function lookupTypeInfo
5624 input Option<PathIdent> inTypePackageOpt;
5625 input Ident inTypeIdent;
5626 input list<ASTDef> inASTDefs;
5627
5628 output PathIdent outTypePackage;
5629 output TypeInfo outTypeInfo;
5630 algorithm
5631 (outTypePackage,outTypeInfo )
5632 := matchcontinue (inTypePackageOpt, inTypeIdent, inASTDefs)
5633 local
5634 list<tuple<Ident, TypeInfo>> typeLst;
5635 Ident typeident;
5636 PathIdent typepckg, importckg;
5637 Option<PathIdent> typepckgOpt;
5638 TypeInfo typeinfo;
5639 list<ASTDef> astDefs;
5640
5641 case (NONE(), typeident,
5642 AST_DEF(
5643 importPackage = importckg,
5644 isDefault = true,
5645 types = typeLst) :: _ )
5646 algorithm
5647 ✗ typeinfo := lookupTupleList(typeLst, typeident);
5648 ✗ then
5649 (importckg, typeinfo);
5650
5651 case ( SOME(typepckg), typeident,
5652 AST_DEF(
5653 importPackage = importckg,
5654 types = typeLst) :: _ )
5655 algorithm
5656 ✗ true := valueEq(typepckg, importckg);
5657 ✗ typeinfo := lookupTupleList(typeLst, typeident);
5658 ✗ then
5659 (typepckg, typeinfo);
5660
5661 /*
5662 case ( SOME(typepckg), typeident,
5663 AST_DEF(
5664 importPackage = importckg,
5665 types = typeLst) :: astDefs )
5666 algorithm
5667 equality(typepckg = importckg);
5668 failure(_ = lookupTupleList(typeLst, typeident));
5669 true = Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - getTypeInfo failed to lookup the type '" + typeident + "' for package '" + pathIdentString(typepckg) + "'.\n");
5670 then
5671 fail();
5672 */
5673
5674 case ( typepckgOpt, typeident, ( _ :: astDefs) )
5675 algorithm
5676 ✗ (typepckg, typeinfo) := lookupTypeInfo(typepckgOpt, typeident, astDefs);
5677 then
5678 (typepckg, typeinfo);
5679
5680 case (NONE(), typeident, {} )
5681 algorithm
5682 ✗ addSusanNotification("Error - getTypeInfo failed to lookup the type '" + typeident + "' after looking up all AST definitions.", dummySourceInfo);
5683 ✗ then fail();
5684
5685 case ( SOME(typepckg), typeident, {} )
5686 algorithm
5687 ✗ addSusanNotification("getTypeInfo failed to lookup the type '" + pathIdentString(typepckg) + "." + typeident + "' after looking up all AST definitions.", dummySourceInfo);
5688 ✗ then fail();
5689
5690 end matchcontinue;
5691 end lookupTypeInfo;
5692
5693
5694 protected function checkUnqualifiedAmbiguity
5695 "Reports an error when an unqualified name is found in more than one
5696 default-imported package and the two do not denote the same entity."
5697 input Ident inIdent;
5698 input PathIdent inPackage;
5699 input list<ASTDef> inASTDefs;
5700 protected
5701 String canonical = canonicalTypeName(inPackage, inIdent, inASTDefs), other;
5702 list<String> clashes = {};
5703 algorithm
5704 ✗ for astDef in inASTDefs loop
5705 ✗ if astDef.isDefault then
5706 try
5707 ✗ lookupTupleList(astDef.types, inIdent);
5708 ✗ other := canonicalTypeName(astDef.importPackage, inIdent, inASTDefs);
5709 ✗ if other <> canonical and not listMember(other, clashes) then
5710 clashes := other :: clashes;
5711 end if;
5712 else
5713 end try;
5714 end if;
5715 end for;
5716 ✗ if not listEmpty(clashes) then
5717 ✗ addSusanError("Ambiguous unqualified name '" + inIdent + "': it denotes " + canonical
5718 + " and " + stringDelimitList(listReverse(clashes), ", ") + ". Qualify it.", dummySourceInfo);
5719 end if;
5720 end checkUnqualifiedAmbiguity;
5721
5722 protected function canonicalTypeName
5723 "What an entity of a package resolves to after following aliases."
5724 input PathIdent inPackage;
5725 input Ident inIdent;
5726 input list<ASTDef> inASTDefs;
5727 output String outName;
5728 protected
5729 TypeSignature ty;
5730 algorithm
5731 ✗ ty := deAliasedType(NAMED_TYPE(makePathIdent(inPackage, inIdent)), inASTDefs);
5732 outName := match ty
5733 local
5734 PathIdent path;
5735 ✗ case NAMED_TYPE(name = path) then pathIdentString(path);
5736 ✗ else typeSignatureString(ty);
5737 end match;
5738 end canonicalTypeName;
5739
5740 protected function deAliasedType
5741 input TypeSignature inType;
5742 input list<ASTDef> inASTDefs;
5743
5744 output TypeSignature outType;
5745 algorithm
5746 outType := matchcontinue(inType, inASTDefs)
5747 local
5748 TypeSignature dt;
5749 Ident typeident;
5750 PathIdent typepath;
5751 Option<PathIdent> typepckgOpt;
5752 list<ASTDef> astDefs;
5753
5754 case ( NAMED_TYPE(name = typepath), astDefs )
5755 algorithm
5756 ✗ (typepckgOpt, typeident) := splitPackageAndIdent(typepath);
5757 ✗ (_, TI_ALIAS_TYPE(aliasType = dt)) := getTypeInfo(typepckgOpt, typeident, astDefs);
5758 ✗ then
5759 deAliasedType(dt, astDefs);
5760
5761 else inType;
5762
5763 end matchcontinue;
5764 end deAliasedType;
5765
5766
5767 protected function typesEqual "function typesEqual:
5768 This function compares two type signatures.
5769 Typed variables and already set type variables can be specified.
5770 "
5771 input TypeSignature inType "may have type variables - not dealiased";
5772 input TypeSignature inTypeConcrete "must be conrete - not dealiased";
5773 input list<Ident> inTypeVars;
5774 input TypedIdents inSetTypeVars;
5775 input list<ASTDef> inASTDefs;
5776
5777 output TypedIdents outSetTypeVars;
5778 algorithm
5779 outSetTypeVars := matchcontinue(inType, inTypeConcrete, inTypeVars, inSetTypeVars, inASTDefs)
5780 local
5781 TypeSignature ota, otb, ty, tyConcrete, tyConcreteDA;
5782 list<TypeSignature> otaLst, otbLst;
5783 Ident tid;
5784 list<Ident> tyVars;
5785 TypedIdents setTyVars;
5786 list<ASTDef> astDefs;
5787
5788
5789 case ( LIST_TYPE(ofType = ota), LIST_TYPE(ofType = otb), tyVars, setTyVars, astDefs )
5790 ✗ then
5791 typesEqual(ota, otb, tyVars, setTyVars, astDefs);
5792
5793 case ( ARRAY_TYPE(ofType = ota), ARRAY_TYPE(ofType = otb), tyVars, setTyVars, astDefs )
5794 ✗ then
5795 typesEqual(ota, otb, tyVars, setTyVars, astDefs);
5796
5797 case ( OPTION_TYPE(ofType = ota), OPTION_TYPE(ofType = otb), tyVars, setTyVars, astDefs )
5798 ✗ then
5799 typesEqual(ota, otb, tyVars, setTyVars, astDefs);
5800
5801 case ( TUPLE_TYPE(ofTypes = otaLst), TUPLE_TYPE(ofTypes = otbLst), tyVars, setTyVars, astDefs )
5802 ✗ then
5803 typesEqualList(otaLst, otbLst, tyVars, setTyVars, astDefs);
5804
5805 // a structural type against an alias of one
5806 case ( ty, tyConcrete as NAMED_TYPE(), tyVars, setTyVars, astDefs )
5807 algorithm
5808 ✗ failure(NAMED_TYPE() := ty);
5809 ✗ tyConcreteDA := deAliasedType(tyConcrete, astDefs);
5810 ✗ false := valueEq(tyConcreteDA, tyConcrete);
5811 ✗ then
5812 typesEqual(ty, tyConcreteDA, tyVars, setTyVars, astDefs);
5813
5814 //concrete named type with PathIdent that is not a type variable
5815 case ( NAMED_TYPE(name = PATH_IDENT()), tyConcrete, _, setTyVars, astDefs )
5816 algorithm
5817 ✗ ty := deAliasedType(inType, astDefs);
5818 ✗ tyConcrete := deAliasedType(tyConcrete, astDefs);
5819 ✗ typesEqualConcrete(ty, tyConcrete, astDefs);
5820 ✗ then
5821 setTyVars;
5822
5823 //concrete named type with Ident that is not a type variable
5824 case ( NAMED_TYPE(name = IDENT(tid)), tyConcrete, tyVars, setTyVars, astDefs )
5825 algorithm
5826 ✗ false := listMember(tid, tyVars);
5827 ✗ ty := deAliasedType(inType, astDefs);
5828 ✗ tyConcrete := deAliasedType(tyConcrete, astDefs);
5829 ✗ typesEqualConcrete(ty, tyConcrete, astDefs);
5830 ✗ then
5831 setTyVars;
5832
5833 //try set type vars first
5834 case ( NAMED_TYPE(name = IDENT(tid)), tyConcrete, (_::_), setTyVars, astDefs )
5835 algorithm
5836 ✗ ty := lookupTupleList(setTyVars, tid);
5837 //true = listMember(na, tyVars); //must be true
5838 ✗ tyConcreteDA := deAliasedType(tyConcrete, astDefs);
5839 ✗ typesEqualConcrete(ty, tyConcreteDA, astDefs);
5840 ✗ then
5841 setTyVars;
5842
5843 //failed after found set type var
5844 case ( NAMED_TYPE(name = IDENT(tid)), tyConcrete, (_::_), setTyVars, astDefs )
5845 algorithm
5846 ✗ true := Flags.isSet(Flags.FAILTRACE);
5847 ✗ ty := lookupTupleList(setTyVars, tid);
5848 //true = listMember(na, tyVars); //must be true
5849 ✗ tyConcreteDA := deAliasedType(tyConcrete, astDefs);
5850 ✗ failure( typesEqualConcrete(ty, tyConcreteDA, astDefs) );
5851 ✗ Debug.trace("Error - unmatched type for type variable '" + tid
5852 + "'. Firstly inferred '" + typeSignatureString(ty)
5853 + "', next inferred '" + typeSignatureString(tyConcrete)
5854 + "'(dealiased '" + typeSignatureString(tyConcreteDA) + "').\n"
5855 );
5856 ✗ then
5857 fail();
5858
5859
5860 //infer/make a new set type var
5861 case ( NAMED_TYPE(name = IDENT(tid)), tyConcrete, tyVars as (_::_), setTyVars, astDefs )
5862 algorithm
5863 ✗ failure(lookupTupleList(setTyVars, tid));
5864 ✗ true := listMember(tid, tyVars);
5865 ✗ tyConcreteDA := deAliasedType(tyConcrete, astDefs);
5866 ✗ then
5867 (tid, tyConcreteDA) :: setTyVars;
5868
5869
5870 //?? don't know if this is needed
5871 case ( UNRESOLVED_TYPE(), UNRESOLVED_TYPE(_), _, setTyVars, _ )
5872 then
5873 setTyVars;
5874
5875 // all the others can be matched structurally (as they have no structure)
5876 //except NAMED_TYPE that was matched above
5877 case ( ty, tyConcrete, _, setTyVars,_ )
5878 algorithm
5879 ✗ failure(NAMED_TYPE() := ty);
5880 ✗ true := valueEq(ty, tyConcrete);
5881 ✗ then
5882 setTyVars;
5883
5884 end matchcontinue;
5885 end typesEqual;
5886
5887
5888 protected function typesEqualConcrete "function typesEqualConcrete:
5889 This function compares two type signatures.
5890 It assumes the input types are deAliasedType-ed.
5891 "
5892 input TypeSignature inTypeA "must be concrete - dealiased without type variables";
5893 input TypeSignature inTypeB "must be concrete - dealiased without type variables";
5894 input list<ASTDef> inASTDefs;
5895
5896 algorithm
5897 ():= match(inTypeA, inTypeB, inASTDefs)
5898 local
5899 TypeSignature tyA, tyB;
5900 PathIdent na, nb;
5901 list<ASTDef> astDefs;
5902
5903 //named types
5904 case ( NAMED_TYPE(name = na), NAMED_TYPE(name = nb), _ ) guard valueEq(na, nb)
5905 then
5906 ();
5907
5908 //non-NAME_TYPE can call typesEqual ... the above case prevents infinite recursion loop for NAMED_TYPE
5909 case ( tyA, tyB, astDefs )
5910 algorithm
5911 ✗ failure(NAMED_TYPE() := tyA);
5912 ✗ typesEqual(tyA, tyB, {},{}, astDefs);
5913 then
5914 ();
5915
5916 end match;
5917 end typesEqualConcrete;
5918
5919
5920 protected function typesEqualList
5921 input list<TypeSignature> inTypeAList;
5922 input list<TypeSignature> inTypeBList;
5923 input list<Ident> inTypeVars;
5924 input TypedIdents inSetTypeVars;
5925 input list<ASTDef> inASTDefs;
5926
5927 output TypedIdents outSetTypeVars;
5928 algorithm
5929 outSetTypeVars := match(inTypeAList, inTypeBList, inTypeVars, inSetTypeVars, inASTDefs)
5930 local
5931 TypeSignature ota, otb;
5932 list<TypeSignature> otaLst, otbLst;
5933 list<ASTDef> astDefs;
5934 list<Ident> tyVars;
5935 TypedIdents setTyVars;
5936
5937 case ( {}, {},_ , setTyVars, _)
5938 then setTyVars;
5939
5940 case ( ota :: otaLst, otb :: otbLst, tyVars, setTyVars, astDefs )
5941 algorithm
5942 ✗ setTyVars := typesEqual(ota, otb, tyVars, setTyVars, astDefs);
5943 ✗ then
5944 typesEqualList(otaLst, otbLst, tyVars, setTyVars, astDefs);
5945
5946 end match;
5947 end typesEqualList;
5948
5949
5950 protected function specializeType "function specializeType:
5951 This function specializes type with set type variables and checks if all of them are replaced.
5952 "
5953 input TypeSignature inType "may have type variables";
5954 input list<Ident> inTypeVars;
5955 input TypedIdents inSetTypeVars;
5956
5957 output TypeSignature outType;
5958 algorithm
5959 outType := matchcontinue(inType, inTypeVars, inSetTypeVars)
5960 local
5961 TypeSignature ota, tyConcrete;
5962 list<TypeSignature> otaLst;
5963 Ident tid;
5964 list<Ident> tyVars;
5965 TypedIdents setTyVars;
5966
5967
5968 case ( LIST_TYPE(ofType = ota), tyVars, setTyVars)
5969 algorithm
5970 ✗ ota := specializeType(ota, tyVars, setTyVars);
5971 ✗ then
5972 LIST_TYPE(ota);
5973
5974 case ( ARRAY_TYPE(ofType = ota), tyVars, setTyVars)
5975 algorithm
5976 ✗ ota := specializeType(ota, tyVars, setTyVars);
5977 ✗ then
5978 ARRAY_TYPE(ota);
5979
5980 case ( OPTION_TYPE(ofType = ota), tyVars, setTyVars)
5981 algorithm
5982 ✗ ota := specializeType(ota, tyVars, setTyVars);
5983 ✗ then
5984 OPTION_TYPE(ota);
5985
5986 case ( TUPLE_TYPE(ofTypes = otaLst), tyVars, setTyVars)
5987 algorithm
5988 ✗ otaLst := List.map2(otaLst, specializeType, tyVars, setTyVars);
5989 ✗ then
5990 TUPLE_TYPE(otaLst);
5991
5992 //normal named type that is not a type variable
5993 case ( tyConcrete as NAMED_TYPE(name = IDENT(tid)), tyVars, _)
5994 algorithm
5995 ✗ false := listMember(tid, tyVars);
5996 ✗ then
5997 tyConcrete;
5998
5999 //try set type vars first
6000 case ( NAMED_TYPE(name = IDENT(tid)), (_::_), setTyVars)
6001 algorithm
6002 ✗ tyConcrete := lookupTupleList(setTyVars, tid);
6003 then
6004 tyConcrete;
6005
6006 //error - is type var but not assigned/inferred
6007 case ( NAMED_TYPE(name = IDENT(tid)), tyVars as (_::_), setTyVars )
6008 algorithm
6009 ✗ true := Flags.isSet(Flags.FAILTRACE);
6010 ✗ true := listMember(tid, tyVars);
6011 ✗ failure(lookupTupleList(setTyVars, tid));
6012 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - cannot infer type variable '" + tid + "'.\n" );
6013 ✗ then
6014 fail();
6015
6016
6017 // all the others are concrete already
6018 //except NAMED_TYPE with ident that was dealt above
6019 case ( tyConcrete, _, _)
6020 algorithm
6021 ✗ failure(NAMED_TYPE(name = IDENT()) := tyConcrete);
6022 ✗ then
6023 tyConcrete;
6024
6025 end matchcontinue;
6026 end specializeType;
6027
6028 //for now, succeed or error + fail
6029 public function getFunSignature
6030 input PathIdent inFunName;
6031 input SourceInfo inSourceInfo;
6032 input TemplPackage inTplPackage;
6033
6034 output PathIdent outPath;
6035 output TypedIdents outInArgs;
6036 output TypedIdents outOutArgs;
6037 output list<Ident> outTypeVars;
6038 algorithm
6039 (outPath, outInArgs, outOutArgs, outTypeVars)
6040 := matchcontinue (inFunName, inTplPackage)
6041 local
6042 PathIdent fname, funpckg;
6043 Option<PathIdent> funpckgOpt;
6044 Ident templname, fident;
6045 list<Ident> tyVars;
6046 list<tuple<Ident,TemplateDef>> templateDefs;
6047 list<ASTDef> astDefs;
6048 TypedIdents iargs, oargs;
6049 String msg;
6050
6051 case (fname as IDENT(ident = templname), TEMPL_PACKAGE(templateDefs = templateDefs))
6052 algorithm
6053 ✗ TEMPLATE_DEF(args = iargs) := lookupTupleList(templateDefs, templname);
6054 iargs := imlicitTxtArg :: iargs;
6055 ✗ oargs := List.filterOnTrue(iargs, isText); //just for now, it is not inferred from the usage
6056 //not encoding templates now
6057 //templname = encodeIdent(templname);
6058 //fname = IDENT( templname );
6059 then
6060 (fname, iargs, oargs, {});
6061
6062 case (IDENT(templname), TEMPL_PACKAGE(templateDefs = templateDefs))
6063 algorithm
6064 ✗ lookupTupleList(templateDefs, templname);
6065 ✗ msg := "Constant template '" + templname + "' is used in a function/template context (while it is defined as a constant).";
6066 ✗ addSusanError(msg, inSourceInfo);
6067 ✗ then
6068 fail();
6069
6070 case (fname, TEMPL_PACKAGE(astDefs = astDefs))
6071 algorithm
6072 ✗ NAMED_TYPE(fname) := deAliasedType(NAMED_TYPE(fname), astDefs);
6073 ✗ (funpckgOpt, fident) := splitPackageAndIdent(fname);
6074 ✗ (funpckg, TI_FUN_TYPE(inArgs = iargs, outArgs = oargs, tyVars = tyVars))
6075 := getTypeInfo(funpckgOpt, fident, astDefs);
6076 ✗ fname := if valueEq(IDENT("builtin"), funpckg) then IDENT(fident) else makePathIdent(funpckg, fident);
6077 then
6078 (fname, iargs, oargs, tyVars);
6079
6080 else
6081 algorithm
6082 ✗ msg := "Unresolved template/function name '" + pathIdentString(inFunName) + "'.";
6083 ✗ addSusanError(msg, inSourceInfo);
6084 ✗ then
6085 fail();
6086 end matchcontinue;
6087 end getFunSignature;
6088
6089
6090 public function checkPackageOpt
6091 input PathIdent inPackage;
6092 input Option<PathIdent> inPackageOpt;
6093 algorithm
6094 () := match (inPackage, inPackageOpt)
6095 local
6096 PathIdent path, pckgpath;
6097
6098 case ( _,NONE())
6099 then
6100 ();
6101
6102 case ( path, SOME(pckgpath) ) guard valueEq(path, pckgpath)
6103 then
6104 ();
6105
6106 else
6107 algorithm
6108 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!checkPackageOpt failed - package paths are not the same.\n");
6109 ✗ then
6110 fail();
6111
6112 end match;
6113 end checkPackageOpt;
6114
6115
6116 public function getFields
6117 input Ident inTagIdent;
6118 input TypeInfo inTypeInfo;
6119 input Ident inTypeIdent;
6120
6121 output TypedIdents outFields;
6122 algorithm
6123 outFields := matchcontinue (inTagIdent, inTypeInfo, inTypeIdent)
6124 local
6125 Ident typeident, tagident;
6126 TypeInfo typeinfo;
6127 TypedIdents fields;
6128 list<tuple<Ident, TypedIdents>> rectags;
6129
6130 case ( tagident, TI_UNION_TYPE(recTags = rectags) , _)
6131 algorithm
6132 ✗ fields := lookupTupleList(rectags, tagident);
6133 then
6134 fields;
6135
6136 case ( tagident, TI_UNION_TYPE(recTags = rectags) , typeident)
6137 algorithm
6138 ✗ true := Flags.isSet(Flags.FAILTRACE);
6139 ✗ failure(lookupTupleList(rectags, tagident));
6140 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - getFields failed to lookup the union tag '" + tagident + "', that is not found in type '" + typeident + "'.\n");
6141 ✗ then
6142 fail();
6143
6144 case ( tagident, TI_RECORD_TYPE(fields = fields), typeident )
6145 algorithm
6146 ✗ true := stringEq(tagident, typeident);
6147 then
6148 fields;
6149
6150 case ( tagident, TI_RECORD_TYPE(), typeident )
6151 algorithm
6152 ✗ false := stringEq(tagident, typeident);
6153 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("Error - getFields failed to match the tag '" + tagident + "', the type '" + typeident + "' expected.\n");
6154 ✗ then
6155 fail();
6156
6157 //should not ever happen
6158 case ( _, typeinfo, _ )
6159 algorithm
6160 ✗ failure(TI_UNION_TYPE() := typeinfo);
6161 ✗ failure(TI_RECORD_TYPE() := typeinfo);
6162 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("- getFields failed - the typeinfo is neither union nor record type.\n");
6163 ✗ then
6164 fail();
6165
6166 end matchcontinue;
6167 end getFields;
6168
6169
6170 public function isRecordTag
6171 input Ident inTagIdent;
6172 input TypeInfo inTypeInfo;
6173 input Ident inTypeIdent;
6174
6175 algorithm
6176 () :=
6177 match (inTagIdent, inTypeInfo, inTypeIdent)
6178 local
6179 Ident typeident, tagident;
6180 list<tuple<Ident, TypedIdents>> rectags;
6181
6182 case ( tagident, TI_UNION_TYPE(recTags = rectags) , _)
6183 algorithm
6184 ✗ lookupTupleList(rectags, tagident);
6185 then ();
6186
6187 case ( tagident, TI_RECORD_TYPE(), typeident )
6188 algorithm
6189 ✗ true := stringEq(tagident, typeident);
6190 then ();
6191 end match;
6192 end isRecordTag;
6193
6194 public function fullyQualifyASTDefs
6195 input list<ASTDef> inASTDefs;
6196 output list<ASTDef> outFullyQualifiedASTDefs;
6197 algorithm
6198 outFullyQualifiedASTDefs := matchcontinue inASTDefs
6199 local
6200 list<tuple<Ident, TypeInfo>> typeLst;
6201 PathIdent importckg;
6202 list<ASTDef> restAstDefs;
6203 Boolean isdefault, isinterface;
6204
6205 case {} then {};
6206
6207 case AST_DEF(
6208 importPackage = importckg,
6209 isDefault = isdefault,
6210 isInterface = isinterface,
6211 types = typeLst) :: restAstDefs
6212 algorithm
6213 ✗ typeLst := listMap1Tuple22(typeLst, fullyQualifyAstTypeInfo, importckg);
6214 ✗ restAstDefs := fullyQualifyASTDefs(restAstDefs);
6215 ✗ then
6216 (AST_DEF(importckg, isdefault, isinterface, typeLst) :: restAstDefs);
6217
6218 case AST_DEF(
6219 importPackage = importckg,
6220 types = typeLst) :: _
6221 algorithm
6222 ✗ true := Flags.isSet(Flags.FAILTRACE);
6223 ✗ failure(typeLst := listMap1Tuple22(typeLst, fullyQualifyAstTypeInfo, importckg));
6224 ✗ Debug.trace("-fullyQualifyASTDefs failed for importckg = " + pathIdentString(importckg) + " .\n");
6225 ✗ then
6226 fail();
6227
6228 //should not happen
6229 else
6230 algorithm
6231 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!! fullyQualifyASTDefs failed .\n");
6232 ✗ then
6233 fail();
6234 end matchcontinue;
6235 end fullyQualifyASTDefs;
6236
6237
6238 public function fullyQualifyAstTypeInfo
6239 input TypeInfo inASTTypeInfo;
6240 input PathIdent inImportPackage;
6241
6242 output TypeInfo outFullyQualifiedASTTypeInfo;
6243 algorithm
6244 outFullyQualifiedASTTypeInfo := matchcontinue (inASTTypeInfo, inImportPackage)
6245 local
6246 PathIdent importpckg;
6247 list<tuple<Ident, TypedIdents>> recTags;
6248 TypedIdents fields, inArgs, outArgs;
6249 TypeSignature aliasType, constType;
6250 list<Ident> tyvars;
6251
6252 case ( TI_UNION_TYPE( recTags = recTags ) , importpckg )
6253 algorithm
6254 ✗ recTags := listMap2Tuple22(recTags, fullyQualifyAstTypedIdents, importpckg, {});
6255 ✗ then
6256 TI_UNION_TYPE(recTags);
6257
6258 case ( TI_RECORD_TYPE( fields = fields ) , importpckg )
6259 algorithm
6260 ✗ fields := fullyQualifyAstTypedIdents(fields, importpckg, {});
6261 ✗ then
6262 TI_RECORD_TYPE(fields);
6263
6264 case ( TI_ALIAS_TYPE( aliasType = aliasType ) , importpckg )
6265 algorithm
6266 ✗ aliasType := fullyQualifyAstTypeSignature(aliasType, importpckg, {});
6267 ✗ then
6268 TI_ALIAS_TYPE(aliasType);
6269
6270 case ( TI_FUN_TYPE( inArgs = inArgs, outArgs = outArgs, tyVars = tyvars) , importpckg )
6271 algorithm
6272 ✗ inArgs := fullyQualifyAstTypedIdents(inArgs, importpckg, tyvars);
6273 ✗ outArgs := fullyQualifyAstTypedIdents(outArgs, importpckg, tyvars);
6274 ✗ then
6275 TI_FUN_TYPE( inArgs, outArgs, tyvars);
6276
6277 case ( TI_CONST_TYPE( constType = constType ) , importpckg )
6278 algorithm
6279 ✗ constType := fullyQualifyAstTypeSignature(constType, importpckg, {});
6280 ✗ then
6281 TI_CONST_TYPE( constType );
6282
6283
6284 //should not happen
6285 else
6286 algorithm
6287 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!! fullyQualifyAstTypeInfo failed .\n");
6288 ✗ then
6289 fail();
6290 end matchcontinue;
6291 end fullyQualifyAstTypeInfo;
6292
6293
6294 public function fullyQualifyAstTypedIdents
6295 input TypedIdents inASTDefTypedIdents;
6296 input PathIdent inImportPackage;
6297 input list<Ident> inTypeVars;
6298
6299 output TypedIdents outASTDefTypedIdents;
6300 algorithm
6301 ✗ outASTDefTypedIdents :=
6302 listMap2Tuple22(inASTDefTypedIdents, fullyQualifyAstTypeSignature, inImportPackage, inTypeVars);
6303 end fullyQualifyAstTypedIdents;
6304
6305
6306 public function fullyQualifyAstTypeSignature
6307 input TypeSignature inASTDefTypeSignature;
6308 input PathIdent inImportPackage;
6309 input list<Ident> inTypeVars;
6310
6311 output TypeSignature outASTDefTypeSignature;
6312 algorithm
6313 outASTDefTypeSignature := matchcontinue (inASTDefTypeSignature, inImportPackage, inTypeVars)
6314 local
6315 list<TypeSignature> typeLst;
6316 Ident typeident;
6317 list<Ident> tyVars;
6318 PathIdent importpckg, na;
6319 TypeSignature ota, ts;
6320
6321 case ( LIST_TYPE(ofType = ota), importpckg, tyVars )
6322 algorithm
6323 ✗ ota := fullyQualifyAstTypeSignature(ota, importpckg, tyVars);
6324 ✗ then
6325 LIST_TYPE(ota);
6326
6327 case ( ARRAY_TYPE(ofType = ota), importpckg, tyVars )
6328 algorithm
6329 ✗ ota := fullyQualifyAstTypeSignature(ota, importpckg, tyVars);
6330 ✗ then
6331 ARRAY_TYPE(ota);
6332
6333 case ( OPTION_TYPE(ofType = ota), importpckg, tyVars )
6334 algorithm
6335 ✗ ota := fullyQualifyAstTypeSignature(ota, importpckg, tyVars);
6336 ✗ then
6337 OPTION_TYPE(ota);
6338
6339 case ( TUPLE_TYPE(ofTypes = typeLst), importpckg, tyVars )
6340 algorithm
6341 ✗ typeLst := List.map2(typeLst, fullyQualifyAstTypeSignature, importpckg, tyVars);
6342 ✗ then
6343 TUPLE_TYPE(typeLst);
6344
6345 //exclude a type variable from qualification
6346 case ( ts as NAMED_TYPE(name = IDENT(ident = typeident)), _, tyVars )
6347 algorithm
6348 ✗ true := listMember(typeident, tyVars);
6349 then
6350 ts;
6351
6352
6353 //qualify and convert Tpl.Text -> TEXT_TYPE()
6354 case ( NAMED_TYPE(name = IDENT(ident = typeident)), importpckg, _ )
6355 algorithm
6356 ✗ na := makePathIdent(importpckg, typeident);
6357 ✗ ts := convertNameTypeIfIntrinsic(na);
6358 then
6359 ts;
6360
6361 //convert Tpl.Text -> TEXT_TYPE()
6362 case ( NAMED_TYPE(name = na as PATH_IDENT()), _, _ )
6363 algorithm
6364 ✗ ts := convertNameTypeIfIntrinsic(na);
6365 then
6366 ts;
6367
6368 //all the others
6369 else inASTDefTypeSignature;
6370
6371 end matchcontinue;
6372 end fullyQualifyAstTypeSignature;
6373
6374
6375 public function convertNameTypeIfIntrinsic
6376 input PathIdent inNameOfType;
6377 output TypeSignature outTypeSignature;
6378 algorithm
6379 outTypeSignature := match inNameOfType
6380
6381 case PATH_IDENT(ident = "Tpl", path = IDENT("Text"))
6382 then
6383 TEXT_TYPE();
6384
6385 //case ( PATH_IDENT(ident = "Tpl", path = IDENT("StringToken")) )
6386 // then
6387 // STRING_TOKEN_TYPE();
6388
6389
6390 ✗ else NAMED_TYPE(inNameOfType);
6391
6392 end match;
6393 end convertNameTypeIfIntrinsic;
6394
6395
6396 public function fullyQualifyTemplateDef
6397 input TemplateDef inTemplateDef;
6398 input list<ASTDef> inASTDefs;
6399
6400 output TemplateDef outTemplateDef;
6401 algorithm
6402 outTemplateDef := matchcontinue (inTemplateDef, inASTDefs)
6403 local
6404 TypedIdents targs;
6405 Expression texp;
6406 String lesc, resc, str;
6407 TypeSignature litType;
6408 list<ASTDef> astDefs;
6409 TemplateDef def;
6410
6411
6412 case ( LITERAL_DEF(value = str, litType = litType), astDefs)
6413 algorithm
6414 ✗ litType := fullyQualifyTemplateTypeSignature(litType, astDefs); //only for a future ... it can be now only INTEGER_TYPE, REAL_TYPE or BOOLEAN_TYPE
6415 ✗ then
6416 LITERAL_DEF(str, litType);
6417
6418 case ( def as STR_TOKEN_DEF(), _)
6419 then
6420 def;
6421
6422 case ( TEMPLATE_DEF(args = targs, lesc = lesc, resc = resc, exp = texp), astDefs)
6423 algorithm
6424 ✗ targs := listMap1Tuple22(targs, fullyQualifyTemplateTypeSignature, astDefs);
6425 ✗ then
6426 TEMPLATE_DEF(targs, lesc, resc, texp);
6427
6428 //can fail on errror
6429 else
6430 algorithm
6431 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("- fullyQualifyTemplateDef failed .\n");
6432 ✗ then
6433 fail();
6434
6435 end matchcontinue;
6436 end fullyQualifyTemplateDef;
6437
6438
6439 public function fullyQualifyTemplateTypeSignature
6440 input TypeSignature inTemplateTypeSignature;
6441 input list<ASTDef> inASTDefs;
6442
6443 output TypeSignature outFullyQualifiedTypeSignature;
6444 algorithm
6445 outFullyQualifiedTypeSignature := matchcontinue (inTemplateTypeSignature, inASTDefs)
6446 local
6447 list<TypeSignature> typeLst;
6448 Ident typeident;
6449 TypeSignature ota;
6450 list<ASTDef> astDefs;
6451 PathIdent typepckg, typepath;
6452 Option<PathIdent> typepckgOpt;
6453
6454
6455 case ( LIST_TYPE(ofType = ota), astDefs )
6456 algorithm
6457 ✗ ota := fullyQualifyTemplateTypeSignature(ota, astDefs);
6458 ✗ then
6459 LIST_TYPE(ota);
6460
6461 case ( ARRAY_TYPE(ofType = ota), astDefs )
6462 algorithm
6463 ✗ ota := fullyQualifyTemplateTypeSignature(ota, astDefs);
6464 ✗ then
6465 ARRAY_TYPE(ota);
6466
6467 case ( OPTION_TYPE(ofType = ota), astDefs )
6468 algorithm
6469 ✗ ota := fullyQualifyTemplateTypeSignature(ota, astDefs);
6470 ✗ then
6471 OPTION_TYPE(ota);
6472
6473 case ( TUPLE_TYPE(ofTypes = typeLst), astDefs )
6474 algorithm
6475 ✗ typeLst := List.map1(typeLst, fullyQualifyTemplateTypeSignature, astDefs);
6476 ✗ then
6477 TUPLE_TYPE(typeLst);
6478
6479 //a special case for Text ... Text is an intrinsic type from Susan's viewpoint
6480 case ( NAMED_TYPE(name = IDENT("Text")), _ )
6481 then
6482 TEXT_TYPE();
6483
6484 //check existence and qualify if needed
6485 case ( NAMED_TYPE(name = typepath), astDefs )
6486 algorithm
6487 ✗ (typepckgOpt, typeident) := splitPackageAndIdent(typepath);
6488 ✗ (typepckg, _) := getTypeInfo(typepckgOpt, typeident, astDefs);
6489 ✗ typepath := makePathIdent(typepckg, typeident);
6490 ✗ then
6491 NAMED_TYPE(typepath);
6492
6493 //all the others
6494 else inTemplateTypeSignature;
6495 end matchcontinue;
6496 end fullyQualifyTemplateTypeSignature;
6497
6498 protected function lookupTupleList
6499 input list<tuple<Type_a,Type_b>> inList;
6500 input Type_a inItemA;
6501 output Type_b outItemB;
6502
6503 replaceable type Type_a subtypeof Any;
6504 replaceable type Type_b subtypeof Any;
6505 algorithm
6506 outItemB := match(inList, inItemA)
6507 local
6508 Type_a a, itemA;
6509 Type_b itemB;
6510 list<tuple<Type_a,Type_b>> rest;
6511
6512 case ( (a, itemB) :: _, itemA ) guard valueEq(a, itemA)
6513 then itemB;
6514 case ( _ :: rest, itemA)
6515 ✗ then lookupTupleList(rest, itemA);
6516 end match;
6517 end lookupTupleList;
6518
6519 protected function updateTupleList
6520 input list<tuple<Type_a,Type_b>> inList;
6521 input tuple<Type_a,Type_b> inTuple;
6522
6523 output list<tuple<Type_a,Type_b>> outList;
6524
6525 replaceable type Type_a subtypeof Any;
6526 replaceable type Type_b subtypeof Any;
6527 algorithm
6528 outList := matchcontinue(inList, inTuple)
6529 local
6530 Type_a a;
6531 list<tuple<Type_a,Type_b>> lst;
6532
6533 case (lst, (a,_))
6534 algorithm
6535 ✗ lookupTupleList(lst, a);
6536 then lst;
6537
6538 else (inTuple :: inList);
6539 end matchcontinue;
6540 end updateTupleList;
6541
6542 protected function lookupDeleteTupleList
6543 input list<tuple<Type_a,Type_b>> inList;
6544 input Type_a inItemA;
6545 output Type_b outItemB;
6546 output list<tuple<Type_a,Type_b>> outList;
6547
6548 replaceable type Type_a subtypeof Any;
6549 replaceable type Type_b subtypeof Any;
6550 algorithm
6551 (outItemB, outList) := match(inList, inItemA)
6552 local
6553 Type_a a, itemA;
6554 Type_b itemB;
6555 list<tuple<Type_a,Type_b>> rest;
6556 tuple<Type_a,Type_b> h;
6557
6558 case ( (a, itemB) :: rest, itemA ) guard valueEq(a, itemA)
6559 ✗ then
6560 (itemB, rest);
6561
6562 case ( h :: rest, itemA)
6563 algorithm
6564 ✗ (itemB, rest) := lookupDeleteTupleList(rest, itemA);
6565 ✗ then
6566 (itemB, h :: rest);
6567 end match;
6568 end lookupDeleteTupleList;
6569
6570 protected function alignTupleList "
6571 Alignes the first list to be ordered by the second list with respect of the first elements of the (double) tuples.
6572 Only those tuples from the first list that have a corresponding tuple with the same first element in the second list will be included.
6573 Assuming the lists have distinct tuples (no multiple first elements occurrences)."
6574 input list<tuple<Type_a,Type_b>> inListToAlign;
6575 input list<tuple<Type_a,Type_c>> inListAlignBy;
6576
6577 output list<tuple<Type_a,Type_b>> outAlignedList;
6578
6579 replaceable type Type_a subtypeof Any;
6580 replaceable type Type_b subtypeof Any;
6581 replaceable type Type_c subtypeof Any;
6582 algorithm
6583 outAlignedList := matchcontinue(inListToAlign, inListAlignBy)
6584 local
6585 Type_a a;
6586 Type_b b;
6587 list<tuple<Type_a,Type_b>> lst, lstAl;
6588 list<tuple<Type_a,Type_c>> lstBy;
6589
6590 case (lstAl, (a,_) :: lstBy)
6591 algorithm
6592 ✗ b := lookupTupleList(lstAl, a);
6593 ✗ lst := alignTupleList(lstAl, lstBy);
6594 ✗ then (a,b) :: lst;
6595
6596 case (lstAl, _ :: lstBy)
6597 algorithm
6598 //failure(b = lookupTupleList(lstAl, a));
6599 ✗ lst := alignTupleList(lstAl, lstBy);
6600 then lst;
6601
6602 case (_, {} )
6603 then {};
6604
6605 end matchcontinue;
6606 end alignTupleList;
6607
6608 protected function listMap1Tuple22
6609 input list<tuple<Type_a,Type_b>> inList;
6610 input Fun_Tbd_to_Tc inFun_Tbd_to_Tc;
6611 input Type_d inExtraArg;
6612
6613 output list<tuple<Type_a,Type_c>> outList;
6614
6615 partial function Fun_Tbd_to_Tc
6616 input Type_b inTypeB;
6617 input Type_d inTypeD;
6618 output Type_c outTypeC;
6619 replaceable type Type_b subtypeof Any;
6620 replaceable type Type_c subtypeof Any;
6621 end Fun_Tbd_to_Tc;
6622 replaceable type Type_a subtypeof Any;
6623 replaceable type Type_b subtypeof Any;
6624 replaceable type Type_c subtypeof Any;
6625 replaceable type Type_d subtypeof Any;
6626 algorithm
6627 outList := match(inList, inFun_Tbd_to_Tc, inExtraArg)
6628 local
6629 Type_a a;
6630 Type_b itemB;
6631 Type_c itemC;
6632 Type_d extarg;
6633 Fun_Tbd_to_Tc funBDtoC;
6634 list<tuple<Type_a,Type_b>> restB;
6635 list<tuple<Type_a,Type_c>> restC;
6636
6637 case ( {}, _, _) then {};
6638
6639 case ( (a, itemB) :: restB, funBDtoC, extarg )
6640 algorithm
6641 ✗ itemC := funBDtoC(itemB, extarg);
6642 ✗ restC := listMap1Tuple22(restB, funBDtoC, extarg);
6643 ✗ then
6644 ((a, itemC) :: restC);
6645
6646
6647 end match;
6648 end listMap1Tuple22;
6649
6650
6651 protected function listMap2Tuple22
6652 input list<tuple<Type_a,Type_b>> inList;
6653 input Fun_Tbde_to_Tc inFun_Tbde_to_Tc;
6654 input Type_d inExtraArg;
6655 input Type_e inExtraArg2;
6656
6657 output list<tuple<Type_a,Type_c>> outList;
6658
6659 partial function Fun_Tbde_to_Tc
6660 input Type_b inTypeB;
6661 input Type_d inTypeD;
6662 input Type_e inExtraArg2;
6663 output Type_c outTypeC;
6664 replaceable type Type_b subtypeof Any;
6665 replaceable type Type_c subtypeof Any;
6666 end Fun_Tbde_to_Tc;
6667 replaceable type Type_a subtypeof Any;
6668 replaceable type Type_b subtypeof Any;
6669 replaceable type Type_c subtypeof Any;
6670 replaceable type Type_d subtypeof Any;
6671 replaceable type Type_e subtypeof Any;
6672 algorithm
6673 outList := match(inList, inFun_Tbde_to_Tc, inExtraArg, inExtraArg2)
6674 local
6675 Type_a a;
6676 Type_b itemB;
6677 Type_c itemC;
6678 Type_d extarg;
6679 Type_e extarg2;
6680 Fun_Tbde_to_Tc funBDEtoC;
6681 list<tuple<Type_a,Type_b>> restB;
6682 list<tuple<Type_a,Type_c>> restC;
6683
6684 case ( {}, _, _, _) then {};
6685
6686 case ( (a, itemB) :: restB, funBDEtoC, extarg, extarg2 )
6687 algorithm
6688 ✗ itemC := funBDEtoC(itemB, extarg, extarg2);
6689 ✗ restC := listMap2Tuple22(restB, funBDEtoC, extarg, extarg2);
6690 ✗ then
6691 ((a, itemC) :: restC);
6692
6693
6694 end match;
6695 end listMap2Tuple22;
6696
6697 //**************************************
6698 // *** debug output functions
6699 //**************************************
6700
6701 public function addSusanError
6702 input String inErrMsg;
6703 input SourceInfo inInfo;
6704 algorithm
6705 ✗ if Flags.isSet(Flags.FAILTRACE) then
6706 ✗ Debug.traceln("Error - " + inErrMsg);
6707 end if;
6708 ✗ Error.addSourceMessage(Error.SUSAN_ERROR, {inErrMsg}, inInfo);
6709 end addSusanError;
6710
6711 protected function addSusanNotification
6712 input String inErrMsg;
6713 input SourceInfo inInfo;
6714 algorithm
6715 ✗ Error.addSourceMessage(Error.SUSAN_NOTIFY, {inErrMsg}, inInfo);
6716 end addSusanNotification;
6717
6718 public function canBeEscapedUnquoted
6719 input list<String> inStringList;
6720 output Boolean outCanBeUnquoted;
6721 algorithm
6722 outCanBeUnquoted :=
6723 match inStringList
6724 local
6725 String str;
6726 list<String> rest;
6727
6728 case { str } guard (stringLength(str) > 0) and canBeEscapedUnquotedChars(stringListStringChar(str))
6729 then
6730 true;
6731
6732 case str :: (rest as (_::_)) guard (stringLength(str) > 0) and canBeEscapedUnquotedChars(stringListStringChar(str))
6733 ✗ then
6734 canBeEscapedUnquoted(rest);
6735
6736 //can not be unquoted or empty list(should not happen)
6737 else
6738 false;
6739
6740 end match;
6741 end canBeEscapedUnquoted;
6742
6743
6744 protected function canBeEscapedUnquotedChars
6745 input list<String> inChars;
6746 output Boolean outCanBeUnquoted;
6747 algorithm
6748 outCanBeUnquoted :=
6749 match inChars
6750 local
6751 String c;
6752 list<String> chars;
6753
6754 case {} then true;
6755
6756 // \a \b \f \r \v ... TODO: Error in the .srz or .c compilation(\r)
6757 case c :: chars
6758 guard (c == "\'")
6759 or (c == "\"")
6760 or (c == "?")
6761 or (c == "\\")
6762 or (c == "\n")
6763 or (c == "\t")
6764 or (c == " ")
6765 ✗ then canBeEscapedUnquotedChars(chars);
6766
6767 else false;
6768
6769 end match;
6770 end canBeEscapedUnquotedChars;
6771
6772
6773 public function canBeOnOneLine
6774 input list<String> inStringList;
6775 output Boolean outCanBeOnOneLine;
6776 algorithm
6777 ✗ outCanBeOnOneLine :=
6778 (listLength(inStringList) <= 4)
6779 and stringLength(stringAppendList(inStringList)) <= 10;
6780 end canBeOnOneLine;
6781
6782
6783 public function pathIdentString
6784 input PathIdent inPathIndent;
6785 output String outPathIdentString;
6786 algorithm
6787 outPathIdentString := match inPathIndent
6788 local
6789 Ident ident;
6790 PathIdent path;
6791
6792 case IDENT(ident = ident)
6793 then
6794 ident;
6795
6796 case PATH_IDENT(ident = ident, path = path )
6797 algorithm
6798 ✗ ident := ident + "." + pathIdentString(path);
6799 then
6800 ident;
6801
6802 //should not ever happen
6803 else
6804 algorithm
6805 ✗ true := Flags.isSet(Flags.FAILTRACE); Debug.trace("-!!!pathIdentString failed.\n");
6806 ✗ then
6807 fail();
6808
6809 end match;
6810 end pathIdentString;
6811
6812
6813 protected
6814 constant Tpl.Text eTxt = Tpl.emptyTxt;
6815
6816 public function typeSignatureString
6817 input TypeSignature inTS;
6818 output String outStr;
6819
6820 protected
6821 Tpl.Text txt;
6822 algorithm
6823 ✗ txt := TplCodegen.typeSig(eTxt, inTS);
6824 ✗ outStr := Tpl.textString(txt);
6825 end typeSignatureString;
6826
6827 public function mmExpString
6828 input MMExp inMMExp;
6829 output String outStr;
6830
6831 protected
6832 Tpl.Text txt;
6833 algorithm
6834 ✗ txt := TplCodegen.mmExp(eTxt, inMMExp,"=");
6835 ✗ outStr := Tpl.textString(txt);
6836 end mmExpString;
6837
6838 public function stmtsString
6839 input list<MMExp> inStmts;
6840 output String outStr;
6841
6842 protected
6843 Tpl.Text txt;
6844 //list<MMExp> v_statements;
6845 algorithm
6846 ✗ txt := TplCodegen.mmStatements(eTxt, inStmts); //<statements : mmExp(it, '=')\n>
6847 ✗ outStr := Tpl.textString(txt);
6848 end stmtsString;
6849
6850 public function removeUnusedImports
6851 input output MMPackage pkg;
6852 protected
6853 AvlSetString.Tree set;
6854 PathIdent name;
6855 Boolean b;
6856 algorithm
6857 set := AvlSetString.EMPTY();
6858 ✗ for e in pkg.mmDeclarations loop
6859 () := match e
6860 case MM_FUN()
6861 algorithm
6862 ✗ set := addTypedIdentsToSet(set, e.inArgs);
6863 ✗ set := addTypedIdentsToSet(set, e.outArgs);
6864 ✗ set := addTypedIdentsToSet(set, e.locals);
6865 ✗ for exp in e.statements loop
6866 ✗ set := addExpToSet(set, exp);
6867 end for;
6868 then ();
6869 else ();
6870 end match;
6871 end for;
6872 ✗ pkg.mmDeclarations := list(elt for elt guard match elt
6873 case MM_IMPORT(packageName=name)
6874 algorithm
6875 ✗ b := AvlSetString.hasKey(set, getPackageIdent(name));
6876 ✗ if not b and Flags.isSet(Flags.FAILTRACE) then
6877 ✗ Debug.trace("removeUnusedImports: "+encodePathIdent(name,"")+"\n");
6878 end if;
6879 then b;
6880 else true;
6881 end match in pkg.mmDeclarations);
6882 end removeUnusedImports;
6883
6884 protected
6885
6886 function addTypedIdentsToSet
6887 input output AvlSetString.Tree set;
6888 input TypedIdents ids;
6889 protected
6890 TypeSignature sig;
6891 algorithm
6892 ✗ for tpl in ids loop
6893 ✗ (_,sig) := tpl;
6894 ✗ set := addTypeSignatureToSet(set,sig);
6895 end for;
6896 end addTypedIdentsToSet;
6897
6898 function addTypeSignatureToSet
6899 input output AvlSetString.Tree set;
6900 input TypeSignature sig;
6901 protected
6902 TypeSignature sig2;
6903 list<TypeSignature> sigs;
6904 PathIdent name;
6905 algorithm
6906 set := match sig
6907 ✗ case LIST_TYPE(sig2) then addTypeSignatureToSet(set, sig2);
6908 ✗ case ARRAY_TYPE(sig2) then addTypeSignatureToSet(set, sig2);
6909 ✗ case OPTION_TYPE(sig2) then addTypeSignatureToSet(set, sig2);
6910 ✗ case TUPLE_TYPE(sigs) then List.foldr(sigs, addTypeSignatureToSet, set);
6911 ✗ case NAMED_TYPE(name) then addPathIdentToSet(set, name);
6912 else set;
6913 end match;
6914 end addTypeSignatureToSet;
6915
6916 function addPathIdentToSet
6917 input output AvlSetString.Tree set;
6918 input PathIdent name;
6919 algorithm
6920 set := match name
6921 ✗ case IDENT() then AvlSetString.add(set, name.ident);
6922 ✗ case PATH_IDENT() then AvlSetString.add(set, name.ident);
6923 end match;
6924 end addPathIdentToSet;
6925
6926 function addExpToSet
6927 input output AvlSetString.Tree set;
6928 input MMExp exp;
6929 algorithm
6930 set := match exp
6931 ✗ case MM_ASSIGN() then addExpToSet(set, exp.rhs);
6932 ✗ case MM_FN_CALL() then List.foldr(exp.args, addExpToSet, addPathIdentToSet(set, exp.fnName));
6933 ✗ case MM_IDENT() then addPathIdentToSet(set, exp.ident);
6934 ✗ case MM_MATCH() then List.foldr(exp.matchCases, addMatchCaseToSet, set);
6935 ✗ case MM_LIST_FOR_LOOP() then List.foldr(exp.matchCases, addMatchCaseToSet, set);
6936 else set;
6937 end match;
6938 end addExpToSet;
6939
6940 function addMatchCaseToSet
6941 input output AvlSetString.Tree set;
6942 input MMMatchCase c;
6943 protected
6944 list<MatchingExp> mexps;
6945 list<MMExp> exps;
6946 algorithm
6947 ✗ (mexps,exps) := c;
6948 ✗ set := List.foldr(exps, addExpToSet, set);
6949 ✗ set := List.foldr(mexps, addMatchingExpToSet, set);
6950 end addMatchCaseToSet;
6951
6952 function addMatchingExpToSet
6953 input output AvlSetString.Tree set;
6954 input MatchingExp exp;
6955 protected
6956 MatchingExp e;
6957 algorithm
6958 set := match exp
6959 ✗ case BIND_AS_MATCH() then addMatchingExpToSet(set, exp.matchingExp);
6960 case RECORD_MATCH()
6961 algorithm
6962 ✗ set := addPathIdentToSet(set, exp.tagName);
6963 ✗ for tpl in exp.fieldMatchings loop
6964 ✗ (_, e) := tpl;
6965 ✗ set := addMatchingExpToSet(set, e);
6966 end for;
6967 then set;
6968 ✗ case SOME_MATCH() then addMatchingExpToSet(set, exp.value);
6969 ✗ case TUPLE_MATCH() then List.foldr(exp.tupleArgs, addMatchingExpToSet, set);
6970 ✗ case LIST_MATCH() then List.foldr(exp.listElts, addMatchingExpToSet, set);
6971 ✗ case LIST_CONS_MATCH() then addMatchingExpToSet(addMatchingExpToSet(set, exp.head), exp.rest);
6972 else set;
6973 end match;
6974 end addMatchingExpToSet;
6975
6976 annotation(__OpenModelica_Interface="susan");
6977 end TplAbsyn;
6978