IPWrittenMasterImpl.mesa
Last edited by:
Doug Wyatt, February 29, 1984 5:28:06 pm PST
DIRECTORY
Convert USING [IntFromRope, RealFromRope],
IO USING [Backup, EndOfStream, GetChar, GetIndex, int, Put, PutChar, PutRope, real, STREAM],
IP USING [Op, Vector],
IPMaster USING [Error, nullToken, Rational, Reader, ReaderProcs, ReaderProcsRep, RegisterEncoding, Token, TokenType, Writer, WriterProcs, WriterProcsRep],
RefText USING [Append, Find, InlineAppendChar, ObtainScratch, ReleaseScratch, TrustTextAsRope],
Rope USING [Fetch, Length, ROPE],
SymTab USING [Create, Fetch, Insert, Ref];
IPWrittenMasterImpl: CEDAR PROGRAM
IMPORTS Convert, IO, IPMaster, RefText, Rope, SymTab
~ BEGIN OPEN IPMaster, IP;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
NonDefaultingRope: TYPE ~ ROPE ←
EncodeTable: TYPE ~ ARRAY Op OF NonDefaultingRope;
encode: REF EncodeTable ~ NEW[EncodeTable ← [nil: NIL, get: "GET", makeveclu: "MAKEVECLU", makevec: "MAKEVEC", shape: "SHAPE", openvec: "OPENVEC", getprop: "GETPROP", getp: "GETP", mergeprop: "MERGEPROP", frame: "FRAME", fget: "FGET", fset: "FSET", poolop: "POOLOP", pool: "POOL", pget: "PGET", pset: "PSET", env: "ENV", makepool: "MAKEPOOL", nopool: "NOPOOL", makeco: "MAKECO", makesimpleco: "MAKESIMPLECO", do: "DO", dosave: "DOSAVE", dosaveall: "DOSAVEALL", dobody: "DOBODY", dosavebody: "DOSAVEBODY", dosaveallbody: "DOSAVEALLBODY", dosavesimplebody: "DOSAVESIMPLEBODY", makecompiledimage: "MAKECOMPILEDIMAGE", pop: "POP", copy: "COPY", dup: "DUP", roll: "ROLL", exch: "EXCH", mark: "MARK", unmark: "UNMARK", unmark0: "UNMARK0", count: "COUNT", nop: "NOP", error: "ERROR", if: "IF", ifelse: "IFELSE", ifcopy: "IFCOPY", loop: "LOOP", eq: "EQ", eqname: "EQNAME", gt: "GT", ge: "GE", and: "AND", or: "OR", not: "NOT", type: "TYPE", add: "ADD", sub: "SUB", neg: "NEG", abs: "ABS", floor: "FLOOR", ceiling: "CEILING", trunc: "TRUNC", round: "ROUND", mul: "MUL", div: "DIV", mod: "MOD", rem: "REM", max: "MAX", min: "MIN", sqrt: "SQRT", exp: "EXP", log: "LOG", sin: "SIN", cos: "COS", atan: "ATAN", iget: "IGET", iset: "ISET", dround: "DROUND", maket: "MAKET", opent: "OPENT", translate: "TRANSLATE", rotate: "ROTATE", scale: "SCALE", scale2: "SCALE2", concat: "CONCAT", invert: "INVERT", transform: "TRANSFORM", transformvec: "TRANSFORMVEC", roundxy: "ROUNDXY", roundxyvec: "ROUNDXYVEC", concatt: "CONCATT", move: "MOVE", trans: "TRANS", show: "SHOW", showandxrel: "SHOWANDXREL", setxy: "SETXY", setxyrel: "SETXYREL", setxrel: "SETXREL", setyrel: "SETYREL", getcp: "GETCP", getcprounded: "GETCPROUNDED", makepixelarray: "MAKEPIXELARRAY", extractpixelarray: "EXTRACTPIXELARRAY", finddecompressor: "FINDDECOMPRESSOR", makegray: "MAKEGRAY", findcolor: "FINDCOLOR", findcoloroperator: "FINDCOLOROPERATOR", findcolormodeloperator: "FINDCOLORMODELOPERATOR", makesampledcolor: "MAKESAMPLEDCOLOR", makesampledblack: "MAKESAMPLEDBLACK", setgray: "SETGRAY", moveto: "MOVETO", lineto: "LINETO", linetox: "LINETOX", linetoy: "LINETOY", curveto: "CURVETO", conicto: "CONICTO", arcto: "ARCTO", makeoutline: "MAKEOUTLINE", maskfill: "MASKFILL", maskstroke: "MASKSTROKE", maskstrokeclosed: "MASKSTROKECLOSED", maskvector: "MASKVECTOR", maskrectangle: "MASKRECTANGLE", startunderline: "STARTUNDERLINE", maskunderline: "MASKUNDERLINE", masktrapezoidx: "MASKTRAPEZOIDX", masktrapezoidy: "MASKTRAPEZOIDY", maskpixel: "MASKPIXEL", clipoutline: "CLIPOUTLINE", cliprectangle: "CLIPRECTANGLE", findfont: "FINDFONT", findfontvec: "FINDFONTVEC", modifyfont: "MODIFYFONT", setfont: "SETFONT", correctmask: "CORRECTMASK", correctspace: "CORRECTSPACE", correct: "CORRECT", setcorrectmeasure: "SETCORRECTMEASURE", setcorrecttolerance: "SETCORRECTTOLERANCE", space: "SPACE", beginBody: "{", endBody: "}", beginBlock: "BEGIN", endBlock: "END", pageInstructions: "PAGEINSTRUCTIONS", noPages: "NOPAGES", metricMaster: "METRICMASTER", environmentMaster: "ENVIRONMENTMASTER", beginVec: "[", comma: ",", endVec: "]"]];
decode: SymTab.Ref ~ BuildDecodeTable[encode];
BuildDecodeTable:
PROC[encode:
REF EncodeTable]
RETURNS[decode: SymTab.Ref] = {
decode ← SymTab.Create[mod: 101, case: FALSE];
FOR op: Op
IN Op
DO
key: ROPE ~ encode[op];
IF key#
NIL
THEN {
opRef: REF Op ~ NEW[Op ← op];
IF decode.Insert[key: key, val: opRef] THEN NULL ELSE ERROR;
};
ENDLOOP;
};
RopeFromOp:
PROC[op: Op]
RETURNS[
ROPE] ~ {
RETURN[encode[op]] };
OpFromRope:
PROC[rope:
ROPE]
RETURNS[Op] ~ {
found: BOOL; val: REF;
[found: found, val: val] ← decode.Fetch[key: rope];
IF found THEN { opRef: REF Op ~ NARROW[val]; RETURN[opRef^] }
ELSE RETURN[nil];
};
writtenReaderProcs: ReaderProcs ~
NEW[ReaderProcsRep ← [
getToken: WrittenGetToken,
readInt: WrittenReadInt,
readReal: WrittenReadReal,
readRational: WrittenReadRational,
readVector: WrittenReadVector
]];
WrittenGetToken:
PROC[reader: Reader, flushComments:
BOOL ←
TRUE] ~ {
stream: STREAM ~ reader.stream;
token: Token ← nullToken;
text: REF TEXT ← NIL;
DO
state: {begin, op, id, plus, minus, ast, int, den1, den2, den3, dot, frac, exp1, exp2, exp3, string, escape, com, com1, file, file1, ann, ann1} ← begin;
err: {ok, illegalChar, invalidRational, invalidReal, invalidEscape} ← ok;
char: CHAR; -- last character fetched
got: BOOL ← TRUE; -- true if got char from stream, false if char is fake space at end
esc: NAT; -- starting index of escape sequence
BeginEscape: PROC ~ { esc ← text.length-1 };
EndEscape:
PROC ~ {
start: NAT ~ esc+1; stop: NAT ~ text.length-1;
val: CARDINAL ← 0;
IF stop<=start THEN err ← invalidEscape
ELSE
FOR i:
NAT
IN[start..stop)
DO c:
CHAR ~ text[i];
IF c IN['0..'9] THEN val ← val*10+(c-'0) ELSE { err ← invalidEscape; EXIT };
IF val>255 THEN { val ← 0; err ← invalidEscape; EXIT };
ENDLOOP;
text[esc] ← 0C+val; text.length ← esc+1;
};
reader.index ← stream.GetIndex[];
DO
-- skip white space
char ← stream.GetChar[! IO.EndOfStream => GOTO EndOfFile];
IF char IN['\041..'\176] THEN EXIT ELSE reader.index ← reader.index+1;
ENDLOOP;
text ← reader.buffer; text.length ← 0;
DO
-- scan a token
text ← RefText.InlineAppendChar[text, char]; -- tentatively append char to token text
{
SELECT state
FROM
begin =>
SELECT char
FROM
IN['A..'Z] => { state ← op }; -- begin op
IN['a..'z] => { state ← id }; -- begin identifier
IN['0..'9] => { state ← int }; -- begin number
'{ => { token.op ← beginBody; GOTO SingleOp };
'} => { token.op ← endBody; GOTO SingleOp };
'[ => { token.op ← beginVec; GOTO SingleOp };
'] => { token.op ← endVec; GOTO SingleOp };
', => { token.op ← comma; GOTO SingleOp };
'< => { state ← string; GOTO Begin }; -- begin string
'+ => { state ← plus }; -- might begin number or insertfile
'- => { state ← minus }; -- might begin number or annotation
'* => { state ← ast }; -- might begin comment
'. => { state ← dot }; -- might begin real
ENDCASE => { err ← illegalChar; GOTO Stop };
op =>
SELECT char
FROM
IN['A..'Z], IN['0..'9] => { }; -- extend op
IN['a..'z], '- => { state ← id }; -- switch to id
ENDCASE => { token.type ← op; GOTO Back }; -- op token
id =>
SELECT char
FROM
IN['a..'z], IN['A..'Z], IN['0..'9], '- => { }; -- extend id
ENDCASE => { token.type ← identifier; GOTO Back };
plus =>
SELECT char
FROM
IN['0..'9] => { state ← int }; -- first integer digit
'+ => { state ← file; GOTO Begin }; -- begin insertfile
ENDCASE => { err ← illegalChar; GOTO Back }; -- plus sign alone
minus =>
SELECT char
FROM
IN['0..'9] => { state ← int }; -- first integer digit
'- => { state ← ann; GOTO Begin }; -- begin annotation
ENDCASE => { err ← illegalChar; GOTO Back }; -- minus sign alone
ast =>
SELECT char
FROM
'* => { state ← com; GOTO Begin }; -- begin comment
ENDCASE => { err ← illegalChar; GOTO Back }; -- asterisk alone
int =>
SELECT char
FROM
IN['0..'9] => { }; -- integer digit
'. => { state ← frac }; -- fraction follows
'/ => { state ← den1 }; -- denominator follows
'E, 'e => { state ← exp1 }; -- exponent follows
ENDCASE => { token.type ← integer; GOTO Back }; -- integer token
den1 =>
SELECT char
FROM
IN['0..'9] => { state ← den3 }; -- first denominator digit
'+, '- => { state ← den2 }; -- denominator sign
ENDCASE => { err ← invalidRational; GOTO Back };
den2 =>
SELECT char
FROM
IN['0..'9] => { state ← den3 }; -- first denominator digit (after sign)
ENDCASE => { err ← invalidRational; GOTO Back };
den3 =>
SELECT char
FROM
IN['0..'9] => { }; -- denominator digit
ENDCASE => { token.type ← rational; GOTO Back }; -- rational token
dot =>
SELECT char
FROM
IN['0..'9] => { state ← frac }; -- first fraction digit
ENDCASE => { err ← illegalChar; GOTO Back }; -- dot alone
frac =>
SELECT char
FROM
IN['0..'9] => { }; -- fraction digit
'E, 'e => { state ← exp1 }; -- exponent follows
ENDCASE => { token.type ← real; GOTO Back }; -- real token (no exponent)
exp1 =>
SELECT char
FROM
IN['0..'9] => { state ← exp3 }; -- first exponent digit
'+, '- => { state ← exp2 }; -- exponent sign
ENDCASE => { err ← invalidReal; GOTO Back };
exp2 =>
SELECT char
FROM
IN['0..'9] => { state ← exp3 }; -- first exponent digit (after sign)
ENDCASE => { err ← invalidReal; GOTO Back };
exp3 =>
SELECT char
FROM
IN['0..'9] => { }; -- exponent digit
ENDCASE => { token.type ← real; GOTO Back }; -- real token (with exponent)
string =>
SELECT char
FROM
'> => { token.type ← string; GOTO Lop1 }; -- end string token
'# => { BeginEscape[]; state ← escape }; -- begin escape sequence
ENDCASE => { }; -- extend string
escape =>
SELECT char
FROM
'# => { EndEscape[]; state ← string }; -- end escape sequence
ENDCASE => { }; -- extend escape sequence
com =>
SELECT char
FROM
'* => { state ← com1 }; -- look for second *
ENDCASE => { }; -- extend comment
com1 =>
SELECT char
FROM
'* => { token.type ← comment; GOTO Lop2 }; -- end comment
ENDCASE => { state ← com }; -- continue comment
file =>
SELECT char
FROM
'+ => { state ← file1 }; -- look for second +
ENDCASE => { }; -- extend file name
file1 =>
SELECT char
FROM
'+ => { token.type ← insertfile; GOTO Lop2 }; -- end insertfile
ENDCASE => { state ← file }; -- continue file name
ann =>
SELECT char
FROM
'- => { state ← ann1 }; -- look for second -
ENDCASE => { }; -- extend annotation
ann1 =>
SELECT char
FROM
'- => { token.type ← annotation; GOTO Lop2 }; -- end annotation
ENDCASE => { state ← ann }; -- continue annotation
ENDCASE => ERROR; -- unknown state
EXITS
Begin => text.length ← 0;
SingleOp => { token.type ← op; EXIT };
Stop => { EXIT };
Lop1 => { text.length ← text.length-1; EXIT };
Lop2 => { text.length ← text.length-2; EXIT };
Back => { IF got THEN stream.Backup[char]; text.length ← text.length-1; EXIT };
};
char ← stream.GetChar[!
IO.EndOfStream => IF got THEN { char ← ' ; got ← FALSE; CONTINUE }];
ENDLOOP;
reader.text ← text;
IF err#ok
THEN
ERROR Error[$illegalToken,
SELECT err
FROM
illegalChar => "Illegal character.",
invalidRational => "Invalid rational.",
invalidReal => "Invalid real number.",
invalidEscape => "Invalid escape sequence in string.",
ENDCASE => NIL];
SELECT token.type
FROM
$nil => ERROR Error[$bug, "WrittenGetLiteral didn't set token type."];
$op =>
IF token.op=$nil
THEN {
token.op ← OpFromRope[RefText.TrustTextAsRope[text]];
IF token.op=$nil THEN token.type ← identifier;
};
$comment, $annotation => IF flushComments THEN LOOP;
ENDCASE;
EXIT;
REPEAT
EndOfFile => token.type ← eof;
ENDLOOP;
reader.token ← token;
};
ParseInt:
PROC[text:
REF
TEXT, start:
NAT ← 0, len:
NAT ←
NAT.
LAST]
RETURNS[x:
INT] ~ {
s: NAT ~ MIN[start, text.length];
n: NAT ~ MIN[len, text.length-s];
IF s=0 AND n=text.length THEN x ← Convert.IntFromRope[RefText.TrustTextAsRope[text]]
ELSE {
scratch: REF TEXT ~ RefText.ObtainScratch[n];
{
ENABLE
UNWIND => RefText.ReleaseScratch[scratch];
temp: REF TEXT ~ RefText.Append[to: scratch, from: text, start: s, len: n];
x ← Convert.IntFromRope[RefText.TrustTextAsRope[temp]];
};
RefText.ReleaseScratch[scratch];
};
};
ParseReal:
PROC[text:
REF
TEXT, start:
NAT ← 0, len:
NAT ←
NAT.
LAST]
RETURNS[x:
REAL] ~ {
s: NAT ~ MIN[start, text.length];
n: NAT ~ MIN[len, text.length-s];
IF s=0 AND n=text.length THEN x ← Convert.RealFromRope[RefText.TrustTextAsRope[text]]
ELSE {
scratch: REF TEXT ~ RefText.ObtainScratch[n];
{
ENABLE
UNWIND => RefText.ReleaseScratch[scratch];
temp: REF TEXT ~ RefText.Append[to: scratch, from: text, start: s, len: n];
x ← Convert.RealFromRope[RefText.TrustTextAsRope[temp]];
};
RefText.ReleaseScratch[scratch];
};
};
WrittenReadInt:
PROC[reader: Reader]
RETURNS[
INT] ~ {
SELECT reader.token.type
FROM
$shortNumber => RETURN[reader.shortNumber];
$integer => RETURN[ParseInt[reader.text]];
ENDCASE => ERROR Error[$illegalArgument, "Token is not an integer."];
};
WrittenReadReal:
PROC[reader: Reader]
RETURNS[
REAL] ~ {
SELECT reader.token.type
FROM
$integer, $real => RETURN[ParseReal[reader.text]];
ENDCASE => ERROR Error[$illegalArgument, "Token type is not $integer or $real."];
};
WrittenReadRational:
PROC[reader: Reader]
RETURNS[Rational] ~ {
text: REF TEXT ~ reader.text;
SELECT reader.token.type
FROM
$rational => {
slash: NAT ~ RefText.Find[s1: text, s2: "/"];
{
ENABLE Error =>
IF code=$overflow
THEN
GOTO Overflow;
num: INT ~ ParseInt[text: text, len: slash];
den: INT ~ ParseInt[text: text, start: slash+1];
RETURN[[int[num: num, den: den]]];
EXITS Overflow => {
num: REAL ~ ParseReal[text: text, len: slash];
den: REAL ~ ParseReal[text: text, start: slash+1];
RETURN[[real[num: num, den: den]]];
};
};
};
ENDCASE => ERROR Error[$illegalArgument, "Token is not a rational."];
};
WrittenReadVector:
PROC[reader: Reader]
RETURNS[Vector] ~ {
type: TokenType ~ reader.token.type;
SELECT reader.token.type
FROM
$vector => ERROR Error[$unimplemented, "Can't handle $vector yet."];
ENDCASE => ERROR Error[$illegalArgument, "Token is not a vector."];
};
writtenWriterProcs: WriterProcs ~
NEW[WriterProcsRep ← [
putOp: WrittenPutOp,
putInt: WrittenPutInt,
putReal: WrittenPutReal,
putRational: WrittenPutRational,
putIdentifier: WrittenPutIdentifier,
putString: WrittenPutString,
putInsertfile: WrittenPutInsertfile,
putComment: WrittenPutComment,
putAnnotation: WrittenPutAnnotation
]];
WrittenPutOp:
PROC[writer: Writer, op: Op] = {
stream: STREAM ~ writer.stream;
rope: ROPE ~ RopeFromOp[op];
IF rope=NIL THEN ERROR Error[$illegalArgument, "Illegal argument to PutOp."];
stream.PutRope[rope];
stream.PutChar[' ];
};
WrittenPutInt:
PROC[writer: Writer, value:
INT] = {
stream: STREAM ~ writer.stream;
stream.Put[IO.int[value]];
stream.PutChar[' ];
};
WrittenPutReal:
PROC[writer: Writer, value:
REAL] = {
stream: STREAM ~ writer.stream;
stream.Put[IO.real[value]];
stream.PutChar[' ];
};
WrittenPutRational:
PROC[writer: Writer, value: Rational] = {
stream: STREAM ~ writer.stream;
WITH value: value
SELECT
FROM
int => {
stream.Put[IO.int[value.num]];
stream.PutChar['/];
stream.Put[IO.int[value.den]];
stream.PutChar[' ];
};
real => WrittenPutReal[writer, value.num/value.den];
ENDCASE => ERROR;
};
WrittenPutIdentifier:
PROC[writer: Writer, rope:
ROPE] = {
stream: STREAM ~ writer.stream;
ok: BOOL ← FALSE;
len: INT ~ rope.Length[];
IF len=0 THEN ERROR Error[$illegalArgument];
FOR i:
INT
IN[0..len)
DO
char: CHAR ~ rope.Fetch[i];
IF i=0
THEN
SELECT char
FROM
IN['a..'z] => ok ← TRUE;
IN['A..'Z] => NULL;
ENDCASE => ERROR Error[$illegalArgument]
ELSE
SELECT char
FROM
IN['a..'z], IN['0..'9], '- => ok ← TRUE;
IN['A..'Z] => NULL;
ENDCASE => ERROR Error[$illegalArgument];
stream.PutChar[char];
ENDLOOP;
IF NOT ok AND OpFromRope[rope]#nil THEN Error[$illegalArgument];
stream.PutChar[' ];
};
WrittenPutString:
PROC[writer: Writer, rope:
ROPE] = {
stream: STREAM ~ writer.stream;
stream.PutChar['<];
FOR i:
INT
IN[0..rope.Length)
DO
char: CHAR ~ rope.Fetch[i];
SELECT char
FROM
'>, '#, <40C, >176C => {
stream.PutChar['#];
stream.Put[IO.int[char-0C]];
stream.PutChar['#];
};
ENDCASE => stream.PutChar[char];
ENDLOOP;
stream.PutChar['>];
stream.PutChar[' ];
};
WrittenPutComment:
PROC[writer: Writer, rope:
ROPE] = {
stream: STREAM ~ writer.stream;
stream.PutRope["**"];
stream.PutRope[rope];
stream.PutRope["**"];
stream.PutChar[' ];
};
WrittenPutInsertfile:
PROC[writer: Writer, rope:
ROPE] = {
stream: STREAM ~ writer.stream;
stream.PutRope["++ "];
stream.PutRope[rope];
stream.PutRope[" ++"];
stream.PutChar[' ];
};
WrittenPutAnnotation:
PROC[writer: Writer, rope:
ROPE] = {
stream: STREAM ~ writer.stream;
stream.PutRope["--"];
stream.PutRope[rope];
stream.PutRope["--"];
stream.PutChar[' ];
};
RegisterEncoding[name: "Written", version: [2, 1],
readerProcs: writtenReaderProcs, writerProcs: writtenWriterProcs];
END.