IPVectorImpl.mesa
Copyright © 1984 Xerox Corporation. All rights reserved.
Doug Wyatt, November 15, 1984 5:51:59 pm PST
DIRECTORY
IO,
IPInterpreter,
Rope;
IPVectorImpl: CEDAR PROGRAM
IMPORTS IO, IPInterpreter, Rope
EXPORTS IPInterpreter
~ BEGIN OPEN IPInterpreter;
Shape:
PUBLIC
PROC[v: Vector]
RETURNS[VectorShape] ~ {
RETURN[v.class.shape[v]] };
Get: PUBLIC PROC[v: Vector, j: Integer] RETURNS[Any] ~ { RETURN[v.class.get[v, j]] };
GetInteger:
PUBLIC
PROC[v: Vector, j: Integer]
RETURNS[Integer] ~ {
RETURN[IntegerFromAny[Get[v, j]]];
};
GetReal:
PUBLIC
PROC[v: Vector, j: Integer]
RETURNS[
REAL] ~ {
RETURN[RealFromAny[Get[v, j]]];
};
GetProp:
PUBLIC
PROC[v: Vector, propName: Any]
RETURNS[found:
BOOL, value: Any] ~ {
IF v.class.getProp#NIL THEN [found, value] ← v.class.getProp[v, propName]
ELSE {
shape: VectorShape ~ Shape[v];
IF
NOT Even[shape.n]
THEN {
MasterError[$invalidArgs, "Property vector has illegal shape."];
ERROR Error;
};
FOR i: Integer ← shape.l, i+2
WHILE i<(shape.l+shape.n)
DO
IF EqName[Get[v, i], propName] THEN RETURN[TRUE, Get[v, i+1]];
ENDLOOP;
RETURN[found: FALSE, value: NIL];
};
};
GetP:
PUBLIC
PROC[v: Vector, propName: Any]
RETURNS[Any] ~ {
found: BOOL; value: Any;
[found, value] ← GetProp[v, propName];
IF found THEN RETURN[value]
ELSE {
MasterError[$undefinedProperty, "Undefined property."];
ERROR Error;
};
};
RunSize:
PUBLIC
PROC[r: Vector]
RETURNS[Integer] ~ {
shape: VectorShape ~ Shape[r];
s: Integer ← 0; -- sum of the run lengths
IF
NOT(shape.l=0
AND Even[shape.n])
THEN {
MasterError[$invalidArgs, "Run encoded vector has illegal shape."];
ERROR Error;
};
FOR j: Integer ← 0, j+2
WHILE j<shape.n
DO
c: Integer ~ GetInteger[r, j];
IF c<=(maxInteger-s) THEN s ← s + c
ELSE {
MasterError[$limitExceeded, "Result of *RUNSIZE exceeds maxInteger."];
ERROR Error;
};
ENDLOOP;
RETURN[s];
};
RunGet:
PUBLIC
PROC[r: Vector, i: Integer]
RETURNS[Any] ~ {
shape: VectorShape ~ Shape[r];
s: Integer ← 0; -- sum of the run lengths
IF
NOT(shape.l=0
AND Even[shape.n])
THEN {
MasterError[$invalidArgs, "Run encoded vector has illegal shape."];
ERROR Error;
};
IF i<1
THEN {
MasterError[$boundsFault, "Index too small for *RUNGET."];
ERROR Error;
};
FOR j: Integer ← 0, j+2
WHILE j<shape.n
DO
c: Integer ~ GetInteger[r, j];
IF (i-s)<=c THEN RETURN[Get[r, j+1]];
IF c<=(maxInteger-s) THEN s ← s + c
ELSE {
MasterError[$limitExceeded, "Result of *RUNSIZE exceeds maxInteger."];
ERROR Error;
};
ENDLOOP;
MasterError[$boundsFault, "Index too large for *RUNGET."];
ERROR Error;
};
arrayClass: VectorClass ~
NEW[VectorClassRep ← [type: $Array,
shape: ArrayShape, get: ArrayGet]];
ArrayShape:
PROC[v: Vector]
RETURNS[VectorShape] ~ {
array: Array ~ NARROW[v.data];
RETURN[[l: array.l, n: array.n]];
};
ArrayGet:
PROC[v: Vector, j: Integer]
RETURNS[Any] ~ {
array: Array ~ NARROW[v.data];
RETURN[array[j-array.l]];
};
MakeVec:
PUBLIC
PROC[shape: VectorShape, pop:
PROC
RETURNS[Any]]
RETURNS[Vector] ~ {
array: Array ~ NEW[ArrayRep[shape.n] ← [l: shape.l, array: ]];
FOR i: NAT DECREASING IN[0..array.n) DO array[i] ← pop[] ENDLOOP;
RETURN[NEW[VectorRep ← [class: arrayClass, data: array]]];
};
CopyArray:
PROC[old: Array]
RETURNS[new: Array] ~ {
new ← NEW[ArrayRep[old.n] ← [l: old.l, array: ]];
FOR i: NAT IN[0..new.n) DO new[i] ← old[i] ENDLOOP;
};
VectorFromArray:
PUBLIC
PROC[array: Array]
RETURNS[Vector] ~ {
RETURN[NEW[VectorRep ← [class: arrayClass, data: CopyArray[array]]]];
};
ArrayFromVector:
PUBLIC
PROC[v: Vector]
RETURNS[Array] ~ {
IF v.class.type=$Array
THEN {
array: Array ~ NARROW[v.data];
RETURN[CopyArray[array]];
}
ELSE {
shape: VectorShape ~ Shape[v];
array: Array ~ NEW[ArrayRep[shape.n] ← [l: shape.l, array: ]];
FOR i: NAT IN[0..array.n) DO array[i] ← Get[v, array.l+i] ENDLOOP;
RETURN[array];
};
};
MergedData: TYPE ~ REF MergedDataRep;
MergedDataRep: TYPE ~ RECORD[v1, v2: Vector];
mergedClass: VectorClass ~
NEW[VectorClassRep ← [type: $Merged,
shape: MergedShape, get: MergedGet, getProp: MergedGetProp]];
MergedShape:
PROC[v: Vector]
RETURNS[VectorShape] ~ {
data: MergedData ~ NARROW[v.data];
MasterError[$undefinedOperation, "SHAPE is undefined for the result of MERGEPROP."];
ERROR Error;
};
MergedGet:
PROC[v: Vector, j: Integer]
RETURNS[Any] ~ {
data: MergedData ~ NARROW[v.data];
MasterError[$undefinedOperation, "GET is undefined for the result of MERGEPROP."];
ERROR Error;
};
MergedGetProp:
PROC[v: Vector, propName: Any]
RETURNS[found:
BOOL, value: Any] ~ {
data: MergedData ~ NARROW[v.data];
[found, value] ← GetProp[data.v2, propName];
IF NOT found THEN [found, value] ← GetProp[data.v1, propName];
};
MergeProp:
PUBLIC
PROC[v1, v2: Vector]
RETURNS[Vector] ~ {
data: MergedData ~ NEW[MergedDataRep ← [v1: v1, v2: v2]];
RETURN[NEW[VectorRep ← [class: mergedClass, data: data]]];
};
CharAction: TYPE ~ PROC[c: CARDINAL] RETURNS[quit: BOOL ← FALSE];
BYTE: TYPE ~ [0..255];
StringMap:
PROC[rope:
ROPE, action: CharAction]
RETURNS[
BOOL] ~ {
offset: BYTE ← 0;
state: {run, escape, escape2, extended, extended2} ← run;
FOR i:
INT
IN[0..Rope.Length[rope])
DO
b: BYTE ~ ORD[CHAR[Rope.Fetch[rope, i]]];
SELECT state
FROM
run => IF b=255 THEN state ← escape ELSE IF action[offset*256+b] THEN RETURN[TRUE];
escape => IF b=255 THEN state ← escape2 ELSE { offset ← b; state ← run };
escape2 => IF b=0 THEN state ← extended ELSE ERROR;
extended => IF b=255 THEN state ← escape ELSE { offset ← b; state ← extended2 };
extended2 => { IF action[offset*256+b] THEN RETURN[TRUE]; state ← extended };
ENDCASE;
ENDLOOP;
IF
NOT(state=run
OR state=extended)
THEN
MasterWarning[$illegalString, "Encoded string ended in wrong state."];
RETURN[FALSE];
};
stringClass: VectorClass ~
NEW[VectorClassRep ← [type: $String,
shape: StringShape, get: StringGet]];
StringShape:
PROC[v: Vector]
RETURNS[VectorShape] ~ {
string: ROPE ~ NARROW[v.data];
n: Integer ← 0;
action: CharAction ~ { n ← n+1 };
[] ← StringMap[string, action];
RETURN[[l: 0, n: n]];
};
StringGet:
PROC[v: Vector, j: Integer]
RETURNS[Any] ~ {
string: ROPE ~ NARROW[v.data];
n: Integer ← 0;
result: Integer;
action: CharAction ~ { IF n=j THEN { result ← c; RETURN[TRUE] } ELSE n ← n+1 };
IF StringMap[string, action] THEN RETURN[NumberFromInteger[result]]
ELSE {
MasterError[$boundsFault, "Invalid index for string."];
ERROR Error;
};
};
VectorFromString:
PUBLIC
PROC[string:
ROPE]
RETURNS[Vector] ~ {
RETURN[NEW[VectorRep ← [class: stringClass, data: string]]];
};
StringFromVector:
PUBLIC
PROC[v: Vector]
RETURNS[
ROPE] ~ {
IF v.class.type=$String
THEN {
string: ROPE ~ NARROW[v.data];
RETURN[string];
}
ELSE {
shape: VectorShape ~ Shape[v];
stream: STREAM ~ IO.ROS[];
offset: BYTE ← 0;
FOR i: Integer
IN[shape.l .. shape.l+shape.n)
DO
char: CARDINAL ~ GetInteger[v, i];
IF (char/256)#offset
THEN {
stream.PutChar[VAL[255]];
stream.PutChar[VAL[offset ← char/256]];
};
stream.PutChar[VAL[char MOD 256]];
ENDLOOP;
RETURN[IO.RopeFromROS[stream]];
};
};
RopeFromVector:
PUBLIC
PROC[v: Vector]
RETURNS[
ROPE] ~ {
IF v.class.type=$String
THEN {
string: ROPE ~ NARROW[v.data];
stream: STREAM ~ IO.ROS[];
action: CharAction ~ { stream.PutChar[VAL[c]] };
[] ← StringMap[string, action];
RETURN[IO.RopeFromROS[stream]];
}
ELSE {
shape: VectorShape ~ Shape[v];
i: Integer ← 0;
p:
PROC
RETURNS[
CHAR] ~ {
b: BYTE ~ GetInteger[v, shape.l+i]; i ← i+1; RETURN[VAL[b]] };
RETURN[Rope.FromProc[len: shape.n, p: p]];
};
};
InputVectorStreamData: TYPE ~ REF InputVectorStreamRecord;
InputVectorStreamRecord: TYPE ~ RECORD [
v: Vector,
length: INT,
index: INT
];
InputVectorStreamProcs: REF StreamProcs ~ IO.CreateStreamProcs[
variety: $input, class: $InterpressVector,
getChar: InputVectorStreamGetChar,
endOf: InputVectorStreamEndOf,
getIndex: InputVectorStreamGetIndex,
setIndex: InputVectorStreamSetIndex,
getLength: InputVectorStreamGetLength
];
StreamFromVector: PUBLIC PROC[v: Vector, xxx: Xxx]
RETURNS [stream: STREAM] ~ {
RETURN[IO.CreateStream[InputVectorStreamProcs,
NEW[InputVectorStreamRecord ← [v: v, length: rope.Length[], index: 0]]]];
};
InputVectorStreamGetChar: PROC [self: STREAM] RETURNS [char: CHAR] ~ {
data: InputVectorStreamData ~ NARROW[self.streamData];
IF data.index >= data.length THEN ERROR IO.EndOfStream[self]
ELSE {
j: Integer ~ data.index/data.bytesPerElement;
char ← data.rope.InlineFetch[data.index];
data.index ← data.index + 1;
};
};
InputVectorStreamEndOf: PROC [self: STREAM] RETURNS [BOOL] ~ {
data: InputVectorStreamData ~ NARROW[self.streamData];
RETURN[data.index >= data.length];
};
InputVectorStreamGetIndex: PROC [self: STREAM] RETURNS [INT] ~ {
data: InputVectorStreamData ~ NARROW[self.streamData];
RETURN[data.index];
};
InputVectorStreamSetIndex: PROC [self: STREAM, index: INT] ~ {
data: InputVectorStreamData ~ NARROW[self.streamData];
IF index NOT IN [0 .. data.length] THEN ERROR IO.Error[$BadIndex, self];
data.index ← index;
};
InputVectorStreamGetLength: PROC [self: STREAM] RETURNS [length: INT] ~ {
data: InputVectorStreamData ~ NARROW[self.streamData];
RETURN[data.length];
};
END.