diff --git a/src/libsac2c/arrayopt/wlsimplification.c b/src/libsac2c/arrayopt/wlsimplification.c index 0d0fb23d37442145b156ade7e820b07b86415a3c..21ff6b93ee3424c4843f60580992221eced1a0a2 100644 --- a/src/libsac2c/arrayopt/wlsimplification.c +++ b/src/libsac2c/arrayopt/wlsimplification.c @@ -59,6 +59,11 @@ * If it was not AKS, either there would be a default partition, * or partition generation would have inserted a second partition * which depends on the unknown lower / upper limit! + * Well, in case we have a partition [0,0] -> [0,a], we can + * decide that it is empty despite not knowing the exact shape! + * in that case, we generate more complex code: + * ====> res = _reshape_VxA_ (_cat_VxV_ (shape, _shape_A_ (default)), + * []); * * res = with { ===> res = a; * } modarray( a ); @@ -438,8 +443,15 @@ WLSIMPwith (node *arg_node, info *arg_info) * @fn node *WLSIMPgenarray( node *arg_node, info *arg_info) * * @brief creates an assignment of the form: - * lhs = [:lhstype]; - * where INFO_LHS == lhs and the type of lhs is lhstype! + * lhs = [:lhstype]; \ + * where INFO_LHS == lhs | iff lhstype is AKS! + * and the type of lhs is lhstype! / + * + * tmp = shp; \ + * tmp2 = _shape_A_ (default); | + * tmp3 = _cat_VxV_ (tmp, tmp2); | otherwise + * tmp4 = [lhsscal]; | + * lhs = _reshape_VxA_ (tmp3, tmp4); / * *****************************************************************************/ node * @@ -447,6 +459,8 @@ WLSIMPgenarray (node *arg_node, info *arg_info) { node *lhs, *empty; ntype *lhstype; + node *avis, *avis2, *avis3, *avis4; + node *shp, *shpdef, *cat, *rhs; DBUG_ENTER (); @@ -455,16 +469,56 @@ WLSIMPgenarray (node *arg_node, info *arg_info) lhs = INFO_LHS (arg_info); lhstype = IDS_NTYPE (lhs); - empty = TBmakeArray (TYmakeAKS (TYcopyType (TYgetScalar (lhstype)), SHmakeShape (0)), - SHcopyShape (TYgetShape (lhstype)), NULL); - INFO_PREASSIGN (arg_info) - = TBmakeAssign (TBmakeLet (DUPdoDupNode (lhs), empty), INFO_PREASSIGN (arg_info)); - AVIS_SSAASSIGN (IDS_AVIS (lhs)) = INFO_PREASSIGN (arg_info); + if (TUshapeKnown (lhstype)) { + empty = TBmakeArray (TYmakeAKS (TYcopyType (TYgetScalar (lhstype)), SHmakeShape (0)), + SHcopyShape (TYgetShape (lhstype)), NULL); + INFO_PREASSIGN (arg_info) + = TBmakeAssign (TBmakeLet (DUPdoDupNode (lhs), empty), INFO_PREASSIGN (arg_info)); + AVIS_SSAASSIGN (IDS_AVIS (lhs)) = INFO_PREASSIGN (arg_info); + } else { + avis = TBmakeAvis (TRAVtmpVar (), TYmakeAKD (TYmakeSimpleType (T_int), 1, SHmakeShape (0))); + avis2 = TBmakeAvis (TRAVtmpVar (), TYmakeAKD (TYmakeSimpleType (T_int), 1, SHmakeShape (0))); + avis3 = TBmakeAvis (TRAVtmpVar (), TYmakeAKD (TYmakeSimpleType (T_int), 1, SHmakeShape (0))); + avis4 = TBmakeAvis (TRAVtmpVar (), TYmakeAKD (TYcopyType (TYgetScalar (lhstype)), 1, SHmakeShape (0))); + + shp = DUPdoDupNode (GENARRAY_SHAPE (arg_node)); + shpdef = TCmakePrf1 (F_shape_A, DUPdoDupNode (GENARRAY_DEFAULT (arg_node))); + cat = TCmakePrf2 (F_cat_VxV, TBmakeId (avis), TBmakeId (avis2)); + empty = TBmakeArray (TYmakeAKS (TYcopyType (TYgetScalar (lhstype)), SHmakeShape (0)), + SHcreateShape (1,0), NULL); + rhs = TCmakePrf2 (F_reshape_VxA, TBmakeId (avis3), TBmakeId (avis4)); + + INFO_PREASSIGN (arg_info) + = TBmakeAssign (TBmakeLet (DUPdoDupNode (lhs), rhs), INFO_PREASSIGN (arg_info)); + AVIS_SSAASSIGN (IDS_AVIS (lhs)) = INFO_PREASSIGN (arg_info); + + INFO_PREASSIGN (arg_info) + = TBmakeAssign (TBmakeLet (TBmakeIds (avis4, NULL), empty), INFO_PREASSIGN (arg_info)); + AVIS_SSAASSIGN (avis4) = INFO_PREASSIGN (arg_info); + FUNDEF_VARDECS (INFO_FUNDEF (arg_info)) + = TBmakeVardec (avis4, FUNDEF_VARDECS (INFO_FUNDEF (arg_info))); - INFO_REPLACE (arg_info) = TRUE; + INFO_PREASSIGN (arg_info) + = TBmakeAssign (TBmakeLet (TBmakeIds (avis3, NULL), cat), INFO_PREASSIGN (arg_info)); + AVIS_SSAASSIGN (avis3) = INFO_PREASSIGN (arg_info); + FUNDEF_VARDECS (INFO_FUNDEF (arg_info)) + = TBmakeVardec (avis3, FUNDEF_VARDECS (INFO_FUNDEF (arg_info))); - DBUG_ASSERT (TUshapeKnown (lhstype), - "all partitions of genarray WL are gone but lhs shape unknown!"); + INFO_PREASSIGN (arg_info) + = TBmakeAssign (TBmakeLet (TBmakeIds (avis2, NULL), shpdef), INFO_PREASSIGN (arg_info)); + AVIS_SSAASSIGN (avis2) = INFO_PREASSIGN (arg_info); + FUNDEF_VARDECS (INFO_FUNDEF (arg_info)) + = TBmakeVardec (avis2, FUNDEF_VARDECS (INFO_FUNDEF (arg_info))); + + INFO_PREASSIGN (arg_info) + = TBmakeAssign (TBmakeLet (TBmakeIds (avis, NULL), shp), INFO_PREASSIGN (arg_info)); + AVIS_SSAASSIGN (avis) = INFO_PREASSIGN (arg_info); + FUNDEF_VARDECS (INFO_FUNDEF (arg_info)) + = TBmakeVardec (avis, FUNDEF_VARDECS (INFO_FUNDEF (arg_info))); + + } + + INFO_REPLACE (arg_info) = TRUE; if (GENARRAY_NEXT (arg_node) != NULL) { INFO_LHS (arg_info) = IDS_NEXT (INFO_LHS (arg_info)); @@ -630,9 +684,7 @@ WLSIMPpart (node *arg_node, info *arg_info) PART_GENERATOR (arg_node) = TRAVdo (PART_GENERATOR (arg_node), arg_info); - if ((INFO_ZEROTRIP (arg_info)) - && ((1 != INFO_NUM_GENPARTS (arg_info)) - || (TUshapeKnown (IDS_NTYPE (INFO_LHS (arg_info)))))) { + if (INFO_ZEROTRIP (arg_info)) { DBUG_PRINT ("eliminating zero-trip generator"); /** * The following free implicitly decrements CODE_USED. diff --git a/src/libsac2c/codegen/compile.c b/src/libsac2c/codegen/compile.c index eb9d1793e919b7b25b40415c420b94a79330d5e5..9b50427dc61a60cd33d7ea0126e1acf2c2a726f4 100644 --- a/src/libsac2c/codegen/compile.c +++ b/src/libsac2c/codegen/compile.c @@ -572,12 +572,12 @@ GenericFun (generic_fun_t which, ntype *type) DBUG_ENTER (); - DBUG_EXECUTE (tmp = CVtype2String (type, 0, FALSE); switch (which) { + DBUG_EXECUTE_TAG ("COMP_GEN", tmp = CVtype2String (type, 0, FALSE); switch (which) { case GF_copy: - DBUG_PRINT ("Looking for generic copy function for type %s", tmp); + DBUG_PRINT_TAG ("COMP_GEN","Looking for generic copy function for type %s", tmp); break; case GF_free: - DBUG_PRINT ("Looking for generic free function for type %s", tmp); + DBUG_PRINT_TAG ("COMP_GEN","Looking for generic free function for type %s", tmp); break; } tmp = MEMfree (tmp)); @@ -603,7 +603,7 @@ GenericFun (generic_fun_t which, ntype *type) } } - DBUG_PRINT ("Found generic fun `%s'", STRonNull ("", ret)); + DBUG_PRINT_TAG ("COMP_GEN","Found generic fun `%s'", STRonNull ("", ret)); DBUG_RETURN (ret); } @@ -3031,6 +3031,8 @@ COMPFundefArgs (node *fundef, info *arg_info) DBUG_ENTER (); + DBUG_PRINT ("processing arguments of fundef %s", FUNDEF_NAME (fundef)); + DBUG_ASSERT (NODE_TYPE (fundef) == N_fundef, "no N_fundef node found!"); argtab = FUNDEF_ARGTAB (fundef); @@ -3536,6 +3538,7 @@ COMPblock (node *arg_node, info *arg_info) = TCappendAssign (INFO_VARDEC_INIT (arg_info), BLOCK_ASSIGNS (arg_node)); INFO_VARDEC_INIT (arg_info) = NULL; } + DBUG_PRINT (" done..."); DBUG_RETURN (arg_node); } @@ -3889,6 +3892,8 @@ COMPlet (node *arg_node, info *arg_info) INFO_LASTIDS (arg_info) = LET_IDS (arg_node); INFO_LET (arg_info) = arg_node; + DBUG_PRINT (" compiling %s, ... = \n", (LET_IDS (arg_node) != NULL ? + IDS_NAME (LET_IDS (arg_node)) : "(void)")); expr = TRAVdo (LET_EXPR (arg_node), arg_info); /* @@ -8364,13 +8369,13 @@ COMPprfArrayVect2Offset (node *arg_node, info *arg_info) "First argument of F_array_vect2offset must be an N_id Node!"); icm = TCmakeIcm5 ("ND_ARRAY_VECT2OFFSET_id", DUPdupIdsIdNt (let_ids), - TBmakeNum (SHgetUnrLen (TYgetShape (ID_NTYPE (iv_vect)))), + TBmakeNum (TUgetLengthEncoding (ID_NTYPE (iv_vect))), DUPdupIdNt (iv_vect), MakeDimArg (PRF_ARG1 (arg_node), TRUE), DUPdupIdNt (PRF_ARG1 (arg_node))); /* icm = TCmakeIcm5( "ND_VECT2OFFSET_id", DUPdupIdsIdNt( let_ids), - TBmakeNum( SHgetUnrLen (TYgetShape( ID_NTYPE( iv_vect)))), + TBmakeNum( TUgetLengthEncoding (ID_NTYPE( iv_vect))), DUPdupIdNt( iv_vect), MakeSizeArg( PRF_ARG1( arg_node), TRUE), DUPdupIdNt( PRF_ARG1( arg_node))); @@ -8405,12 +8410,12 @@ COMPprfVect2Offset (node *arg_node, info *arg_info) */ if (NODE_TYPE (PRF_ARG1 (arg_node)) == N_array) { icm = TCmakeIcm5 ("ND_VECT2OFFSET_arr", DUPdupIdsIdNt (let_ids), - TBmakeNum (SHgetUnrLen (TYgetShape (ID_NTYPE (iv_vect)))), + TBmakeNum (TUgetLengthEncoding (ID_NTYPE (iv_vect))), DUPdupIdNt (iv_vect), MakeSizeArg (PRF_ARG1 (arg_node), TRUE), DupExprs_NT_AddReadIcms (ARRAY_AELEMS (PRF_ARG1 (arg_node)))); } else if (NODE_TYPE (PRF_ARG1 (arg_node)) == N_id) { icm = TCmakeIcm5 ("ND_VECT2OFFSET_id", DUPdupIdsIdNt (let_ids), - TBmakeNum (SHgetUnrLen (TYgetShape (ID_NTYPE (iv_vect)))), + TBmakeNum (TUgetLengthEncoding (ID_NTYPE (iv_vect))), DUPdupIdNt (iv_vect), MakeSizeArg (PRF_ARG1 (arg_node), TRUE), DUPdupIdNt (PRF_ARG1 (arg_node))); #ifndef DBUG_OFF @@ -10293,7 +10298,11 @@ MakeIcm_WL_SET_OFFSET (node *arg_node, node *assigns) * full range (== -1, if the segment's domain equals the full index * vector space) */ - shp = TYgetShape (IDS_NTYPE (tmp_ids)); + if (TUshapeKnown (IDS_NTYPE (tmp_ids))) { + shp = TYgetShape (IDS_NTYPE (tmp_ids)); + } else { + shp = NULL; + } d = dims - 1; d_u = d; while (d >= 0) { diff --git a/src/libsac2c/flatten/wlbounds2structconsts.c b/src/libsac2c/flatten/wlbounds2structconsts.c index 70f6778085b95e99f48de20fbe485fd203f3256d..cdfabf9b9ed0963912f17fc60f9a96a92958ff73 100644 --- a/src/libsac2c/flatten/wlbounds2structconsts.c +++ b/src/libsac2c/flatten/wlbounds2structconsts.c @@ -230,6 +230,14 @@ EnsureStructConstant (node *bound, ntype *type, info *arg_info) pat = PMarray (1, PMAgetNode (&array), 1, PMskip (0)); } + DBUG_EXECUTE ( if (NODE_TYPE (bound) == N_id) { + DBUG_PRINT ("ensuring structural constant for \"%s\"", ID_NAME (bound)); + } else if (NODE_TYPE (bound) == N_array) { + DBUG_PRINT ("ensuring structural constant ..."); + } else { + DBUG_ASSERT (FALSE, "found neither N_id nor N_array in generator/shape position"); + } ); + if (PMmatchFlat (pat, bound)) { /* this is somehow defined as an array */ @@ -262,6 +270,8 @@ EnsureStructConstant (node *bound, ntype *type, info *arg_info) new_bound = CreateArrayOfShapeSels (ID_AVIS (bound), dim, arg_info); bound = FREEdoFreeTree (bound); bound = new_bound; + } else { + DBUG_PRINT ("neither array nor AKS/AKV"); } DBUG_RETURN (bound); diff --git a/src/libsac2c/global/phase_sac2c.mac b/src/libsac2c/global/phase_sac2c.mac index 18dc80ecb5e1cc5fe798e0a3ebca8e3bdaefeb01..95eb757ca24cb0eded2972c359432ad1cd68b6f9 100644 --- a/src/libsac2c/global/phase_sac2c.mac +++ b/src/libsac2c/global/phase_sac2c.mac @@ -1118,9 +1118,12 @@ ENDPHASE (cuda) PHASE (wlt, "Transforming with-loop representation", !global.on_demand_lib) +SUBPHASE (wlbsc, "Unflattening WL-partition structural constants", + WLBSCdoWlbounds2nonFlatStructConsts, ALWAYS, wlt) + SUBPHASE (wlsimp, "Simplifying with-loops", WLSIMPdoWithloopSimplification, ALWAYS, wlt) /* - * Repeating this optimisation here is necessary to avoid problems with exotic + * Repeating these two optimisations here is necessary to avoid problems with exotic * with-loops in subsequent wl-transform. */ diff --git a/src/libsac2c/stdopt/SSAWLUnroll.c b/src/libsac2c/stdopt/SSAWLUnroll.c index ac1705ad71c4c3db7329404f25788fda26965497..ec0954b471a7e84648d4a31cab2c08f112652d32 100644 --- a/src/libsac2c/stdopt/SSAWLUnroll.c +++ b/src/libsac2c/stdopt/SSAWLUnroll.c @@ -1145,11 +1145,15 @@ DoUnrollWithloop (node *wln, info *arg_info) static bool CheckUnrollWithloop (node *wln, info *arg_info) { - int ok = TRUE; + bool ok = TRUE; + bool b1, b2, idx; node *partn; node *genn; node *op; node *lhs; +#ifndef DBUG_OFF + int p=0; +#endif DBUG_ENTER (); @@ -1158,12 +1162,17 @@ CheckUnrollWithloop (node *wln, info *arg_info) /* Everything constant? */ while (ok && (partn != NULL)) { genn = PART_GENERATOR (partn); - ok = (NODE_TYPE (genn) == N_generator && COisConstant (GENERATOR_BOUND1 (genn)) - && COisConstant (GENERATOR_BOUND2 (genn)) - && TYisAKS (IDS_NTYPE (PART_VEC (partn))) + DBUG_ASSERT (NODE_TYPE (genn) == N_generator, "non N_generator partition found!"); + b1 = COisConstant (GENERATOR_BOUND1 (genn)); + b2 = COisConstant (GENERATOR_BOUND2 (genn)); + idx = TYisAKS (IDS_NTYPE (PART_VEC (partn))); + DBUG_PRINT (" Bound1: %s", (b1 ? "is const" : "not const")); + DBUG_PRINT (" Bound2: %s", (b2 ? "is const" : "not const")); + DBUG_PRINT (" idx-vec: %s", (idx ? "is AKS" : "is not AKS")); + ok = (b1 && b2 && idx && ((GENERATOR_STEP (genn) == NULL) || COisConstant (GENERATOR_STEP (genn))) - && ((GENERATOR_WIDTH (genn) == NULL) - || COisConstant (GENERATOR_WIDTH (genn)))); + && ((GENERATOR_WIDTH (genn) == NULL) || COisConstant (GENERATOR_WIDTH (genn)))); + DBUG_PRINT (" => partition %d: %s", p++, (ok? "ok" : "not ok")); partn = PART_NEXT (partn); } diff --git a/src/libsac2c/stdopt/constant_folding.c b/src/libsac2c/stdopt/constant_folding.c index 56250ade4da00b7cc1a690eb155e483d548eb2e4..618c2542c9318feb67c06e91bc258616601e90ce 100644 --- a/src/libsac2c/stdopt/constant_folding.c +++ b/src/libsac2c/stdopt/constant_folding.c @@ -1123,18 +1123,21 @@ CFprf (node *arg_node, info *arg_info) /* Try symbolic constant simplification */ if (global.optimize.doscs) { + DBUG_PRINT ("trying SCS..."); res = InvokeCFprfAndFlattenExtrema (arg_node, arg_info, prf_cfscs_funtab[PRF_PRF (arg_node)], res); } /* If that doesn't help, try structural constant constant folding */ if (global.optimize.dosccf) { + DBUG_PRINT ("trying SCCF..."); res = InvokeCFprfAndFlattenExtrema (arg_node, arg_info, prf_cfsccf_funtab[PRF_PRF (arg_node)], res); } /* If that doesn't help, try SAA constant folding */ if (global.optimize.dosaacf) { + DBUG_PRINT ("trying SAACF..."); res = InvokeCFprfAndFlattenExtrema (arg_node, arg_info, prf_cfsaa_funtab[PRF_PRF (arg_node)], res); } diff --git a/src/libsac2c/stdopt/symbolic_constant_simplification.c b/src/libsac2c/stdopt/symbolic_constant_simplification.c index c27ec3d0019ac6aaae1af99987c955565484b417..93c3963e4f44dfa35ecbf27418d9dbb4bfc18a0f 100644 --- a/src/libsac2c/stdopt/symbolic_constant_simplification.c +++ b/src/libsac2c/stdopt/symbolic_constant_simplification.c @@ -879,11 +879,14 @@ static bool isMatchPrfShapes (node *arg_node) { bool res; + ntype *type1, *type2; DBUG_ENTER (); - res = TUeqShapes (AVIS_TYPE (ID_AVIS (PRF_ARG1 (arg_node))), - AVIS_TYPE (ID_AVIS (PRF_ARG2 (arg_node)))); + type1 = AVIS_TYPE (ID_AVIS (PRF_ARG1 (arg_node))); + type2 = AVIS_TYPE (ID_AVIS (PRF_ARG2 (arg_node))); + res = TUshapeKnown (type1) && TUshapeKnown (type2) + && TUeqShapes (type1, type2); DBUG_RETURN (res); } @@ -3359,7 +3362,7 @@ SCSprf_val_lt_shape_VxA (node *arg_node, info *arg_info) if (PMmatchFlat (pat1, arg_node)) { ivtype = ID_NTYPE (iv); arrtype = ID_NTYPE (arr); - if (TUdimKnown (arrtype)) { + if (TUshapeKnown (arrtype)) { arrshp = TYgetShape (arrtype); arrc = COmakeConstantFromShape (arrshp); if ((COgetExtent (ivc, 0) == COgetExtent (arrc, 0)) diff --git a/src/libsac2c/tree/map_fun_trav.c b/src/libsac2c/tree/map_fun_trav.c index a540c60440d2c45db8ed937b2ae08d43d43e3c6b..3163cd6f50fea63f7f814e8b3210fa401f0c2a9a 100644 --- a/src/libsac2c/tree/map_fun_trav.c +++ b/src/libsac2c/tree/map_fun_trav.c @@ -63,9 +63,8 @@ MFTfundef (node *arg_node, info *arg_info) arg_node = INFO_MAPTRAV (arg_info) (arg_node, INFO_EXTINFO (arg_info)); - if (FUNDEF_NEXT (arg_node) != NULL) { - FUNDEF_NEXT (arg_node) = TRAVdo (FUNDEF_NEXT (arg_node), arg_info); - } + FUNDEF_LOCALFUNS (arg_node) = TRAVopt (FUNDEF_LOCALFUNS (arg_node), arg_info); + FUNDEF_NEXT (arg_node) = TRAVopt (FUNDEF_NEXT (arg_node), arg_info); DBUG_RETURN (arg_node); } diff --git a/src/libsac2c/typecheck/new_typecheck.c b/src/libsac2c/typecheck/new_typecheck.c index be92cdcd0d317c9ae91d3443fedf148afb847a61..6140b4dd2f780058921fc17b9a7560c971d40a6a 100644 --- a/src/libsac2c/typecheck/new_typecheck.c +++ b/src/libsac2c/typecheck/new_typecheck.c @@ -434,6 +434,7 @@ ResetWrapperTypes (node *fundef, info *arg_info) if (FUNDEF_ISWRAPPERFUN (fundef) && (FUNDEF_BODY (fundef) != NULL)) { type = FUNDEF_WRAPPERTYPE (fundef); + DBUG_PRINT ("resetting wrapper types for %s", CTIitemName (fundef)); if (TYisFun (type)) { FUNDEF_WRAPPERTYPE (fundef) = TUrebuildWrapperTypeAlpha (type); FUNDEF_RETS (fundef) = TUrettypes2alphaAUDMax (FUNDEF_RETS (fundef)); @@ -453,6 +454,25 @@ ResetWrapperTypes (node *fundef, info *arg_info) DBUG_RETURN (fundef); } +static node * +ResetIsolatedFunTypes (node *fundef, info *arg_info) +{ + DBUG_ENTER (); + + if (!FUNDEF_ISWRAPPERFUN (fundef) && (FUNDEF_BODY (fundef) != NULL)) { + /* + * we do not need to exclude the instances that have been done + * during the handling of wrappers as TUrettypes2alphaAUDMax + * does not modify existing alphas! + */ + DBUG_PRINT ("resetting return types for %s", CTIitemName (fundef)); + FUNDEF_RETS (fundef) = TUrettypes2alphaAUDMax (FUNDEF_RETS (fundef)); + } + + DBUG_RETURN (fundef); +} + + node * NTCdoNewReTypeCheckFromScratch (node *arg_node) { @@ -467,10 +487,20 @@ NTCdoNewReTypeCheckFromScratch (node *arg_node) /* * open up all wrapper types + * this implicitly opens up the return types of all instances of + * that wrapper as well! */ MODULE_FUNS (arg_node) = MFTdoMapFunTrav (MODULE_FUNS (arg_node), NULL, ResetWrapperTypes); + /* + * finally, we need to open up the return types of all dispatched + * functions whose wrappers have been elided already! Otherwise, + * these never get improved anymore! + */ + MODULE_FUNS (arg_node) + = MFTdoMapFunTrav (MODULE_FUNS (arg_node), NULL, ResetIsolatedFunTypes); + arg_node = NTCdoNewReTypeCheck (arg_node); DBUG_RETURN (arg_node); diff --git a/src/libsac2c/typecheck/new_types.c b/src/libsac2c/typecheck/new_types.c index faf008c0e89d13fe32dae634244e733f6d467d28..474e023a1564a263ff5ee672b7bba7d4b6989ca7 100644 --- a/src/libsac2c/typecheck/new_types.c +++ b/src/libsac2c/typecheck/new_types.c @@ -914,15 +914,14 @@ TYgetShape (ntype *array) shape *res; DBUG_ENTER (); - DBUG_ASSERT ((NTYPE_CON (array) == TC_aks) || (NTYPE_CON (array) == TC_akv) - || (NTYPE_CON (array) == TC_akd), - "TYgetShape applied to other than AKV, AKS or AKD type!"); + DBUG_ASSERT ((NTYPE_CON (array) == TC_aks) || (NTYPE_CON (array) == TC_akv), + "TYgetShape applied to other than AKV or AKS type!"); if (NTYPE_CON (array) == TC_akv) { res = COgetShape (AKV_CONST (array)); } else if (NTYPE_CON (array) == TC_aks) { res = AKS_SHP (array); } else { - res = AKD_SHP (array); + res = NULL; } DBUG_RETURN (res); diff --git a/src/libsac2c/typecheck/type_utils.c b/src/libsac2c/typecheck/type_utils.c index e4cc556570a453a8b4c513c3b9330ab5632e9486..5823cd0daf42c28815c7480a1b559bf32859830e 100644 --- a/src/libsac2c/typecheck/type_utils.c +++ b/src/libsac2c/typecheck/type_utils.c @@ -101,6 +101,7 @@ buildWrapperAlphaFix (node *fundef, ntype *type) { DBUG_ENTER (); + DBUG_PRINT_TAG ("TUWRAP", "buildWrapperAlphaFix (%s, type)", CTIitemName (fundef)); /* * set this instances return types to alpha[*] */ @@ -149,7 +150,7 @@ buildWrapperAlpha (node *fundef, ntype *type) /* * set this instances return types to alpha[*] */ - DBUG_PRINT ("opening return types of %s", CTIitemName (fundef)); + DBUG_PRINT_TAG ("TUWRAP", "opening return types of %s", CTIitemName (fundef)); if (FUNDEF_BODY (fundef) != NULL) { FUNDEF_RETS (fundef) = TUrettypes2alphaAUDMax (FUNDEF_RETS (fundef)); } else { @@ -396,18 +397,22 @@ TUargtypes2unknownAUD (node *args) ntype * TUtype2alphaMax (ntype *type) { - ntype *xnew, *scalar; + ntype *xnew, *scalar, *mint; tvar *tv; DBUG_ENTER (); if (TYisAlpha (type)) { tv = TYgetAlpha (type); + mint = SSIgetMin (tv); if (SSIgetMax (tv) != NULL) { xnew = TYmakeAlphaType (TYcopyType (SSIgetMax (tv))); - } else if (SSIgetMin (tv) != NULL) { - xnew - = TYmakeAlphaType (TYmakeAUD (TYcopyType (TYgetScalar (SSIgetMin (tv))))); + } else if (mint !=NULL) { + if (TYisBottom (mint)) { + xnew = TYmakeAlphaType (TYcopyType (mint)); + } else { + xnew = TYmakeAlphaType (TYmakeAUD (TYcopyType (TYgetScalar (mint)))); + } } else { xnew = TYmakeAlphaType (NULL); } @@ -1766,7 +1771,7 @@ int TUgetFullDimEncoding (ntype *type) * * @brief: produces the array info encoding needed by the backend: * >= 0 : AKS / AKD with result == DIM - * == -1: AUSGZ + * == -1: AUDGZ * == -2: AUD * * @@ -1792,6 +1797,38 @@ int TUgetDimEncoding (ntype *type) DBUG_RETURN (res); } +/** + * + * @fn int TUgetLengthEncoding( ntype *type) + * + * @brief: produces the ravel info encoding needed by the backend: + * >= 0 : non-scalar AKS with result == prod (shape) + * == 0 : scalar + * == -1: AKD, AUDGZ, or AUD + * + * + * @param: type: ntype + * + * @return the encoding of the dimensionality. + * + ******************************************************************************/ +int TUgetLengthEncoding (ntype *type) +{ + int res; + + DBUG_ENTER (); + + if (TYisAUDGZ (type) || TYisAUD (type) || TYisAKD (type)) { + res = -1; + } else if (TUisScalar (type)) { + res = 0; + } else { + res = (int)SHgetUnrLen (TYgetShape (type)); + } + + DBUG_RETURN (res); +} + /** * * @fn simpletype TUgetSimpleImplementationType (ntype *type) diff --git a/src/libsac2c/typecheck/type_utils.h b/src/libsac2c/typecheck/type_utils.h index 17c5323bf60a1ccbb894349d79dfe73a50f7659a..c3a65ff145d596b2d68da7b36a2d00d304e39e35 100644 --- a/src/libsac2c/typecheck/type_utils.h +++ b/src/libsac2c/typecheck/type_utils.h @@ -95,6 +95,7 @@ extern bool TUisPolymorphic (ntype *type); */ extern int TUgetFullDimEncoding (ntype *type); extern int TUgetDimEncoding (ntype *type); +extern int TUgetLengthEncoding (ntype *type); extern simpletype TUgetSimpleImplementationType (ntype *type); /** diff --git a/tests/test-issue-2255.sac b/tests/test-issue-2255.sac new file mode 100644 index 0000000000000000000000000000000000000000..5a6a9d3755ab53050aef6d493460ae0c34acb969 --- /dev/null +++ b/tests/test-issue-2255.sac @@ -0,0 +1,18 @@ +// Ported from: issues/2255 +// +// SAC_TEST|include common.mk +// SAC_TEST|SAC2C_FLAGS += -check tc +// SAC_TEST|CALL_SAC2C := $(SAC2C) $(SAC2C_FLAGS) +// +// SAC_TEST|all: +// SAC_TEST|./$< + + +noinline int[.,.] ex (int x) { + return with{}:genarray ([0, x], 0); +} + +int main () { + return _sel_VxA_ ([0], _shape_A_ (ex (42))); +} +