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/types/typesutil.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/Semant/types/typesutil.sml

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

revision 632, Sat Apr 29 15:50:42 2000 UTC revision 633, Sun Apr 30 16:44:09 2000 UTC
# Line 132  Line 132 
132            DEFtyc{tyfun=tyfun,path=path,strict=strict,stamp=stamp}            DEFtyc{tyfun=tyfun,path=path,strict=strict,stamp=stamp}
133        | _ => bugTyc("setTycName",tycon)        | _ => bugTyc("setTycName",tycon)
134    
135    fun eqRecordLabels(nil,nil) = true
136      | eqRecordLabels(x::xs,y::ys) = Symbol.eq(x,y) andalso eqRecordLabels(xs,ys)
137      | eqRecordLabels _ = false
138    
139  fun eqTycon (GENtyc g, GENtyc g') = Stamps.eq (#stamp g, #stamp g')  fun eqTycon (GENtyc g, GENtyc g') = Stamps.eq (#stamp g, #stamp g')
140    | eqTycon (ERRORtyc,_) = true    | eqTycon (ERRORtyc,_) = true
141    | eqTycon (_,ERRORtyc) = true    | eqTycon (_,ERRORtyc) = true
# Line 144  Line 148 
148     * Also used in PPBasics to check data constructors of     * Also used in PPBasics to check data constructors of
149     * a datatype.  Used elsewhere?     * a datatype.  Used elsewhere?
150     *)     *)
151    | eqTycon(RECORDtyc l1, RECORDtyc l2) = l1=l2    | eqTycon(RECORDtyc l1, RECORDtyc l2) = eqRecordLabels(l1,l2)
152    | eqTycon _ = false    | eqTycon _ = false
153    
154          (* for now... *)          (* for now... *)
# Line 255  Line 259 
259      end      end
260    
261  local  local
262      (* making dummy argument lists to be used in equalTycon *)
263        val generator = Stamps.newGenerator()
264      fun makeDummyType() =      fun makeDummyType() =
265          CONty(GENtyc{stamp = Stamps.special "dummy",          CONty(GENtyc{stamp = Stamps.fresh generator,
266                       path = IP.IPATH[S.tycSymbol "dummy"],                       path = IP.IPATH[Symbol.tycSymbol "dummy"],
267                       arity = 0, eq = ref YES, stub = NONE,                       arity = 0, eq = ref YES, stub = NONE,
268                       kind = PRIMITIVE (PrimTyc.ptc_void)},[])                       kind = PRIMITIVE (PrimTyc.ptc_void)},[])
269           (*           (*
270            * Making dummy type is a temporary hack ! pt_void is not used            * Making dummy type is a temporary hack ! pt_void is not used
271            * anywhere in the source language ... Requires major clean up            * anywhere in the source language ... Requires major clean up
272            * in the future. (ZHONG)            * in the future. (ZHONG)
273              * DBM: shouldn't cause any problem here.  Only thing relevant
274              * property of the dummy types is that they have different stamps
275              * and their stamps should not agree with those of any "real" tycons.
276            *)            *)
277        (* precomputing dummy argument lists
278      fun makeargs 0 = []       * -- perhaps a bit of over-optimization here. [dbm] *)
279        | makeargs i = makeDummyType() :: makeargs(i-1)      fun makeargs (0,args) = args
280      val args = makeargs 10        | makeargs (i,args) = makeargs(i-1, makeDummyType()::args)
281      fun dargs(0,_,d) = d      val args10 = makeargs(10,[])  (* 10 dummys *)
282        | dargs(n,a::r,d) = dargs(n-1,r,a::d)      val args1 = [hd args10]
283        | dargs(n,[],d) = dargs(n-1,[],makeDummyType()::d)      val args2 = List.take (args10,2)
284   in fun dummyargs n = dargs(n,args,[])      val args3 = List.take (args10,3)  (* rarely need more than 3 args *)
285     in fun dummyargs 0 = []
286          | dummyargs 1 = args1
287          | dummyargs 2 = args2
288          | dummyargs 3 = args3
289          | dummyargs n =
290            if n <= 10 then List.take (args10,n) (* should be plenty *)
291            else makeargs(n-10,args10)  (* but make new dummys if needed *)
292  end  end
293    
294  (* equalTycon.  This definition deals only partially with types that  (* equalTycon.  This definition deals only partially with types that
# Line 284  Line 300 
300    | equalTycon(t1,t2) =    | equalTycon(t1,t2) =
301       let val a1 = tyconArity t1 and a2 = tyconArity t2       let val a1 = tyconArity t1 and a2 = tyconArity t2
302       in if a1<>a2 then false       in if a1<>a2 then false
303          else           else let val args = dummyargs a1
           let val args = dummyargs a1  
304            in equalType(mkCONty(t1,args),mkCONty(t2,args))            in equalType(mkCONty(t1,args),mkCONty(t2,args))
305            end            end
306       end       end

Legend:
Removed from v.632  
changed lines
  Added in v.633

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