-- file MTEvalImpl.mesa rewritten by PGS, April 2, 1987 5:42:11 pm PST
-- file MTEvalImpl.mesa rewritten by PGS, 19-Jul-83 14:39
-- file MTEvalImpl.mesa rewritten by PGS, 15-Jul-83 16:21
-- file MTEvalImpl.mesa rewritten by PGS, 15-Jul-83 16:10
-- file MTEvalImpl.mesa rewritten by PGS, 15-Jul-83 16:07
-- file MTEvalImpl.mesa rewritten by PGS, 13-Jul-83 18:22
-- file MTEvalImpl.mesa rewritten by PGS, 13-Jul-83 18:19
-- file MTEvalImpl.mesa rewritten by PGS, 11-Jul-83 22:02
-- file MTEvalImpl.mesa rewritten by PGS, 11-Jul-83 13:12
-- file MTEvalImpl.mesa rewritten by PGS, 11-Jul-83 11:36
-- file MTEvalImpl.mesa rewritten by PGS,  7-Jul-83 17:10
-- file MTEvalImpl.mesa rewritten by PGS, 27-Jun-83 18:23
-- file MTEvalImpl.mesa rewritten by PGS, 16-Jun-83 12:03
-- file MTEvalImpl.mesa rewritten by PGS, 14-Jun-83 15:33
-- file MTEvalImpl.mesa

-- Last Edited by: HGM, March 3, 1984 10:46:50 pm PST
-- Last Edited by: Nichols, July 15, 1983 5:35 pm
-- last modified by Satterthwaite, June 2, 1983 12:45 pm
-- last edit by Schmidt, June 11, 1982 3:12 pm

-- pgs [defs: MTParseTable, bcd: MTParseData, grammar: MT] _ MTEvalImpl.mesa;

-- output: new version of MTEvalImpl.mesa, tables in MTParseData.bcd
-- interface on MTParseTable.mesa
-- log on PGS.Log, grammar on MT.Grammar,
-- errors on MTParseData.errlog

DIRECTORY
	List: TYPE USING [Nconc1, NthElement],
	MTMiscOps: TYPE USING [AToI, IToA, Substitute],
	MTP1: TYPE --P1-- USING [ActionStack, AddrSpecNode, DomainNode, DotWordsNode,
		InternalNode, LinkStack, MailboxNode, RouteAddrNode, RouteNode, TerminalNode, TValue,
		ValueStack],
	MTParseTable: TYPE ParseTable USING [ProdDataRef],
	Rope: TYPE USING [Cat, Equal, IsEmpty, Length, ROPE, SkipOver, Substr];
	
MTEvalImpl: CEDAR PROGRAM
		IMPORTS List, MTMiscOps, Rope
		EXPORTS MTP1 ~ {
	-- parse tree building
	OPEN P1~~MTP1, MTParseTable;

-- stores parse tree when done with parse

parseTree: REF ANY;

-- Set if the reduction routines had trouble and we should declare an invalid parse.

badSemantics: BOOLEAN;

-- local data base (supplied by parser)

v: P1.ValueStack;
l: P1.LinkStack;
q: P1.ActionStack;

prodData: ProdDataRef;

-- initialization/termination

AssignDescriptors: PUBLIC PROC[
	qd: P1.ActionStack,
	vd: P1.ValueStack, ld: P1.LinkStack,
	pp: ProdDataRef] ~ {
	q _ qd; v _ vd; l _ ld; prodData _ pp;};

EvalInit: PUBLIC PROC ~ {
	-- This routine should be called before a parse begins.  The parser will do this for you.
	parseTree _ NIL;
	badSemantics _ FALSE;
	};
	
-- Random

digits: Rope.ROPE ~ "0123456789";

-- Tree manipulation

CollectInternals: PROC [top, number: NAT] ~ {
	kids: P1.InternalNode;		-- LIST OF REF ANY
	
	kids _ LIST[v[top+number-1].t];
	FOR i: NAT DECREASING IN [top..top+number-1) DO
		kids _ CONS[v[i].t, kids];
		ENDLOOP;
	v[top].t _ kids;
	};



-- This procedure builds the parse tree.  It is called by the parser for each reduction to be
-- made.  In addition to building the tree, it does a few minor corrections for the extra
-- productions in the grammar.  In particular, a missing ";" is added to a group list, and extra
-- commas are removed from mailbox and address lists.

-- For dates, it does something else (more later).

-- The grammar here is really a pair of grammars, one for name lists and one for dates.
-- We put them together like this because it is pretty inconvenient to have two grammars
-- with pgs.  The name-dummy and date-dummy tokens are the first tokens returned by
-- the lexer in each case and are used to force the parser to parse a name list or a date.

ProcessQueue: PUBLIC PROC[qI, top: CARDINAL] ~ {
	FOR i: CARDINAL IN [0..qI) DO

		GetRule: PROC[n: CARDINAL] RETURNS [CARDINAL] ~ TRUSTED {
			RETURN [prodData[n].rule]};

		UnixProc1: PROC ~ {
			-- date-time ::= day month atom hour atom
			-- Unix date format.  Rearrange everything and fix up the year.
			time, date: LIST OF REF ANY;
			year: REF P1.TerminalNode _ NARROW[v[top+4].t];
			year.text _ year.text.Substr[year.text.Length[]-2, 2];
			time _ LIST[v[top+3].t];
			date _ LIST[v[top+2].t, v[top+1].t, year];
			v[top].t _ LIST[v[top].t, NEW[P1.TerminalNode _ [text~","]], date, time];
			};
			
		UnixProc2: PROC ~ {
			-- date-time ::= day month atom hour zone atom
			-- Unix date format.  Rearrange everything and fix up the year.
			time, date: LIST OF REF ANY;
			year: REF P1.TerminalNode _ NARROW[v[top+5].t];
			year.text _ year.text.Substr[year.text.Length[]-2, 2];
			time _ LIST[v[top+3].t, v[top+4].t];
			date _ LIST[v[top+2].t, v[top+1].t, year];
			v[top].t _ LIST[v[top].t, NEW[P1.TerminalNode _ [text~","]], date, time];
			};
			
		top _ top-q[i].tag.pLength+1;
		SELECT GetRule[q[i].transition] FROM

            0  => -- TABLE: MTParseData  TYPE: ParseTable  EXPORTS: SELF
				-- GOAL:  goal
				-- TERMINALS:
				--   name-dummy
				--   atom
				--   quoted-string
				--   domain-lit
				--   . , : ;
				--   @ < >
				--   eol
				--   error

				--   date-dummy
				--   ampm day month zone

				-- ALIASES:
				--   name-dummy nameDummy
				--   atom	atomTok
				--   quoted-string qStringTok
				--   domain-lit dLitTok
				--   . dotTok
				--   , commaTok
				--   : colonTok
				--   ; semiTok
				--   @ atSignTok
				--   <	lBracketTok
				--   > rBracketTok
				--   error	errorTok
				--   eol EOLTok

				--   date-dummy dateDummy
				--   ampm ampmTok
				--   day dayTok
				--   month monthTok
				--   zone zoneTok

				-- PRODUCTIONS:
				--   goal ::= name-dummy addr-list eol
					BEGIN
					CollectInternals[top+1, 2];		-- save the EOL, too.
					parseTree _ v[top+1].t;
					END;
           1  => -- goal ::= date-dummy date-time eol
					BEGIN
					CollectInternals[top+1, 2];		-- save the EOL, too.
					parseTree _ v[top+1].t;
					END;
           2  => -- address ::=
					v[top].t _ NIL;
           3  => -- address ::= mailbox
					NULL;
           4  => -- address ::= group
					NULL;
           5  => -- addr-list ::= address
					NULL;
           6  => -- addr-list ::= addr-list , address
					IF v[top+2].t # NIL THEN	-- only collect new address if non-empty
						CollectInternals[top, 3];
           7  => -- addr-spec ::= dot-words
					v[top].t _ NEW[P1.AddrSpecNode _ [localPart~v[top].t]];
           8  => -- addr-spec ::= addr-spec @ domain
					BEGIN
					t: REF P1.TerminalNode _ NARROW[v[top+1].t];
					d: REF P1.DomainNode _ NARROW[v[top+2].t];
					t.text _ "@";		-- make sure that we don't have "at"
					-- also zap white space from around the @
					t.whiteSpace _ NIL;
					WHILE d.domain # NIL DO
						d _ d.domain;
						ENDLOOP;
					d.subDomain.whiteSpace _ NIL;
					v[top].t _ NEW[P1.AddrSpecNode _ [localPart~v[top].t,
						atSign~t, domain~NARROW[v[top+2].t]]];
					END;
           9  => -- domain ::= sub-domain
					v[top].t _ NEW[P1.DomainNode _ [subDomain~NARROW[v[top].t]]];
          10  => -- domain ::= domain . sub-domain
					v[top].t _ NEW[P1.DomainNode _ [domain~NARROW[v[top].t],
						dot~NARROW[v[top+1].t], subDomain~NARROW[v[top+2].t]]];
          11  => -- dot-words ::= word
					v[top].t _ NEW[P1.DotWordsNode _ [word~NARROW[v[top].t]]];
          12  => -- dot-words ::= dot-words . word
					v[top].t _ NEW[P1.DotWordsNode _ [dotWords~NARROW[v[top].t],
						dot~NARROW[v[top+1].t], word~NARROW[v[top+2].t]]];
          13  => -- group ::= phrase : mailbox-list ;
					CollectInternals[top, 4];
          14  => -- group ::= phrase : mailbox-list
					BEGIN
					CollectInternals[top, 3];
					-- Add semicolon.
					v[top].t _ List.Nconc1[NARROW[v[top].t, LIST OF REF ANY],
						NEW[P1.TerminalNode _ [text~";"]]];
					END;
          15  => -- mailbox ::= addr-spec
					v[top].t _ NEW[P1.MailboxNode _ [address~v[top].t]];
          16  => -- mailbox ::= route-addr
					v[top].t _ NEW[P1.MailboxNode _ [address~v[top].t]];
          17  => -- mailbox ::= phrase route-addr
					v[top].t _ NEW[P1.MailboxNode _ [phrase~v[top].t, address~v[top+1].t]];
          18  => -- mailbox ::= @ dot-words
					BEGIN
					CollectInternals[top, 2];
					v[top].t _ NEW[P1.MailboxNode _ [address~v[top].t]];
					-- TODO: should hide structure of dl somehow.
					END;
          19  => -- mailbox-list ::=
					v[top].t _ NIL;
          20  => -- mailbox-list ::= mailbox
					NULL;
          21  => -- mailbox-list ::= mailbox-list ,
					NULL;		-- discard comma
          22  => -- mailbox-list ::= mailbox-list , mailbox
					IF v[top+2].t # NIL THEN	-- only collect new mailbox if non-empty
						CollectInternals[top, 3];
          23  => -- phrase ::= dot-words
					NULL;
          24  => -- phrase ::= phrase dot-words
					CollectInternals[top, 2];
          25  => -- route ::= @ domain
					v[top].t _ NEW[P1.RouteNode _ [atSign~NARROW[v[top].t],
						domain~NARROW[v[top+1].t]]];
          26  => -- route ::= route , @ domain
					v[top].t _ NEW[P1.RouteNode _ [route~NARROW[v[top].t],
						comma~NARROW[v[top+1].t], atSign~NARROW[v[top+2].t],
						domain~NARROW[v[top+3].t]]];
          27  => -- route-addr ::= < addr-spec >
					v[top].t _ NEW[P1.RouteAddrNode _ [lBrack~NARROW[v[top].t],
						addrSpec~NARROW[v[top+1].t], rBrack~NARROW[v[top+2].t]]];
          28  => -- route-addr ::= < route : addr-spec >
					v[top].t _ NEW[P1.RouteAddrNode _ [lBrack~NARROW[v[top].t],
						route~NARROW[v[top+1].t], colon~NARROW[v[top+2].t],
						addrSpec~NARROW[v[top+3].t], rBrack~NARROW[v[top+4].t]]];
          29  => -- sub-domain ::= atom
					NULL;
          30  => -- sub-domain ::= domain-lit
					NULL;
          31  => -- word ::= atom
					NULL;
          32  => -- word ::= quoted-string
					NULL;

          33  => -- date-time ::= date time
					CollectInternals[top, 2];
          34  => -- date-time ::= day date time
					BEGIN
					-- Add comma after day and treat like date-time ::= day , date time
					t: REF P1.TerminalNode _ NARROW[v[top].t];
					t.text _ t.text.Substr[0, 3];
					v[top].t _ LIST[v[top].t, NEW[P1.TerminalNode _ [text~","]], v[top+1].t,
						v[top+2].t];
					END;
          35  => -- date-time ::= day , date time
					BEGIN
					-- Day is supposed to be in 3-letter abbreviated form, so truncate it.
					t: REF P1.TerminalNode _ NARROW[v[top].t];
					t.text _ t.text.Substr[0, 3];
					CollectInternals[top, 4];
					END;
          36  => -- date-time ::= day , date , time
					BEGIN
					-- Remove comma after date and treat like date-time ::= day , date time
					t: REF P1.TerminalNode _ NARROW[v[top].t];
					t.text _ t.text.Substr[0, 3];
					-- Cheat!  Rather than chase down the tree to tack on the white space, we just
					-- leave the comma node in.
					t _ NARROW[v[top+3].t];
					t.whiteSpace _ " ";
					t.text _ NIL;
					CollectInternals[top, 5];
					END;
          37  => -- date-time ::= day month atom hour atom
					UnixProc1[];		--COMPILER--
          38  => -- date-time ::= day month atom hour zone atom
					UnixProc2[];		--COMPILER--
          39  => -- date ::= atom month atom
					BEGIN
					-- Month should be truncated to three letters.  Atom at end should be year
					-- in two digit form.
					t: REF P1.TerminalNode _ NARROW[v[top+1].t];
					t.text _ t.text.Substr[0, 3];
					t _ NARROW[v[top+2].t];
					IF t.text.Length[] < 2 OR t.text.SkipOver[skip: digits] # t.text.Length[] THEN
						badSemantics _ TRUE
					ELSE
						t.text _ t.text.Substr[t.text.Length[]-2, 2];
					CollectInternals[top, 3];
					END;
          40  => -- date ::= atom month . atom
					BEGIN
					-- Discard dot and handle as above.
					t: REF P1.TerminalNode _ NARROW[v[top+1].t];
					t.text _ t.text.Substr[0, 3];
					t _ NARROW[v[top+3].t];
					IF t.whiteSpace.IsEmpty THEN t.whiteSpace _ " ";
					IF t.text.Length[] < 2 OR t.text.SkipOver[skip: digits] # t.text.Length[] THEN
						badSemantics _ TRUE
					ELSE
						t.text _ t.text.Substr[t.text.Length[]-2, 2];
					v[top].t _ LIST[v[top].t, v[top+1].t, v[top+3].t];
					END;
          41  => -- date ::= atom
					BEGIN
					-- Most likely, we have a date of the form dd-mmm-yy, so replace the hyphens
					-- with spaces.
					t: REF P1.TerminalNode _ NARROW[v[top].t];
					t.text _ MTMiscOps.Substitute[t.text, '-, ' ];
					END;
          42  => -- time ::= hour zone
					CollectInternals[top, 2];
          43  => -- time ::= hour ampm zone
					BEGIN
					-- Flush ampm and adjust hour.
					t: REF P1.TerminalNode _
						NARROW[NARROW[v[top].t, LIST OF REF ANY].first];
					ampm: REF P1.TerminalNode _ NARROW[v[top+1].t];
					hour: INT _ MTMiscOps.AToI[t.text];
					-- To quote Taft: "If hour is not 12 then AM leaves it alone and PM adds 12.
					-- But if hour is 12 then AM sets it to zero and PM leaves it alone.  The
					-- following code actually sets it to zero and then adds 12 in the 12 PM case."
					IF hour = 12 THEN
						hour _ 0;
					IF ampm.text.Equal["pm", FALSE] THEN
						hour _ hour + 12;
					t.text _ MTMiscOps.IToA[hour];
					IF t.text.Length < 2 THEN
						-- pad it
						t.text _ Rope.Cat["0", t.text];
					v[top].t _ LIST[v[top].t, v[top+2].t];
					END;
          44  => -- time ::= hour
					BEGIN
					-- This comes from Tenex/Twenex format times, in which the zone is separated
					-- from the hour by a hyphen.  Replace hyphens with spaces.
					t: REF P1.TerminalNode _ NARROW[List.NthElement[NARROW[v[top].t], -1]];

					t.text _ MTMiscOps.Substitute[t.text, '-, ' ];
					END;
          45  => -- hour ::= atom : atom
					BEGIN
					-- Make sure we have numbers, but don't force last atom to, as it may have
					-- zone mixed in.
					t: REF P1.TerminalNode _ NARROW[v[top].t];
					t2: REF P1.TerminalNode _ NARROW[v[top+2].t];

					IF t.text.SkipOver[skip: digits] # t.text.Length[] THEN
						badSemantics _ TRUE;
					CollectInternals[top, 3];
					END;
          46  => -- hour ::= atom : atom : atom
					BEGIN
					-- Make sure we have numbers.
					t: REF P1.TerminalNode _ NARROW[v[top].t];
					t2: REF P1.TerminalNode _ NARROW[v[top+2].t];
					t3: REF P1.TerminalNode _ NARROW[v[top+4].t];

					IF t.text.SkipOver[skip: digits] # t.text.Length[] OR
							t2.text.SkipOver[skip: digits] # t2.text.Length[] THEN
						badSemantics _ TRUE;
					CollectInternals[top, 5];
					END;
          47  => -- hour ::= atom
					BEGIN
					-- Time is in 4-digit form: hhmm.  Convert to hh:mm.  There may be junk
					-- after the 4 digits (e.g. -zone) which is preserved.
					t: REF P1.TerminalNode _ NARROW[v[top].t];
					r: Rope.ROPE _ t.text;
					
					IF r.SkipOver[skip: digits] = 4 AND MTMiscOps.AToI[r.Substr[0,2]] <= 23 AND
							MTMiscOps.AToI[r.Substr[2,2]] <= 59 THEN
						v[top].t _ LIST[NEW[P1.TerminalNode _ [whiteSpace~t.whiteSpace,
								text~r.Substr[0, 2]]],
							NEW[P1.TerminalNode _ [text~ ":"]],
							NEW[P1.TerminalNode _ [text~ r.Substr[start: 2]]]]
					ELSE {
						badSemantics _ TRUE;
						v[top].t _ LIST[v[top].t];
						};
					END;
			ENDCASE =>  ERROR;

		ENDLOOP};



ProcessError: PUBLIC PROC [top: CARDINAL, inputValue: P1.TValue] = {
	CollectInternals[1, top];
	parseTree _ LIST[v[1].t, inputValue];
	};

GetEvalResult: PUBLIC PROC RETURNS [tree: REF ANY, badSemantics: BOOL] = {
	RETURN [parseTree, MTEvalImpl.badSemantics];
	};

}.