ktok/src/Main.m3


 Copyright (c) 2000 California Institute of Technology 
 All rights reserved. See the file COPYRIGHT for a full description. 
 $Id: Main.m3.html,v 1.3 2010-04-29 17:18:50 wagner Exp $ 

MODULE Main;
IMPORT tokformBundle, Bundle;
IMPORT TokParams;
IMPORT TokSpec;
IMPORT FileWr, Wr, Thread, OSError;
IMPORT TextWr;
IMPORT TextSubs;
IMPORT TextList;
IMPORT Pathname;
IMPORT Fmt;
IMPORT FmtTable;
IMPORT Term;
<* FATAL Thread.Alerted, Wr.Failure, OSError.E *>

VAR
  Form := tokformBundle.Get();

PROCEDURE FormatTypes(t: TextList.T; tokName, kind: TEXT): TEXT =
  VAR
    wr := TextWr.New();
    cur := t;
    subs: TextSubs.T;
  BEGIN
    WHILE cur # NIL DO
      subs := NEW(TextSubs.T).init();
      subs.add("%type", cur.head);
      subs.add("%tok", tokName);
      Wr.PutText(wr, subs.apply(Bundle.Get(Form, kind)));
      cur := cur.tail;
    END;
    RETURN TextWr.ToText(wr);
  END FormatTypes;

PROCEDURE FormatLegalConst(tok: TokSpec.T): TEXT =
  VAR
    dummy: TEXT;
    fmt := NEW(FmtTable.T).init();
  BEGIN
    FOR i := 1 TO tok.lastConstCode DO
      IF tok.constTokensR.get(i, dummy) THEN
        fmt.putInt(i);
      END;
    END;
    RETURN fmt.toText();
  END FormatLegalConst;

PROCEDURE FormatNamedConst(tok: TokSpec.T): TEXT =
  VAR
    cur := tok.tokens;
    name: TEXT;
    code: INTEGER;
    wr := TextWr.New();
  BEGIN
    WHILE cur # NIL DO
      name := cur.head;
      IF tok.constTokens.get(name, code) THEN
        Wr.PutText(wr, "    " & name & " = " & Fmt.Int(code) & ";\n");
      END;
      cur := cur.tail;
    END;
    RETURN TextWr.ToText(wr);
  END FormatNamedConst;

PROCEDURE Subs(tok: TokSpec.T; name: TEXT): TextSubs.T =
  VAR
    subs := NEW(TextSubs.T).init();
  BEGIN
    subs.add("\\\n", "");
    subs.add("%tok", name);
    subs.add("%type", FormatTypes(tok.varTokens, name, "tokform.type"));
    subs.add("%case", FormatTypes(tok.varTokens, name, "tokform.case"));
    subs.add("%constSet", FormatLegalConst(tok));
    subs.add("%constName", FormatNamedConst(tok));
    subs.add("%lastConst", Fmt.Int(tok.lastConstCode));
    subs.add("%gen", "(* Generated by ktok *)");
    RETURN subs;
  END Subs;

VAR
  tp := TokParams.Get("tok", ".t", "Tok.i3", FALSE);
  tok := TokParams.ReadTokens(tp);
  subs := Subs(tok, tp.outBase);
  wr: Wr.T;
BEGIN
  wr := FileWr.Open(tp.out);
  Wr.PutText(wr, subs.apply(Bundle.Get(Form, "tokform.i3")));
  Wr.Close(wr);

  wr := FileWr.Open(Pathname.ReplaceExt(tp.out, "m3"));
  Wr.PutText(wr, subs.apply(Bundle.Get(Form, "tokform.m3")));
  Wr.Close(wr);
END Main.