IPTypeDictImpl:
CEDAR
PROGRAM
IMPORTS FS, IO, SymTab, IPToolBox
EXPORTS IPTypeDict = BEGIN OPEN TB: IPToolBox, IPTypeDict;
CreateFailure: PUBLIC ERROR[why: Reason, what: ATOM] = CODE;
Create:
PUBLIC
PROC[file: Rope.
ROPE]
RETURNS [r: Ref] ={
stream: IO.STREAM ← FS.StreamOpen[file];
r ← NEW[Rep ← [SymTab.Create[]]];
DO
ENABLE IO.EndOfStream => EXIT;
type: Rope.ROPE ← TB.GetIdRope[stream];
def: REF TypeEntryRep ← GetTypeEntry[stream];
[] ← r.types.Store[type, def];
ENDLOOP;
}; --Create--
LookUp:
PUBLIC
PROC[r: Ref, type: Rope.
ROPE]
RETURNS [found:
BOOL, val:
REF TypeEntryRep] ={
aVal: REF;
[found, aVal] ← r.types.Fetch[type];
val ← NARROW[aVal];
}; --LookUp--
TypeEntries:
PUBLIC PROC[r: Ref, action: EachTypeEntryAction] ={
typeEntryAction: SymTab.EachPairAction ={
RETURN [action[key, NARROW[val]]]};--typeEntryAction
[] ← r.types.Pairs[typeEntryAction];
}; --TypeEntries
GetTypeEntry:
PROC[stream:
IO.
STREAM]
RETURNS [typeEntry:
REF TypeEntryRep] ={
TB.EnterBlock[stream];
typeEntry ← NEW[TypeEntryRep];
UNTIL
TB.ExitBlock[stream]
DO
token: ATOM ← TB.GetIdAtom[stream];
SELECT token
FROM
$origin => typeEntry.origin ← TB.GetIntVector[stream]^; --$origin
$shape => typeEntry.shape ← TB.GetShape[stream];--$shape
$pins => typeEntry.pins ← GetPins[stream]; --$pins
$shapeFn, $restriction => {
TB.EnterBlock[stream];
[] ← TB.ExitBlock[stream];};
ENDCASE => ERROR CreateFailure[badToken, token];
ENDLOOP;
}; --GetTypeEntry--
GetPins:
PROC [stream:
IO.
STREAM]
RETURNS [pins:
LIST
OF
REF
IP.PinRep ←
NIL] = {
getPin:
PROC
RETURNS [pin:
REF
IP.PinRep] = {
getAuxInfo:
PROC
RETURNS [
REF ←
NIL] = {
TB.EnterBlock[stream];
[] ← TB.ExitBlock[stream]
}; --getAuxInfo
getPhysicalPins:
PROC
RETURNS [physicalPins:
LIST
OF
REF
IP.PhysicalPinRep ←
NIL] ={
TB.EnterBlock[stream];
UNTIL
TB.ExitBlock[stream]
DO
physicalPins ← CONS[NEW [IP.PhysicalPinRep ← [TB.GetIntVector[stream]^]], physicalPins];
ENDLOOP;
}; --getPhysicalPins
pin ← NEW[IP.PinRep ← [name: TB.GetIdRope[stream]]];
TB.EnterBlock[stream];
UNTIL
TB.ExitBlock[stream]
DO
token: ATOM ← TB.GetIdAtom[stream];
SELECT token
FROM
$auxInfo => pin.auxInfo ← getAuxInfo[];
$physicalPins => pin.physicalPins ← getPhysicalPins[];
ENDCASE => ERROR CreateFailure[badToken, token];
ENDLOOP;
}; --getPin
TB.EnterBlock[stream];
UNTIL
TB.ExitBlock[stream]
DO
pins ← CONS[getPin[], pins];
ENDLOOP;
}; --GetPins
END.