Home My Page Projects Code Snippets Project Openings SML/NJ
 Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

# SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/Semant/basics/conrep.sml
 [smlnj] / sml / trunk / src / compiler / Semant / basics / conrep.sml

# Diff of /sml/trunk/src/compiler/Semant/basics/conrep.sml

revision 77, Tue Apr 14 05:21:45 1998 UTC revision 78, Fri Apr 17 17:58:14 1998 UTC
# Line 30  Line 30
30      | ty => ty      | ty => ty
31
32  fun notconst(_,true,_) = false  fun notconst(_,true,_) = false
33    (*
34    | notconst(_,_,CONty(_,[t,_])) =    | notconst(_,_,CONty(_,[t,_])) =
35        (case (reduce t)        (case (reduce t)
36          of CONty(RECORDtyc nil,_) => false          of CONty(RECORDtyc nil,_) => false
37           | _ => true)           | _ => true)
38    *)
39    | notconst _ = true    | notconst _ = true
40
41    (*
42     * fun show((sym,_,_)::syms, r::rs) =
43     *      (print(Symbol.name sym); print ":   ";
44     *      PPBasics.ppRep r; print "\n"; show(syms,rs))
45     *   | show _ = (print "\n")
46     *)
47
48  (* the first argument indicates whether this is a recursive datatypes *)  (* the first argument indicates whether this is a recursive datatypes *)
49  fun infer false ([(_, false, CONty(_,[ty,_]))]) =  fun infer false ([(_, false, CONty(_,[ty,_]))]) =
50        (case (reduce ty)        (case (reduce ty)
51          of (CONty(RECORDtyc nil, _)) => ([CONSTANT 0], CSIG (0,1))          of (* (CONty(RECORDtyc nil, _)) => ([CONSTANT 0], CSIG (0,1))
52           | _ => ([UNTAGGED], CSIG(1,0)) (* [TRANSPARENT] *))           | *) _ => ([UNTAGGED], CSIG(1,0)) (* [TRANSPARENT] *))
53        (* The TRANSPARENT conrep is temporarily turned off;        (* The TRANSPARENT conrep is temporarily turned off;
54           it should be working very soon. Ask zsh. *)           it should be working very soon. Ask zsh. *)
55
# Line 54  Line 63
63
64              | decide (ctag,vtag, (_,false,CONty(_,[ty,_]))::rest, reps) =              | decide (ctag,vtag, (_,false,CONty(_,[ty,_]))::rest, reps) =
65                  (case (reduce ty, multiple)                  (case (reduce ty, multiple)
66                    of (CONty(RECORDtyc nil,_),_) =>                    of (*
67                         (CONty(RECORDtyc nil,_),_) =>
68                         decide(ctag+1, vtag, rest, (CONSTANT ctag) :: reps)                         decide(ctag+1, vtag, rest, (CONSTANT ctag) :: reps)
69                     | (_, true) =>                     | *)
70                         (_, true) =>
71                         decide(ctag, vtag+1, rest, (TAGGED vtag) :: reps)                         decide(ctag, vtag+1, rest, (TAGGED vtag) :: reps)
72                     | (_, false) =>                     | (_, false) =>
73                         decide(ctag, vtag+1, rest, (UNTAGGED :: reps)))                         decide(ctag, vtag+1, rest, (UNTAGGED :: reps)))
# Line 66  Line 77
77         in decide(0, 0, cons, [])         in decide(0, 0, cons, [])
78        end        end
79
80  (** rebind infer for debugging purpose **)  (*** val infer = fn l => let val l' = infer l in show(l,l'); l' end ***)
local
val pps = PrettyPrint.mk_ppstream
{consumer=TextIO.print,
linewidth=80,
flush = fn() => TextIO.flushOut TextIO.stdOut}

fun show((sym,_,_)::syms, r::rs) =
(print(Symbol.name sym); print ":   ";
PPVal.ppRep pps r; print "\n"; show(syms,rs))
| show _ = (print "\n")

fun dbg flag cons =
let val result = infer flag cons
in
if !Control.CG.etdebugging then
show(cons, #1 result)
else ();
result
end
in
val infer = dbg
end (* local debugging *)

81
82  end (* local *)  end (* local *)

83  end (* structure ConRep *)  end (* structure ConRep *)
84
85
86  (*  (*
87   * \$Log: conrep.sml,v \$   * \$Log: conrep.sml,v \$
88   * Revision 1.1.1.1  1997/01/14  01:38:09  george   * Revision 1.1.1.1  1998/04/08 18:39:34  george
89   *   Version 109.24   * Version 110.5
90   *   *
91   *)   *)

Legend:
 Removed from v.77 changed lines Added in v.78