<> <<>> <> <> DIRECTORY IP USING [Any, AnyFromInteger, Array, ArrayRep, EqName, Integer, IntegerFromAny, MasterError, MasterWarning, maxInteger, Pop, PopInteger, PopVector, Push, PushBool, PushInteger, PushVector, State, Vector, VectorRep, VectorShape], IPBase USING []; IPVectorImpl: CEDAR PROGRAM IMPORTS IP EXPORTS IP, IPBase ~ BEGIN OPEN IP; Shape: PUBLIC PROC[v: Vector] RETURNS[VectorShape] ~ { RETURN[v.shape[v.data]] }; Get: PUBLIC PROC[v: Vector, j: Integer] RETURNS[Any] ~ { IF v.get#NIL THEN RETURN[v.get[v.data, j]] ELSE RETURN[AnyFromInteger[v.getInteger[v.data, j]]]; }; GetInteger: PUBLIC PROC[v: Vector, j: Integer] RETURNS[Integer] ~ { IF v.getInteger#NIL THEN RETURN[v.getInteger[v.data, j]] ELSE RETURN[IntegerFromAny[v.get[v.data, j]]]; }; GetProp: PUBLIC PROC[v: Vector, propName: Any] RETURNS[value: Any, found: BOOL] ~ { IF v.getProp#NIL THEN [value, found] _ v.getProp[v.data, propName] ELSE { shape: VectorShape ~ Shape[v]; IF (shape.n MOD 2)#0 THEN MasterError[$invalidArgs, "Property vector has illegal shape."]; FOR i: Integer _ shape.l, i+2 WHILE i<(shape.l+shape.n) DO IF EqName[Get[v, i], propName] THEN RETURN[Get[v, i+1], TRUE]; ENDLOOP; RETURN[NIL, FALSE]; }; }; GetP: PUBLIC PROC[v: Vector, propName: Any] RETURNS[value: Any] ~ { found: BOOL; [value, found] _ GetProp[v, propName]; IF NOT found THEN MasterError[$undefinedProperty, "Undefined property."]; }; RunSize: PUBLIC PROC[r: Vector] RETURNS[Integer] ~ { shape: VectorShape ~ Shape[r]; s: Integer _ 0; -- sum of the run lengths IF shape.l#0 OR (shape.n MOD 2)#0 THEN MasterError[$invalidArgs, "Run encoded vector has illegal shape."]; FOR j: Integer _ 0, j+2 WHILE j> <> <<>> NullData: TYPE ~ REF NullDataRep; NullDataRep: TYPE ~ RECORD[shape: VectorShape]; NullShape: PROC[data: REF] RETURNS[VectorShape] ~ { d: NullData ~ NARROW[data]; RETURN[d.shape]; }; NullGet: PROC[data: REF, j: Integer] RETURNS[Any] ~ { d: NullData ~ NARROW[data]; shape: VectorShape ~ d.shape; IF j NOT IN[shape.l..shape.l+shape.n) THEN MasterError[$boundsFault, "Vector index out of bounds."]; RETURN[NIL]; }; NullVector: PUBLIC PROC[shape: VectorShape] RETURNS[Vector] ~ { d: NullData ~ NEW[NullDataRep _ [shape: shape]]; RETURN[NEW[VectorRep _ [class: $Null, shape: NullShape, get: NullGet, data: d]]]; }; maxVecSize: NAT ~ (LAST[NAT]-SIZE[ArrayRep[0]])/SIZE[Any]; ANew: PROC[shape: VectorShape] RETURNS[a: Array _ NIL] ~ { IF shape.n>0 AND (shape.n-1)>(maxInteger-shape.l) THEN MasterError[$invalidArgs, "Illegal shape for an Array."]; IF shape.n>maxVecSize THEN MasterError[$limitExceeded, "Array size exceeds maxVecSize."]; a _ NEW[ArrayRep[shape.n] _ [shape: shape, array: ]]; FOR i: NAT IN[0..a.size) DO a[i] _ NIL ENDLOOP; }; ACopy: PROC[a: Array] RETURNS[Array] ~ { new: Array ~ NEW[ArrayRep[a.size] _ [shape: a.shape, array: ]]; FOR i: NAT IN[0..new.size) DO new[i] _ a[i] ENDLOOP; RETURN[new]; }; AGet: PUBLIC PROC[a: Array, n: Integer] RETURNS[x: Any _ NIL] ~ { IF n IN[a.shape.l .. a.shape.l+a.shape.n) THEN x _ a[n-a.shape.l] ELSE MasterError[$boundsFault, "Index out of bounds."]; }; ASet: PUBLIC PROC[a: Array, x: Any, n: Integer] ~ { IF n IN[a.shape.l .. a.shape.l+a.shape.n) THEN a[n-a.shape.l] _ x ELSE MasterError[$boundsFault, "Index out of bounds."]; }; ArrayShape: PROC[data: REF] RETURNS[VectorShape] ~ { a: Array ~ NARROW[data]; RETURN[a.shape]; }; ArrayGet: PROC[data: REF, j: Integer] RETURNS[Any] ~ { a: Array ~ NARROW[data]; RETURN[AGet[a, j]] }; ArrayCreate: PROC[a: Array] RETURNS[Vector] ~ { RETURN[NEW[VectorRep _ [class: $Array, shape: ArrayShape, get: ArrayGet, data: a]]]; }; VectorFromArray: PUBLIC PROC[a: Array] RETURNS[Vector] ~ { RETURN[ArrayCreate[ACopy[a]]]; }; ArrayFromVector: PUBLIC PROC[v: Vector] RETURNS[Array] ~ { IF v.class=$Array THEN RETURN[ACopy[NARROW[v.data, Array]]] ELSE { shape: VectorShape ~ Shape[v]; a: Array ~ ANew[shape]; FOR i: Integer IN[shape.l..shape.l+shape.n) DO ASet[a, Get[v, i], i] ENDLOOP; RETURN[a]; }; }; Merged: TYPE ~ REF MergedRep; MergedRep: TYPE ~ RECORD[v1, v2: Vector]; MergedShape: PROC[data: REF] RETURNS[VectorShape] ~ { m: Merged ~ NARROW[data]; MasterError[$undefinedOperation, "SHAPE is undefined for the result of MERGEPROP."]; RETURN[[0, 0]]; }; MergedGet: PROC[data: REF, j: Integer] RETURNS[Any] ~ { m: Merged ~ NARROW[data]; MasterError[$undefinedOperation, "GET is undefined for the result of MERGEPROP."]; RETURN[NIL]; }; MergedGetProp: PROC[data: REF, propName: Any] RETURNS[value: Any, found: BOOL] ~ { m: Merged ~ NARROW[data]; [value, found] _ GetProp[m.v2, propName]; IF NOT found THEN [value, found] _ GetProp[m.v1, propName]; }; MergeProp: PUBLIC PROC[v1, v2: Vector] RETURNS[Vector] ~ { m: Merged ~ NEW[MergedRep _ [v1: v1, v2: v2]]; RETURN[NEW[VectorRep _ [class: $Merged, shape: MergedShape, get: MergedGet, getProp: MergedGetProp, data: m]]]; }; CharAction: TYPE ~ PROC[c: CARDINAL] RETURNS[quit: BOOL _ FALSE]; StringMap: PROC[text: REF TEXT, action: CharAction] RETURNS[BOOL] ~ { offset: CARDINAL _ 0; state: {run, escape, escape2, extended, extended2} _ run; FOR i: NAT IN[0..text.length) DO b: [0..255] ~ LOOPHOLE[text[i]]; SELECT state FROM run => IF b=255 THEN state _ escape ELSE IF action[offset+b] THEN RETURN[TRUE]; escape => IF b=255 THEN state _ escape2 ELSE { offset _ b*256; state _ run }; escape2 => IF b=0 THEN state _ extended ELSE ERROR; extended => IF b=255 THEN state _ escape ELSE { offset _ b*256; state _ extended2 }; extended2 => { IF action[offset+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]; }; StringShape: PROC[data: REF] RETURNS[VectorShape] ~ { text: REF TEXT ~ NARROW[data]; n: Integer _ 0; action: CharAction ~ { n _ n+1 }; [] _ StringMap[text, action]; RETURN[[l: 0, n: n]]; }; StringGetInteger: PROC[data: REF, j: Integer] RETURNS[result: Integer] ~ { text: REF TEXT ~ NARROW[data]; n: Integer _ 0; action: CharAction ~ { IF n=j THEN { result _ c; RETURN[TRUE] } ELSE n _ n+1 }; IF StringMap[text, action] THEN NULL ELSE MasterError[$boundsFault, "Invalid index for string."]; }; VectorFromString: PUBLIC PROC[text: REF TEXT] RETURNS[Vector] ~ { len: NAT ~ text.length; string: REF TEXT ~ NEW[TEXT[len]]; FOR i: NAT IN[0..len) DO string[i] _ text[i] ENDLOOP; string.length _ len; RETURN[NEW[VectorRep _ [class: $String, shape: StringShape, getInteger: StringGetInteger, data: string]]]; }; MakeVec: PROC[self: State, shape: VectorShape] RETURNS[Vector] ~ { a: Array ~ ANew[shape]; FOR i: NAT DECREASING IN[0..a.size) DO a[i] _ Pop[self] ENDLOOP; RETURN[ArrayCreate[a]]; }; ApplyGET: PUBLIC PROC[self: State] ~ { j: Integer ~ PopInteger[self]; v: Vector ~ PopVector[self]; Push[self, Get[v, j]]; }; ApplyMAKEVECLU: PUBLIC PROC[self: State] ~ { u: Integer ~ PopInteger[self]; l: Integer ~ PopInteger[self]; n: INT ~ u-l+1; IF n IN[0..maxInteger] THEN PushVector[self, MakeVec[self, [l: l, n: n]]] ELSE MasterError[$invalidArgs, "Illegal vector bounds."]; }; ApplyMAKEVEC: PUBLIC PROC[self: State] ~ { n: Integer ~ PopInteger[self]; PushVector[self, MakeVec[self, [l: 0, n: n]]]; }; ApplySHAPE: PUBLIC PROC[self: State] ~ { v: Vector ~ PopVector[self]; shape: VectorShape ~ Shape[v]; PushInteger[self, shape.l]; PushInteger[self, shape.n]; }; ApplyOPENVEC: PUBLIC PROC[self: State] ~ { v: Vector ~ PopVector[self]; shape: VectorShape ~ Shape[v]; FOR i: Integer IN[shape.l..shape.l+shape.n) DO Push[self, Get[v, i]] ENDLOOP; }; ApplyGETPROP: PUBLIC PROC[self: State] ~ { propName: Any ~ Pop[self]; v: Vector ~ PopVector[self]; value: Any; found: BOOL; [value, found] _ GetProp[v, propName]; IF found THEN Push[self, value]; PushBool[self, found]; }; ApplyGETP: PUBLIC PROC[self: State] ~ { propName: Any ~ Pop[self]; v: Vector ~ PopVector[self]; Push[self, GetP[v, propName]]; }; ApplyMERGEPROP: PUBLIC PROC[self: State] ~ { v2: Vector ~ PopVector[self]; v1: Vector ~ PopVector[self]; PushVector[self, MergeProp[v1, v2]]; }; END.