//
// File GRANAL.RF
//
// Project: GR
//

$use Access;
$use Arithm;
$use Compare;
$use Dos;
$use StdIO;

$use GrPrn;

$func  NTWithout  (e.NTL) (e.Rules) = e.Dead;
$func  EnvWith    (e.NTL) (e.Env) = e.Env;
$func  FindAlive  e.Rules = e.Alive;
$func  IterAlive  (e.Alive) (e.Rules) = e.Alive;
$func  NextAlive  (e.Alive) (e.Rules) = e.NextAlive;
$func  FindReachable  e.Rules = e.Reachable;
$func  IterReachable  (e.Reachable) (e.Rules) = e.Reachable;
$func  NextReachable  (e.Reachable) (e.Rules) = e.NextReachable;
$func  FindNullable  e.Rules = e.Nullable;
$func  IterNullable  (e.Nullable) (e.Rules) = e.Nullable;
$func  NextNullable  (e.Nullable) (e.Rules) = e.NextNullable;
$func? IsNullableRhs  (e.Nullable) (e.Rhs) = ;
$func  FindStarters  (e.Nullable) (e.Rules) = e.SEnv;
$func  IterStarters  (e.Nullable) (e.SEnv) (e.Rules) = e.SEnv;
$func  NextStarters  (e.Nullable) (e.SEnv) (e.Rules) = e.SEnv;
$func  RhsListStarters (e.Nullable) (e.SEnv) (e.L) = e.Starters;
$func  RhsStarters   (e.Nullable) (e.SEnv) (eR) = e.Starters;
$func  FindFollowers (e.Nullable) (e.SEnv) (e.Rules) = e.FEnv;
$func  IterFollowers (e.Nullable) (e.SEnv) (e.FEnv) (e.Rules) = e.SEnv;
$func  NextFollowers (e.Nullable) (e.SEnv) (e.FEnv) (e.Rules) = e.SEnv;
$func  RhsListFollowers s.N (e.Nullable) (e.SEnv) (e.FEnv) (e.L) = e.FEnv;
$func  RhsFollowers  sN (e.Nullable) (e.SEnv) (e.FEnv) (eR) = e.FEnv;
$func  UpdateFollowers sN (e.Nullable) (e.SEnv) (e.FEnv) sX (e.Rest) = e.FEnv;
$func  PrintAnnGrammar (e.Nullable) (e.SEnv) (e.FEnv) (e.Rules) = ;
$func  PrintAnnRules sC (e.Nullable) (e.SEnv) (e.FEnv) (e.S) sN (eL) = ;
$func  SetUnion   (eX) (eY) = eU;
$func  MkSet      e.List = e.Set;
$func  ExtractNT      e.RhsList = e.NTList;
$func  ExtractNTRhs  e.Rhs = e.NTList;
$func  RulesToEnv    e.Rules = e.Env;
$func  LookupEnv      sN (e.Env) = eV;
$func  UpdateEnv      sN (eV) (e.Env) = e.Env;

Analyze (e.Tokens) (e.Rules) =
// <PrintGrammar (e.Tokens) (e.Rules)>,
  <FindAlive e.Rules> :: e.Alive,
  <NTWithout (e.Alive) (e.Rules)> :: e.Dead,
  {
  e.Dead : ;
  <PrintCh &WriteFileCh "\nDead nonterminals:\n\n  ">,
    <PrintSet e.Dead>,<PrintLnCh &WriteFileCh "\n">,
    <Exit 1>;
  },
  <FindReachable e.Rules> :: e.Reachable,
  <NTWithout (e.Reachable) (e.Rules)> :: e.Unreachable,
  {
  e.Unreachable : ;
  <PrintCh &WriteFileCh "\nUnreachable nonterminals:\n\n  ">,
    <PrintSet e.Unreachable>,<PrintLnCh &WriteFileCh "\n">,
    <Exit 1>;
  },
  <FindNullable e.Rules> :: e.Nullable,
  {
  e.Nullable : ;
  <PrintCh &WriteFileCh "\nNullable nonterminals:\n\n  ">,
    <PrintSet e.Nullable>,<PrintLnCh &WriteFileCh "\n">;
  },
  e.Rules : (s.Start e) e,
  ("$START" ( (N s.Start) (T "$END") )) e.Rules :: e.Rules_,
  <FindStarters (e.Nullable) (e.Rules_)> :: e.SEnv,
  <PrintLnCh &WriteFileCh "\nThe starters of nonterminals:">,
  e.SEnv : t e.SEnv1,
  <PrintEnv e.SEnv1>,<PrintLnCh &WriteFileCh>,
  <FindFollowers (e.Nullable) (e.SEnv) (e.Rules_)> :: e.FEnv,
  <PrintLnCh &WriteFileCh "\nThe followers of nullable nonterminals:">,
  e.FEnv : t e.FEnv1,
  <EnvWith (e.Nullable) (e.FEnv1)> :: e.FEnv1,
  <PrintEnv e.FEnv1>,<PrintLnCh &WriteFileCh>,
  <PrintCh &WriteFileCh "\n*** Annotated grammar ***\n\n">,
  <PrintAnnGrammar (e.Nullable) (e.SEnv) (e.FEnv) (e.Rules)>
  ;

NTWithout (e.NTL) (e.Rules) =
  e.Rules :
  {
  = ;
  (s.N e) e.Rest =
    {
    e.NTL : e s.N e,
      = <NTWithout (e.NTL) (e.Rest)>;
      = s.N <NTWithout (e.NTL) (e.Rest)>;
    };
  };

EnvWith (e.NTL) (e.Env) =
  e.Env :
  {
  = ;
  (sN (eV)) e.Rest =
    {
    e.NTL : e sN e
      = (sN (eV)) <EnvWith (e.NTL) (e.Rest)>;
      = <EnvWith (e.NTL) (e.Rest)>;
    };
  };

FindAlive e.Rules =
  <IterAlive () (e.Rules)>;

IterAlive (e.Alive) (e.Rules) =
  <PrintLnCh &StdErr "Alive iteration ...">,
  <NextAlive (e.Alive) (e.Rules)> :: e.NextAlive,
  {
  e.Alive : e.NextAlive,
    = e.Alive;
    = <IterAlive (e.NextAlive) (e.Rules)>;
  };

NextAlive (e.Alive) (e.Rules) =
  e.Rules :
  {
  = e.Alive;
  (s.N e.L) e.Rest =
    {
    e.L : e (eR) e,
      # \{ eR : e (N sX) e, # \{ e.Alive : e sX e; }; },
      = <NextAlive (<SetUnion (e.Alive) (sN)>) (e.Rest)>;
    = <NextAlive (e.Alive) (e.Rest)>;
    };
  };

FindReachable e.Rules =
  e.Rules : (s.Start e) e,
  <IterReachable (s.Start) (e.Rules)>;

IterReachable (e.Reachable) (e.Rules) =
  <PrintLnCh &StdErr "Reachable iteration ...">,
  <NextReachable (e.Reachable) (e.Rules)> :: e.NextReachable,
  {
  e.Reachable : e.NextReachable,
    = e.Reachable;
    = <IterReachable (e.NextReachable) (e.Rules)>;
  };

NextReachable (e.Reachable) (e.Rules) =
  e.Rules :
  {
  = e.Reachable;
  (s.N e.L) e.Rest =
    {
    e.Reachable : e s.N e =
      <MkSet <ExtractNT e.L>> :: e.NewReachable,
      <SetUnion (e.Reachable) (e.NewReachable)> :: e.Reachable,
      = <NextReachable (e.Reachable) (e.Rest)>;
    = <NextReachable (e.Reachable) (e.Rest)>;
    };
  };

FindNullable e.Rules =
  <IterNullable () (e.Rules)>;

IterNullable (e.Nullable) (e.Rules) =
  <PrintLnCh &StdErr "Nullable iteration ...">,
  <NextNullable (e.Nullable) (e.Rules)> :: e.NextNullable,
  {
  e.Nullable : e.NextNullable,
    = e.Nullable;
    = <IterNullable (e.NextNullable) (e.Rules)>;
  };

NextNullable (e.Nullable) (e.Rules) =
  e.Rules :
  {
  = e.Nullable;
  (s.N e.L) e.Rest =
    {
    e.L : e (eR) e,
      <IsNullableRhs (e.Nullable) (eR)>,
      <SetUnion (e.Nullable) (s.N)> :: e.Nullable,
      = <NextNullable (e.Nullable) (e.Rest)>;
    = <NextNullable (e.Nullable) (e.Rest)>;
    };
  };

IsNullableRhs (e.Nullable) (eR) =
  # \{
  eR : e (T sX) e;
  eR : e (N sX) e, # \{ e.Nullable : e sX e; };
  };

FindStarters (e.Nullable) (e.Rules) =
  <RulesToEnv e.Rules> :: e.SEnv,
  <IterStarters (e.Nullable) (e.SEnv) (e.Rules)>;

IterStarters (e.Nullable) (e.SEnv) (e.Rules) =
  <PrintLnCh &StdErr "Starters iteration ...">,
  <NextStarters (e.Nullable) (e.SEnv) (e.Rules)> :: e.NextSEnv,
  {
  e.SEnv : e.NextSEnv,
    = e.SEnv;
    = <IterStarters (e.Nullable) (e.NextSEnv) (e.Rules)>;
  };

NextStarters (e.Nullable) (e.SEnv) (e.Rules) =
  e.Rules :
  {
  = e.SEnv;
  (s.N e.L) e.Rest =
    <RhsListStarters (e.Nullable) (e.SEnv) (e.L)> :: e.NewStarters,
    <LookupEnv s.N (e.SEnv)> :: e.OldStarters,
    <SetUnion (e.OldStarters) (e.NewStarters)> :: e.NewStarters,
    <UpdateEnv s.N (e.NewStarters) (e.SEnv)> :: e.SEnv,
      = <NextStarters (e.Nullable)(e.SEnv) (e.Rest)>;
  };

RhsListStarters (e.Nullable) (e.SEnv) (e.L) =
  e.L :
  {
  = ;
  (eR) e.Rest =
    <SetUnion ( <RhsStarters (e.Nullable) (e.SEnv) (eR)> )
               ( <RhsListStarters (e.Nullable) (e.SEnv) (e.Rest)> )>;
  };

RhsStarters (e.Nullable) (e.SEnv) (eR) =
  eR :
  {
  = ;
  (T sX) e.Rest = sX;
  (N sX) e.Rest =
    <LookupEnv sX (e.SEnv)> :: e.XStarters,
    {
    e.Nullable : e sX e =
      <SetUnion (e.XStarters)
                 ( <RhsStarters (e.Nullable) (e.SEnv) (e.Rest)> )>;
    = e.XStarters;
    };
  };

FindFollowers (e.Nullable) (e.SEnv) (e.Rules) =
  <RulesToEnv e.Rules> :: e.FEnv,
  <IterFollowers (e.Nullable) (e.SEnv) (e.FEnv) (e.Rules)>;

IterFollowers (e.Nullable) (e.SEnv) (e.FEnv) (e.Rules) =
  <PrintLnCh &StdErr "Followers iteration ...">,
  <NextFollowers (e.Nullable) (e.SEnv) (e.FEnv) (e.Rules)> :: e.NextFEnv,
  {
  e.FEnv : e.NextFEnv,
    = e.FEnv;
    = <IterFollowers (e.Nullable) (e.SEnv) (e.NextFEnv) (e.Rules)>;
  };

NextFollowers (e.Nullable) (e.SEnv) (e.FEnv) (e.Rules) =
  e.Rules :
  {
  = e.FEnv;
  (s.N e.L) e.Rest =
    <RhsListFollowers s.N (e.Nullable) (e.SEnv) (e.FEnv) (e.L)> :: e.FEnv,
      = <NextFollowers (e.Nullable) (e.SEnv) (e.FEnv) (e.Rest)>;
  };

RhsListFollowers s.N (e.Nullable) (e.SEnv) (e.FEnv) (e.L) =
  e.L :
  {
  = e.FEnv;
  (eR) e.Rest =
    <RhsFollowers s.N (e.Nullable) (e.SEnv) (e.FEnv) (eR)> :: e.FEnv,
    <RhsListFollowers s.N (e.Nullable) (e.SEnv) (e.FEnv) (e.Rest)>;
  };

RhsFollowers sN (e.Nullable) (e.SEnv) (e.FEnv) (eR) =
  eR :
  {
  = e.FEnv;
  (T sX) e.Rest
    = <RhsFollowers s.N (e.Nullable) (e.SEnv) (e.FEnv) (e.Rest)>;
  (N sX) e.Rest,
    <UpdateFollowers sN (e.Nullable) (e.SEnv) (e.FEnv) sX (e.Rest)>
      :: e.FEnv,
    = <RhsFollowers s.N (e.Nullable) (e.SEnv) (e.FEnv) (e.Rest)>;
  };

UpdateFollowers sN (e.Nullable) (e.SEnv) (e.FEnv) sX (e.Rest) =
  <LookupEnv sX (e.FEnv)> :: e.OldFollowers,
  <RhsStarters (e.Nullable) (e.SEnv) (e.Rest)> :: e.NewFollowers,
  <SetUnion (e.OldFollowers) (e.NewFollowers)> :: e.NewFollowers,
  {
  <IsNullableRhs (e.Nullable) (e.Rest)>
    = <SetUnion ( e.NewFollowers ) ( <LookupEnv sN (e.FEnv)> )>;
    = e.NewFollowers;
  } :: e.NewFollowers,
  <UpdateEnv sX (e.NewFollowers) (e.FEnv)>;

PrintAnnGrammar (e.Nullable) (e.SEnv) (e.FEnv) (e.Rules) =
  e.Rules :
  {
  = ;
  (sN eL) e.Rest =
    <PrintAnnSym (e.Nullable) sN><PrintLnCh &WriteFileCh>
    <PrintAnnRules ":" (e.Nullable) (e.SEnv) (e.FEnv) () sN (eL)>
    <PrintAnnGrammar (e.Nullable) (e.SEnv) (e.FEnv) (e.Rest)>;
  };

PrintAnnRules sC (e.Nullable) (e.SEnv) (e.FEnv) (e.S) sN (eL) =
  eL :
  {
  = <PrintLnCh &WriteFileCh ";\n">;
  (eR) e.Rest =
    <RhsStarters (e.Nullable) (e.SEnv) (eR)> :: e.Sel,
    {
    <IsNullableRhs (e.Nullable) (eR)>
      = <SetUnion (e.Sel) ( <LookupEnv sN (e.FEnv)> )>;
      = e.Sel;
    } :: e.Sel,
    <PrintCh &WriteFileCh sC><PrintCh &WriteFileCh " "><PrintSet e.Sel><PrintLnCh &WriteFileCh>,
    {
    e.S : e s0 e, e.Sel : e s0 e =
      <PrintLnCh &StdErr "*** Conflict !!! ***">,
      <PrintLnCh &WriteFileCh "*** Conflict !!! ***">;
      = ;
    },
    <SetUnion (e.S) (e.Sel)> :: e.S,
    <PrintCh &WriteFileCh "     "><PrintAnnRhs (e.Nullable) (eR)><PrintLnCh &WriteFileCh>,
    = <PrintAnnRules "|" (e.Nullable) (e.SEnv) (e.FEnv) (e.S) sN (e.Rest)>;
  };

SetUnion
  {
  () (eY) = eY;
  (eX) () = eX;
  (eX) (eY), eX : sA eX1, eY : sB eY1 =
    {
    <Lt (sA)(sB)> = sA <SetUnion (eX1) (eY)>;
    <Gt (sA)(sB)> = sB <SetUnion (eX)  (eY1)>;
                   = sA <SetUnion (eX1) (eY1)>;
    };
  };

MkSet  eS =
  <Length eS> :: sLen,
  {
  <Le (sLen) (1)>
    = eS;
    = <Div sLen 2> :: sK,
      <Left 0 sK eS> :: eS1,
      <Middle sK 0 eS> :: eS2,
        <SetUnion ( <MkSet eS1> )( <MkSet eS2> )>;
  };

ExtractNT
  {
  = ;
  (eR) e.Rest =
    <ExtractNTRhs eR> <ExtractNT e.Rest>;
  };

ExtractNTRhs
  {
  e (N s.N) e.Rest
    = s.N <ExtractNTRhs e.Rest>;
  e.Rest = ;
  };

RulesToEnv
  {
  = ;
  (sN e) e.Rest
    = (sN ()) <RulesToEnv e.Rest>;
  };

LookupEnv
  sN (e (sN (eV)) e) = eV;

UpdateEnv
  sN (eV) (e1 (sN (e)) e2) = e1 (sN (eV)) e2;