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
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

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