- Implemented better support for MetaModelica in SCodeFlatten.

git-svn-id: https://openmodelica.org/svn/OpenModelica/trunk@7807 f25d12d1-65f4-0310-ae8a-bbce733d8d8e

Compiler/FrontEnd/Absyn.mo

@@ -1854,6 +1854,11 @@ algorithm
       list<list<Exp>> mat_expl;
       FunctionArgs fargs;
       String error_msg;
+      Ident id;
+      MatchType match_ty;
+      list<ElementItem> match_decls;
+      list<Case> match_cases;
+      Option<String> cmt;
 
     case (INTEGER(value = _), _) then (inExp, inTuple);
     case (REAL(value = _), _) then (inExp, inTuple);
@@ -1951,6 +1956,34 @@ algorithm
       then
         (TUPLE(expl), tup);
 
+    case (AS(id = id, exp = e1), tup)
+      equation
+        (e1, tup) = traverseExpBidir(e1, tup);
+      then
+        (AS(id, e1), tup);
+
+    case (CONS(head = e1, rest = e2), tup)
+      equation
+        (e1, tup) = traverseExpBidir(e1, tup);
+        (e2, tup) = traverseExpBidir(e2, tup);
+      then
+        (CONS(e1, e2), tup);
+
+    case (MATCHEXP(matchTy = match_ty, inputExp = e1, localDecls = match_decls,
+        cases = match_cases, comment = cmt), tup)
+      equation
+        (e1, tup) = traverseExpBidir(e1, tup);
+        (match_cases, tup) = Util.listMapAndFold(match_cases,
+          traverseMatchCase, tup);
+      then
+        (MATCHEXP(match_ty, e1, match_decls, match_cases, cmt), tup);
+
+    case (LIST(exps = expl), tup)
+      equation
+        (expl, tup) = traverseExpListBidir(expl, tup);
+      then
+        (LIST(expl), tup);
+
     else
       equation
         error_msg = "in Absyn.traverseExpBidirSubExps - Unknown expression: ";
@@ -2148,6 +2181,23 @@ algorithm
   outIterator := (name, value);
 end traverseExpBidirIterator;
 
+protected function traverseMatchCase
+  input Case inMatchCase;
+  input tuple<FuncType, FuncType, Argument> inTuple;
+  output Case outMatchCase;
+  output tuple<FuncType, FuncType, Argument> outTuple;
+
+  partial function FuncType
+    input tuple<Exp, Argument> inTuple;
+    output tuple<Exp, Argument> outTuple;
+  end FuncType;
+
+  replaceable type Argument subtypeof Any;
+algorithm
+  outMatchCase := inMatchCase;
+  outTuple := inTuple;
+end traverseMatchCase;
+
 public function makeIdentPathFromString ""
   input String s;
   output Path p;

Compiler/FrontEnd/MetaModelicaBuiltin.mo

@@ -744,9 +744,13 @@ end clock;
 function optionNone "Returns true if the input is NONE()"
   input Option<TypeA> opt;
   output Boolean isNone;
+  replaceable type TypeA subtypeof Any;
 external "builtin";
 end optionNone;
 
+type NONE end NONE;
+type SOME end SOME;
+
 function listStringCharString
   input list<String> strs;
   output String str;
@@ -848,4 +852,4 @@ function realSqrt
   input Real x(unit = "'p");
   output Real y(unit = "'p(1/2)");
 external "builtin" y=sqrt(x);
-end realSqrt;
+end realSqrt;

Compiler/FrontEnd/SCode.mo

@@ -3582,7 +3582,6 @@ algorithm
     case ALG_BREAK(info = info) then info;
     case ALG_TRY(info = info) then info;
     case ALG_CATCH(info = info) then info;
-    case ALG_CATCH(info = info) then info;
     case ALG_THROW(info = info) then info;
     case ALG_FAILURE(info = info) then info;
   end match;

Compiler/FrontEnd/SCodeEnv.mo

@@ -46,6 +46,7 @@ public import SCode;
 protected import Error;
 protected import Util;
 protected import SCodeLookup;
+protected import SCodeUtil;
 
 
 public type Import = Absyn.Import;
@@ -795,6 +796,42 @@ algorithm
   outEnv := extendEnvWithElement(iter, inEnv);
 end extendEnvWithIterator;
 
+public function extendEnvWithMatch
+  input Absyn.Exp inMatchExp;
+  input Env inEnv;
+  output Env outEnv;
+protected
+  Frame frame;
+  list<Absyn.ElementItem> local_decls;
+algorithm
+  frame := newFrame(SOME("$match$"), IMPLICIT_SCOPE());
+  Absyn.MATCHEXP(localDecls = local_decls) := inMatchExp;
+  outEnv := Util.listFold(local_decls, extendEnvWithElementItem, 
+    frame :: inEnv);
+end extendEnvWithMatch;
+
+protected function extendEnvWithElementItem
+  input Absyn.ElementItem inElementItem;
+  input Env inEnv;
+  output Env outEnv;
+algorithm
+  outEnv := match(inElementItem, inEnv)
+    local
+      Absyn.Element element;
+      list<SCode.Element> el;
+      Env env;
+
+    case (Absyn.ELEMENTITEM(element = element), _)
+      equation
+        el = SCodeUtil.translateElement(element, true);
+        env = Util.listFold(el, extendEnvWithElement, inEnv);
+      then 
+        env;
+
+    else then inEnv;
+  end match;
+end extendEnvWithElementItem;
+
 public function insertClassExtendsIntoEnv
   input Env inEnv;
   output Env outEnv;
@@ -1144,6 +1181,9 @@ algorithm
       Absyn.Path path;
       Env rest;
 
+    case (FRAME(frameType = IMPLICIT_SCOPE) :: rest)
+      then getEnvPath(rest);
+
     case ({FRAME(name = SOME(name))})
       then Absyn.IDENT(name);
 

Compiler/FrontEnd/SCodeFlattenImports.mo

@@ -127,7 +127,7 @@ algorithm
       equation
         checkRecursiveShortDefinition(ty, inEnv, inInfo);
         env = SCodeEnv.removeExtendsFromLocalScope(inEnv);
-        (_, ty, _) = SCodeLookup.lookupTypeSpec(ty, env, inInfo);
+        ty = flattenTypeSpec(ty, env, inInfo);
         mods = flattenModifier(mods, inEnv, inInfo);
       then
         SCode.DERIVED(ty, mods, attr, cmt);
@@ -169,6 +169,8 @@ algorithm
           {env_name, type_name}, inInfo);
       then
         fail();
+
+    case (Absyn.TCOMPLEX(path = _), _, _) then ();
   end matchcontinue;
 end checkRecursiveShortDefinition;
 
@@ -240,7 +242,7 @@ algorithm
         info, cc), _)
       equation
         ErrorExt.setCheckpoint("flattenComponent");
-        (_, type_spec, _) = SCodeLookup.lookupTypeSpec(type_spec, inEnv, info);
+        type_spec = flattenTypeSpec(type_spec, inEnv, info);
         mod = flattenModifier(mod, inEnv, info);
         cond = flattenOptExp(cond, inEnv, info);
         ErrorExt.delCheckpoint("flattenComponent");
@@ -269,6 +271,39 @@ algorithm
   end matchcontinue;
 end flattenComponent;
 
+protected function flattenTypeSpec
+  input Absyn.TypeSpec inTypeSpec;
+  input Env inEnv;
+  input Absyn.Info inInfo;
+  output Absyn.TypeSpec outTypeSpec;
+algorithm
+  outTypeSpec := match(inTypeSpec, inEnv, inInfo)
+    local
+      Absyn.Path path;
+      Option<Absyn.ArrayDim> ad;
+      list<Absyn.TypeSpec> tys;
+
+    // A normal type.
+    case (Absyn.TPATH(path = path, arrayDim = ad), _, _)
+      equation
+        (_, path, _) = SCodeLookup.lookupName(path, inEnv, inInfo);
+      then
+        Absyn.TPATH(path, ad);
+
+    // A polymorphic type, i.e. replaceable type Type subtypeof Any.
+    case (Absyn.TCOMPLEX(path = Absyn.IDENT("polymorphic")), _, _)
+      then inTypeSpec;
+
+    // A MetaModelica type such as list or tuple.
+    case (Absyn.TCOMPLEX(path = path, typeSpecs = tys, arrayDim = ad), _, _)
+      equation
+        tys = Util.listMap2(tys, flattenTypeSpec, inEnv, inInfo);
+      then
+        Absyn.TCOMPLEX(path, tys, ad);
+
+  end match;
+end flattenTypeSpec;
+
 protected function evaluateConditionalExp
   input Option<Absyn.Exp> inExp;
   input Env inEnv;
@@ -586,6 +621,9 @@ algorithm
       then
         ((exp, (env, info)));
 
+    case ((Absyn.CALL(function_ = Absyn.CREF_IDENT(name = "SOME")), _)) 
+      then inTuple;
+
     case ((Absyn.CALL(function_ = cref, functionArgs = args), 
         tup as (env, info)))
       equation
@@ -602,6 +640,11 @@ algorithm
       then
         ((Absyn.PARTEVALFUNCTION(cref, args), tup));
 
+    case ((exp as Absyn.MATCHEXP(matchTy = _), tup as (env, info)))
+      equation
+        env = SCodeEnv.extendEnvWithMatch(exp, env);
+      then
+        ((exp, (env, info)));
     else then inTuple;
   end match;
 end flattenExpTraverserEnter;
@@ -621,6 +664,11 @@ algorithm
       then
         ((e, (env, info)));
 
+    case ((e as Absyn.MATCHEXP(matchTy = _), 
+        (SCodeEnv.FRAME(frameType = SCodeEnv.IMPLICIT_SCOPE()) :: env, info)))
+      then
+        ((e, (env, info)));
+
     else then inTuple;
   end match;
 end flattenExpTraverserExit;

Compiler/FrontEnd/SCodeLookup.mo

@@ -430,7 +430,7 @@ algorithm
     case (_, SCodeEnv.VAR(var = SCode.COMPONENT(typeSpec = type_spec, 
         modifications = mods, info = info)), _)
       equation
-        (item, _, type_env) = lookupTypeSpec(type_spec, inEnv, info);
+        (item, type_env) = lookupTypeSpec(type_spec, inEnv, info);
         redeclares = SCodeEnv.extractRedeclaresFromModifier(mods);
         (item, type_env) = 
           SCodeEnv.replaceRedeclaredClassesInEnv(redeclares, item, type_env, inEnv);
@@ -469,7 +469,7 @@ algorithm
     case (_, SCodeEnv.VAR(var = SCode.COMPONENT(typeSpec = type_spec, 
         modifications = mods, info = info)), _)
       equation
-        (item, _, type_env) = lookupTypeSpec(type_spec, inEnv, info);
+        (item, type_env) = lookupTypeSpec(type_spec, inEnv, info);
         redeclares = SCodeEnv.extractRedeclaresFromModifier(mods);
         (item, type_env) = SCodeEnv.replaceRedeclaredClassesInEnv(redeclares, item, type_env, inEnv);
         (item, cref) = lookupCrefInItem(inCref, item, type_env);
@@ -603,6 +603,8 @@ algorithm
         componentRef = Absyn.CREF_IDENT(name = _)), _, _)
       then inCref;
 
+    case (Absyn.WILD(), _, _) then inCref;
+
     case (_, _, _)
       equation
         // First look up all subscripts, because all subscripts should be found
@@ -684,24 +686,25 @@ public function lookupTypeSpec
   input Env inEnv;
   input Absyn.Info inInfo;
   output Item outItem;
-  output Absyn.TypeSpec outTypeSpec;
   output Env outTypeEnv;
 algorithm
-  (outItem, outTypeSpec, outTypeEnv) := match(inTypeSpec, inEnv, inInfo)
+  (outItem, outTypeEnv) := match(inTypeSpec, inEnv, inInfo)
     local
       Absyn.Path path;
       Absyn.Ident name;
-      Option<Absyn.ArrayDim> array_dim;
       Item item;
       Env env;
 
-    case (Absyn.TPATH(path, array_dim), _, _)
+    case (Absyn.TPATH(path = path), _, _)
       equation
-        (item, path, SOME(env)) = lookupName(path, inEnv, inInfo);
+        (item, _, SOME(env)) = lookupName(path, inEnv, inInfo);
       then
-        (item, Absyn.TPATH(path, array_dim), env);
+        (item, env);
 
+    case (Absyn.TCOMPLEX(path = Absyn.IDENT(name = name)), _, _)
+      then (SCodeEnv.BUILTIN(name), SCodeEnv.emptyEnv);
+
   end match;
 end lookupTypeSpec;
-    
+
 end SCodeLookup;