CVS: sml-dist/src/compiler/FLINT/kernel lty.sig, 1.1.2.11, 1.1.2.12 lty.sml, 1.1.2.17, 1.1.2.18 ltybasic.sml, 1.13.24.5, 1.13.24.6 ltydef.sig, 1.4.24.2, 1.4.24.3 ltydef.sml, 1.4.24.2, 1.4.24.3 ltyextern.sml, 1.19.24.14, 1.19.24.15 ltykernel.sml, 1.18.12.21, 1.18.12.22 ltykindchk.sml, 1.1.2.3, 1.1.2.4 pplty.sml, 1.1.2.15, 1.1.2.16
David MacQueen <[email protected]> Thu, 24 Aug 2006 12:29:14 -0700
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv28058/src/compiler/FLINT/kernel
Modified Files:
Tag: primop-branch-2
lty.sig lty.sml ltybasic.sml ltydef.sig ltydef.sml
ltyextern.sml ltykernel.sml ltykindchk.sml pplty.sml
Log Message:
added datatype names to TC_FIX for printing tycs better
Index: lty.sig
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/lty.sig,v
retrieving revision 1.1.2.11
retrieving revision 1.1.2.12
diff -C2 -d -r1.1.2.11 -r1.1.2.12
*** lty.sig 23 Aug 2006 23:44:17 -0000 1.1.2.11
--- lty.sig 24 Aug 2006 19:28:40 -0000 1.1.2.12
***************
*** 96,100 ****
| TC_SUM of tyc list (* sum tyc *)
! | TC_FIX of (int * tyc * tyc list) * int (* recursive tyc *)
| TC_TUPLE of rflag * tyc list (* std record tyc *)
--- 96,104 ----
| TC_SUM of tyc list (* sum tyc *)
! | TC_FIX of {family: {size: int, (* recursive tyc *)
! names: string vector,
! gen : tyc,
! params : tyc list},
! index: int}
| TC_TUPLE of rflag * tyc list (* std record tyc *)
Index: lty.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/lty.sml,v
retrieving revision 1.1.2.17
retrieving revision 1.1.2.18
diff -C2 -d -r1.1.2.17 -r1.1.2.18
*** lty.sml 23 Aug 2006 23:44:17 -0000 1.1.2.17
--- lty.sml 24 Aug 2006 19:28:40 -0000 1.1.2.18
***************
*** 127,137 ****
| TC_SUM of tyc list (* sum tyc *)
! | TC_FIX of (int * tyc * tyc list) * int (* (mutually-)recursive tyc
! * int # of family members
! * tyc of rec-type generator
! * tyc list is freetycs
! * int index of dcon in dt
! * built in
! * trans/transtypes.sml*)
| TC_TUPLE of rflag * tyc list (* std record tyc *)
--- 127,138 ----
| TC_SUM of tyc list (* sum tyc *)
! | TC_FIX of (* datatype tyc *)
! {family : (* recursive dt family *)
! {size : int, (* size of family *)
! names : string vector, (* datatype names for printing *)
! gen : tyc, (* common generator fn *)
! params: tyc list}, (* parameters for generator *)
! index : int} (* index of this dt in family *)
! (* TC_FIX are built in trans/transtypes.sml*)
| TC_TUPLE of rflag * tyc list (* std record tyc *)
***************
*** 319,323 ****
| (TC_PROJ(t, i)) => combine [6, (getnum t), i]
| (TC_SUM ts) => combine (7::(map getnum ts))
! | (TC_FIX((n, t, ts), i)) =>
combine (8::n::i::(getnum t)::(map getnum ts))
| (TC_ABS t) => combine [9, getnum t]
--- 320,325 ----
| (TC_PROJ(t, i)) => combine [6, (getnum t), i]
| (TC_SUM ts) => combine (7::(map getnum ts))
! | (TC_FIX{family={size=n,gen=t,params=ts,...},index=i}) =>
! (* names not involved the the hash *)
combine (8::n::i::(getnum t)::(map getnum ts))
| (TC_ABS t) => combine [9, getnum t]
***************
*** 397,404 ****
| (TC_PROJ(t, _)) => getAux t
| (TC_SUM ts) => fsmerge ts
! | (TC_FIX((_,t,ts), _)) =>
! let val ax = getAux t
in case ax
! of AX_REG(_,[],[]) => mergeAux(ax, fsmerge ts)
| AX_REG _ => bug "unexpected TC_FIX freevars in tc_aux"
| AX_NO => AX_NO
--- 399,406 ----
| (TC_PROJ(t, _)) => getAux t
| (TC_SUM ts) => fsmerge ts
! | (TC_FIX{family={gen,params,...},...}) =>
! let val ax = getAux gen
in case ax
! of AX_REG(_,[],[]) => mergeAux(ax, fsmerge params)
| AX_REG _ => bug "unexpected TC_FIX freevars in tc_aux"
| AX_NO => AX_NO
Index: ltybasic.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltybasic.sml,v
retrieving revision 1.13.24.5
retrieving revision 1.13.24.6
diff -C2 -d -r1.13.24.5 -r1.13.24.6
*** ltybasic.sml 23 Aug 2006 23:44:17 -0000 1.13.24.5
--- ltybasic.sml 24 Aug 2006 19:28:40 -0000 1.13.24.6
***************
*** 89,93 ****
let val tbool = tcc_sum [tcc_unit, tcc_unit]
val tsig_bool = tcc_fn ([tkc_mono], tbool)
! in tcc_fix((1, tsig_bool, []), 0)
end
--- 89,93 ----
let val tbool = tcc_sum [tcc_unit, tcc_unit]
val tsig_bool = tcc_fn ([tkc_mono], tbool)
! in tcc_fix((1, #["bool"], tsig_bool, []), 0)
end
***************
*** 101,105 ****
that in basics/basictypes.sml **)
val tsig_list = tcc_fn([tkc_int 1], tlist)
! in tcc_fix((1, tsig_list, []), 0)
end
--- 101,105 ----
that in basics/basictypes.sml **)
val tsig_list = tcc_fn([tkc_int 1], tlist)
! in tcc_fix((1, #["list"], tsig_list, []), 0)
end
***************
*** 172,176 ****
| LT.TC_SUM tcs =>
"TSUM(" ^ (plist(tc_print, tcs)) ^ ")"
! | LT.TC_FIX ((_, tc, ts), i) =>
if tc_eqv(x,tcc_bool) then "B"
else if tc_eqv(x,tcc_list) then "LST"
--- 172,176 ----
| LT.TC_SUM tcs =>
"TSUM(" ^ (plist(tc_print, tcs)) ^ ")"
! | LT.TC_FIX {family={gen=tc,params=ts,...}, index=i} =>
if tc_eqv(x,tcc_bool) then "B"
else if tc_eqv(x,tcc_list) then "LST"
Index: ltydef.sig
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltydef.sig,v
retrieving revision 1.4.24.2
retrieving revision 1.4.24.3
diff -C2 -d -r1.4.24.2 -r1.4.24.3
*** ltydef.sig 23 Aug 2006 23:44:17 -0000 1.4.24.2
--- ltydef.sig 24 Aug 2006 19:28:40 -0000 1.4.24.3
***************
*** 113,117 ****
val tcc_proj : tyc * int -> tyc
val tcc_sum : tyc list -> tyc
! val tcc_fix : (int * tyc * tyc list) * int -> tyc
val tcc_wrap : tyc -> tyc
val tcc_abs : tyc -> tyc
--- 113,117 ----
val tcc_proj : tyc * int -> tyc
val tcc_sum : tyc list -> tyc
! val tcc_fix : (int * string vector * tyc * tyc list) * int -> tyc
val tcc_wrap : tyc -> tyc
val tcc_abs : tyc -> tyc
Index: ltydef.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltydef.sml,v
retrieving revision 1.4.24.2
retrieving revision 1.4.24.3
diff -C2 -d -r1.4.24.2 -r1.4.24.3
*** ltydef.sml 23 Aug 2006 23:44:17 -0000 1.4.24.2
--- ltydef.sml 24 Aug 2006 19:28:40 -0000 1.4.24.3
***************
*** 139,143 ****
val tcc_proj : tyc * int -> tyc = tc_inj o LT.TC_PROJ
val tcc_sum : tyc list -> tyc = tc_inj o LT.TC_SUM
! val tcc_fix : (int * tyc * tyc list) * int -> tyc = tc_inj o LT.TC_FIX
val tcc_wrap : tyc -> tyc = fn tc => tc_inj (LT.TC_TOKEN(LK.wrap_token, tc))
val tcc_abs : tyc -> tyc = tc_inj o LT.TC_ABS
--- 139,145 ----
val tcc_proj : tyc * int -> tyc = tc_inj o LT.TC_PROJ
val tcc_sum : tyc list -> tyc = tc_inj o LT.TC_SUM
! val tcc_fix : (int * string vector * tyc * tyc list) * int -> tyc =
! fn ((s,ns,g,p),i) =>
! tc_inj(LT.TC_FIX{family={size=s,names=ns,gen=g,params=p},index=i})
val tcc_wrap : tyc -> tyc = fn tc => tc_inj (LT.TC_TOKEN(LK.wrap_token, tc))
val tcc_abs : tyc -> tyc = tc_inj o LT.TC_ABS
***************
*** 172,177 ****
| _ => bug "unexpected tyc in tcd_sum")
val tcd_fix : tyc -> (int * tyc * tyc list) * int = fn tc =>
! (case tc_out tc of LT.TC_FIX x => x
! | _ => bug "unexpected tyc in tcd_fix")
val tcd_wrap : tyc -> tyc = fn tc =>
(case tc_out tc
--- 174,180 ----
| _ => bug "unexpected tyc in tcd_sum")
val tcd_fix : tyc -> (int * tyc * tyc list) * int = fn tc =>
! (case tc_out tc of LT.TC_FIX{family={size,names,gen,params},index} =>
! ((size,gen,params),index)
! | _ => bug "unexpected tyc in tcd_fix")
val tcd_wrap : tyc -> tyc = fn tc =>
(case tc_out tc
***************
*** 242,246 ****
(case tc_out tc of LT.TC_SUM x => f x | _ => g tc)
fun tcw_fix (tc, f, g) =
! (case tc_out tc of LT.TC_FIX x => f x | _ => g tc)
fun tcw_wrap (tc, f, g) =
(case tc_out tc
--- 245,251 ----
(case tc_out tc of LT.TC_SUM x => f x | _ => g tc)
fun tcw_fix (tc, f, g) =
! (case tc_out tc
! of LT.TC_FIX{family={size,names,gen,params},index} => f((size,gen,params),index)
! | _ => g tc)
fun tcw_wrap (tc, f, g) =
(case tc_out tc
Index: ltyextern.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltyextern.sml,v
retrieving revision 1.19.24.14
retrieving revision 1.19.24.15
diff -C2 -d -r1.19.24.14 -r1.19.24.15
*** ltyextern.sml 24 Aug 2006 16:32:44 -0000 1.19.24.14
--- ltyextern.sml 24 Aug 2006 19:28:40 -0000 1.19.24.15
***************
*** 251,255 ****
else PO.UPDATE
| h(LT.TC_TUPLE _ | LT.TC_ARROW _) = PO.BOXEDUPDATE
! | h(LT.TC_FIX ((1,tc,ts), 0)) =
let val ntc = case ts of [] => tc
| _ => tcc_app(tc, ts)
--- 251,255 ----
else PO.UPDATE
| h(LT.TC_TUPLE _ | LT.TC_ARROW _) = PO.BOXEDUPDATE
! | h(LT.TC_FIX{family={size=1,gen=tc,params=ts,...},index=0}) =
let val ntc = case ts of [] => tc
| _ => tcc_app(tc, ts)
***************
*** 316,321 ****
| LT.TC_PROJ (tc, i) => tcc_proj(w tc, i)
| LT.TC_SUM tcs => tcc_sum (map w tcs)
! | LT.TC_FIX ((n,tc,ts), i) =>
! tcc_fix((n, tc_norm (u tc), map w ts), i)
| LT.TC_TUPLE (_, ts) => tcc_wrap(tcc_tuple (map w ts)) (* ? *)
--- 316,321 ----
| LT.TC_PROJ (tc, i) => tcc_proj(w tc, i)
| LT.TC_SUM tcs => tcc_sum (map w tcs)
! | LT.TC_FIX{family={size=n,names,gen=tc,params=ts},index=i} =>
! tcc_fix((n, names, tc_norm (u tc), map w ts), i)
| LT.TC_TUPLE (_, ts) => tcc_wrap(tcc_tuple (map w ts)) (* ? *)
***************
*** 343,348 ****
| LT.TC_PROJ (tc, i) => tcc_proj(u tc, i)
| LT.TC_SUM tcs => tcc_sum (map u tcs)
! | LT.TC_FIX ((n,tc,ts), i) =>
! tcc_fix((n, tc_norm (u tc), map w ts), i)
| LT.TC_TUPLE (rk, tcs) => tcc_tuple(map u tcs)
--- 343,348 ----
| LT.TC_PROJ (tc, i) => tcc_proj(u tc, i)
| LT.TC_SUM tcs => tcc_sum (map u tcs)
! | LT.TC_FIX{family={size=n,names,gen=tc,params=ts},index=i} =>
! tcc_fix((n, names, tc_norm (u tc), map w ts), i)
| LT.TC_TUPLE (rk, tcs) => tcc_tuple(map u tcs)
***************
*** 434,439 ****
| LT.TC_SUM ts =>
tcc_sum (rs ts)
! | LT.TC_FIX ((i,t,ts),j) =>
! tcc_fix ((i, r t, rs ts), j)
| LT.TC_TUPLE (rf,ts) =>
tcc_tuple (rs ts)
--- 434,439 ----
| LT.TC_SUM ts =>
tcc_sum (rs ts)
! | LT.TC_FIX {family={size,names,gen,params},index} =>
! tcc_fix ((size,names,r gen,rs params),index)
| LT.TC_TUPLE (rf,ts) =>
tcc_tuple (rs ts)
***************
*** 563,568 ****
| LT.TC_SUM ts =>
tcc_sum (map loop ts)
! | LT.TC_FIX ((i,t,ts),j) =>
! tcc_fix ((i, loop t, map loop ts), j)
| LT.TC_TUPLE (rf,ts) =>
tcc_tuple (map loop ts)
--- 563,568 ----
| LT.TC_SUM ts =>
tcc_sum (map loop ts)
! | LT.TC_FIX{family={size,names,gen,params},index} =>
! tcc_fix ((size, names, loop gen, map loop params),index)
| LT.TC_TUPLE (rf,ts) =>
tcc_tuple (map loop ts)
***************
*** 703,708 ****
| LT.TC_SUM ts =>
tcc_sum (rs ts)
! | LT.TC_FIX ((i,t,ts),j) =>
! tcc_fix ((i, r t, rs ts), j)
| LT.TC_TUPLE (rf,ts) =>
tcc_tuple (rs ts)
--- 703,708 ----
| LT.TC_SUM ts =>
tcc_sum (rs ts)
! | LT.TC_FIX{family={size,names,gen,params},index} =>
! tcc_fix ((size, names, r gen, rs params), index)
| LT.TC_TUPLE (rf,ts) =>
tcc_tuple (rs ts)
Index: ltykernel.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltykernel.sml,v
retrieving revision 1.18.12.21
retrieving revision 1.18.12.22
diff -C2 -d -r1.18.12.21 -r1.18.12.22
*** ltykernel.sml 23 Aug 2006 23:44:17 -0000 1.18.12.21
--- ltykernel.sml 24 Aug 2006 19:28:40 -0000 1.18.12.22
***************
*** 145,154 ****
of (TC_FN(_, tc')) => getArity tc'
| _ => 0)
! | (TC_FIX((numFamily,tc,freetycs),index)) =>
! (case (tc_outX tc) of
! (TC_FN (_,tc')) => (* generator function *)
! (case (tc_outX tc') of
! (TC_SEQ tycs) => getArity (List.nth (tycs, index))
! | TC_FN (params, _) => length params
| _ => bug "Malformed generator range")
| _ => bug "FIX without generator!" )
--- 145,155 ----
of (TC_FN(_, tc')) => getArity tc'
| _ => 0)
! | (TC_FIX{family={size,gen,params,...},index}) =>
! (case (tc_outX gen)
! of (TC_FN (_,tc')) => (* generator function *)
! (case (tc_outX tc')
! of (TC_SEQ tycs) =>
! getArity (List.nth (tycs, index))
! | TC_FN (args, _) => length args
| _ => bug "Malformed generator range")
| _ => bug "FIX without generator!" )
***************
*** 176,180 ****
val tcc_seq = tc_injX o TC_SEQ
val tcc_proj = tc_injX o TC_PROJ
! val tcc_fix = tc_injX o TC_FIX
val tcc_abs = tc_injX o TC_ABS
val tcc_tup = tc_injX o TC_TUPLE
--- 177,183 ----
val tcc_seq = tc_injX o TC_SEQ
val tcc_proj = tc_injX o TC_PROJ
! val tcc_fix =
! fn ((size:int,names: string vector,gen: tyc,params: tyc list),index:int) =>
! tc_injX(TC_FIX{family={size=size,names=names,gen=gen,params=params},index=index})
val tcc_abs = tc_injX o TC_ABS
val tcc_tup = tc_injX o TC_TUPLE
***************
*** 328,333 ****
| TC_PROJ (tc, i) => tcc_proj(prop tc, i)
| TC_SUM tcs => tcc_sum (map prop tcs)
! | TC_FIX ((n,tc,ts), i) =>
! tcc_fix((n, prop tc, map prop ts), i)
| TC_ABS tc => tcc_abs (prop tc)
| TC_BOX tc => tcc_box (prop tc)
--- 331,336 ----
| TC_PROJ (tc, i) => tcc_proj(prop tc, i)
| TC_SUM tcs => tcc_sum (map prop tcs)
! | TC_FIX{family={size,names,gen,params},index} =>
! tcc_fix((size, names, prop gen, map prop params), index)
| TC_ABS tc => tcc_abs (prop tc)
| TC_BOX tc => tcc_box (prop tc)
***************
*** 391,400 ****
of (TC_FN(_, tc')) => getArity tc'
| _ => 0)
! | (TC_FIX((numFamily,tc,freetycs),index)) =>
! (case (tc_outX tc) of
! (TC_FN (_,tc')) => (* generator function *)
! (case (tc_outX tc') of
! (TC_SEQ tycs) => getArity (List.nth (tycs, index))
! | TC_FN (params, _) => length params
| _ => bug "Malformed generator range")
| _ => bug "FIX without generator!" )
--- 394,403 ----
of (TC_FN(_, tc')) => getArity tc'
| _ => 0)
! | (TC_FIX{family={size,gen,params,...},index}) =>
! (case (tc_outX gen)
! of (TC_FN (_,tc')) => (* generator function *)
! (case (tc_outX tc')
! of (TC_SEQ tycs) => getArity (List.nth (tycs, index))
! | TC_FN (args, _) => length args
| _ => bug "Malformed generator range")
| _ => bug "FIX without generator!" )
***************
*** 503,508 ****
| TC_PROJ (tc, i) => tcc_proj(tc_norm tc, i)
| TC_SUM tcs => tcc_sum (map tc_norm tcs)
! | TC_FIX ((n,tc,ts), i) =>
! tcc_fix((n, tc_norm tc, map tc_norm ts), i)
| TC_ABS tc => tcc_abs(tc_norm tc)
| TC_BOX tc => tcc_box(tc_norm tc)
--- 506,511 ----
| TC_PROJ (tc, i) => tcc_proj(tc_norm tc, i)
| TC_SUM tcs => tcc_sum (map tc_norm tcs)
! | TC_FIX{family={size,names,gen,params},index} =>
! tcc_fix((size,names,tc_norm gen,map tc_norm params),index)
| TC_ABS tc => tcc_abs(tc_norm tc)
| TC_BOX tc => tcc_box(tc_norm tc)
***************
*** 697,714 ****
(** unrolling a fix, tyc -> tyc *)
fun tc_unroll_fix tyc =
! case tc_outX tyc of
! (TC_FIX((n,tc,ts),i)) => let
! fun genfix i = tcc_fix ((n,tc,ts),i)
! val fixes = List.tabulate(n, genfix)
! val mu = tc
! val mu = if null ts then mu
! else tcc_app (mu,ts)
! val mu = tcc_app (mu, fixes)
! val mu = if n=1 then mu
! else tcc_proj (mu, i)
! in
! Click.unroll();
! mu
! end
| _ => bug "unexpected non-FIX in tc_unroll_fix"
--- 700,717 ----
(** unrolling a fix, tyc -> tyc *)
fun tc_unroll_fix tyc =
! case tc_outX tyc
! of (TC_FIX{family={size=n,names,gen=tc,params=ts},index=i}) =>
! let fun genfix i = tcc_fix ((n,names,tc,ts),i)
! val fixes = List.tabulate(n, genfix)
! val mu = tc
! val mu = if null ts then mu
! else tcc_app (mu,ts)
! val mu = tcc_app (mu, fixes)
! val mu = if n=1 then mu
! else tcc_proj (mu, i)
! in
! Click.unroll();
! mu
! end
| _ => bug "unexpected non-FIX in tc_unroll_fix"
***************
*** 762,766 ****
fun eq_fix (eqop1, hyp) (t1, t2) =
(case (tc_outX t1, tc_outX t2)
! of (TC_FIX((n1,tc1,ts1),i1), TC_FIX((n2,tc2,ts2),i2)) =>
if not (!Control.FLINT.checkDatatypes) then true
else let
--- 765,770 ----
fun eq_fix (eqop1, hyp) (t1, t2) =
(case (tc_outX t1, tc_outX t2)
! of (TC_FIX{family={size=n1,gen=tc1,params=ts1,...},index=i1},
! TC_FIX{family={size=n2,gen=tc2,params=ts2,...},index=i2}) =>
if not (!Control.FLINT.checkDatatypes) then true
else let
Index: ltykindchk.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/ltykindchk.sml,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -C2 -d -r1.1.2.3 -r1.1.2.4
*** ltykindchk.sml 24 Aug 2006 16:32:45 -0000 1.1.2.3
--- ltykindchk.sml 24 Aug 2006 19:28:40 -0000 1.1.2.4
***************
*** 245,249 ****
(List.app (tkAssertIsMono o g) tcs;
tkc_mono)
! | TC_FIX ((n, tc, ts), i) =>
let (* Kind check generator tyc *)
val k = g tc
--- 245,249 ----
(List.app (tkAssertIsMono o g) tcs;
tkc_mono)
! | TC_FIX {family={size=n, gen=tc, params=ts,...},index=i} =>
let (* Kind check generator tyc *)
val k = g tc
Index: pplty.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/pplty.sml,v
retrieving revision 1.1.2.15
retrieving revision 1.1.2.16
diff -C2 -d -r1.1.2.15 -r1.1.2.16
*** pplty.sml 24 Aug 2006 16:32:45 -0000 1.1.2.15
--- pplty.sml 24 Aug 2006 19:28:40 -0000 1.1.2.16
***************
*** 22,25 ****
--- 22,27 ----
in
+ val dtPrintNames : bool ref = ref true
+
fun ppSeq ppstrm {sep: string, pp : PP.stream -> 'a -> unit} (list: 'a list) =
let val {openHOVBox, closeBox, pps, ...} = en_pp ppstrm
***************
*** 175,225 ****
(* TC_FIX is a recursive datatype constructor
from a (mutually-)recursive family *)
! | ppTycI (Lty.TC_FIX((numStamps, datatypeFamily, freetycs), index)) =
(openHOVBox 1;
! pps "FIX(";
! (case (Lty.tc_outX datatypeFamily)
! of Lty.TC_FN(params, rectyc) => (* generator function *)
! let fun ppMus 0 = ()
! | ppMus i = (pps "mu";
! ppi i;
! pps " ";
! ppMus (i - 1))
! in
! (pps "REC(";
! if (length params) > 0 then (pps "[";
! ppi (length params);
! pps "]")
! else ();
! PP.break ppstrm {nsp=1,offset=1};
! (case (Lty.tc_outX rectyc) of
! (rectycI as Lty.TC_FN _) => ppTycI rectycI
! | Lty.TC_SEQ(dconstycs) =>
! ppTyc' (List.nth(dconstycs, index))
! | tycI => ppTycI tycI);
! PP.break ppstrm {nsp=0,offset=0};
! pps ")")
! end
! | _ => pps "<No rectyc generator>");
! PP.break ppstrm {nsp=0,offset=0};
! pps ")";
! closeBox()
! (* pps "TC_FIX(";
! PP.break ppstrm {nsp=1,offset=1};
! pps "nStamps = ";
! pps (Int.toString numStamps);
! pps ",";
! PP.break ppstrm {nsp=1, offset=0};
! pps "datatypeFamily = ";
! ppTyc' datatypeFamily;
! pps ", ";
! PP.break ppstrm {nsp=1, offset=0};
! pps "freeTycs = ";
! ppList' {sep = ", ", pp = ppTyc} freetycs;
! pps ", ";
! PP.break ppstrm {nsp=1, offset=0};
! pps "index = ";
! pps (Int.toString index);
! pps ")";
! closeBox() *) )
| ppTycI (Lty.TC_ABS tyc) =
(pps "ABS(";
--- 177,199 ----
(* TC_FIX is a recursive datatype constructor
from a (mutually-)recursive family *)
! | ppTycI (Lty.TC_FIX{family={size,names,gen,params},index}) =
! if !dtPrintNames then pps (Vector.sub(names,index))
! else
(openHOVBox 1;
! pps "FIX(";
! openHVBox 0;
! pps "size = "; ppi size; PP.break ppstrm {nsp=1,offset=0};
! pps "index = "; ppi index; PP.break ppstrm {nsp=1,offset=0};
! pps "gen = ";
! openHOVBox 2;
! ppTyc' gen;
! closeBox;
! pps "prms = ";
! openHOVBox 2;
! ppList' {sep = ",", pp = ppTyc (pd-1)} params;
! closeBox ();
! PP.break ppstrm {nsp=0,offset=0};
! pps ")";
! closeBox())
| ppTycI (Lty.TC_ABS tyc) =
(pps "ABS(";
-------------------------------------------------------------------------
Using Tomcat but need to do more? Need to support web services, security?
Get stuff done quickly with pre-integrated technology to make your job easier
Download IBM WebSphere Application Server v.1.0.1 based on Apache Geronimo
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=120709&bid=263057&dat=121642