#
# $Id: parser.icn,v 1.1 2004-02-12 17:01:53 rparlett Exp $
#
# This file is in the public domain.
#
# Author: Robert Parlett (parlett@dial.pipex.com)
#
#
# Updated: Bruce Rennie - convert all standard Unicon functions to have "::" prefix
# Date:    2020-12-28
#
# Add additional output formats for the dump_tree procedure. Each format is shown
# as a comment for the relevant procedure.
#
# Change the standard Unicon function calls to have the :: prefix to ensure that
# any future additions to the package will not shadow the standard Unicon functions
# being used.
#
# Updated: Bruce Rennie - define all local variables as local, to prevent problems
#                         when using the Unicon compiler -n option
#                         Remove tree searching procedures as they are no longer
#                         used
# Date:    2021-01-03
#
package parser

link unigram, preproce, unilex

procedure parse_unicon(fname)
   yyin := ""
   /yydebug := 0
   every yyin ||:= preprocessor(fname, predefs()) do
      yyin ||:= "\n"
   ::write("parse_unicon(", ::image(fname), ") \nyyin:", yyin)
   yylex_reinit()
   yyout := &output
   rv := yyparse()
   if yynerrs > 0 then
      fail
   return yyval
end


procedure dump_node(n)
   if /n then
      ::write("EmptyNode")
   else if ::type(n) == "treenode" then {
      ::write("treenode : ", n.label, ", ", *n.children, " children")
   } else if type(n) == "token" then {
      ::write("token ", n.s)
   } else
      ::write("other ", ::image(n))
end

#PD:
#: dump_tree(root, variation) - print the parse tree represented by "root" with
#: the choice of how to display the tree by specifying a number between 0 and 6.
#: Each of these variations will be shown in the comments assocated with each of
#: the display procedures
#:
procedure dump_tree(root, variation)
   /variation := 0
   case variation of {
      0 : dump_tree0(root)
      1 : dump_tree1(root)
      2 : dump_tree2(root)
      3 : dump_tree3(root)
      4 : dump_tree4(root)
      5 : dump_tree5(root)
      6 : dump_tree6(root)
      default : dump_tree2(root)
   }
end

#PD:
#: dump_tree0(root, level, count)
#:
#:    |Start Column
#:    |-----------------------------------------
#:    |0:node("decls" : *children=2)
#:    |   1:node("package" : *children=1)
#:    |      1:node("lnkfile" : *children=1)
#:    |         1:parser
#:    |   2:node("class" : *children=8)
#:    |      1:DatabaseInfo
#:    |      2:node("supers" : *children=0)
#:    |      3:node("cparmlist" : *children=2)
#:    |         1:node("carg" : *children=2)
#:    |            1:node("priv" : *children=0)
#:    |            2:node("arg" : *children=1)
#:    |               1:name
#:    |         2:node("carg" : *children=2)
#:    |            1:node("priv" : *children=0)
#:    |            2:node("arg" : *children=1)
#:    |               1:directory
#:    |      4:node("semicolon" : *children=0)
#:
procedure dump_tree0(root, level, count)
   local i, j, e

   /level := 0
   /count := 0
   i := ::repl(" ", level * 3) || count || ":"
   if /root then {
      ::write(i, "EmptyNode")
   } else if ::type(root) == "treenode" then {
      ::write(i, "node(\"", root.label, "\" : *children=", *root.children, ")")
      j := 1
      every e := !root.children do  {
         dump_tree0(e, level + 1, j)
         j +:= 1
      }
   } else if ::type(root) == "token" then {
      ::write(i, root.s)
   } else
      ::write(i, ::image(root))
end

#PD:
#: dump_tree1(root, level, count, prefix1l, prefixfl, branch)
#:
#:    |Start Column
#:    |-----------------------------------------
#:    |--1:node("decls" : *children=2)
#:    |   +----1:node("package" : *children=1)
#:    |   |     +----1:node("lnkfile" : *children=1)
#:    |   |           +----1:parser
#:    |   +----2:node("class" : *children=8)
#:    |         +----1:DatabaseInfo
#:    |         +----2:node("supers" : *children=0)
#:    |         +----3:node("cparmlist" : *children=2)
#:    |         |     +----1:node("carg" : *children=2)
#:    |         |     |     +----1:node("priv" : *children=0)
#:    |         |     |     +----2:node("arg" : *children=1)
#:    |         |     |           +----1:name
#:    |         |     +----2:node("carg" : *children=2)
#:    |         |           +----1:node("priv" : *children=0)
#:    |         |           +----2:node("arg" : *children=1)
#:    |         |                 +----1:directory
#:    |         +----4:node("semicolon" : *children=0)
#:
procedure dump_tree1(root, level, count, prefix1l, prefixfl, branch)
   local i, j, e

   /level := 0
   /count := 1
   /prefix1l := ""
   /prefixfl := "   "
   /branch := ""
   i := prefix1l || branch || ::right(count, 3, "-") || ":"
   if /root then {
      ::write(i, "EmptyNode")
   } else if ::type(root) == "treenode" then {
      ::write(i, "node(\"", root.label, "\" : *children=", *root.children, ")")
      prefix1l := prefixfl
      every e := root.children[j := 1 to *root.children - 1] do  {
         dump_tree1(e, level + 1, j, prefix1l, prefixfl || "|     ", "+--")
      }
      dump_tree1(root.children[*root.children], level + 1, *root.children, prefix1l, prefixfl || "      ", "+--")
   } else if ::type(root) == "token" then {
      ::write(i, root.s)
   } else
      ::write(i, ::image(root))
end

#PD:
#: dump_tree2(root, level, count, prefix1l, prefixfl, branch)
#:
#:    |Start Column
#:    |-----------------------------------------
#:    |--1:node("decls" : *children=2)
#:    |   +--1:node("package" : *children=1)
#:    |   |   +--1:node("lnkfile" : *children=1)
#:    |   |       +--1:parser
#:    |   +--2:node("class" : *children=8)
#:    |       +--1:DatabaseInfo
#:    |       +--2:node("supers" : *children=0)
#:    |       +--3:node("cparmlist" : *children=2)
#:    |       |   +--1:node("carg" : *children=2)
#:    |       |   |   +--1:node("priv" : *children=0)
#:    |       |   |   +--2:node("arg" : *children=1)
#:    |       |   |       +--1:name
#:    |       |   +--2:node("carg" : *children=2)
#:    |       |       +--1:node("priv" : *children=0)
#:    |       |       +--2:node("arg" : *children=1)
#:    |       |           +--1:directory
#:    |       +--4:node("semicolon" : *children=0)
#:
procedure dump_tree2(root, level, count, prefix1l, prefixfl, branch)
   local i, j, e

   /level := 0
   /count := 1
   /prefix1l := ""
   /prefixfl := "   "
   /branch := ""
   i := prefix1l || branch || ::right(count, 3, "-") || ":"
   if /root then {
      ::write(i, "EmptyNode")
   } else if ::type(root) == "treenode" then {
      ::write(i, "node(\"", root.label, "\" : *children=", *root.children, ")")
      prefix1l := prefixfl
      every e := root.children[j := 1 to *root.children - 1] do  {
         dump_tree2(e, level + 1, j, prefix1l, prefixfl || "|   ", "+")
      }
      dump_tree2(root.children[*root.children], level + 1, *root.children, prefix1l, prefixfl || "    ", "+")
   } else if ::type(root) == "token" then {
      ::write(i, root.s)
   } else
      ::write(i, ::image(root))
end

#PD:
#: dump_tree3(root, level, count, prefix1l, prefixfl, branch)
#:
#:    |Start Column
#:    |-----------------------------------------
#:    |--1:node("decls")
#:    |   +--1:node("package")
#:    |   |   +--1:node("lnkfile")
#:    |   |       +--1:parser
#:    |   +--2:node("class")
#:    |       +--1:DatabaseInfo
#:    |       +--2:node("supers")
#:    |       +--3:node("cparmlist")
#:    |       |   +--1:node("carg")
#:    |       |   |   +--1:node("priv")
#:    |       |   |   +--2:node("arg")
#:    |       |   |       +--1:name
#:    |       |   +--2:node("carg")
#:    |       |       +--1:node("priv")
#:    |       |       +--2:node("arg")
#:    |       |           +--1:directory
#:    |       +--4:node("semicolon")
#:
procedure dump_tree3(root, level, count, prefix1l, prefixfl, branch)
   local i, j, e

   /level := 0
   /count := 1
   /prefix1l := ""
   /prefixfl := "   "
   /branch := ""
   i := prefix1l || branch || ::right(count, 3, "-") || ":"
   if /root then {
      ::write(i, "EmptyNode")
   } else if ::type(root) == "treenode" then {
      ::write(i, "node(\"", root.label, "\")")
      prefix1l := prefixfl
      every e := root.children[j := 1 to *root.children - 1] do  {
         dump_tree3(e, level + 1, j, prefix1l, prefixfl || "|   ", "+")
      }
      dump_tree3(root.children[*root.children], level + 1, *root.children, prefix1l, prefixfl || "    ", "+")
   } else if ::type(root) == "token" then {
      ::write(i, root.s)
   } else
      ::write(i, ::image(root))
end

#PD:
#: dump_tree4(root, level, count)
#:
#:    |Start Column
#:    |-----------------------------------------
#:    |0:node("decls")
#:    |   1:node("package")
#:    |      1:node("lnkfile")
#:    |         1:parser
#:    |   2:node("class")
#:    |      1:DatabaseInfo
#:    |      2:node("supers")
#:    |      3:node("cparmlist")
#:    |         1:node("carg")
#:    |            1:node("priv")
#:    |            2:node("arg")
#:    |               1:name
#:    |         2:node("carg")
#:    |            1:node("priv")
#:    |            2:node("arg")
#:    |               1:directory
#:    |      4:node("semicolon")
#:
procedure dump_tree4(root, level, count)
   local i, j, e

   /level := 0
   /count := 0
   i := ::repl(" ", level * 3) || count || ":"
   if /root then {
      ::write(i, "EmptyNode")
   } else if ::type(root) == "treenode" then {
      ::write(i, "node(\"", root.label, "\")")
      j := 1
      every e := !root.children do  {
         dump_tree4(e, level + 1, j)
         j +:= 1
      }
   } else if ::type(root) == "token" then {
      ::write(i, root.s)
   } else
      ::write(i, ::image(root))
end

#PD:
#: dump_tree5(root, level, count)
#:
#:    |Start Column
#:    |-----------------------------------------
#:    |0:node("decls"
#:    |   1:node("package"
#:    |      1:node("lnkfile"
#:    |         1:parser
#:    |   2:node("class"
#:    |      1:DatabaseInfo
#:    |      2:node("supers"
#:    |      3:node("cparmlist"
#:    |         1:node("carg"
#:    |            1:node("priv"
#:    |            2:node("arg"
#:    |               1:name
#:    |         2:node("carg"
#:    |            1:node("priv"
#:    |            2:node("arg"
#:    |               1:directory
#:    |      4:node("semicolon"
#:
procedure dump_tree5(root, level, count)
   local i, j, e

   /level := 0
   /count := 0
   i := ::repl(" ", level * 3) || count || ":"
   if /root then {
      ::write(i, "EmptyNode")
   } else if ::type(root) == "treenode" then {
      ::write(i, "node(\"", root.label, "\"")
      j := 1
      every e := !root.children do  {
         dump_tree5(e, level + 1, j)
         j +:= 1
      }
   } else if ::type(root) == "token" then {
      ::write(i, root.s)
   } else
      ::write(i, ::image(root))
end

#PD:
#: dump_tree6(root, level, count, prefix1l, prefixfl, branch)
#:
#:    |Start Column
#:    |-----------------------------------------
#:    |--1:node("decls"
#:    |   +--1:node("package"
#:    |   |   +--1:node("lnkfile"
#:    |   |       +--1:parser
#:    |   +--2:node("class"
#:    |       +--1:DatabaseInfo
#:    |       +--2:node("supers"
#:    |       +--3:node("cparmlist"
#:    |       |   +--1:node("carg"
#:    |       |   |   +--1:node("priv"
#:    |       |   |   +--2:node("arg"
#:    |       |   |       +--1:name
#:    |       |   +--2:node("carg"
#:    |       |       +--1:node("priv"
#:    |       |       +--2:node("arg"
#:    |       |           +--1:directory
#:    |       +--4:node("semicolon"
#:
procedure dump_tree6(root, level, count, prefix1l, prefixfl, branch)
   local i, j, e

   /level := 0
   /count := 1
   /prefix1l := ""
   /prefixfl := "   "
   /branch := ""
   i := prefix1l || branch || ::right(count, 3, "-") || ":"
   if /root then {
      ::write(i, "EmptyNode")
   } else if ::type(root) == "treenode" then {
      ::write(i, "node(\"", root.label, "\"")
      prefix1l := prefixfl
      every e := root.children[j := 1 to *root.children - 1] do  {
         dump_tree6(e, level + 1, j, prefix1l, prefixfl || "|   ", "+")
      }
      dump_tree6(root.children[*root.children], level + 1, *root.children, prefix1l, prefixfl || "    ", "+")
   } else if ::type(root) == "token" then {
      ::write(i, root.s)
   } else
      ::write(i, ::image(root))
end

procedure parsing_error(t)
   ::write(&errout, "something has gone wrong - we expected an identifier or a string literal",
                    "\nand we got something else instead: ", ::image(t))
end

