-- cyk.adb   Given a grammar, G, and a string, x, determine if x in L(G)
--
--           input string x of length n, n>0
--           CFG, context free grammar in Chomsky normal form
--           G = (V, T, P, S) where V is the set of variables
--               T is the set of terminal symbols, symbols in the string x
--               P is the set of productions of the forms A -> a  and A -> B C
--               which is Chomsky normal form, when A, B and C are variables
--               in V and 'a' is a variable in T, with exactly these two forms.
--
-- This algorithm is directly from
-- Introduction to Automata theory, Languages and computation by
-- Hopcroft and Ullman, pp 139-141. Much output and checking is also coded.
-- Set union is done with a simple linked list that allows duplicates.
-- This is a debug version, absolutely not efficently coded.
--
-- The output from this program is in the file cyk.out
--
-- Future, read in string x and compute n
--
-- Far Future, read in Grammar
--
-- Far, Far Future, read in Grammer and convert it to Chomsky normal form
--
-- Better idea, scrap this and use Bison
--

with Text_IO; use Text_IO;
procedure CYK is
  x : String(1..5) := "baaba"; -- input string
  n : Positive := x'length;    -- input string length

  type Variable is ('S', 'A', 'B', 'C'); -- the set V, S is first variable
  type Terminal is ('a', 'b');           -- the set T

  type Prod1 is  -- type of productions of form  A -> alpha
    record
      A : Variable;
      alpha : Terminal;
    end record;
  np1 : Positive := 3; -- number of productions of type Prod1
  type Prod1_array is array(Positive range 1..np1) of Prod1;
  P1 : Prod1_array
     := (('A', 'a'),    -- some specific set of type 1 productions
         ('B', 'b'),
         ('C', 'a'));

  type Prod2 is  -- type of productions of form  A -> B C
    record
      A : Variable;
      B : Variable;
      C : Variable;
    end record;
  np2 : Positive := 5; -- number of productions of type Prod2
  type Prod2_array is array(Positive range 1..np2) of Prod2;
  P2 : Prod2_array
     := (('S', 'A', 'B') , ('S', 'B', 'C'), -- some specific set of type 2
         ('A', 'B', 'A'),                   -- productions
         ('B', 'C', 'C'),
         ('C', 'A', 'B'));

  type List;
  type Productions is access List;
  type List is
    record
      v : Variable;
      next : Productions;
    end record;

  V : array(Positive range 1..n, Positive range 1..n) of Productions;
  Link : Productions; -- working variable
  B_OK : Boolean;
  C_OK : Boolean;
  Accepted : Boolean := False;

begin
  Put_Line("CYK starting");
  Put_Line("Input string x=" & x & " of length " & Integer'image(x'length));
  New_Line;
  Put_Line("Productions of type A -> a");
  for i in P1'range loop
    Put_Line(Variable'Image(P1(i).A) & " -> " &
             Terminal'Image(P1(i).alpha));
  end loop;
  New_Line;
  Put_Line("Productions of type A -> B C");
  for i in P2'range loop
    Put_Line(Variable'Image(P2(i).A) & " -> " &
             Variable'Image(P2(i).B) & "  " &
             Variable'Image(P2(i).C));
  end loop;
  New_Line;
  Put_Line("V the set of variables");
  for i in Variable loop
    Put(Variable'Image(i)); Put("  ");
  end loop;
  New_Line;
  Put_Line("T the set of terminals");
  for i in Terminal loop
    Put(Terminal'Image(i)); Put("  ");
  end loop;
  New_Line;
  Put_Line("All data is in");

  -- check that all symbols in x are terminals
  for i in x'range loop
    for a_term in Terminal loop
      exit when "'"&x(i)&"'" = Terminal'Image(a_term);
      if a_term = Terminal'Last then
        Put_Line("'"&x(i)&"'" & " from x is not a terminal symbol, trivial no accept");
      end if;
    end loop;
  end loop;

  -- be sure array is initialized to nulls
  for i in V'range(1) loop
    for J in V'range(2) loop
      V(i,j) := null;
    end loop;
  end loop;

  Put_Line("run CYK algorithm to build array");
  for i in 1..n loop  -- loop through the symbols in x
    for ip in P1'range loop      -- loop through type 1 productions
      if Terminal'Image(P1(ip).alpha) = "'"&x(i)&"'" then
        V(i,1) := new List'(P1(ip).A, V(i,1)); -- link this production
      end if;
    end loop;
  end loop;
  Put_Line("Finished first row of V table");
  for i in 1..n loop
    if V(i,1) /= null then
      Link := V(i,1);
      while Link /= null loop
        Put(Variable'Image(Link.v)); Put(" ");
        Link := Link.next;
      end loop;
    else
      Put("null ");
    end if;
    exit when i=n;
    Put(",");
  end loop;
  New_Line;

  for j in 2..n loop
    for i in 1..n-j+1 loop
      V(i,j) := null;
      for k in 1..j-1 loop
        for ip in P2'range loop
          B_OK := False;
          C_OK := False;
          if V(i,k) /= null then
            Link := V(i,k);
            while Link /= null loop
              if P2(ip).B = Link.v then
                B_OK := True;
                exit;
              end if;
              Link := Link.next;
            end loop;
          end if;
          if V(i+k,j-k) /= null then
            Link := V(i+k,j-k);
            while Link /= null loop
              if P2(ip).C = Link.v then
                C_OK := True;
                exit;
              end if;
              Link := Link.next;
            end loop;
          end if;
          if B_OK and C_OK then
            V(i,j) := new List'(P2(ip).A, V(i,j)); -- link this production
          end if;
        end loop;
      end loop;
    end loop;
    Put_Line("Finished " & Integer'Image(j) & " row of V table");
    for i in 1..n loop
      if V(i,j) /= null then
        Link := V(i,j);
        While Link /= null loop
          Put(Variable'Image(Link.v)); Put(" ");
          Link := Link.next;
        end loop;
      else
        Put("null ");
      end if;
      exit when i=n;
      Put(",");
    end loop;
    New_Line;
  end loop;
  -- finished building V table

  Put_Line("finish CYK algorithm, check for 'S' and thus Accepted ");
  New_Line;
  Link := V(1,n);
  while Link /= null loop
    if Link.v = 'S' then
      Accepted := True;
      exit;
    end if;
    Link := Link.next;
  end loop;
  if Accepted then
    Put_Line("x accepted by G, x is in L(G)");
  else
    Put_Line("x not accepted by G, x is not in L(G)");
  end if;
end CYK;