//
// File GRREAD.RF
//
// Project: GR
//

$use Class;
$use Convert;
$use Dos;
$use StdIO;

$use GrScn;
$use GrPrn;

$func  Parse         e.Chl = (e.Tokens) (e.Rules);
$func  Grammar       sC sI = sC sI (e.Tokens) (e.Rules);
$func  TokenSeq     sC sI (e.Tokens) = sC sI (e.Tokens);
$func  GroupSeq     sC sI (e.Groups) = sC sI (e.Groups);
$func  Group         sC sI = sC sI (e.Group);
$func  RhsSeq       sC sI (e.Group) = sC sI (e.Group);
$func  RhsSeqRest  sC sI (e.Group) = sC sI (e.Group);
$func  Rhs           sC sI (e.Rhs) = sC sI (e.Rhs);
$func? IsKeyword      s.KW sC sI    = sC sI ;
$func  Keyword       s.KW sC sI    = sC sI ;
$func? IsName         sC sI         = sC sI s.Name;
$func  Name          sC sI         = sC sI s.Name;

$func CheckGrammar (e.Tokens) (e.Rules) = ;
$func InsertTags   (e.Tokens) (e.Rules) = e.TaggedRules;
$func InsertTagsRhsList
                    (e.Tokens) (e.RhsList) = e.TaggedRhsList;
$func InsertTagsRhs
                    (e.Tokens) (e.Rhs) = e.TaggedRhs;

$channel Input;

ReadGrammar e.FileName =
  {
  <OpenFile &Input e.FileName "r">
    = ;
    = <PrintCh &StdErr "Unable to open file \"">,
      <PrintCh &StdErr e.FileName>,
      <PrintLnCh &StdErr "\"">,
      <Exit 1>;
  },
  <Parse &Input> :: (e.Tokens) (e.Rules),
  <CloseChannel &Input>,
  <CheckGrammar (e.Tokens) (e.Rules)>,
  (e.Tokens) (<InsertTags (e.Tokens) (e.Rules)>);

Parse  s.Chl =
  <InitScanner s.Chl>,
  <Grammar <ReadToken>> :: sC sI (e.Tokens) (e.Rules),
  <TermScanner>,
  {
  sC sI : Key Eof
    = ;
    = <WriteCh &StdErr sC sI>
      <PrintLnCh &StdErr " instead of Eof after the grammar">
      <Exit 1>;
  },
  = (e.Tokens) (e.Rules);

Grammar sC sI =
  <TokenSeq sC sI ()> :: sC sI (e.Tokens),
  <Keyword "%%" sC sI> :: sC sI,
  <GroupSeq sC sI ()> :: sC sI (e.Rules),
    = sC sI (e.Tokens) (e.Rules);

TokenSeq sC sI (e.Tokens) =
  {
  <IsName sC sI> :: sC sI s.Name
    = <TokenSeq sC sI (e.Tokens s.Name)>;
  <IsKeyword "%token" sC sI> :: sC sI
    = <TokenSeq sC sI (e.Tokens)>;
    = sC sI (e.Tokens);
  };

GroupSeq sC sI (e.Groups) =
  {
  sC sI : Key Eof
    = sC sI (e.Groups);
    = <Group sC sI> :: sC sI (e.Group),
      = <GroupSeq sC sI (e.Groups (e.Group))>;
  };

Group sC sI =
  <Name sC sI> :: sC sI s.Name,
  <Keyword ":" sC sI> :: sC sI,
  <RhsSeq sC sI (s.Name)> :: sC sI (e.Group),
  <Keyword ";" sC sI> :: sC sI
    = sC sI (e.Group);

RhsSeq sC sI (e.Group) =
  <Rhs sC sI ()> :: sC sI (e.Rhs)
  = <RhsSeqRest sC sI (e.Group (e.Rhs))>;

RhsSeqRest sC sI (e.Group) =
  {
  <IsKeyword "|" sC sI> :: sC sI
    = <Rhs sC sI ()> :: sC sI (e.Rhs),
      <RhsSeqRest sC sI (e.Group (e.Rhs))>;
    = sC sI (e.Group);
  };

Rhs sC sI (e.Rhs) =
  {
  <IsName sC sI> :: sC sI s.Name
    = <Rhs sC sI (e.Rhs s.Name)>;
    = sC sI (e.Rhs);
  };

IsKeyword  s.KW_ Key s.KW_
  = <ReadToken>;

Keyword s.KW sC sI =
  {
  sC sI : Key s.KW
    = ;
    = <WriteCh &StdErr sC sI>
      <PrintCh &StdErr " instead of ">
      <WriteLnCh &StdErr Key s.KW>
      <Exit 1>;
  },
  <ReadToken>;

IsName  Name sI
  = <ReadToken> sI;

Name  sC sI =
  {
  sC : Name
    = ;
    = <WriteCh &StdErr sC sI>
      <PrintLnCh &StdErr " instead of a name">
      <Exit 1>;
  },
  = <ReadToken> sI;

CheckGrammar (e.Tokens) (e.Rules) =
  {
  e.Rules : =
    <PrintLnCh &StdErr " The grammar is empty">
    <Exit 1>;
  e.Rules : e (s.NT e) e, e.Tokens : e s.NT e =
    <PrintCh &StdErr "Symbol "><WriteCh &StdErr s.NT>
    <PrintLnCh &StdErr " is a token and a non-terminal at the same time">
    <Exit 1>;
  e.Rules : e (s.NT e) e (s.NT e) e =
    <PrintCh &StdErr "Non-terminal "><WriteCh &StdErr s.NT>
    <PrintLnCh &StdErr " is defined twice">
    <Exit 1>;
  e.Rules : e (s e (e s.NT e) e) e,
    # \{ e.Tokens : e s.NT e; },
    # \{ e.Rules : e (s.NT e) e; } =
      <PrintCh &StdErr "Symbol "><WriteCh &StdErr s.NT>
      <PrintLnCh &StdErr " is not a token and is not a non-terminal">
      <Exit 1>;
  = ;
  };

InsertTags
  {
  (e.Tokens) () = ;
  (e.Tokens) ((s.N e.RhsList) e.Rules) =
    (s.N <InsertTagsRhsList (e.Tokens) (e.RhsList)>)
    <InsertTags (e.Tokens) (e.Rules)>;
  };

InsertTagsRhsList
  {
  (e.Tokens) () = ;
  (e.Tokens) ((e.Rhs) e.Rest) =
    (<InsertTagsRhs (e.Tokens) (e.Rhs)>)
    <InsertTagsRhsList (e.Tokens) (e.Rest)>;
  };

InsertTagsRhs (e.Tokens) (e.Rhs) =
  e.Rhs :
  {
  = ;
  s.Sym e.Rest,
    { e.Tokens : e s.Sym e = T; = N; } :: s.Tag,
    = (s.Tag s.Sym) <InsertTagsRhs (e.Tokens) (e.Rest)>;
  };