[Cyan]<Cedar6.0>BCDStuff>TypePack.mesa!2

TypePack.mesa

Satterthwaite, February 17, 1983 4:51 pm

Rovner, July 6, 1983 1:42 pm

Russ Atkinson (RRA) January 31, 1985 1:15:53 pm PST

DIRECTORY

ConvertUnsafe USING [SubString, EqualSubStrings],

SymbolTable USING [Base],

Symbols USING [Name, SEIndex, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, MDIndex, nullName, MDNull, OwnMdi, ISENull, RecordSENull, StandardContext, typeANY, typeTYPE],

Types USING [Handle];

TypePack: PROGRAM IMPORTS ConvertUnsafe 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: ConvertUnsafe.SubString;

IF id1 = id2 THEN RETURN [TRUE];

ss1 ← b1.SubStringForName[id1.name]; ss2 ← b2.SubStringForName[id2.name];

RETURN [ConvertUnsafe.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: ConvertUnsafe.SubString;

sei2: ISEIndex;

ss ← b1.SubStringForName[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])

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: SEIndex];

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

(IF b1.seb[type1.sei].seTag = id AND b2.seb[type2.sei].seTag = id

THEN

((SIGNAL Resolved[type1, type2])

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]

(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])

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]]]

(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

(IF b1.seb[type1.sei].seTag = id AND b2.seb[type2.sei].seTag = id THEN

((SIGNAL Resolved[type1, type2])

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]

(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]]};