- Fix listMember( (a,b), lst ), and similar problems with polymorphic…

… functions git-svn-id: https://openmodelica.org/svn/OpenModelica/branches/sjoelund-functiontree@6654 f25d12d1-65f4-0310-ae8a-bbce733d8d8e
OpenModelica · Oct 27, 2010 · 89cf0d6 · 89cf0d6
1 parent 2ed3cbb
commit 89cf0d6
Show file tree

Hide file tree

Showing 2 changed files with 27 additions and 11 deletions.
diff --git a/Compiler/Types.mo b/Compiler/Types.mo
@@ -1533,10 +1533,11 @@ algorithm
     case ((DAE.T_LIST(t1),_),(DAE.T_LIST(t2),_)) then subtype(t1,t2);
     case ((DAE.T_META_ARRAY(t1),_),(DAE.T_META_ARRAY(t2),_)) then subtype(t1,t2);
     case ((DAE.T_METATUPLE(tList1),_),(DAE.T_METATUPLE(tList2),_))
-      local list<Type> tList1,tList2; Boolean ret; 
+      local
+        list<Type> tList1,tList2;
       equation
-        ret = subtypeTypelist(tList1,tList2);
-      then ret;
+        res = subtypeTypelist(tList1,tList2);
+      then res;
     case ((DAE.T_METAOPTION(t1),_),(DAE.T_METAOPTION(t2),_))
       then subtype(t1,t2);
 
@@ -5397,7 +5398,7 @@ protected function polymorphicBindingStr
 algorithm
   (str,tys) := binding;
   // Don't bother doing this fast; it's just for error messages
-  str := "    " +& str +& ":\n" +& Util.stringDelimitList(Util.listMap1r(Util.listMapMap(tys, unboxedType, unparseType), stringAppend, "      "), "\n");
+  str := "    " +& str +& ":\n" +& Util.stringDelimitList(Util.listMap1r(Util.listMap(tys, unparseType), stringAppend, "      "), "\n");
 end polymorphicBindingStr;
 
 public function polymorphicBindingsStr
@@ -5765,10 +5766,16 @@ algorithm
       list<Type> tys;
       PolymorphicBindings rest;
       tuple<String,list<Type>> first;
-    case (id,ty,{}) then {(id,{ty})};
+    case (id,ty,{})
+      equation
+        ty = unboxedType(ty);
+        ty = boxIfUnboxedType(ty);
+      then {(id,{ty})};
     case (id1,ty,(id2,tys)::rest)
       equation
         true = id1 ==& id2;
+        ty = unboxedType(ty);
+        ty = boxIfUnboxedType(ty);
       then (id2,ty::tys)::rest;
     case (id,ty,first::rest)
       equation
@@ -6061,9 +6068,7 @@ algorithm
       Absyn.Path path,path1,path2;
       list<String> ids;
     case (actual,(DAE.T_POLYMORPHIC(id),_),bindings)
-      equation
-        ty = boxIfUnboxedType(actual);
-      then addPolymorphicBinding("$" +& id,ty,bindings);
+      then addPolymorphicBinding("$" +& id,actual,bindings);
     case ((DAE.T_BOXED(ty1),_),ty2,bindings)
       equation
         ty1 = unboxedType(ty1);

diff --git a/c_runtime/meta_modelica.c b/c_runtime/meta_modelica.c
@@ -279,6 +279,10 @@ int mmc_boxes_equal(void* lhs, void* rhs)
   void *lhs_data, *rhs_data;
   struct record_description *lhs_desc,*rhs_desc;
 
+  if (lhs == rhs) {
+    return 1;
+  }
+
   if ((0 == ((mmc_sint_t)lhs & 1)) && (0 == ((mmc_sint_t)rhs & 1))) {
     return lhs == rhs;
   }
@@ -291,7 +295,10 @@ int mmc_boxes_equal(void* lhs, void* rhs)
   }
 
   if (h_lhs == MMC_REALHDR) {
-    return mmc_prim_get_real(MMC_REALDATA(lhs)) == mmc_prim_get_real(MMC_REALDATA(rhs));;
+    double d1,d2;
+    d1 = mmc_prim_get_real(lhs);
+    d2 = mmc_prim_get_real(rhs);
+    return d1 == d2;
   }
   if (MMC_HDRISSTRING(h_lhs))
     return 0 == strcmp(MMC_STRINGDATA(lhs),MMC_STRINGDATA(rhs));
@@ -319,8 +326,12 @@ int mmc_boxes_equal(void* lhs, void* rhs)
 
   if (numslots>0 && ctor == 0) { /* TUPLE */
     for (i=0; i<numslots; i++) {
-      if (0 == mmc_boxes_equal(MMC_FETCH(MMC_OFFSET(MMC_UNTAGPTR(lhs),i+1)),MMC_FETCH(MMC_OFFSET(MMC_UNTAGPTR(rhs),i+1))))
+      void *tlhs, *trhs;
+      tlhs = MMC_FETCH(MMC_OFFSET(MMC_UNTAGPTR(lhs),i+1));
+      trhs = MMC_FETCH(MMC_OFFSET(MMC_UNTAGPTR(rhs),i+1));
+      if (0 == mmc_boxes_equal(tlhs,trhs)) {
         return 0;
+      }
     }
     return 1;
   }
@@ -377,7 +388,7 @@ void printAny(void* any) /* For debugging */
   struct record_description *desc;
 
   if ((0 == ((mmc_sint_t)any & 1))) {
-    fprintf(stderr, "%d", (int) ((mmc_sint_t)any)>>1);
+    fprintf(stderr, "%ld", (long) ((mmc_sint_t)any)>>1);
     return;
   }