-- ConvertImpl.mesa, for safe number/string conversions
-- Russ Atkinson, September 9, 1982 3:40 pm

DIRECTORY
Convert,
ConvertUnsafe USING
[ToRefText, ToRope],
Inline USING
[LowHalf, HighHalf],
Real USING
[DefaultSinglePrecision, ReadReal, WriteReal],
RefText USING
[Append, Find, ObtainScratch, ReleaseScratch],
Rope USING
[Fetch, ROPE, Size],
Time USING
[Append, Pack, Packed, Unpack, Unpacked];

ConvertImpl: CEDAR PROGRAM
IMPORTS ConvertUnsafe, Inline, Real, RefText, Rope, Time
EXPORTS Convert
= BEGIN OPEN Convert, Real, Rope;

NotImplemented: PUBLIC ERROR = CODE;

BadIndex: Value = [error[badIndex]];

ValueToRope: PUBLIC PROC [value: Value] RETURNS [ROPE] = TRUSTED {
s: STRING ← [40];
len: NAT ← 0;
Add: PROC [c: CHAR] = TRUSTED {s[len] ← c; len ← len + 1};
MapValue[Add, value];
s.length ← len;
RETURN [ConvertUnsafe.ToRope[s]]};

ValueToRefText: PUBLIC PROC
[value: Value] RETURNS [REF TEXT] = TRUSTED {
s: STRING ← [40];
len: NAT ← 0;
Add: PROC [c: CHAR] = TRUSTED {s[len] ← c; len ← len + 1};
MapValue[Add, value];
s.length ← len;
RETURN [ConvertUnsafe.ToRefText[s]]};

MapValue: PUBLIC PROC [put: Put, value: Value] = TRUSTED {
s: STRING ← [40];
pos, start: NAT ← 0;
WITH v: value SELECT FROM
unsigned =>
pos ← LocalUnparse[s, LOOPHOLE[v.unsigned], v.base, FALSE];
signed =>
pos ← LocalUnparse[s, v.signed, v.base, TRUE];
real =>
{Real.WriteReal[put, v.real, v.precision, v.useE];
RETURN};
time => {
len: NAT ← 0;
 c: CHAR ← 0C;
Time.Append[s, Time.Unpack[v.time], v.useZone];
len ← s.length;
 FOR pos IN [pos..len) WHILE (c ← s[pos]) = 40C DO
  IF v.useDate THEN put[c];
  ENDLOOP;
 FOR pos IN [pos..len) WHILE (c ← s[pos]) # 40C DO
  IF v.useDate THEN put[c];
  ENDLOOP;
 IF NOT (v.useTime AND v.useDate) THEN {
  -- skip intervening blanks
  FOR pos IN [pos..len) WHILE s[pos] = 40C DO NULL; ENDLOOP;
  IF NOT v.useTime THEN
  -- skip the time field
  FOR pos IN [pos..len) WHILE s[pos] # 40C DO NULL; ENDLOOP;
  };
FOR pos IN [pos..len) DO put[s[pos]]; ENDLOOP;
RETURN};
error => {
lit: REF TEXT ← NIL;
SELECT v.kind FROM
badFormat => lit ← "Bad Format!";
empty => lit ← "Empty!";
overflow => lit ← "Overflow!";
  badIndex => lit ← "Bad Index!";
ENDCASE => ERROR;
FOR i: NAT IN [0..lit.length) DO put[lit[i]]; ENDLOOP;
RETURN};
ENDCASE => ERROR;
WHILE pos > 0 DO put[s[pos←pos-1]]; ENDLOOP;
};

Parse: PUBLIC PROC
[text: Text, template: Value ← DefaultValue, pos: INT ← 0, size: INT ← MaxIndex]
RETURNS [value: Value, stop: CARD] = TRUSTED {
get: Get ← NIL;
ref: REF ← NIL;
len: INT ← size;
overflow: BOOL ← FALSE;
sGet: PROC [index: INT] RETURNS [CHAR] = TRUSTED {
RETURN [LOOPHOLE[ref, REF TEXT][Inline.LowHalf[index]]]};
rGet: PROC [index: INT] RETURNS [CHAR] = TRUSTED {
RETURN[Fetch[LOOPHOLE[ref], index]]};
IF pos < 0 THEN RETURN [BadIndex, pos];
stop ← pos;
value ← template;
WITH t: text SELECT FROM
string => {ref ← LOOPHOLE[t.string]; len ← t.string.length; get ← sGet};
rope => {ref ← t.rope; len ← Size[t.rope]; get ← rGet};
get => {get ← t.get};
ENDCASE => ERROR;
size ← MIN[size, len];
WHILE pos < size DO
IF get[pos] # 40C THEN EXIT;
pos ← pos + 1;
ENDLOOP;
IF size <= pos THEN {value ← [error[empty]]; RETURN};
WITH v: template SELECT FROM
unsigned => [value, stop] ← LocalParse[get, size, pos, template];
signed => [value, stop] ← LocalParse[get, size, pos, template];
real => {getNext: PROC RETURNS [c: CHAR] = TRUSTED {
IF pos < size THEN c ← get[pos] ELSE c ← 0C;
pos ← pos + 1};
putBack: PROC [CHAR] = TRUSTED {pos ← pos - 1};
real: REAL ← 0.0;
real ← Real.ReadReal[getNext, putBack !
ANY => {overflow ← TRUE; CONTINUE}];
value ← [real[real: real, precision: v.precision, useE: v.useE]];
stop ← pos;
IF overflow THEN value ← [error[overflow]]};
time => [value, stop] ← LocalParseTime[get, size, pos, v];
ENDCASE => value ← [error[badFormat]];
};

LocalUnparse: PRIVATE PROC
[accum: STRING, number: INT, base: Base ← 10,
signed: BOOLEAN ← TRUE]
RETURNS [pos: NAT] = TRUSTED {
unsigned: CARD ← LOOPHOLE[number];
pos ← 0;
IF base NOT IN [2..36] THEN ERROR;
IF number < 0 AND signed THEN unsigned ← LOOPHOLE[-unsigned];
DO
digit: NAT ← Inline.LowHalf[unsigned MOD base];
IF digit < 10
THEN digit ← digit + LOOPHOLE['0, NAT]
ELSE digit ← digit - 10 + LOOPHOLE['A, NAT];
accum[pos] ← LOOPHOLE[digit, CHARACTER];
pos ← pos + 1;
IF unsigned < base THEN EXIT;
unsigned ← unsigned / base;
ENDLOOP;
IF number < 0 AND signed THEN {
accum[pos] ← '-; pos ← pos + 1};
};

LocalParse: PRIVATE PROC
[fetch: Get, size: INT, pos: INT ← 0, template: Value]
RETURNS [value: Value, stop: INT] = TRUSTED {
negative: BOOLEAN ← FALSE;
c: CHARACTER ← 0C;
base: [2..36] ← 10;
overflow: BOOL ← FALSE;
empty: BOOL ← TRUE;
number: CARD ← 0;
signed: BOOL ← TRUE;
stop ← MIN[pos, size];
WITH v: template SELECT FROM
signed => base ← v.base;
unsigned => {base ← v.base; signed ← FALSE};
ENDCASE => ERROR;
value ← [error[empty]];

WHILE stop < size DO
c ← fetch[stop];
SELECT c FROM
'\t, '\n, 40C, 215C => stop ← stop + 1;
  ENDCASE => EXIT;
ENDLOOP;

IF c = '- THEN { -- a negative number
negative ← TRUE;
value ← [error[badFormat]];
IF (stop ← stop + 1) >= size THEN RETURN;
c ← fetch[stop]};

DO -- scan the digits and convert
digit: NAT ← c - 0C;
SELECT TRUE FROM
c IN ['0..'9] => digit ← digit - LOOPHOLE['0, NAT];
c IN ['A..'Z] => digit ← digit - LOOPHOLE['A, NAT] + 10;
c IN ['a..'z] => digit ← digit - LOOPHOLE['a, NAT] + 10;
ENDCASE => EXIT;
IF digit >= base THEN EXIT;
empty ← FALSE;
{low: CARD ← LONG[Inline.LowHalf[number]]*base + digit;
high: CARD ← LONG[Inline.HighHalf[number]]*base + Inline.HighHalf[low];
IF Inline.HighHalf[high] # 0 THEN overflow ← TRUE;
number ← number * base + digit};
IF (stop ← stop + 1) >= size THEN EXIT;
c ← fetch[stop];
ENDLOOP;
IF empty THEN RETURN;
IF overflow THEN GO TO over;
IF negative
THEN {
number ← - number;
IF signed AND LOOPHOLE[number, INT] > 0 THEN GO TO over}
ELSE {
IF signed AND LOOPHOLE[number, INT] < 0 THEN GO TO over};
WITH v: template SELECT FROM
signed => {value ← [signed[LOOPHOLE[number], base]]};
unsigned => {value ← [unsigned[number, base]]};
ENDCASE => ERROR;
EXITS over => value ← [error[overflow]];
};

LocalParseTime: PROC
[get: Get, size: INT, pos: INT, time: time Value]
RETURNS [value: Value, stop: INT] = TRUSTED {
GrabID: PROC = TRUSTED {
id.length ← 0;
term ← 40C;
invalid ← TRUE;
WHILE stop < size DO
c: CHAR ← get[stop];
SELECT c FROM
40C => stop ← stop + 1;
  ENDCASE => EXIT;
ENDLOOP;
pos ← stop;
WHILE stop < size DO
term ← get[stop];
SELECT TRUE FROM
(term IN ['a..'z]) => term ← LOOPHOLE[LOOPHOLE[term, CARDINAL]-32, CHAR];
(term IN ['A..'Z]) => NULL;
ENDCASE => EXIT;
invalid ← FALSE;
{sz: NAT ← id.length;
IF sz = id.maxLength THEN
{new: REF TEXT ← RefText.ObtainScratch[sz + 32];
RefText.Append[new, id];
RefText.ReleaseScratch[id];
id ← new};
id[sz] ← term;
id.length ← sz + 1};
stop ← stop + 1;
ENDLOOP;
WHILE stop < size AND (term ← get[stop]) = 40C DO stop ← stop + 1; ENDLOOP;
id.length ← 3};
GrabNum: PROC = TRUSTED {
num ← 0;
term ← 40C;
invalid ← TRUE;
WHILE stop < size DO
c: CHAR ← get[stop];
SELECT c FROM
40C => stop ← stop + 1;
  ENDCASE => EXIT;
ENDLOOP;
pos ← stop;
WHILE stop < size DO
IF (term ← get[stop]) NOT IN ['0..'9] THEN EXIT;
num ← num*10 + LOOPHOLE[term, CARDINAL]-LOOPHOLE['0, CARDINAL];
invalid ← FALSE;
stop ← stop + 1;
ENDLOOP;
WHILE stop < size AND (term ← get[stop]) = 40C DO stop ← stop + 1; ENDLOOP;
};
GrabTime: PROC = TRUSTED {
-- accept HH:MM:SS | HH:MM | HHMM | null
GrabNum[];
IF invalid THEN {
-- null format
invalid ← FALSE; RETURN};
IF term = ':
THEN {
-- HH:MM | HH:MM:SS format
IF num >= 24 THEN GO TO bad;
unpacked.hour ← num;
stop ← stop + 1;
GrabNum[]}
ELSE {
IF num < 2400 THEN {
-- HHMM format
unpacked.hour ← num / 100;
num ← num MOD 100};
};
-- check minute
IF invalid OR num NOT IN [0..60) THEN GO TO bad;
unpacked.minute ← num;
IF term = ': THEN {
-- HH:MM:SS format
stop ← stop + 1;
GrabNum[];
IF invalid OR num NOT IN [0..60) THEN GO TO bad;
unpacked.second ← num};
EXITS bad => invalid ← TRUE;
};
GrabDate: PROC = TRUSTED {
needYear: BOOL ← FALSE;
-- get day of month
GrabNum[];
SELECT TRUE FROM
invalid OR (num IN [1..12] AND term = '/) => {
-- first, process the month
IF invalid
THEN
{x: INTEGER;
GrabID[];
IF id.length # 3 THEN GO TO bad;
x ← RefText.Find[months, id, 0, FALSE];
IF x < 0 THEN GO TO bad;
num ← x / 4}
ELSE num ← num - 1;
unpacked.month ← num;
IF term = '/ THEN stop ← stop + 1;
-- process the day
GrabNum[];
IF num NOT IN [1..31] THEN GO TO bad;
unpacked.day ← num;
IF term = '/ THEN {needYear ← TRUE; stop ← stop + 1};
};
num IN [1..31] AND (term = '- OR term = 40C OR
term IN ['A..'Z] OR term IN ['a..'z]) => {
-- first, process the day
unpacked.day ← num;
IF term = '- THEN stop ← stop + 1;
-- next, get the month
GrabID[];
IF invalid
THEN {GrabNum[]; num ← num - 1}
ELSE {
x: INTEGER ← RefText.Find[months, id, 0, FALSE];
IF x < 0 OR id.length # 3 THEN GO TO bad;
num ← x / 4};
IF invalid OR num NOT IN [0..12) THEN GO TO bad;
unpacked.month ← num;
IF term = '- THEN {needYear ← TRUE; stop ← stop + 1};
};
term = ': AND time.useTime => {stop ← pos; RETURN};
ENDCASE => GO TO bad;

-- get year (optional, default: this year)
IF term = ', THEN {needYear ← TRUE; stop ← stop + 1};
GrabNum[];
IF invalid THEN {invalid ← needYear; RETURN};
IF term = ': AND time.useTime THEN {stop ← pos; invalid ← needYear; RETURN};
IF num NOT IN [0..2050] THEN GO TO bad;
IF num < 100 THEN num ← (IF num < 50 THEN num + 2000 ELSE num + 1900);
unpacked.year ← num;
EXITS
bad => invalid ← TRUE
};
num: CARDINAL ← 0;
term: CHAR ← 40C;
id: REF TEXT ← RefText.ObtainScratch[32];
invalid: BOOL ← TRUE;

months: REF READONLY TEXT = "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ";
unpacked: Time.Unpacked ← Time.Unpack[]; -- get current unpacked time
{unpacked.hour ← 0; unpacked.minute ← 0; unpacked.second ← 0;
value ← [error[badFormat]];
stop ← pos;
WHILE stop < size DO
c: CHAR ← get[stop];
SELECT c FROM
'\t, '\n, 40C, 215C => stop ← stop + 1;
  ENDCASE => EXIT;
ENDLOOP;
IF time.useDate THEN {
GrabDate[];
IF invalid THEN GO TO bye;
};
IF time.useTime THEN {
GrabTime[];
IF invalid THEN GO TO bye;
};
IF time.useZone THEN {
STzones: REF READONLY TEXT = "AECMPYH"; -- zones 4..10
zone: CARDINAL ← 0;
GrabID[];
IF invalid THEN time.useZone ← FALSE ELSE {
IF id.length # 3 OR id[2] # 'T THEN GO TO bye;
SELECT id[1] FROM
'S => unpacked.dst ← FALSE;
'D => unpacked.dst ← TRUE;
ENDCASE => RETURN;
term ← id[0];
FOR i: NAT IN [0..STzones.length) DO
IF term = STzones[i] THEN {zone ← 4 + i; EXIT};
ENDLOOP;
IF zone = 0 THEN GO TO bye;
unpacked.zone ← zone};
};
time.time ← Time.Pack[unpacked, NOT time.useZone ! ANY => GO TO bye];
value ← time;
EXITS bye => {}};
RefText.ReleaseScratch[id];
};

END.