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 / 173
Functions: -% 0 / 1 / 1
Branches: 0.0% 0 / 0 / 80

OMCompiler/Compiler/Script/Figaro.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 Figaro "Figaro support."
37
38 // Imports
39 import Absyn;
40 import Error;
41 import FBuiltin;
42 import SCode;
43 protected
44
45 import Autoconf;
46 import AbsynUtil;
47 import System;
48
49 // Aliases
50 public type Ident = Absyn.Ident;
51 public type Path = Absyn.Path;
52 public type TypeSpec = Absyn.TypeSpec;
53
54 public function run "The main function to be called from CevalScript. This one is very imperative
55 because of all the side-effects. However, all of them are captured here."
56 input SCode.Program inProgram;
57 input Path inPath;
58 input String workingDir "working directory";
59 input String inDatabaseFile "Figaro database file";
60 input String inMode "Figaro processor mode";
61 input String inOptions "Figaro fault tree generation options";
62 input String inFigaroProcessorFile "Figaro processor to call";
63 protected
64 String bdfFile = workingDir + "/FigaroObjects.fi" "Figaro code to the Figaro processor";
65 String figaroFile = workingDir + "/Figaro0.fi" "Figaro code from the Figaro processor";
66 String argumentFile = workingDir + "/figp_commands.xml" "instructions to the Figaro processor";
67 String resultFile = System.pwd() + "/result.xml" "status from the Figaro processor"; // File name cannot be changed.
68 SCode.Element program;
69 String figaro, database, xml, xml2;
70 list<String> sl;
71 algorithm
72
73 ✗ program := FBuiltin.getElementWithPathCheckBuiltin(inProgram, inPath);
74
75 // Code for the Figaro objects.
76 ✗ figaro := makeFigaro(inProgram, program, inProgram);
77
78 ✗ if figaro == ""
79 ✗ then fail();
80 end if;
81 ✗ System.writeFile(bdfFile, figaro);
82
83 // Get XML defining the database.
84 //database := System.readFile(inDatabaseFile);
85 database := inDatabaseFile;
86 //database := System.trimWhitespace(database);
87
88 // Instructions for the Figaro processor.
89 ✗ xml := makeXml(workingDir, database, bdfFile, inMode, inOptions, figaroFile);
90 ✗ System.writeFile(argumentFile, xml);
91
92 ✗ callFigaroProcessor(inFigaroProcessorFile, argumentFile);
93
94 // Temporary (or maybe permanent) fix because the Figaro processor works in an asynchronous way.
95
96 if Autoconf.os == "Windows_NT" then
97 System.systemCall("timeout 5");
98 else
99 ✗ System.systemCall("sleep 5");
100 end if;
101
102 // Result from the Figaro processor.
103 ✗ xml2 := System.readFile(resultFile);
104 ✗ sl := interpret(xml2);
105 ✗ if reportErrors(sl)
106 then
107 /* Error.addMessage(Error.FIGARO_ERROR, {"For more information see" + System.pwd() + "/result.xml"}); */
108 ✗ fail();
109 end if;
110 end run;
111
112 protected uniontype FigaroClass "A class that has a corresponding class in Figaro."
113 record FIGAROCLASS
114 Ident className;
115 String typeName "Figaro type name";
116 end FIGAROCLASS;
117 end FigaroClass;
118
119 protected uniontype FigaroObject "A component that will be an object in Figaro."
120 record FIGAROOBJECT
121 String objectName;
122 String typeName "Figaro type name";
123 String figaroCode "a piece of Figaro code that belongs to the object";
124 end FIGAROOBJECT;
125 end FigaroObject;
126
127 public function makeFigaro "Translates a program to Figaro. First finds all relevant classes. Then
128 finds all instances of those classes."
129 input list<SCode.Element> inProgram;
130 input SCode.Element inModel;
131 input list<SCode.Element> env;
132 output String outCode;
133 protected
134 list<FigaroClass> fcl;
135 list<FigaroObject> fol;
136 algorithm
137 ✗ fcl := listAppend(
138 fcElementList("Figaro_Object", "", inModel, NONE(), inProgram, env),
139 fcElementList("Figaro_Object_connector", "", inModel, NONE(), inProgram, env)
140 );
141
142 // Debug.
143 ✗ printFigaroClassList(fcl);
144 ✗ print("\n\n");
145
146 ✗ fol := foElement(fcl, inModel);
147
148 // Debug.
149 ✗ printFigaroObjectList(fol);
150
151 ✗ outCode := figaroObjectListToString(fol);
152 end makeFigaro;
153
154 /* Finds all classes derived from the specified base class and also
155 carries along the Figaro type name in order to assign the correct Figaro type to a class if it
156 does not have an explicit fullClassName modifier. */
157
158 protected function fcElement
159 input Ident inFigaroBase;
160 input String inFigaroType;
161 input SCode.Element inProgram;
162
163 input Option<Ident> inClassName;
164
165 input SCode.Element inElement;
166 input list<SCode.Element> env;
167 output list<FigaroClass> outFigaroClassList;
168 algorithm
169 outFigaroClassList := matchcontinue (inFigaroBase, inFigaroType, inProgram, inClassName, inElement, env)
170 local
171 Ident fb;
172 String ft;
173 SCode.Element program, cdef;
174 list<SCode.Element> e;
175 Ident cn;
176 Path bcp;
177 SCode.Mod m;
178 String tn;
179 Ident n;
180 SCode.ClassDef cd;
181 // Element is an extends clause.
182 case (fb, ft, program, SOME(cn), SCode.EXTENDS(baseClassPath = bcp, modifications = m), e)
183 algorithm
184
185 ✗ true := fb == getLastIdent(bcp);
186 ✗ tn := fcMod1(m);
187 ✗ then fcAddFigaroClass(ft, program, cn, tn, e);
188 case (fb, ft, program, SOME(cn), SCode.EXTENDS(baseClassPath = bcp, modifications = m), e)
189 algorithm
190 ✗ cdef := FBuiltin.getElementWithPathCheckBuiltin(e, bcp);
191 ✗ true := fcExtends(fb, ft, program, SOME(cn), cdef, e);
192 ✗ tn := fcMod1(m);
193 ✗ then fcAddFigaroClass(ft, program, cn, tn, e);
194 // Nested class of some sort.
195 case (fb, ft, program, _, SCode.CLASS(name = n, classDef = cd), e)
196 ✗ then fcClassDef(fb, ft, program, n, cd, e);
197 end matchcontinue;
198 end fcElement;
199
200 protected function fcExtends
201 input Ident inFigaroBase;
202 input String inFigaroType;
203 input SCode.Element inProgram;
204 input Option<Ident> inClassName;
205
206 input SCode.Element inElement;
207 input list<SCode.Element> env;
208 output Boolean doExtend;
209 algorithm
210 doExtend := matchcontinue (inFigaroBase, inFigaroType, inProgram, inClassName, inElement, env)
211 local
212 Ident fb;
213 String ft;
214 SCode.Element program, cdef;
215 list<SCode.Element> e, el;
216 Ident cn;
217 Path bcp;
218 Ident n;
219 // Element is an extends clause.
220 case (fb, ft, program, _, SCode.CLASS(name = n, classDef = SCode.PARTS(elementLst = el)), e)
221 algorithm
222 ✗ then fcElementListExt(fb, ft, program, SOME(n), el, e);
223 case (fb, _, _, SOME(_), SCode.EXTENDS(baseClassPath = bcp), _)
224 algorithm
225 ✗ true := fb == getLastIdent(bcp);
226 then true;
227 case (fb, ft, program, SOME(cn), SCode.EXTENDS(baseClassPath = bcp), e)
228 algorithm
229 ✗ cdef := FBuiltin.getElementWithPathCheckBuiltin(e, bcp);
230 ✗ then fcExtends(fb, ft, program, SOME(cn), cdef, e);
231 // Nested class of some sort.
232 case (_, _, _, _, _, _)
233 then false;
234 end matchcontinue;
235 end fcExtends;
236
237 protected function fcElementListExt
238 input Ident inFigaroBase;
239 input String inFigaroType;
240 input SCode.Element inProgram;
241 input Option<Ident> inClassName;
242 input list<SCode.Element> inElementList;
243 input list<SCode.Element> env;
244 output Boolean res;
245 algorithm
246 res := matchcontinue (inFigaroBase, inFigaroType, inProgram, inClassName, inElementList, env)
247 local
248 Ident fb;
249 String ft;
250 SCode.Element program;
251 Option<Ident> cn;
252 list<SCode.Element> e;
253 SCode.Element first;
254 list<SCode.Element> rest;
255 case (_, _, _, _, {}, _)
256 then false;
257 case (fb, ft, program, cn, first :: _, e)
258 algorithm
259 ✗ true := fcExtends(fb, ft, program, cn, first, e);
260 then true;
261 case (fb, ft, program, cn, _ :: rest, e)
262 ✗ then fcElementListExt(fb, ft, program, cn, rest, e);
263 end matchcontinue;
264 end fcElementListExt;
265
266 protected function fcAddFigaroClass "Adds Figaro class. Finds classes inherited from that class."
267 input String inFigaroType;
268 input SCode.Element inProgram;
269 input Ident inClassName;
270
271 input String inTypeName;
272 input list<SCode.Element> env;
273 output list<FigaroClass> outFigaroClassList;
274 protected
275 String tn;
276 FigaroClass fc;
277 algorithm
278 ✗ tn := if inTypeName == "" then inFigaroType else inTypeName;
279 ✗ fc := FIGAROCLASS(inClassName, tn);
280 ✗ outFigaroClassList := fc :: fcElement(inClassName, tn, inProgram, NONE(), inProgram, env);
281 end fcAddFigaroClass;
282
283 protected function fcClassDef
284 input Ident inFigaroBase;
285 input String inFigaroType;
286 input SCode.Element inProgram;
287
288 input Ident inClassName;
289 input SCode.ClassDef inClassDef;
290 input list<SCode.Element> env;
291 output list<FigaroClass> outFigaroClassList;
292 algorithm
293 outFigaroClassList := match (inFigaroBase, inFigaroType, inProgram, inClassName, inClassDef, env)
294 local
295 Ident fb;
296 String ft;
297 SCode.Element program;
298 Ident cn;
299 list<SCode.Element> e;
300 list<SCode.Element> el;
301 TypeSpec ts;
302 SCode.Mod m;
303 Path p;
304 String tn;
305 case (fb, ft, program, cn, SCode.PARTS(elementLst = el), e)
306 ✗ then fcElementList(fb, ft, program, SOME(cn), el, e);
307 // Short class definitions.
308 case (fb, ft, program, cn, SCode.DERIVED(typeSpec = ts, modifications = m), e)
309 algorithm
310 ✗ p := AbsynUtil.typeSpecPath(ts);
311 ✗ true := fb == getLastIdent(p);
312 ✗ tn := fcMod1(m);
313 ✗ then fcAddFigaroClass(ft, program, cn, tn, e);
314 end match;
315 end fcClassDef;
316
317 protected function fcElementList
318 input Ident inFigaroBase;
319 input String inFigaroType;
320 input SCode.Element inProgram;
321 input Option<Ident> inClassName;
322 input list<SCode.Element> inElementList;
323 input list<SCode.Element> env;
324 output list<FigaroClass> outFigaroClassList;
325 algorithm
326 outFigaroClassList := matchcontinue (inFigaroBase, inFigaroType, inProgram, inClassName, inElementList, env)
327 local
328 Ident fb;
329 String ft;
330 SCode.Element program;
331 Option<Ident> cn;
332 list<SCode.Element> e;
333 SCode.Element first;
334 list<SCode.Element> rest;
335 list<FigaroClass> rf, rr;
336 case (_, _, _, _, {}, _)
337 then {};
338 case (fb, ft, program, cn, first :: rest, e)
339 algorithm
340 ✗ rf := fcElement(fb, ft, program, cn, first, e);
341 ✗ rr := fcElementList(fb, ft, program, cn, rest, e);
342 ✗ then listAppend(rf, rr);
343 case (fb, ft, program, cn, _ :: rest, e)
344 ✗ then fcElementList(fb, ft, program, cn, rest, e);
345 end matchcontinue;
346 end fcElementList;
347
348 protected function fcMod1
349 input SCode.Mod inMod;
350 output String outTypeName;
351 algorithm
352 outTypeName := match inMod
353 local
354 list<SCode.SubMod> sml;
355 case SCode.MOD(subModLst = sml)
356 ✗ then fcSubModList(sml);
357 case SCode.NOMOD()
358 then "";
359 end match;
360 end fcMod1;
361
362 protected function fcSubModList
363 input list<SCode.SubMod> inSubModList;
364 output String outTypeName;
365 algorithm
366 outTypeName := matchcontinue inSubModList
367 local
368 SCode.SubMod first;
369 list<SCode.SubMod> rest;
370 case {}
371 then "";
372 case first :: _
373 ✗ then fcSubMod(first);
374 case _ :: rest
375 ✗ then fcSubModList(rest);
376 end matchcontinue;
377 end fcSubModList;
378
379 protected function fcSubMod
380 input SCode.SubMod inSubMod;
381 output String outTypeName;
382 algorithm
383 outTypeName := match inSubMod
384 local
385 Ident n;
386 SCode.Mod m;
387 case SCode.NAMEMOD(ident = n, mod = m)
388 algorithm
389 ✗ true := n == "fullClassName";
390 ✗ then fcMod2(m);
391 end match;
392 end fcSubMod;
393
394 protected function fcMod2
395 input SCode.Mod inMod;
396 output String outTypeName;
397 algorithm
398 outTypeName := match inMod
399 local
400 Absyn.Exp e;
401 case SCode.MOD(binding = NONE())
402 then "";
403 case SCode.MOD(binding = SOME(e))
404 ✗ then fcExp(e);
405 end match;
406 end fcMod2;
407
408 protected function fcExp "returns the actual Figaro type name"
409 input Absyn.Exp inExp;
410 output String outTypeName;
411 algorithm
412 outTypeName := match inExp
413 local
414 String tn;
415 case Absyn.STRING(value = tn)
416 then tn;
417 end match;
418 end fcExp;
419
420 /* Finds declarations and checks whether the type matches any of the Figaro classes.
421 If that is the case, then those objects are collected. */
422
423 protected function foElement
424 input list<FigaroClass> inFigaroClassList;
425
426 input SCode.Element inElement;
427 output list<FigaroObject> outFigaroObjectList;
428 algorithm
429 outFigaroObjectList := match (inFigaroClassList, inElement)
430 local
431 list<FigaroClass> fcl;
432
433 Ident n;
434 SCode.ClassDef cd;
435 Path p;
436 TypeSpec ts;
437 SCode.Mod m;
438 String tn;
439 String c, tmp;
440 FigaroObject fo;
441 case (fcl, SCode.CLASS(classDef = cd))
442 ✗ then foClassDef(fcl, cd);
443 case (fcl, SCode.COMPONENT(name = n, typeSpec = ts, modifications = m))
444 algorithm
445 ✗ p := AbsynUtil.typeSpecPath(ts);
446 //tn = findFigaroTypeName(p, fcl);
447 ✗ tmp := foMod1(m, "fullClassName");
448 ✗ tn := if tmp == "" then findFigaroTypeName(p, fcl) else tmp;
449 ✗ c := foMod1(m, "codeInstanceFigaro");
450 ✗ fo := FIGAROOBJECT(n, tn, c);
451 then {fo};
452 end match;
453 end foElement;
454
455 protected function foClassDef
456 input list<FigaroClass> inFigaroClassList;
457
458 input SCode.ClassDef inClassDef;
459 output list<FigaroObject> outFigaroObjectList;
460 algorithm
461 outFigaroObjectList := match (inFigaroClassList, inClassDef)
462 local
463 list<FigaroClass> fcl;
464 list<SCode.Element> el;
465 case (fcl, SCode.PARTS(elementLst = el))
466 ✗ then foElementList(fcl, el);
467 end match;
468 end foClassDef;
469
470 protected function foElementList
471 input list<FigaroClass> inFigaroClassList;
472
473 input list<SCode.Element> inElementList;
474 output list<FigaroObject> outFigaroObjectList;
475 algorithm
476 outFigaroObjectList := matchcontinue (inFigaroClassList, inElementList)
477 local
478 list<FigaroClass> fcl;
479 SCode.Element first;
480 list<SCode.Element> rest;
481 list<FigaroObject> rf, rr;
482 case (_, {})
483 then {};
484 case (fcl, first :: rest)
485 algorithm
486 ✗ rf := foElement(fcl, first);
487 ✗ rr := foElementList(fcl, rest);
488 ✗ then listAppend(rf, rr);
489 case (fcl, _ :: rest)
490 ✗ then foElementList(fcl, rest);
491 end matchcontinue;
492 end foElementList;
493
494 protected function findFigaroTypeName
495 input Path inClassPath;
496 input list<FigaroClass> inFigaroClassList;
497 output String outTypeName;
498 algorithm
499 outTypeName := matchcontinue (inClassPath, inFigaroClassList)
500 local
501 Path p;
502 FigaroClass first;
503 list<FigaroClass> rest;
504 String tn;
505 case (_, {})
506 then fail();
507 case (p, first :: _)
508 algorithm
509 ✗ tn := getFigaroTypeName(p, first);
510 then tn;
511 case (p, _ :: rest)
512 algorithm
513 ✗ tn := findFigaroTypeName(p, rest);
514 then tn;
515 end matchcontinue;
516 end findFigaroTypeName;
517
518 protected function getFigaroTypeName
519 input Path inClassPath;
520 input FigaroClass inFigaroClass;
521 output String outTypeName;
522 algorithm
523 outTypeName := match (inClassPath, inFigaroClass)
524 local
525 Path p;
526 Ident cn;
527 String tn;
528 case (p, FIGAROCLASS(className = cn, typeName = tn))
529 algorithm
530 ✗ true := getLastIdent(p) == cn;
531 then tn;
532 end match;
533 end getFigaroTypeName;
534
535 protected function foMod1
536 input SCode.Mod inMod;
537 input String name;
538 output String outCode;
539 algorithm
540 outCode := match inMod
541 local
542 list<SCode.SubMod> sml;
543 case SCode.MOD(subModLst = sml)
544 ✗ then foSubModList(sml, name);
545 case SCode.NOMOD()
546 then "";
547 end match;
548 end foMod1;
549
550 protected function foSubModList
551 input list<SCode.SubMod> inSubModList;
552 input String name;
553 output String outCode;
554 algorithm
555 outCode := matchcontinue inSubModList
556 local
557 SCode.SubMod first;
558 list<SCode.SubMod> rest;
559 case {}
560 then "";
561 case first :: _
562 ✗ then foSubMod(first, name);
563 case _ :: rest
564 ✗ then foSubModList(rest, name);
565 end matchcontinue;
566 end foSubModList;
567
568 protected function foSubMod
569 input SCode.SubMod inSubMod;
570 input String name;
571 output String outCode;
572 algorithm
573 outCode := match inSubMod
574 local
575 Ident n;
576 SCode.Mod m;
577 case SCode.NAMEMOD(ident = n, mod = m)
578 algorithm
579 ✗ true := n == name;
580 ✗ then foMod2(m);
581 end match;
582 end foSubMod;
583
584 protected function foMod2
585 input SCode.Mod inMod;
586 output String outCode;
587 algorithm
588 outCode := match inMod
589 local
590 Absyn.Exp e;
591 case SCode.MOD(binding = NONE())
592 then "";
593 case SCode.MOD(binding = SOME(e))
594 ✗ then foExp(e);
595 end match;
596 end foMod2;
597
598 protected function foExp "returns the actual Figaro code"
599 input Absyn.Exp inExp;
600 output String outCode;
601 algorithm
602 outCode := match inExp
603 local
604 String c;
605 case Absyn.STRING(value = c)
606 then c;
607 end match;
608 end foExp;
609
610 protected function getLastIdent "Retrieves the last identifier in a path."
611 input Path inPath;
612 output Ident outIdent;
613 algorithm
614 outIdent := match inPath
615 local
616 Path p;
617 Ident n;
618 case Absyn.QUALIFIED(path = p)
619 ✗ then getLastIdent(p);
620 case Absyn.IDENT(name = n)
621 then n;
622 case Absyn.FULLYQUALIFIED(path = p)
623 ✗ then getLastIdent(p);
624 end match;
625 end getLastIdent;
626
627 protected function figaroObjectListToString "Makes Figaro code from a list of Figaro objects."
628 input list<FigaroObject> inFigaroObjectList;
629 output String outString;
630 algorithm
631 outString := match inFigaroObjectList
632 local
633 FigaroObject first;
634 list<FigaroObject> rest;
635 String rf, rr;
636 case {}
637 then "";
638 case first :: rest
639 algorithm
640 ✗ rf := figaroObjectToString(first);
641 ✗ rr := figaroObjectListToString(rest);
642 ✗ then rf + rr;
643 end match;
644 end figaroObjectListToString;
645
646 protected function figaroObjectToString "Makes Figaro code from a Figaro object."
647 input FigaroObject inFigaroObject;
648 output String outString;
649 algorithm
650 outString := match inFigaroObject
651 local
652 String on;
653 String tn;
654 String fc;
655 String middle;
656 case FIGAROOBJECT(objectName = on, typeName = tn, figaroCode = fc)
657 algorithm
658 ✗ middle := if fc == "" then "" else "\n" + fc;
659 ✗ then "OBJECT " + on + " IS_A " + tn + ";" + middle + "\n\n";
660 end match;
661 end figaroObjectToString;
662
663 protected function makeXml "Makes instructions for the Figaro processor."
664 input String workingDir;
665 input String inDatabase "database the Figaro processor will use";
666 input String inBdfFile "Figaro code to the Figaro processor";
667 input String inMode "Figaro processor mode";
668 input String inOptions "Figaro fault tree generation options";
669 input String inFigaroFile "Figaro code from the Figaro processor";
670 output String outXml;
671 protected
672 String xml, newName;
673 list<String> sl;
674 algorithm
675 xml := "<REQUESTS>\n ";
676 ✗ xml := xml + "\n\n<LOAD_BDC_FI>\n <FILE_FI>";
677 ✗ xml := xml + inDatabase + "</FILE_FI>\n";
678
679 // In case a dbc file exists
680 ✗ sl := stringListStringChar(inDatabase);
681 ✗ newName := truncateExtension(sl);
682 ✗ if System.regularFileExists(newName + ".bdc") then
683 ✗ xml := xml + "<FILE> " + newName + ".bdc</FILE>\n";
684 end if;
685 ✗ xml := xml + "</LOAD_BDC_FI>\n";
686 ✗ xml := xml + "\n\n<LOAD_BDF_FI>\n <FILE>";
687 ✗ xml := xml + inBdfFile;
688 ✗ xml := xml + "</FILE>\n</LOAD_BDF_FI>\n";
689 ✗ xml := xml + "<RUN_TREATMENT>\n";
690
691
692 // In case the fault tree will be needed.
693 ✗ if inMode == "figaro0" then
694 ✗ xml := xml + " <TREATMENT>GENERATE_FIG0</TREATMENT>\n <FILE>";
695 ✗ xml := xml + inFigaroFile;
696 ✗ xml := xml + "</FILE>";
697 elseif inMode == "fault-tree" then
698 ✗ xml := xml + " <TREATMENT>GENERATE_TREE</TREATMENT>\n <FILE>";
699 ✗ xml := xml + workingDir + "/FaultTree.xml";
700 ✗ xml := xml + "</FILE>\n";
701 ✗ xml := xml + " <FILE_MACRO>fiab_ADD.h</FILE_MACRO>";
702 ✗ xml := xml + "\n <FILE_TREE_OPTIONS>" + inOptions + "</FILE_TREE_OPTIONS>";
703 end if;
704
705 ✗ xml := xml + "\n <RESOLVE_CONST>VRAI</RESOLVE_CONST>\n <RESOLVE_ATTR>FAUX</RESOLVE_ATTR>\n <INST_RULE>VRAI</INST_RULE>\n";
706 ✗ xml := xml + "</RUN_TREATMENT>\n</REQUESTS>";
707 outXml := xml;
708 end makeXml;
709
710 protected function truncateExtension
711 input List<String> name;
712
713 output String newName;
714 algorithm
715 newName := match name
716 local String c;
717 List<String> rest;
718 case "."::_
719 then "";
720 case c::rest
721 ✗ then stringAppend (c, truncateExtension(rest));
722 end match;
723 end truncateExtension;
724
725 protected function callFigaroProcessor "Calls the Figaro processor."
726 input String inFigaroProcessorFile "Figaro processor to call";
727 input String inArgumentFile "argument to the Figaro processor";
728 protected
729 String command;
730 algorithm
731 ✗ command := "start " + inFigaroProcessorFile + " -testxml " + inArgumentFile;
732 ✗ System.systemCall(command);
733 end callFigaroProcessor;
734
735 protected uniontype Token "An XML token."
736 record OPENTAG
737 String tagName;
738 end OPENTAG;
739 record CLOSETAG
740 String tagName;
741 end CLOSETAG;
742 record TEXT
743 String text;
744 end TEXT;
745 end Token;
746
747 protected function interpret "Interprets XML from the Figaro processor."
748 input String inString "XML to interpret";
749 output list<String> outStringList "errors found";
750 algorithm
751 outStringList := match inString
752 local
753 String s;
754 list<String> sl, sl2;
755 list<Token> tl, tl2, tl3;
756 case s
757 algorithm
758 ✗ sl := stringListStringChar(s);
759 ✗ tl := scan(sl);
760 ✗ tl2 := removeFirstIfText(tl);
761 ✗ tl3 := removeTokens(tl2);
762 ✗ sl2 := parse(tl3);
763 then sl2;
764 case _
765 algorithm
766 // Report unknown error. Bad XML.
767 then fail();
768 end match;
769 end interpret;
770
771 protected function scan "Lexer main function."
772 input list<String> inStringList "character sequence to scan";
773 output list<Token> outTokenList "token sequence";
774 algorithm
775 outTokenList := matchcontinue inStringList
776 local
777 list<String> rest, r;
778 Token t;
779 String s;
780 case {}
781 then {};
782 // XML declaration.
783 case "<" :: "?" :: rest
784 algorithm
785 ✗ r := scanDeclaration(rest);
786 ✗ then scan(r);
787 // Closing tag.
788 case "<" :: "/" :: rest
789 algorithm
790 ✗ (r, s) := scanTagName(rest);
791 ✗ t := CLOSETAG(s);
792 ✗ then t :: scan(r);
793 // Opening tag.
794 case "<" :: rest
795 algorithm
796 ✗ (r, s) := scanTagName(rest);
797 ✗ t := OPENTAG(s);
798 ✗ then t :: scan(r);
799 // Some text.
800 case rest
801 algorithm
802 ✗ (r, s) := scanText(rest);
803 ✗ t := TEXT(s);
804 ✗ then t :: scan(r);
805 end matchcontinue;
806 end scan;
807
808 protected function scanDeclaration "Scans a declaration."
809 input list<String> inStringList "string sequence to scan";
810 output list<String> outStringList "string sequence to continue scanning";
811 algorithm
812 outStringList := match inStringList
813 local
814 list<String> rest;
815 case "?" :: ">" :: rest
816 then rest;
817 case _ :: rest
818 ✗ then scanDeclaration(rest);
819 end match;
820 end scanDeclaration;
821
822 protected function scanTagName "Scans a tag name."
823 input list<String> inStringList "string sequence to scan";
824 input String inTagName = "" "accumulated tag name";
825 output list<String> outStringList "string sequence to continue scanning";
826 output String outTagName;
827 algorithm
828 (outStringList, outTagName) := match inStringList
829 local
830 String first;
831 list<String> rest;
832 case ">" :: rest
833 then (rest, inTagName);
834 case first :: rest
835 ✗ then scanTagName(rest, inTagName + first);
836 end match;
837 end scanTagName;
838
839 protected function scanText "Greedy. Scans text until some kind of tag begins."
840 input list<String> inStringList "string sequence to scan";
841 input String inText = "" "accumulated text";
842 output list<String> outStringList "string sequence to continue scanning";
843 output String outText;
844 algorithm
845 (outStringList, outText) := match inStringList
846 local
847 String first;
848 list<String> rest;
849 case {}
850 then ({}, "");
851 case "<" :: _
852 then (inStringList, inText);
853 case first :: rest
854 ✗ then scanText(rest, inText + first);
855 end match;
856 end scanText;
857
858 /* These functions walk over the token sequence from the lexer and throw away tokens that will not
859 be usable. E. g., if a tag is not known, the tokens associated with it will be thrown away.
860 The purpose of this step is to return a very simple sequence for the parser to work on. */
861
862 protected function removeTokens
863 input list<Token> inTokenList;
864 output list<Token> outTokenList;
865 algorithm
866 outTokenList := match inTokenList
867 local
868 Token first;
869 list<Token> rest, r;
870 String tn;
871 case {}
872 then {};
873 case OPENTAG(tagName = tn) :: rest guard isKnownTag(tn) and not isInfoTag(tn)
874 algorithm
875 ✗ r := removeFirstIfText(rest);
876 ✗ then OPENTAG(tn) :: removeTokens(r);
877 case OPENTAG(tagName = tn) :: rest guard not isKnownTag(tn)
878 algorithm
879 ✗ r := removeUnknown(rest, tn);
880 ✗ then removeTokens(r);
881 case CLOSETAG(tagName = tn) :: rest
882 algorithm
883 ✗ r := removeFirstIfText(rest);
884 ✗ then CLOSETAG(tn) :: removeTokens(r);
885 case first :: rest
886 ✗ then first :: removeTokens(rest);
887 end match;
888 end removeTokens;
889
890 protected function removeFirstIfText
891 input list<Token> inTokenList;
892 output list<Token> outTokenList;
893 algorithm
894 outTokenList := match inTokenList
895 local
896 list<Token> rest;
897 case TEXT() :: rest
898 then rest;
899 else
900 inTokenList;
901 end match;
902 end removeFirstIfText;
903
904 protected function removeUnknown "Removes tokens until the closing tag is found."
905 input list<Token> inTokenList;
906 input String inTagName;
907 output list<Token> outTokenList;
908 algorithm
909 outTokenList := match inTokenList
910 local
911 String tn;
912 list<Token> rest;
913 case {}
914 then {};
915 case CLOSETAG(tagName = tn) :: rest guard tn == inTagName
916 ✗ then removeFirstIfText(rest);
917 case _ :: rest
918 ✗ then removeUnknown(rest, inTagName);
919 end match;
920 end removeUnknown;
921
922 protected function isKnownTag "Answers whether the tag contributes to the tree structure we want to
923 parse for fault analysis."
924 input String inTagName;
925 output Boolean outBoolean;
926 protected
927 list<String> ktl = {"ANSWERS", "ANSWER", "ERROR", "LABEL", "CRITICITY"} "list of tags defining
928 the important structure";
929 algorithm
930 ✗ outBoolean := listMember(inTagName, ktl);
931 end isKnownTag;
932
933 protected function isInfoTag "Answers whether a tag gives us any concrete information about an error."
934 input String inTagName;
935 output Boolean outBoolean;
936 protected
937 list<String> itl = {"LABEL", "CRITICITY"} "list of tags containing information about an error";
938 algorithm
939 ✗ outBoolean := listMember(inTagName, itl);
940 end isInfoTag;
941
942 protected function parse "Parser main function."
943 input list<Token> inTokenList "token sequence to parse";
944 output list<String> outStringList "list of error messages";
945 algorithm
946 outStringList := match inTokenList
947 local
948 String tn;
949 list<Token> rest;
950 case {}
951 then {};
952 case OPENTAG(tagName = tn) :: rest
953 algorithm
954 ✗ true := tn == "ANSWERS";
955 ✗ then parseAnswers(rest);
956 end match;
957 end parse;
958
959 protected function parseAnswers
960 input list<Token> inTokenList;
961 output list<String> outStringList "list of error messages";
962 protected
963 list<String> sl;
964 algorithm
965 ✗ (sl, _) := parseAnswerList(inTokenList);
966 outStringList := sl;
967 end parseAnswers;
968
969 protected function parseAnswerList
970 input list<Token> inTokenList;
971 output list<String> outStringList "list of error messages";
972 output list<Token> outTokenList;
973 algorithm
974 (outStringList, outTokenList) := match inTokenList
975 local
976 String tn;
977 list<String> sl, sl2;
978 list<Token> rest, tl, tl2;
979 case OPENTAG(tagName = tn) :: rest
980 algorithm
981 ✗ true := tn == "ANSWER";
982 ✗ (sl, tl) := parseAnswer(rest);
983 ✗ (sl2, tl2) := parseAnswerList(tl);
984 ✗ then (listAppend(sl, sl2), tl2);
985 case CLOSETAG(tagName = tn) :: rest
986 algorithm
987 ✗ true := tn == "ANSWERS";
988 then ({}, rest);
989 end match;
990 end parseAnswerList;
991
992 protected function parseAnswer
993 input list<Token> inTokenList;
994 output list<String> outStringList "list of error messages";
995 output list<Token> outTokenList;
996 algorithm
997 ✗ (outStringList, outTokenList) := parseErrorList(inTokenList);
998 end parseAnswer;
999
1000 protected function parseErrorList
1001 input list<Token> inTokenList;
1002 output list<String> outStringList "list of error messages";
1003 output list<Token> outTokenList;
1004 algorithm
1005 (outStringList, outTokenList) := match inTokenList
1006 local
1007 String tn;
1008 list<String> sl, sl2;
1009 list<Token> rest, tl, tl2;
1010 case OPENTAG(tagName = tn) :: rest
1011 algorithm
1012 ✗ true := tn == "ERROR";
1013 ✗ (sl, tl) := parseError(rest);
1014 ✗ (sl2, tl2) := parseErrorList(tl);
1015 ✗ then (listAppend(sl, sl2), tl2);
1016 case CLOSETAG(tagName = tn) :: rest
1017 algorithm
1018 ✗ true := tn == "ANSWER";
1019 then ({}, rest);
1020 end match;
1021 end parseErrorList;
1022
1023 protected function parseError
1024 input list<Token> inTokenList;
1025 output list<String> outStringList "list of error messages";
1026 output list<Token> outTokenList;
1027 protected
1028 list<tuple<String, String>> stl;
1029 list<Token> tl;
1030 list<String> sl;
1031 algorithm
1032 ✗ (stl, tl) := parseInfoList(inTokenList);
1033 ✗ sl := if isToBeReported(stl) then {getMessage(stl)} else {};
1034 ✗ (outStringList, outTokenList) := (sl, tl);
1035 end parseError;
1036
1037 protected function parseInfoList
1038 input list<Token> inTokenList;
1039 output list<tuple<String, String>> outStringTupleList;
1040 output list<Token> outTokenList;
1041 algorithm
1042 (outStringTupleList, outTokenList) := match inTokenList
1043 local
1044 String tn, s;
1045 list<tuple<String, String>> stl;
1046 list<Token> rest, tl, tl2;
1047 case OPENTAG(tagName = tn) :: rest
1048 algorithm
1049 ✗ (s, tl) := parseInfo(rest);
1050 ✗ (stl, tl2) := parseInfoList(tl);
1051 ✗ then ((tn, s) :: stl, tl2);
1052 case CLOSETAG(tagName = tn) :: rest
1053 algorithm
1054 ✗ true := tn == "ERROR";
1055 then ({}, rest);
1056 end match;
1057 end parseInfoList;
1058
1059 protected function parseInfo
1060 input list<Token> inTokenList;
1061 output String outString;
1062 output list<Token> outTokenList;
1063 algorithm
1064 (outString, outTokenList) := match inTokenList
1065 local
1066 String s;
1067 list<Token> rest;
1068 case TEXT(s) :: _ :: rest
1069 then (s, rest);
1070 end match;
1071 end parseInfo;
1072
1073 protected function isToBeReported "Answers whether an error should be reported."
1074 input list<tuple<String, String>> inStringTupleList;
1075 output Boolean outBoolean;
1076 protected
1077 list<String> errorsToReport = {"FATAL" /*, "MAJOR" */} "list of errors we are interested in";
1078 algorithm
1079 outBoolean := match inStringTupleList
1080 local
1081 String k, v;
1082 list<tuple<String, String>> rest;
1083 case {}
1084 then false;
1085 case (k, v) :: _ guard k == "CRITICITY"
1086 ✗ then listMember(v, errorsToReport);
1087 case _ :: rest
1088 ✗ then isToBeReported(rest);
1089 end match;
1090 end isToBeReported;
1091
1092 protected function getMessage "Retrieves the error message."
1093 input list<tuple<String, String>> inStringTupleList;
1094 output String outString;
1095 algorithm
1096 outString := match inStringTupleList
1097 local
1098 String k, v;
1099 list<tuple<String, String>> rest;
1100 case (k, v) :: _ guard k == "LABEL"
1101 then v;
1102 case _ :: rest
1103 ✗ then getMessage(rest);
1104 end match;
1105 end getMessage;
1106
1107 protected function reportErrors "Reports Figaro errors one by one."
1108 input list<String> inStringList "list of error messages";
1109 output Boolean outBoolean "true if any error was reported";
1110 algorithm
1111 outBoolean := match inStringList
1112 local
1113 String first;
1114 list<String> rest;
1115 case {}
1116 then false;
1117 case first :: rest
1118 algorithm
1119 // It has its own kind of error, because it is not a Modelica error.
1120 ✗ Error.addMessage(Error.FIGARO_ERROR, {first});
1121 ✗ reportErrors(rest);
1122 then true;
1123 end match;
1124 end reportErrors;
1125
1126
1127 /* Debug */
1128
1129 protected function printFigaroClassList
1130 input list<FigaroClass> inFigaroClassList;
1131 algorithm
1132 () := match inFigaroClassList
1133 local
1134 FigaroClass first;
1135 list<FigaroClass> rest;
1136 case {}
1137 then ();
1138 case first :: rest
1139 algorithm
1140 ✗ printFigaroClass(first);
1141 ✗ printFigaroClassList(rest);
1142 then ();
1143 case _ :: rest
1144 algorithm
1145 ✗ printFigaroClassList(rest);
1146 then ();
1147 end match;
1148 end printFigaroClassList;
1149
1150 protected function printFigaroClass
1151 input FigaroClass inFigaroClass;
1152 algorithm
1153 () := match inFigaroClass
1154 local
1155 Ident cn;
1156 String tn;
1157 case FIGAROCLASS(className = cn, typeName = tn)
1158 algorithm
1159 ✗ print(cn + " = " + tn + "\n");
1160 then ();
1161 end match;
1162 end printFigaroClass;
1163
1164 protected function printFigaroObjectList
1165 input list<FigaroObject> inFigaroObjectList;
1166 algorithm
1167 () := match inFigaroObjectList
1168 local
1169 FigaroObject first;
1170 list<FigaroObject> rest;
1171 case {}
1172 then ();
1173 case first :: rest
1174 algorithm
1175 ✗ print(figaroObjectToString(first));
1176 ✗ printFigaroObjectList(rest);
1177 then ();
1178 case _ :: rest
1179 algorithm
1180 ✗ printFigaroObjectList(rest);
1181 then ();
1182 end match;
1183 end printFigaroObjectList;
1184
1185 protected function printTokenList
1186 input list<Token> inTokenList;
1187 algorithm
1188 () := match inTokenList
1189 local
1190 Token first;
1191 list<Token> rest;
1192 case {}
1193 then ();
1194 case first :: rest
1195 algorithm
1196 ✗ printToken(first);
1197 ✗ print("\n");
1198 ✗ printTokenList(rest);
1199 then ();
1200 case _ :: rest
1201 algorithm
1202 ✗ printTokenList(rest);
1203 then ();
1204 end match;
1205 end printTokenList;
1206
1207 protected function printToken
1208 input Token inToken;
1209 algorithm
1210 () := match inToken
1211 local
1212 String s;
1213 case OPENTAG(tagName = s)
1214 algorithm
1215 ✗ print("OPEN: " + s);
1216 then ();
1217 case CLOSETAG(tagName = s)
1218 algorithm
1219 ✗ print("CLOSE: " + s);
1220 then ();
1221 case TEXT(text = s)
1222 algorithm
1223 ✗ print("\"" + s + "\"");
1224 then ();
1225 end match;
1226 end printToken;
1227
1228 annotation(__OpenModelica_Interface="frontend");
1229 end Figaro;
1230