Diff of /sml/trunk/src/compiler/FLINT/kernel/ltykernel.sml

Parent Directory | Revision Log | Patch

	revision 75, Sun Apr 12 02:22:44 1998 UTC	revision 76, Sun Apr 12 02:23:26 1998 UTC
#	Line 590	Line 590
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
#	Line 608	Line 610
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))
#	Line 616	Line 618
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) =

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.75   changed lines   Added in v.76

---

root@smlnj-gforge.cs.uchicago.edu	ViewVC Help
Powered by ViewVC 1.0.0