-- file TypePack.mesa
-- last modified by Satterthwaite, February 22, 1983 2:05 pm
DIRECTORY
Strings: TYPE USING [SubStringDescriptor, EqualSubStrings],
SymbolTable: TYPE USING [Base],
Symbols: TYPE USING [
Name, Type, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, MDIndex,
nullName, MDNull, OwnMdi, ISENull, RecordSENull, StandardContext,
typeANY, typeTYPE],
Types: TYPE USING [Handle];
TypePack: PROGRAM IMPORTS Strings EXPORTS Types = {
OPEN Symbols;
-- internal utilities
NameHandle: TYPE = RECORD [
stb: SymbolTable.Base,
name: Name];
EqualIds: PROC [id1, id2: NameHandle] RETURNS [BOOL] = {
OPEN b1: id1.stb, b2: id2.stb;
ss1, ss2: Strings.SubStringDescriptor;
IF id1 = id2 THEN RETURN [TRUE];
b1.SubStringForName[@ss1, id1.name]; b2.SubStringForName[@ss2, id2.name];
RETURN [Strings.EqualSubStrings[@ss1, @ss2]]};
CTXHandle: TYPE = RECORD [
stb: SymbolTable.Base,
ctx: CTXIndex];
EqContexts: PROC [context1, context2: CTXHandle] RETURNS [BOOL] = {
OPEN b1: context1.stb, b2: context2.stb;
ctx1, ctx2: CTXIndex;
mdi1, mdi2: MDIndex;
IF context1 = context2 THEN RETURN [TRUE];
IF context1.ctx IN StandardContext THEN
RETURN [context1.ctx = context2.ctx]; -- predefined types
WITH c1: b1.ctxb[context1.ctx] SELECT FROM
simple => {mdi1 ← OwnMdi; ctx1 ← context1.ctx};
included => {mdi1 ← c1.module; ctx1 ← c1.map};
ENDCASE => ERROR;
WITH c2: b2.ctxb[context2.ctx] SELECT FROM
simple => {mdi2 ← OwnMdi; ctx2 ← context2.ctx};
included => {mdi2 ← c2.module; ctx2 ← c2.map};
ENDCASE => ERROR;
RETURN [ctx1 = ctx2 AND b1.mdb[mdi1].stamp = b2.mdb[mdi2].stamp]};
OpaqueValue: PROC [type: Types.Handle, base: SymbolTable.Base]
RETURNS [val: Types.Handle] = {
OPEN b1: type.stb;
val ← type; -- the default
WITH t1: b1.seb[type.sei] SELECT FROM
opaque => {
mdi1: MDIndex = WITH c1: b1.ctxb[b1.seb[t1.id].idCtx] SELECT FROM
included => c1.module,
imported => b1.ctxb[c1.includeLink].module,
ENDCASE => OwnMdi;
mdi2: MDIndex = base.FindMdi[b1.mdb[mdi1].stamp];
IF mdi2 # MDNull AND base.mdb[mdi2].exported THEN {
ss: Strings.SubStringDescriptor;
sei2: ISEIndex;
b1.SubStringForName[@ss, b1.seb[t1.id].hash];
sei2 ← base.SearchContext[base.FindString[@ss], base.mainCtx];
IF sei2 # ISENull
AND base.seb[sei2].idType = typeTYPE AND base.seb[sei2].public THEN
val ← [base, base.UnderType[sei2]]}};
ENDCASE;
RETURN};
-- type relations
Equivalent: PUBLIC PROC [type1, type2: Types.Handle] RETURNS [BOOL] = {
RETURN [type1 = type2 OR EqualTypes[type1, type2
! Resolved => {RESUME [FALSE]}; Matched => {RESUME [FALSE]}] ]};
Matched: SIGNAL [m1, m2: Types.Handle] RETURNS [BOOL] = CODE;
EqualTypes: PROC [type1, type2: Types.Handle] RETURNS [BOOL] = {
OPEN b1: type1.stb, b2: type2.stb;
IF type1 = type2 OR type1.sei = typeANY OR type2.sei = typeANY THEN RETURN [TRUE];
IF (b1.seb[type1.sei].typeTag = opaque) # (b2.seb[type2.sei].typeTag = opaque)
THEN {type1 ← OpaqueValue[type1, type2.stb]; type2 ← OpaqueValue[type2, type1.stb]};
RETURN [WITH t1: b1.seb[type1.sei] SELECT FROM
basic =>
WITH t2: b2.seb[type2.sei] SELECT FROM
basic => t1.code = t2.code,
ENDCASE => FALSE,
enumerated =>
WITH t2: b2.seb[type2.sei] SELECT FROM
enumerated =>
IF ~t1.unpainted THEN
~t2.unpainted AND EqContexts[[type1.stb, t1.valueCtx], [type2.stb, t2.valueCtx]]
ELSE
t2.unpainted AND MatchConstants[[type1.stb, t1.valueCtx], [type2.stb, t2.valueCtx]],
ENDCASE => FALSE,
record =>
WITH t2: b2.seb[type2.sei] SELECT FROM
record =>
IF t1.painted THEN
t2.painted AND EqContexts[[type1.stb, t1.fieldCtx], [type2.stb, t2.fieldCtx]]
ELSE
~t2.painted AND t1.argument = t2.argument AND (
(SIGNAL Matched[type1, type2])
OR
MatchFields[
[type1.stb, LOOPHOLE[type1.sei]], [type2.stb, LOOPHOLE[type2.sei]]
! Matched => {IF m1 = type1 AND m2 = type2 THEN RESUME [TRUE]}]),
ENDCASE => FALSE,
ref =>
WITH t2: b2.seb[type2.sei] SELECT FROM
ref =>
(t1.counted = t2.counted) AND (t1.var = t2.var)
AND (t1.readOnly = t2.readOnly) AND (t1.ordered = t2.ordered)
AND Equal[[type1.stb, t1.refType], [type2.stb, t2.refType]],
ENDCASE => FALSE,
array =>
WITH t2: b2.seb[type2.sei] SELECT FROM
array =>
t1.packed = t2.packed
AND Equal[[type1.stb, t1.componentType], [type2.stb, t2.componentType]]
AND Equal[[type1.stb, t1.indexType], [type2.stb, t2.indexType]],
ENDCASE => FALSE,
arraydesc =>
WITH t2: b2.seb[type2.sei] SELECT FROM
arraydesc =>
t1.readOnly = t2.readOnly
AND Equal[[type1.stb, t1.describedType], [type2.stb, t2.describedType]],
ENDCASE => FALSE,
transfer =>
WITH t2: b2.seb[type2.sei] SELECT FROM
transfer =>
(t1.mode = t2.mode) AND (t1.safe = t2.safe)
AND EqualTypes[[type2.stb, t2.typeIn], [type1.stb, t1.typeIn]]
AND EqualTypes[[type1.stb, t1.typeOut], [type2.stb, t2.typeOut]],
ENDCASE => FALSE,
union =>
WITH t2: b2.seb[type2.sei] SELECT FROM
union => EqContexts[[type1.stb, t1.caseCtx], [type2.stb, t2.caseCtx]],
ENDCASE => FALSE,
sequence =>
WITH t2: b2.seb[type2.sei] SELECT FROM
sequence =>
t1.packed = t2.packed AND t1.controlled = t2.controlled
AND Equal[[type1.stb, t1.componentType], [type2.stb, t2.componentType]]
AND MatchTags[[type1.stb, t1.tagSei], [type2.stb, t2.tagSei]],
ENDCASE => FALSE,
relative =>
WITH t2: b2.seb[type2.sei] SELECT FROM
relative =>
Equal[[type1.stb, t1.baseType], [type2.stb, t2.baseType]]
AND
Equal[[type1.stb, t1.offsetType], [type2.stb, t2.offsetType]],
ENDCASE => FALSE,
opaque =>
WITH t2: b2.seb[type2.sei] SELECT FROM
opaque =>
EqContexts[[type1.stb, b1.seb[t1.id].idCtx], [type2.stb, b2.seb[t2.id].idCtx]]
AND
EqualIds[[type1.stb, b1.seb[t1.id].hash], [type2.stb, b2.seb[t2.id].hash]],
ENDCASE => FALSE,
zone =>
WITH t2: b2.seb[type2.sei] SELECT FROM
zone => (t1.mds = t2.mds AND t1.counted = t2.counted),
ENDCASE => FALSE,
subrange =>
WITH t2: b2.seb[type2.sei] SELECT FROM
subrange =>
Equal[[type1.stb, t1.rangeType], [type2.stb, t2.rangeType]]
AND
(~t1.filled OR ~t2.filled
OR (t1.origin = t2.origin AND t1.empty = t2.empty
AND (t1.empty OR t1.range = t2.range))),
ENDCASE => FALSE,
long =>
WITH t2: b2.seb[type2.sei] SELECT FROM
long => Equal[[type1.stb, t1.rangeType], [type2.stb, t2.rangeType]],
ENDCASE => FALSE,
real =>
WITH t2: b2.seb[type2.sei] SELECT FROM real => TRUE, ENDCASE => FALSE,
any =>
WITH t2: b2.seb[type2.sei] SELECT FROM any => TRUE, ENDCASE => FALSE,
nil => type1.sei = type2.sei,
ENDCASE => FALSE]};
SEHandle: TYPE = RECORD [
stb: SymbolTable.Base,
sei: Type];
Resolved: SIGNAL [se1, se2: SEHandle] RETURNS [BOOL] = CODE;
Equal: PROC [type1, type2: SEHandle] RETURNS [BOOL] = {
OPEN b1: type1.stb, b2: type2.stb;
RETURN [
type1 = type2
OR
(IF b1.seb[type1.sei].seTag = id AND b2.seb[type2.sei].seTag = id
THEN
((SIGNAL Resolved[type1, type2])
OR
EqualTypes[ [type1.stb, b1.UnderType[type1.sei]],
[type2.stb, b2.UnderType[type2.sei]]
! Resolved => {IF se1 = type1 AND se2 = type2 THEN RESUME [TRUE]}])
ELSE
EqualTypes[
[type1.stb, b1.UnderType[type1.sei]], [type2.stb, b2.UnderType[type2.sei]]]) ]};
Assignable: PUBLIC PROC [typeL, typeR: Types.Handle] RETURNS [BOOL] = {
OPEN bL: typeL.stb, bR: typeR.stb;
ENABLE {Resolved => {RESUME [FALSE]}; Matched => {RESUME [FALSE]}};
IF typeL = typeR OR typeL.sei = typeANY OR typeR.sei = typeANY THEN
RETURN [TRUE];
RETURN [
FreeAssignable[typeL, typeR, val]
OR
(SELECT typeL.stb.TypeForm[typeL.sei] FROM
record, opaque => ConformingVariant[typeL, typeR]
ENDCASE => FreeAssignable[FullRangeType[typeL], FullRangeType[typeR], val])]};
Mode: TYPE = {val, ref};
FreeAssignable: PROC [typeL, typeR: Types.Handle, mode: Mode] RETURNS [BOOL] = {
OPEN bL: typeL.stb, bR: typeR.stb;
IF typeL = typeR OR typeL.sei = typeANY OR typeR.sei = typeANY THEN
RETURN [TRUE];
IF (bL.seb[typeL.sei].typeTag = opaque) # (bR.seb[typeR.sei].typeTag = opaque)
THEN {
typeL ← OpaqueValue[typeL, typeR.stb]; typeR ← OpaqueValue[typeR, typeL.stb]};
RETURN [WITH tR: bR.seb[typeR.sei] SELECT FROM
record =>
WITH tL: bL.seb[typeL.sei] SELECT FROM
record =>
IF (tL.painted OR tR.painted) THEN Equivalent[typeL, typeR]
ELSE
tL.argument = tR.argument AND (
(SIGNAL Matched[typeL, typeR])
OR
CheckFields[
[typeL.stb, LOOPHOLE[typeL.sei]], [typeR.stb, LOOPHOLE[typeR.sei]], mode
! Matched => {IF m1 = typeL AND m2 = typeR THEN RESUME [TRUE]}]),
ENDCASE => FALSE,
ref =>
WITH tL: bL.seb[typeL.sei] SELECT FROM
ref =>
(tL.counted = tR.counted) AND (tL.var = tR.var) AND
(~tL.ordered OR tR.ordered) AND
(~tR.readOnly OR tL.readOnly) AND
(SELECT bL.TypeForm[tL.refType] FROM
record, opaque =>
ConformingVariant[ -- assumes immutability
[typeL.stb, bL.UnderType[tL.refType]],
[typeR.stb, bR.UnderType[tR.refType]]]
OR
(tL.readOnly
AND Conformable[[typeL.stb, tL.refType], [typeR.stb, tR.refType], ref]),
any => TRUE,
ENDCASE =>
IF ~tL.readOnly THEN
Equivalent[
[typeL.stb, bL.UnderType[tL.refType]],
[typeR.stb, bR.UnderType[tR.refType]]]
ELSE Conformable[[typeL.stb, tL.refType], [typeR.stb, tR.refType], ref])
ENDCASE => FALSE,
array =>
WITH tL: bL.seb[typeL.sei] SELECT FROM
array =>
tL.packed = tR.packed
AND Equivalent[
[typeL.stb, bL.UnderType[tL.indexType]],
[typeR.stb, bR.UnderType[tR.indexType]]]
AND (
IF tL.packed THEN
Equivalent[
[typeL.stb, bL.UnderType[tL.componentType]],
[typeR.stb, bR.UnderType[tR.componentType]]]
ELSE Conformable[
[typeL.stb, tL.componentType], [typeR.stb, tR.componentType], mode])
ENDCASE => FALSE,
arraydesc =>
WITH tL: bL.seb[typeL.sei] SELECT FROM
arraydesc =>
(tL.readOnly OR ~tR.readOnly)
AND Covering[
[typeL.stb, bL.UnderType[tL.describedType]],
[typeR.stb, bR.UnderType[tR.describedType]]],
ENDCASE => FALSE,
transfer =>
WITH tL: bL.seb[typeL.sei] SELECT FROM
transfer =>
(tL.mode = tR.mode OR (tL.mode = error AND tR.mode = signal))
AND (~tL.safe OR tR.safe)
AND (FreeAssignable[[typeR.stb, tR.typeIn], [typeL.stb, tL.typeIn], mode]
OR bL.TypeForm[tL.typeIn] = any)
AND (FreeAssignable[[typeL.stb, tL.typeOut], [typeR.stb, tR.typeOut], mode]
OR bL.TypeForm[tL.typeOut] = any),
ENDCASE => FALSE,
relative =>
WITH tL: bL.seb[typeL.sei] SELECT FROM
relative =>
Equivalent[
[typeL.stb, bL.UnderType[tL.baseType]],
[typeR.stb, bR.UnderType[tR.baseType]]]
AND FreeAssignable[
FullRangeType[[typeL.stb, bL.UnderType[tL.offsetType]]],
FullRangeType[[typeR.stb, bR.UnderType[tR.offsetType]]],
mode],
ENDCASE => FALSE,
subrange =>
FreeAssignable[FullRangeType[typeL], FullRangeType[typeR], mode]
AND
(WITH tL: bL.seb[typeL.sei] SELECT FROM
subrange =>
~tL.filled OR ~tR.filled
OR (tL.origin = tR.origin
AND (tR.empty OR (~tL.empty AND tL.range >= tR.range))),
ENDCASE => (~tR.filled OR tR.origin = 0)),
long =>
WITH tL: bL.seb[typeL.sei] SELECT FROM
long =>
FreeAssignable[
FullRangeType[[typeL.stb, bL.UnderType[tL.rangeType]]],
FullRangeType[[typeR.stb, bR.UnderType[tR.rangeType]]],
mode],
real => bR.UnderType[tR.rangeType] = typeANY,
ENDCASE => FALSE,
real =>
WITH tL: bL.seb[typeL.sei] SELECT FROM
real => TRUE,
long => bL.UnderType[tL.rangeType] = typeANY,
ENDCASE => FALSE,
ENDCASE => Equivalent[typeL, typeR]]};
Conformable: PROC [type1, type2: SEHandle, mode: Mode] RETURNS [BOOL] = {
OPEN b1: type1.stb, b2: type2.stb;
RETURN [
type1 = type2
OR
(IF b1.seb[type1.sei].seTag = id AND b2.seb[type2.sei].seTag = id THEN
((SIGNAL Resolved[type1, type2])
OR
FreeAssignable[ [type1.stb, b1.UnderType[type1.sei]],
[type2.stb, b2.UnderType[type2.sei]],
mode
! Resolved => {IF se1 = type1 AND se2 = type2 THEN RESUME [TRUE]}])
ELSE
FreeAssignable[ [type1.stb, b1.UnderType[type1.sei]],
[type2.stb, b2.UnderType[type2.sei]],
mode]) ]};
ConformingVariant: PROC [typeL, typeR: Types.Handle]
RETURNS [BOOL] = {
OPEN bL: typeL.stb, bR: typeR.stb;
RETURN [
Equivalent[typeL, typeR]
OR
(WITH tR: bR.seb[typeR.sei] SELECT FROM
record =>
WITH tV: tR SELECT FROM
linked => ConformingVariant[typeL, [typeR.stb, bR.UnderType[tV.linkType]]],
ENDCASE => FALSE,
ENDCASE => FALSE)]};
-- auxiliary predicates
RecordHandle: TYPE = RECORD [
stb: SymbolTable.Base,
sei: RecordSEIndex];
MatchFields: PROC [rec1, rec2: RecordHandle] RETURNS [BOOL] = {
OPEN b1: rec1.stb, b2: rec2.stb;
sei1, sei2: ISEIndex;
IF rec1.sei = RecordSENull OR rec2.sei = RecordSENull
THEN RETURN [rec1.sei = rec2.sei];
IF EqContexts[[rec1.stb, b1.seb[rec1.sei].fieldCtx], [rec2.stb, b2.seb[rec2.sei].fieldCtx]]
THEN RETURN [TRUE];
sei1 ← b1.FirstCtxSe[b1.seb[rec1.sei].fieldCtx];
sei2 ← b2.FirstCtxSe[b2.seb[rec2.sei].fieldCtx];
UNTIL sei1 = ISENull OR sei2 = ISENull DO
IF ~(Equal[[rec1.stb, b1.seb[sei1].idType], [rec2.stb, b2.seb[sei2].idType]] AND
EqualIds[[rec1.stb, b1.seb[sei1].hash], [rec2.stb, b2.seb[sei2].hash]])
THEN RETURN [FALSE];
sei1 ← b1.NextSe[sei1]; sei2 ← b2.NextSe[sei2];
ENDLOOP;
RETURN [sei1 = sei2]};
CheckFields: PROC [rec1, rec2: RecordHandle, mode: Mode] RETURNS [BOOL] = {
OPEN b1: rec1.stb, b2: rec2.stb;
sei1, sei2: ISEIndex;
checkIds: BOOL;
IF rec1.sei = RecordSENull OR rec2.sei = RecordSENull
THEN RETURN [rec1.sei = rec2.sei];
IF EqContexts[[rec1.stb, b1.seb[rec1.sei].fieldCtx], [rec2.stb, b2.seb[rec2.sei].fieldCtx]]
THEN RETURN [TRUE];
checkIds ← ~(b1.seb[rec1.sei].hints.unifield OR b2.seb[rec2.sei].hints.unifield);
sei1 ← b1.FirstCtxSe[b1.seb[rec1.sei].fieldCtx];
sei2 ← b2.FirstCtxSe[b2.seb[rec2.sei].fieldCtx];
UNTIL sei1 = ISENull OR sei2 = ISENull DO
IF ~Conformable[[rec1.stb, b1.seb[sei1].idType], [rec2.stb, b2.seb[sei2].idType], mode]
OR (checkIds AND
b1.seb[sei1].hash # nullName AND b2.seb[sei2].hash # nullName AND
~EqualIds[[rec1.stb, b1.seb[sei1].hash], [rec2.stb, b2.seb[sei2].hash]])
THEN RETURN [FALSE];
sei1 ← b1.NextSe[sei1]; sei2 ← b2.NextSe[sei2];
ENDLOOP;
RETURN [sei1 = sei2]};
MatchConstants: PROC [context1, context2: CTXHandle] RETURNS [BOOL] = {
OPEN b1: context1.stb, b2: context2.stb;
sei1, sei2: ISEIndex;
IF EqContexts[context1, context2] THEN RETURN [TRUE];
sei1 ← b1.FirstCtxSe[context1.ctx];
sei2 ← b2.FirstCtxSe[context2.ctx];
UNTIL sei1 = ISENull OR sei2 = ISENull DO
IF ~EqualIds[[context1.stb, b1.seb[sei1].hash], [context2.stb, b2.seb[sei2].hash]]
THEN RETURN [FALSE];
sei1 ← b1.NextSe[sei1]; sei2 ← b2.NextSe[sei2];
ENDLOOP;
RETURN [sei1 = sei2]};
ISEHandle: TYPE = RECORD [
stb: SymbolTable.Base,
sei: ISEIndex];
MatchTags: PROC [tag1, tag2: ISEHandle] RETURNS [BOOL] = {
OPEN b1: tag1.stb, b2: tag2.stb;
RETURN [
EqualIds[[tag1.stb, b1.seb[tag1.sei].hash], [tag2.stb, b2.seb[tag2.sei].hash]] AND
Equal[[tag1.stb, b1.seb[tag1.sei].idType], [tag2.stb, b2.seb[tag2.sei].idType]]]};
Covering: PROC [typeL, typeR: Types.Handle] RETURNS [BOOL] = {
OPEN bL: typeL.stb, bR: typeR.stb;
IF typeL = typeR THEN RETURN [TRUE];
RETURN [WITH tL: bL.seb[typeL.sei] SELECT FROM
array =>
WITH tR: bR.seb[typeR.sei] SELECT FROM
array =>
tL.packed = tR.packed
AND Equivalent[
[typeL.stb, bL.UnderType[tL.componentType]],
[typeR.stb, bR.UnderType[tR.componentType]]]
AND Conformable[[typeL.stb, tL.indexType], [typeR.stb, tR.indexType], val],
ENDCASE => FALSE,
ENDCASE => Equivalent[typeL, typeR]]};
FullRangeType: PROC [type: Types.Handle] RETURNS [Types.Handle] = {
OPEN b: type.stb;
sei, next: CSEIndex;
FOR sei ← type.sei, next DO
WITH b.seb[sei] SELECT FROM
subrange => next ← b.UnderType[rangeType];
ENDCASE => EXIT;
ENDLOOP;
RETURN [[type.stb, sei]]};
}.