| 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 |
| 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... *) |
| 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 |
| 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 |
Parent Directory
| 
Revision Log
| 
Patch
