IPWrittenEncodingImpl:
CEDAR
PROGRAM
IMPORTS IO, IPEncoding, Real, Rope, RopeReader
EXPORTS IPWritten
= BEGIN OPEN IPEncoding, IPBasic;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
NonDefaultingText: TYPE = REF TEXT ←
EncodeTable: TYPE = ARRAY PrimitiveOrSymbol OF NonDefaultingText;
encode:
REF
READONLY EncodeTable =
NEW[EncodeTable = [nil:
NIL,
abs: "ABS", add: "ADD", and: "AND", arcto: "ARCTO", atan: "ATAN", ceiling: "CEILING", clipoutline: "CLIPOUTLINE", cliprectangle: "CLIPRECTANGLE", concat: "CONCAT", concatt: "CONCATT", conicto: "CONICTO", copy: "COPY", correct: "CORRECT", correctmask: "CORRECTMASK", correctspace: "CORRECTSPACE", cos: "COS", count: "COUNT", curveto: "CURVETO", div: "DIV", do: "DO", dobody: "DOBODY", dosave: "DOSAVE", dosaveall: "DOSAVEALL", dosaveallbody: "DOSAVEALLBODY", dosavebody: "DOSAVEBODY", dosavesimplebody: "DOSAVESIMPLEBODY", dround: "DROUND", dup: "DUP", env: "ENV", eq: "EQ", eqn: "EQN", exch: "EXCH", exp: "EXP", fget: "FGET", findcolor: "FINDCOLOR", findcolormodeloperator: "FINDCOLORMODELOPERATOR", findcoloroperator: "FINDCOLOROPERATOR", finddecompressor: "FINDDECOMPRESSOR", findfont: "FINDFONT", findfontvec: "FINDFONTVEC", floor: "FLOOR", frame: "FRAME", fset: "FSET", ge: "GE", get: "GET", getcp: "GETCP", getcprounded: "GETCPROUNDED", getp: "GETP", getprop: "GETPROP", gt: "GT", if: "IF", ifcopy: "IFCOPY", ifelse: "IFELSE", iget: "IGET", invert: "INVERT", iset: "ISET", lineto: "LINETO", linetox: "LINETOX", linetoy: "LINETOY", log: "LOG", loop: "LOOP", makeco: "MAKECO", makecompiledimage: "MAKECOMPILEDIMAGE", makegray: "MAKEGRAY", makeoutline: "MAKEOUTLINE", makepixelarray: "MAKEPIXELARRAY", makepool: "MAKEPOOL", makesampledblack: "MAKESAMPLEDBLACK", makesampledcolor: "MAKESAMPLEDCOLOR", makesimpleco: "MAKESIMPLECO", maket: "MAKET", makevec: "MAKEVEC", makeveclu: "MAKEVECLU", mark: "MARK", maskfill: "MASKFILL", maskpixel: "MASKPIXEL", maskrectangle: "MASKRECTANGLE", maskstroke: "MASKSTROKE", maskstrokeclosed: "MASKSTROKECLOSED", masktrapezoidx: "MASKTRAPEZOIDX", masktrapezoidy: "MASKTRAPEZOIDY", maskunderline: "MASKUNDERLINE", maskvector: "MASKVECTOR", max: "MAX", mergeprop: "MERGEPROP", min: "MIN", mod: "MOD", modifyfont: "MODIFYFONT", move: "MOVE", moveto: "MOVETO", mul: "MUL", neg: "NEG", nop: "NOP", nopool: "NOPOOL", not: "NOT", opent: "OPENT", openvec: "OPENVEC", or: "OR", pget: "PGET", pool: "POOL", poolop: "POOLOP", pop: "POP", pset: "PSET", rem: "REM", roll: "ROLL", rotate: "ROTATE", round: "ROUND", roundxy: "ROUNDXY", roundxyvec: "ROUNDXYVEC", scale: "SCALE", scale2: "SCALE2", setcorrectmeasure: "SETCORRECTMEASURE", setcorrecttolerance: "SETCORRECTTOLERANCE", setfont: "SETFONT", setgray: "SETGRAY", setxrel: "SETXREL", setxy: "SETXY", setxyrel: "SETXYREL", setyrel: "SETYREL", shape: "SHAPE", show: "SHOW", showandxrel: "SHOWANDXREL", sin: "SIN", space: "SPACE", sqrt: "SQRT", startunderline: "STARTUNDERLINE", sub: "SUB", trans: "TRANS", transform: "TRANSFORM", transformvec: "TRANSFORMVEC", translate: "TRANSLATE", trunc: "TRUNC", type: "TYPE", unmark: "UNMARK", unmark0: "UNMARK0",
beginBlock: "BEGIN", endBlock: "END", beginBody: "{", endBody: "}", pageInstructions: "PAGEINSTRUCTIONS", noPages: "NOPAGES", beginVec: "[", comma: ",", endVec: "]"
]];
Match:
PROC[a, b:
REF
READONLY
TEXT]
RETURNS[
BOOL] =
INLINE {
RETURN[IF a.length=b.length THEN MatchChars[a, b] ELSE FALSE];
};
MatchChars:
PROC[a, b:
REF
READONLY
TEXT]
RETURNS[
BOOL] = {
len: NAT = a.length;
IF b.length#len THEN RETURN[FALSE];
FOR i: NAT IN[0..len) DO IF a[i]#b[i] THEN RETURN[FALSE] ENDLOOP;
RETURN[TRUE];
};
Decode:
PROC[name:
REF
READONLY
TEXT]
RETURNS[PrimitiveOrSymbol] = {
maybe some day this search will be made smarter...
FOR op: PrimitiveOrSymbol
IN PrimitiveOrSymbol
DO
IF op#nil AND Match[name, encode[op]] THEN RETURN[op];
ENDLOOP;
RETURN[nil];
};
RopeFromOp:
PUBLIC
PROC[op: PrimitiveOrSymbol]
RETURNS[
ROPE] = {
RETURN[Rope.FromRefText[encode[op]]];
};
readerProcs:
REF
READONLY ReaderProcs =
NEW[ReaderProcs = [
GetToken: GetToken,
GetInt: GetInt,
GetRational: GetRational,
GetReal: GetReal,
GetRope: GetRope
]];
EOF: CHAR = '\000; -- end of file marker (the master better not include any NULs)
bufferSize: NAT = 50; -- must be enough for longest primitive name
NewReader:
PROC[ropeReader: RopeReader.Ref]
RETURNS[Reader] = {
self: Reader =
NEW[ReaderRep ← [procs:
NIL,
ropeReader: NIL, buffer: NIL, bytesRemaining: 0, startingIndex: 0]];
self.procs ← readerProcs;
self.ropeReader ← ropeReader;
self.buffer ← NEW[TEXT[bufferSize]];
self.startingIndex ← ropeReader.GetIndex[];
ropeReader.SetCharForEndOfRope[EOF];
RETURN[self];
};
Get:
PROC[self: Reader]
RETURNS[
CHAR] =
INLINE {
RETURN[self.ropeReader.Get[]] };
Peek:
PROC[self: Reader]
RETURNS[
CHAR] =
INLINE {
RETURN[self.ropeReader.Peek[]] };
BackUp:
PROC[self: Reader] =
INLINE {
[] ← self.ropeReader.Backwards[] };
GetIndex:
PROC[self: Reader]
RETURNS[
INT] =
INLINE {
RETURN[self.ropeReader.GetIndex[]] };
SetIndex:
PROC[self: Reader, index:
INT] =
INLINE {
self.ropeReader.SetIndex[index] };
GetBaseRope:
PROC[self: Reader]
RETURNS[
ROPE] =
INLINE {
RETURN[self.ropeReader.GetRope[]] };
GetToken:
PROC[self: Reader, index:
INT]
RETURNS[Token] = {
name: REF TEXT ← self.buffer;
len: NAT ← 0; -- character count
maxLen: NAT = name.maxLength;
token: Token ← nullToken;
state: {null, paren, file, star, op, id, string, escape, escape2, escape3, com, comdash, plus, dash, int, integer, dnext, dsign, denom, dot, fraction, enext, esign, expon} ← null;
val: NAT ← 0; -- short integer value
maxVal: NAT = (LAST[NAT]-9)/10;
lcount, rcount: NAT ← 0; -- digits to left and right of . or /
SetIndex[self, token.index ← index];
DO char:
CHARACTER = Get[self];
SELECT state
FROM
null =>
SELECT char
FROM
EOF => { token.type ← eof; GOTO Stop };
' , '\n, '\t => { token.index ← GetIndex[self] };
'{ => { token.op ← beginBody; token.type ← op; GOTO Stop };
'} => { token.op ← endBody; token.type ← op; GOTO Stop };
'[ => { token.op ← beginVec; token.type ← op; GOTO Stop };
', => { token.op ← comma; token.type ← op; GOTO Stop };
'] => { token.op ← endVec; token.type ← op; GOTO Stop };
'< => { len ← 0; state ← string }; -- begin string
'( => { state ← paren }; -- might begin (*
'+ => { state ← plus }; -- might begin number
'- => { state ← dash }; -- might begin number or comment
'. => { state ← dot }; -- might begin real
IN['0..'9] => { lcount ← 1; state ← integer }; -- begin integer
IN['A..'Z] => { name[0] ← char; len ← 1; state ← op }; -- begin op
IN['a..'z] => { state ← id; len ← 1 }; -- begin identifier
ENDCASE => { ERROR Error["invalid character"]; --GOTO Stop-- };
paren =>
SELECT char
FROM
'* => { len ← 0; state ← file }; -- next char begins name for insertFile
ENDCASE => { ERROR Error["misused ("]; --GOTO Stop-- }; -- left paren alone
file =>
SELECT char
FROM
'* => { state ← star }; -- look for )
ENDCASE => { len ← len+1 }; -- extend file name
star =>
SELECT char
FROM
') => { token.type ← insertFile; GOTO Stop }; -- end insertFile
ENDCASE => { len ← len+2; state ← file }; -- extend file name
op =>
SELECT char
FROM
IN['A..'Z], IN['0..'9] => { IF len<maxLen THEN name[len] ← char; len ← len+1 };
IN['a..'z], '- => { len ← len+1; state ← id }; -- must be an id
ENDCASE => {
-- end op token
IF len<=maxLen THEN { name.length ← len; token.op ← Decode[name] };
IF token.op#nil THEN token.type ← op
ELSE token.type ← identifier; -- *** or raise an Error ***
GOTO Back;
};
id =>
SELECT char
FROM
IN['a..'z], IN['A..'Z], IN['0..'9], '- => { len ← len+1 }; -- extend id
ENDCASE => { token.type ← identifier; GOTO Back };
string =>
SELECT char
FROM
'> => { token.type ← string; GOTO Stop };
'\\ => { state ← escape }; -- escape sequence follows
ENDCASE => { len ← len+1 }; -- extend string
escape =>
SELECT char
FROM
IN['0..'9] => { state ← escape2 }; -- 1st of three digits
ENDCASE => { len ← len+1; state ← string };
escape2 =>
SELECT char
FROM
IN['0..'9] => { state ← escape3 }; -- 2nd digit
ENDCASE => ERROR Error["invalid escape sequence"];
escape3 =>
SELECT char
FROM
IN['0..'9] => { len ← len+1; state ← string }; -- 3rd digit
ENDCASE => ERROR Error["invalid escape sequence"];
com =>
SELECT char
FROM
'- => { state ← comdash }; -- another dash will end comment
ENDCASE => { len ← len+1 }; -- extend comment
comdash =>
SELECT char
FROM
'- => { token.index ← GetIndex[self]; state ← null }; -- ignore annotation
ENDCASE => { len ← len+2; state ← com }; -- false alarm; extend comment
plus =>
SELECT char
FROM
IN['0..'9] => { val ← (char-'0); lcount ← 1; state ← int }; -- first integer digit
ENDCASE => { ERROR Error["misused +"]; --GOTO Back-- }; -- plus sign alone
dash =>
SELECT char
FROM
'- => { len ← 0; state ← com }; -- begin comment with next char
IN['0..'9] => { lcount ← 1; state ← integer }; -- first integer digit
ENDCASE => { ERROR Error["misused -"]; --GOTO Back-- }; -- minus sign alone
integer =>
SELECT char
FROM
IN['0..'9] => { lcount ← lcount+1 }; -- integer digit
'. => { state ← fraction }; -- fraction coming
'/ => { state ← dnext }; -- denominator coming
'E, 'e => { state ← enext }; -- exponent coming
ENDCASE => { token.type ← int; GOTO Back }; -- end integer token
dnext =>
SELECT char
FROM
'+, '- => { state ← dsign }; -- denominator sign
IN['0..'9] => { rcount ← 1; state ← denom }; -- first denominator digit
ENDCASE => { ERROR Error["missing denominator"]; --GOTO Back-- };
dsign =>
SELECT char
FROM
IN['0..'9] => { rcount ← 1; state ← denom }; -- first denominator digit
ENDCASE => { ERROR Error["invalid denominator"]; --GOTO Back-- };
denom =>
SELECT char
FROM
IN['0..'9] => { rcount ← rcount+1 }; -- extend denominator
ENDCASE => {
-- end rational token
token.type ← (IF MAX[lcount, rcount]<10 THEN rational ELSE real);
GOTO Back;
};
dot =>
SELECT char
FROM
IN['0..'9] => { rcount ← 1; state ← fraction }; -- first fraction digit
ENDCASE => { ERROR Error["misused ."]; --GOTO Back-- }; -- no digits after dot
fraction =>
SELECT char
FROM
IN['0..'9] => { rcount ← rcount+1 }; -- extend fraction
'E, 'e => { state ← enext }; -- exponent coming
ENDCASE => {
-- end real token with no exponent
token.type ← real;
GOTO Back;
};
enext =>
SELECT char
FROM
'+, '- => { state ← esign }; -- exponent sign
IN['0..'9] => { state ← expon }; -- first exponent digit
ENDCASE => { ERROR Error["missing exponent"]; --GOTO Back-- };
esign =>
SELECT char
FROM
IN['0..'9] => { state ← expon }; -- first exponent digit
ENDCASE => { ERROR Error["invalid exponent"]; --GOTO Back-- };
expon =>
SELECT char
FROM
IN['0..'9] => { }; -- extend exponent
ENDCASE => { token.type ← real; GOTO Back }; -- end real token
ENDCASE => ERROR; -- unknown state
IF char=EOF THEN { ERROR Error["end of file inside token"]; --GOTO Back-- };
REPEAT
Stop => NULL; -- token ends with current char
Back => BackUp[self]; -- token ended with previous char
ENDLOOP;
token.length ← len;
token.next ← GetIndex[self];
RETURN[token];
};
ReadInt:
PROC[self: Reader]
RETURNS[
INT] = {
i: INT ← 0;
sign: CHAR ← '+;
IF Peek[self] NOT IN['0..'9] THEN sign ← Get[self];
DO c:
CHAR = Get[self];
IF c IN['0..'9] THEN i ← i*10+(c-'0)
ELSE { BackUp[self]; EXIT };
ENDLOOP;
RETURN[IF sign='- THEN -i ELSE i];
};
ReadReal:
PROC[self: Reader]
RETURNS[
REAL] = {
get: PROC RETURNS[CHAR] = { RETURN[Get[self]] };
putback: PROC[CHAR] = { BackUp[self] };
r: REAL = Real.ReadReal[get, putback];
RETURN[r];
};
GetInt:
PROC[self: Reader, token: Token]
RETURNS[
INT] = {
SetIndex[self, token.index];
IF token.type=int
THEN {
i: INT = ReadInt[self];
RETURN[i];
}
ELSE ERROR Error["wrong token type"];
};
GetRational:
PROC[self: Reader, token: Token]
RETURNS[Rational] = {
SetIndex[self, token.index];
IF token.type=rational
THEN {
r: Rational;
r.num ← ReadInt[self];
IF Get[self]#'/ THEN ERROR Error["malformed rational"];
r.den ← ReadInt[self];
RETURN[r];
}
ELSE ERROR Error["wrong token type"];
};
GetReal:
PROC[self: Reader, token: Token]
RETURNS[
REAL] = {
SetIndex[self, token.index];
IF token.type=real
THEN {
r: REAL = ReadReal[self];
RETURN[r];
}
ELSE ERROR Error["wrong token type"];
};
GetRope:
PROC[self: Reader, token: Token]
RETURNS[
ROPE] = {
base: ROPE = GetBaseRope[self];
SELECT token.type
FROM
identifier => RETURN[Rope.Substr[base, token.index, token.length]];
string => RETURN[GetString[self, token]];
comment => RETURN[Rope.Substr[base, token.index+2, token.length]];
insertFile => RETURN[Rope.Substr[base, token.index+2, token.length]];
ENDCASE => ERROR Error["wrong token type"];
};
GetString:
PROC[self: Reader, token: Token]
RETURNS[string:
ROPE] = {
gp:
PROC
RETURNS[c:
CHAR] = {
c ← Get[self];
IF c='> THEN ERROR;
IF c='\\
THEN {
c ← Get[self];
SELECT c
FROM
'n, 'N => c ← '\n;
'r, 'R => c ← '\r;
't, 'T => c ← '\t;
'b, 'B => c ← '\b;
'f, 'F => c ← '\f;
'l, 'L => c ← '\l;
IN['0..'9] => {
x: NAT ← c-'0;
c ← Get[self]; IF c IN['0..'9] THEN x ← x*10B+(c-'0) ELSE ERROR;
c ← Get[self]; IF c IN['0..'9] THEN x ← x*10B+(c-'0) ELSE ERROR;
c ← LOOPHOLE[x MOD 400B];
};
ENDCASE;
};
RETURN[c]
};
SetIndex[self, token.index];
IF Get[self]#'< THEN ERROR Error["invalid string"];
string ← Rope.FromProc[token.length, gp];
IF Get[self]#'> THEN ERROR Error["invalid string"];
};
writerProcs:
REF
READONLY WriterProcs =
NEW[WriterProcs = [
PutOp: PutOp,
PutInt: PutInt,
PutRational: PutRational,
PutReal: PutReal,
PutRope: PutRope
]];
NewWriter:
PROC[stream:
STREAM]
RETURNS[Writer] = {
self: Writer = NEW[WriterRep ← [procs: writerProcs, stream: stream]];
RETURN[self];
};
PutOp:
PROC[self: Writer, op: IPBasic.PrimitiveOrSymbol] = {
s: STREAM = self.stream;
name: REF READONLY TEXT = encode[op];
IF name=NIL THEN ERROR Error["invalid op"];
s.PutText[name]; s.PutChar[' ];
};
PutInt:
PROC[self: Writer, i:
INT] = {
s: STREAM = self.stream;
s.Put[IO.int[i]]; s.PutChar[' ];
};
PutRational:
PROC[self: Writer, r: Rational] = {
s: STREAM = self.stream;
s.Put[IO.int[r.num]]; s.PutChar['/];
s.Put[IO.int[r.den]]; s.PutChar[' ];
};
PutReal:
PROC[self: Writer, r:
REAL] = {
s: STREAM = self.stream;
s.Put[IO.real[r]]; s.PutChar[' ];
};
LowerCase:
PROC[c:
CHAR]
RETURNS[
CHAR] =
INLINE {
RETURN[IF c IN['A..'Z] THEN 'a+(c-'A) ELSE c] };
PutRope:
PROC[self: Writer, type: TokenType, text:
ROPE] = {
s: STREAM = self.stream;
SELECT type
FROM
identifier => s.PutRope[text];
string => PutString[s, text];
comment => { s.PutRope["**"]; s.PutRope[text]; s.PutRope["**"]; };
insertFile => { s.PutRope["(*"]; s.PutRope[text]; s.PutRope["*)"]; };
largeVec => {
put:
PROC[c:
CHAR]
RETURNS[
BOOL] = {
n: NAT = LOOPHOLE[c];
s.Put[IO.int[n]]; s.PutChar[' ];
RETURN[FALSE];
};
s.PutRope["[ "];
[] ← Rope.Map[base: text, action: put];
s.PutRope["]"];
};
ENDCASE => ERROR Error["wrong token type for PutRope"];
s.PutChar[' ];
};
PutString:
PROC[s:
STREAM, string:
ROPE] = {
pp: Rope.ActionType
--PROC [c: CHAR] RETURNS [quit: BOOL ← FALSE]-- = {
SELECT c
FROM
'\\, '<, '> => { s.PutChar['\\]; s.PutChar[c] };
<40C, >176C => {
n: NAT = LOOPHOLE[c];
s.PutChar['\\];
s.PutChar['0+(n/100B) MOD 10B];
s.PutChar['0+(n/10B) MOD 10B];
s.PutChar['0+(n/1B) MOD 10B];
};
ENDCASE => s.PutChar[c];
};
s.PutChar['<];
[] ← Rope.Map[base: string, action: pp];
s.PutChar['>];
};
IPEncoding.Register["Written", [2,0], NewReader, NewWriter];
END.