590 |
(** the following function contains the procedure on how to |
(** the following function contains the procedure on how to |
591 |
* flatten the arguments and results of an arbitrary FLINT function |
* flatten the arguments and results of an arbitrary FLINT function |
592 |
*) |
*) |
593 |
|
val maxFlat = 5 (* most number of args to flatten *) |
594 |
|
|
595 |
fun isKnown tc = |
fun isKnown tc = |
596 |
(case tc_outX(tc_whnm tc) |
(case tc_outX(tc_whnm tc) |
597 |
of (TC_PRIM _ | TC_ARROW _ | TC_BOX _ | TC_ABS _ | TC_PARROW _) => true |
of (TC_PRIM _ | TC_ARROW _ | TC_BOX _ | TC_ABS _ | TC_PARROW _) => true |
610 |
| TC_TUPLE (_, []) => (* unit is not flattened to avoid coercions *) |
| TC_TUPLE (_, []) => (* unit is not flattened to avoid coercions *) |
611 |
(true, [ntc], false) |
(true, [ntc], false) |
612 |
| TC_TUPLE (_, ts) => |
| TC_TUPLE (_, ts) => |
613 |
if length ts < 10 then (true, ts, true) |
if length ts < maxFlat then (true, ts, true) |
614 |
else (true, [ntc], false) (* ZHONG added the magic number 10 *) |
else (true, [ntc], false) (* ZHONG added the magic number 10 *) |
615 |
| _ => if isKnown ntc then (true, [ntc], false) |
| _ => if isKnown ntc then (true, [ntc], false) |
616 |
else (false, [ntc], false)) |
else (false, [ntc], false)) |
618 |
|
|
619 |
and tc_autotuple [x] = x |
and tc_autotuple [x] = x |
620 |
| tc_autotuple xs = |
| tc_autotuple xs = |
621 |
if length xs < 10 then tcc_tup (RF_TMP, xs) |
if length xs < maxFlat then tcc_tup (RF_TMP, xs) |
622 |
else bug "fatal error with tc_autotuple" |
else bug "fatal error with tc_autotuple" |
623 |
|
|
624 |
and tcs_autoflat (flag, ts) = |
and tcs_autoflat (flag, ts) = |