IPVectorImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
Michael Plass, January 28, 1986 1:35:51 pm PST
Doug Wyatt, October 31, 1986 2:52:01 pm PST
DIRECTORY
Basics,
ImagerFont USING [BYTE, MapRope, XChar, XCharProc, XStringProc],
ImagerSample,
IO USING [PutChar, RopeFromROS, ROS, STREAM],
IPInterpreter,
IPMaster,
IPVector,
PrincOps,
PrincOpsUtils,
RefText,
Rope;
IPVectorImpl: CEDAR MONITOR
IMPORTS Basics, IO, IPInterpreter, ImagerFont, ImagerSample, IPMaster, PrincOpsUtils, RefText, Rope
EXPORTS IPInterpreter
~ BEGIN OPEN IPInterpreter, IPVector;
ROPE: TYPE ~ Rope.ROPE;
BYTE: TYPE ~ ImagerFont.BYTE;
XChar: TYPE ~ ImagerFont.XChar;
XCharProc: TYPE ~ ImagerFont.XCharProc;
XStringProc: TYPE ~ ImagerFont.XStringProc;
Shape:
PUBLIC
PROC [v: Vector]
RETURNS [VectorShape] ~ {
shape: VectorShape ~ v.class.shape[v];
[] ← BoundsCheckCardinal[shape.lowerBound];
IF shape.size=0 THEN NULL
ELSE [] ← BoundsCheckCardinal[shape.lowerBound+BoundsCheckCardinal[shape.size-1]];
RETURN[shape];
};
Get:
PUBLIC
PROC [v: Vector, i: Cardinal]
RETURNS [Any] ~ {
IF v.class.get # NIL THEN RETURN[v.class.get[v, BoundsCheckCardinal[i]]]
ELSE {
val: INT ← v.class.getCardinal[v, BoundsCheckCardinal[i]];
RETURN[IF val=0 THEN zeroObj ELSE IF val=1 THEN oneObj ELSE NEW[NumberRep ← [int[val]]]];
};
};
zeroObj: Any ~ NEW[NumberRep ← [zero[0]]];
oneObj: Any ~ NEW[NumberRep ← [int[1]]];
GetCardinal:
PUBLIC
PROC [v: Vector, i: Cardinal]
RETURNS [Cardinal] ~ {
IF v.class.getCardinal # NIL THEN RETURN[v.class.getCardinal[v, BoundsCheckCardinal[i]]];
RETURN[CardinalFromAny[v.class.get[v, BoundsCheckCardinal[i]]]];
};
GetReal:
PUBLIC
PROC [v: Vector, i: Cardinal]
RETURNS [
REAL] ~ {
RETURN[RealFromAny[v.class.get[v, BoundsCheckCardinal[i]]]];
};
MapProp:
PUBLIC
PROC [v: Vector, action: PropProc]
RETURNS [
BOOL] ~ {
IF v.class=mergedClass
THEN {
data: MergedData ~ NARROW[v.data];
IF MapProp[data.v2, action] THEN RETURN[TRUE];
IF MapProp[data.v1, action] THEN RETURN[TRUE];
}
ELSE {
shape: VectorShape ~ Shape[v];
IF NOT Even[shape.size] THEN MasterError[$invalidPropVec,
"Property vector has odd length"];
FOR i:
INT ← 0, i+2
WHILE i<shape.size
DO
j: Cardinal ~ BoundsCheckCardinal[shape.lowerBound+i];
IF action[v, j] THEN RETURN[TRUE];
ENDLOOP;
};
RETURN[FALSE];
};
GetProp:
PUBLIC
PROC [v: Vector, propName: Any]
RETURNS [found:
BOOL, value: Any] ~ {
action: PropProc ~ {
key: Any ~ Get[v, j];
IF EqName[key, propName] THEN { value ← Get[v, j+1]; RETURN[TRUE] };
};
IF MapProp[v, action] THEN RETURN[found: TRUE, value: value];
RETURN[found: FALSE, value: NIL];
};
GetPropR:
PUBLIC
PROC [v: Vector, rope:
ROPE]
RETURNS [found:
BOOL, value: Any] ~ {
propName: Identifier ~ rope;
action: PropProc ~ {
key: Any ~ Get[v, j];
IF EqName[key, propName] THEN { value ← Get[v, j+1]; RETURN[TRUE] };
};
IF MapProp[v, action] THEN RETURN[found: TRUE, value: value];
RETURN[found: FALSE, value: NIL];
};
GetPropC:
PUBLIC
PROC [v: Vector, card: Cardinal]
RETURNS [found:
BOOL, value: Any] ~ {
propName: REAL ~ card;
action: PropProc ~ {
key: Any ~ Get[v, j];
IF Type[key]=number
THEN {
IF RealFromAny[key]=propName THEN { value ← Get[v, j+1]; RETURN[TRUE] };
};
};
IF MapProp[v, action] THEN RETURN[found: TRUE, value: value];
RETURN[found: FALSE, value: NIL];
};
UndefinedProperty:
PROC ~ { MasterError[$undefinedProperty, "Property not found"] };
GetP:
PUBLIC
PROC [v: Vector, propName: Any]
RETURNS [value: Any] ~ {
found: BOOL; [found, value] ← GetProp[v, propName];
IF NOT found THEN UndefinedProperty[];
};
GetPR:
PUBLIC
PROC [v: Vector, rope:
ROPE]
RETURNS [value: Any] ~ {
found: BOOL; [found, value] ← GetPropR[v, rope];
IF NOT found THEN UndefinedProperty[];
};
GetPI:
PUBLIC
PROC [v: Vector, card: Cardinal]
RETURNS [value: Any] ~ {
found: BOOL; [found, value] ← GetPropC[v, card];
IF NOT found THEN UndefinedProperty[];
};
OutOfBounds:
PROC ~ { MasterError[$boundsFault, "Vector index out of bounds"] };
RunSize:
PUBLIC
PROC [r: Vector]
RETURNS [Cardinal] ~ {
shape: VectorShape ~ Shape[r];
sum: Cardinal ← 0; -- sum of the run lengths
IF shape.lowerBound#0 OR NOT Even[shape.size] THEN MasterError[$invalidRunVec,
"Run vector has nonzero lower bound or odd length"];
FOR i: Cardinal ← 0, i+2
WHILE i<shape.size
DO
run: Cardinal ~ GetCardinal[r, i];
IF run>(maxCardinal-sum) THEN MasterError[$boundsFault,
"Sum of run sizes exceeds maxCardinal"];
sum ← BoundsCheckCardinal[sum+run];
ENDLOOP;
RETURN[sum];
};
RunGet:
PUBLIC
PROC [r: Vector, i: Cardinal]
RETURNS [Any] ~ {
shape: VectorShape ~ Shape[r];
sum: Cardinal ← 0; -- sum of the run lengths
IF shape.lowerBound#0 OR NOT Even[shape.size] THEN MasterError[$invalidRunVec,
"Run vector has nonzero lower bound or odd length"];
IF BoundsCheckCardinal[i]=0 THEN OutOfBounds[];
FOR i: Cardinal ← 0, i+2
WHILE i<shape.size
DO
run: Cardinal ~ GetCardinal[r, i];
IF run>(maxCardinal-sum) THEN MasterError[$boundsFault,
"Sum of run sizes exceeds maxCardinal"];
sum ← BoundsCheckCardinal[sum+run];
IF i<=sum THEN RETURN[Get[r, i+1]];
ENDLOOP;
OutOfBounds[];
RETURN[NIL];
};
arrayClass: VectorClass ~
NEW[VectorClassRep ← [type: $Array,
shape: ArrayShape, get: ArrayGet]];
ArrayShape:
PROC [v: Vector]
RETURNS [VectorShape] ~ {
array: Array ~ NARROW[v.data];
RETURN[[lowerBound: BoundsCheckCardinal[array.lowerBound], size: array.size]];
};
ArrayGet:
PROC [v: Vector, i: Cardinal]
RETURNS [Any] ~ {
array: Array ~ NARROW[v.data];
RETURN[array[BoundsCheckCardinal[i]-BoundsCheckCardinal[array.lowerBound]]];
};
NewArray:
PROC [shape: VectorShape]
RETURNS [Array] ~ {
RETURN[NEW[ArrayRep[shape.size] ← [lowerBound: shape.lowerBound, array: ]]];
};
MakeVecLU:
PUBLIC
PROC [l, u: Cardinal, pop:
PROC
RETURNS [Any]]
RETURNS [Vector] ~ {
array: Array ~ NewArray[[BoundsCheckCardinal[l], BoundsCheckCardinal[u]-l+1]];
FOR i: NAT DECREASING IN[0..array.size) DO array[i] ← pop[] ENDLOOP;
RETURN[NEW[VectorRep ← [class: arrayClass, data: array]]];
};
MakeVec:
PUBLIC
PROC [n: Cardinal, pop:
PROC
RETURNS [Any]]
RETURNS [Vector] ~ {
array: Array ~ NewArray[[0, BoundsCheckCardinal[n]]];
FOR i: NAT DECREASING IN[0..array.size) DO array[i] ← pop[] ENDLOOP;
RETURN[NEW[VectorRep ← [class: arrayClass, data: array]]];
};
CopyArray:
PROC [old: Array]
RETURNS [new: Array] ~ {
new ← NewArray[[old.lowerBound, old.size]];
FOR i: NAT IN[0..new.size) 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 {
array: Array ~ NewArray[Shape[v]];
FOR i: NAT IN[0..array.size) DO array[i] ← Get[v, array.lowerBound+i] ENDLOOP;
RETURN[array];
};
};
ZeroData: TYPE ~ REF ZeroDataRep;
ZeroDataRep: TYPE ~ RECORD[n: Cardinal];
zeroClass: VectorClass ~
NEW[VectorClassRep ← [type: $Zero,
shape: ZeroShape, get: ZeroGet]];
ZeroShape:
PROC [v: Vector]
RETURNS [VectorShape] ~ {
data: ZeroData ~ NARROW[v.data];
RETURN[[lowerBound: 0, size: data.n]];
};
ZeroGet:
PROC [v: Vector, i: Cardinal]
RETURNS [Any] ~ {
data: ZeroData ~ NARROW[v.data];
IF NOT i IN[0..data.n) THEN OutOfBounds[];
RETURN[NIL];
};
ZeroVec:
PUBLIC
PROC [n: Cardinal]
RETURNS [Vector] ~ {
data: ZeroData ~ NEW[ZeroDataRep ← [n: BoundsCheckCardinal[n]]];
RETURN[NEW[VectorRep ← [class: zeroClass, data: data]]];
};
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 merged property vector"];
RETURN[[0, 0]];
};
MergedGet:
PROC [v: Vector, i: Cardinal]
RETURNS [Any] ~ {
data: MergedData ~ NARROW[v.data];
MasterError[$undefinedOperation, "GET is undefined for merged property vector"];
RETURN[NIL];
};
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]]];
};
StringData: TYPE ~ REF StringDataRep;
StringDataRep: TYPE ~ RECORD[SEQUENCE size: NAT OF XChar];
stringClass: VectorClass ~
NEW[VectorClassRep ← [type: $String,
shape: StringShape, get: StringGet]];
StringShape:
PROC [v: Vector]
RETURNS [VectorShape] ~ {
s: StringData ~ NARROW[v.data];
RETURN[[lowerBound: 0, size: s.size]];
};
StringGet:
PROC [v: Vector, i: Cardinal]
RETURNS [Any] ~ {
s: StringData ~ NARROW[v.data];
char: XChar ~ s[i];
RETURN[NEW[NumberRep ← [int[LOOPHOLE[char, CARDINAL]]]]];
};
VectorFromString:
PUBLIC
PROC [string: XStringProc]
RETURNS [Vector] ~ {
size, i: NAT ← 0;
s: StringData ← NIL;
count: XCharProc ~ { size ← size+1 };
store: XCharProc ~ { s[i] ← char; i ← i+1 };
string[count]; -- determine size
s ← NEW[StringDataRep[size]];
string[store]; -- store the characters
IF i#size THEN ERROR Bug;
RETURN[NEW[VectorRep ← [class: stringClass, data: s]]];
};
VectorFromRope:
PUBLIC
PROC [rope:
ROPE]
RETURNS [Vector] ~ {
xStringProc: XStringProc ~ {ImagerFont.MapRope[rope: rope, charAction: charAction]};
RETURN [VectorFromString[xStringProc]]
};
StringFromVector:
PUBLIC
PROC [v: Vector, charAction: XCharProc] ~ {
IF v.class.type=$String
THEN {
s: StringData ~ NARROW[v.data];
FOR i: NAT IN[0..s.size) DO charAction[s[i]] ENDLOOP;
}
ELSE {
shape: VectorShape ~ Shape[v];
FOR i:
INT
IN[0..shape.size)
DO
char: CARDINAL ~ GetCardinal[v, shape.lowerBound+i];
charAction[LOOPHOLE[char]];
ENDLOOP;
};
};
RopeFromVector:
PUBLIC
PROC [v: Vector]
RETURNS [
ROPE] ~ {
stream: IO.STREAM ~ IO.ROS[];
set: BYTE ← 0;
charAction:
PROC [char: XChar] ~ {
IF char.set#set
THEN {
IO.PutChar[stream, VAL[255]];
IO.PutChar[stream, VAL[set ← char.set]];
};
IO.PutChar[stream, VAL[char.code]];
};
StringFromVector[v, charAction];
RETURN[IO.RopeFromROS[stream]];
};
VectorFromName:
PUBLIC
PROC [rope:
ROPE]
RETURNS [Vector] ~ {
size, i: NAT ← 0;
array: Array ← NIL;
count: IPMaster.PartActionType ~ { size ← size+1 };
store: IPMaster.PartActionType ~ { array[i] ← Rope.Substr[base, start, len]; i ← i+1 };
[] ← IPMaster.MapParts[base: rope, delimiter: '/, action: count];
array ← NewArray[[0, size]];
[] ← IPMaster.MapParts[base: rope, delimiter: '/, action: store];
RETURN[NEW[VectorRep ← [class: arrayClass, data: array]]];
};
NameFromVector:
PUBLIC
PROC [v: Vector]
RETURNS [name:
ROPE] ~ {
shape: VectorShape ~ Shape[v];
scratch: REF TEXT ~ RefText.ObtainScratch[100];
text: REF TEXT ← scratch;
FOR i: Cardinal
IN[0..shape.size)
DO
id: Identifier ~ IdentifierFromAny[Get[v, shape.lowerBound+i]];
IF i#0 THEN text ← RefText.AppendChar[text, '/];
text ← RefText.AppendRope[text, id];
ENDLOOP;
name ← Rope.FromRefText[text];
RefText.ReleaseScratch[scratch];
};
packedByteClass: VectorClass ~
NEW[VectorClassRep ← [type: $PackedByte,
shape: PackedByteShape, getCardinal: PackedByteGetCardinal]];
PackedByteData: TYPE ~ REF PackedByteDataRep;
PackedByteDataRep:
TYPE ~
RECORD [
bytes: ROPE,
size: INT,
bytesPerElement: NAT,
signed: BOOL
];
PackedByteShape:
PROC [v: Vector]
RETURNS [VectorShape] ~ {
data: PackedByteData ~ NARROW[v.data];
RETURN[[lowerBound: 0, size: data.size]];
};
PackedByteGetCardinal:
PROC [v: Vector, i: Cardinal]
RETURNS [Cardinal] ~ {
data: PackedByteData ~ NARROW[v.data];
start: INT ~ BoundsCheckCardinal[i]*data.bytesPerElement;
char: CHAR ← Rope.Fetch[data.bytes, start];
val: INT ← ORD[char];
IF data.signed AND val >= 128 THEN val ← val - 256;
FOR i:
INT
IN [1..data.bytesPerElement)
DO
char ← Rope.Fetch[data.bytes, start+i];
val ← Basics.DoubleShiftLeft[[li[val]], 8].li + ORD[char];
ENDLOOP;
RETURN[val];
};
VectorFromBytes:
PUBLIC
PROC [bytes:
ROPE, bytesPerElement:
NAT, signed:
BOOL]
RETURNS [Vector] ~ {
ropeSize: INT ~ Rope.Size[bytes];
bpe: [1..4] ~ bytesPerElement;
data: PackedByteData ← NEW[PackedByteDataRep ← [bytes: bytes, size: ropeSize/bpe, bytesPerElement: bytesPerElement, signed: signed]];
IF data.size*bpe # ropeSize THEN ERROR;
RETURN[NEW[VectorRep ← [class: packedByteClass, data: data]]];
};
packedBitClass: VectorClass ~
NEW[VectorClassRep ← [type: $PackedBits,
shape: PackedBitShape, getCardinal: PackedBitGetCardinal]];
PackedBitData: TYPE ~ REF PackedBitDataRep;
PackedBitDataRep:
TYPE ~
RECORD [
bytes: ROPE,
size: INT,
dataBitsPerLine: NAT,
bytesPerLine: NAT
];
PackedBitShape:
PROC [v: Vector]
RETURNS [VectorShape] ~ {
data: PackedBitData ~ NARROW[v.data];
RETURN[[lowerBound: 0, size: data.size]];
};
PackedBitGetCardinal:
PROC [v: Vector, i: Cardinal]
RETURNS [Cardinal] ~ {
data: PackedBitData ~ NARROW[v.data];
index: LONG CARDINAL ~ BoundsCheckCardinal[i];
line, dot, val: CARDINAL;
char: CHAR;
[quotient: line, remainder: dot] ← Basics.LongDivMod[index, data.dataBitsPerLine];
char ← Rope.Fetch[data.bytes, Basics.LongMult[line, data.bytesPerLine]+dot/8];
val ← Basics.BITSHIFT[ORD[char], INTEGER[dot MOD 8]-7] MOD 2;
RETURN[val];
};
VectorFromBits:
PUBLIC
PROC [bytes:
ROPE, dataBitsPerLine, padBitsPerLine:
NAT]
RETURNS [Vector] ~ {
ropeSize: INT ~ Rope.Size[bytes];
totalBitsPerLine: NAT ~ dataBitsPerLine+padBitsPerLine;
bytesPerLine: NAT ~ totalBitsPerLine/8;
slop: [0..0] ~ totalBitsPerLine MOD 8;
lines: INT ~ ropeSize/bytesPerLine;
data: PackedBitData ~ NEW[PackedBitDataRep ← [bytes: bytes, size: lines*dataBitsPerLine, dataBitsPerLine: dataBitsPerLine, bytesPerLine: bytesPerLine]];
RETURN [NEW[VectorRep ← [class: packedBitClass, data: data]]]
};
scratchText: REF TEXT ← NIL;
ObtainScratch:
ENTRY
PROC [size:
NAT]
RETURNS [text:
REF
TEXT ←
NIL] ~ {
ENABLE UNWIND => NULL;
IF scratchText#NIL AND scratchText.maxLength >= size THEN {text ← scratchText; text.length ← 0; scratchText ← NIL}
ELSE text ← NEW[TEXT[size]];
};
ReleaseScratch:
ENTRY
PROC [text:
REF
TEXT] ~ {
scratchText ← text;
};
UnsafeGetElements:
PUBLIC
UNSAFE
PROC [vector: Vector, buffer:
LONG
POINTER
TO Basics.RawWords, start:
INT, count:
NAT] ~
UNCHECKED {
IF vector.class = packedByteClass
THEN {
data: PackedByteData ~ NARROW[vector.data];
byteCount: NAT ~ Basics.LongMult[count, data.bytesPerElement];
text: REF TEXT ~ ObtainScratch[byteCount];
startByte: INT ~ BoundsCheckCardinal[start]*data.bytesPerElement;
zero: [0..0] ~ Rope.AppendChars[buffer: text, rope: data.bytes, start: startByte, len: byteCount]-byteCount;
bytePtr: LONG POINTER ~ LOOPHOLE[text, LONG POINTER] + SIZE[TEXT[0]];
ImagerSample.UnsafeGetF[samples: buffer, count: count, s: 0, f: 0, base: bytePtr, wordsPerLine: LAST[NAT], bitsPerSample: data.bytesPerElement*8];
ReleaseScratch[text];
}
ELSE {
We hope this does not happen very often.
FOR i:
INT
IN [0..count)
DO
buffer[i] ← GetCardinal[vector, start+i];
ENDLOOP;
};
};
bitsPerWord: NAT ~ Basics.bitsPerWord;
nullBitBltTable: PrincOps.BitBltTable ~ [
dst: [word: NIL, bit: 0], dstBpl: 0,
src: [word: NIL, bit: 0], srcDesc: [srcBpl[0]],
width: 0, height: 0, flags: []
];
UnsafeGetBits:
PUBLIC
UNSAFE
PROC [vector: Vector, dst: PrincOps.BitAddress, start:
INT, count:
NAT, srcFunc: PrincOps.SrcFunc, dstFunc: PrincOps.DstFunc] ~
UNCHECKED {
IF vector.class = packedBitClass
THEN {
data: PackedBitData ~ NARROW[vector.data];
text: REF TEXT ~ ObtainScratch[(CARDINAL[count]+7)/8];
index: INT ← BoundsCheckCardinal[start];
residual: CARDINAL ← count;
dstBase: LONG POINTER ← dst.word;
dstBit: CARDINAL ← dst.bit;
bbTableSpace: PrincOps.BBTableSpace;
bb: PrincOps.BBptr ~ PrincOpsUtils.AlignedBBTable[@bbTableSpace];
bb^ ← nullBitBltTable;
bb.flags ← [disjoint: TRUE, gray: FALSE, srcFunc: srcFunc, dstFunc: dstFunc];
bb.height ← 1;
bb.src.word ← LOOPHOLE[text, LONG POINTER] + SIZE[TEXT[0]];
UNTIL residual = 0
DO
zero: [0..0];
line, dot, delta, byteCount: CARDINAL;
[quotient: line, remainder: dot] ← Basics.LongDivMod[index, data.dataBitsPerLine];
bb.width ← delta ← MIN[residual, NAT[data.dataBitsPerLine-dot]];
byteCount ← (delta+7)/8;
text.length ← 0;
zero ← Rope.AppendChars[buffer: text, rope: data.bytes, start: Basics.LongMult[line, data.bytesPerLine]+dot/8, len: byteCount]-byteCount;
bb.dst ← [word: dstBase, bit: dstBit];
bb.src.bit ← dot MOD 8;
PrincOpsUtils.BITBLT[bb];
dstBase ← dstBase + NAT[dstBit + delta] / bitsPerWord;
dstBit ← NAT[dstBit + delta] MOD bitsPerWord;
index ← index + delta;
residual ← residual - delta;
ENDLOOP;
ReleaseScratch[text];
}
ELSE ERROR; -- could do it, but it would be slow; avoid at a higher level.
};
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 {
i: Cardinal ~ 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.