home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / ICHARTP.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  19.5 KB  |  590 lines
  1. ############################################################################
  2. #
  3. #    File:     ichartp.icn
  4. #
  5. #    Subject:  Procedures for a simple chart parser
  6. #
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     September 2, 1992
  10. #
  11. ###########################################################################
  12. #
  13. #    Version:  1.7
  14. #
  15. ###########################################################################
  16. #
  17. #  General:
  18. #
  19. #      Ichartp implements a simple chart parser - a slow but
  20. #  easy-to-implement strategy for parsing context free grammars (it
  21. #  has a cubic worst-case time factor).  Chart parsers are flexible
  22. #  enough to handle a lot of natural language constructs.  They also
  23. #  lack many of the troubles associated with empty and left-recursive
  24. #  derivations.  To obtain a parse, just create a BNF file, obtain a
  25. #  line of input, and then invoke parse_sentence(sentence,
  26. #  bnf_filename, start-symbol).  Parse_sentence suspends successive
  27. #  edge structures corresponding to possible parses of the input
  28. #  sentence.  There is a routine called edge_2_tree() that converts
  29. #  these edges to a more standard form.  See the stub main() procedure
  30. #  for an example of how to make use of all these facilities.
  31. #
  32. #  Implementation details:
  33. #
  34. #      The parser itself operates in bottom-up fashion, but it might
  35. #  just as well have been coded top-down, or for that matter as a
  36. #  combination bottom-up/top-down parser (chart parsers don't care).
  37. #  The parser operates in breadth-first fashion, rather than walking
  38. #  through each alternative until it is exhausted.  As a result, there
  39. #  tends to be a pregnant pause before any results appear, but when
  40. #  they appear they come out in rapid succession.  To use a depth-first
  41. #  strategy, just change the "put" in "put(ch.active, new_e)" to read
  42. #  "push."  I haven't tried to do this, but it should be that simple
  43. #  to implement.
  44. #      BNFs are specified using the same notation used in Griswold &
  45. #  Griswold, and as described in the IPL program "pargen.icn," with
  46. #  the following difference:  All metacharacters (space, tab, vertical
  47. #  slash, right/left parends, brackets and angle brackets) are
  48. #  converted to literals by prepending a backslash.  Comments can be
  49. #  include along with BNFs using the same notation as for Icon code
  50. #  (i.e. #-sign).
  51. #
  52. #  Gotchas:
  53. #
  54. #      Pitfalls to be aware of include things like <L> ::= <L> | ha |
  55. #  () (a weak attempt at a laugh recognizer).  This grammar will
  56. #  accept "ha," "ha ha," etc. but will suspend an infinite number of
  57. #  possible parses.  The right way to do this sort of thing is <L> ::=
  58. #  ha <S> | ha, or if you really insist on having the empty string as
  59. #  a possibility, try things like:
  60. #
  61. #          <S>      ::= () | <LAUGHS>
  62. #          <LAUGHS> ::= ha <LAUGHS> | ha
  63. #
  64. #  Of course, the whole problem of infinite parses can be avoided by
  65. #  simply invoking the parser in a context where it is not going to
  66. #  be resumed, or else one in which it will be resumed a finite number
  67. #  of times.
  68. #
  69. #  Motivation:
  70. #
  71. #      I was reading Byte Magazine (vol. 17:2 [February, 1992]), and
  72. #  ran into an article entitled "A Natural Solution" (pages 237-244)
  73. #  in which a standard chart parser was described in terms of its C++
  74. #  implementation.  The author remarked at how his optimizations made
  75. #  it possible to parse a 14-word sentence in only 32 seconds (versus
  76. #  146 for a straight Gazdar-Mellish LISP chart parser).  32 seconds
  77. #  struck me as hardly anything to write home about, so I coded up a
  78. #  quick system in Icon to see how it compared.  This library is the
  79. #  result.
  80. #      I'm quite sure that this code could be very much improved upon.
  81. #  As it stands, its performance seems as good as the C++ parser in
  82. #  BYTE, if not better.  It's hard to tell, though, seeing as I have
  83. #  no idea what hardware the guy was using.  I'd guess a 386 running
  84. #  DOS.  On a 386 running Xenix the Icon version beats the BYTE times
  85. #  by a factor of about four.  The Icon compiler creates an executable
  86. #  that (in the above environment) parses 14-15 word sentences in
  87. #  anywhere from 6 to 8 seconds.  Once the BNF file is read, it does
  88. #  short sentences in a second or two.  If I get around to writing it,
  89. #  I'll probably use the code here as the basic parsing engine for an
  90. #  adventure game my son wants me to write.
  91. #
  92. ############################################################################
  93. #
  94. #  Links: structs, slashbal, rewrap, strip, stripcom (ximage for debugging)
  95. #
  96. ############################################################################
  97. #
  98. #  Requires:  co-expressions
  99. #
  100. ############################################################################
  101. #
  102. #       Here's a sample BNF file (taken, modified, from the BYTE
  103. #  Magazine article mentioned above).  Note again the conventions a)
  104. #  that nonterminals be enclosed in angle brackets & b) that overlong
  105. #  lines be continued by terminating the preceding line with a
  106. #  backslash.  Although not illustrated below, the metacharacters <,
  107. #  >, (, ), and | can all be escaped (i.e. can all have their special
  108. #  meaning neutralized) with a backslash (e.g. \<).  Comments can also
  109. #  be included using the Icon #-notation.  Empty symbols are illegal,
  110. #  so if you want to specify a zero-derivation, use "()."  There is an
  111. #  example of this usage below.
  112. #
  113. #  <S>    ::= <NP> <VP> | <S> <CONJ> <S>
  114. #  <VP>   ::= <VP> <CONJ> <VP> | <IV> ( () | <PP> ) | \
  115. #         <TV> ( <NP> | <NP> <PP> | <NP> <VP> | <REL> <S> )
  116. #  <NP>   ::= <DET> ( <NP> | <ADJ> <NP> | <ADJ> <NP> <PP> | <NP> <PP> ) | \
  117. #         <ADJ> <NP> | <N> | <N> <CONJ> <N> | \
  118. #         <NP> <CONJ> <NP>
  119. #  <PP>   ::= <P> ( <NP> | <ADJ> <NP> ) | <PP> <CONJ> <PP>
  120. #  <ADJ>  ::= <ADJ> <CONJ> <ADJ>
  121. #  <CONJ> ::= and
  122. #  <DET>  ::= the | a | his | her
  123. #  <NP>   ::= her | he | they
  124. #  <N>    ::= nurse | nurses | book | books | travel | arrow | arrows | \
  125. #        fortune | fortunes | report
  126. #  <ADJ>  ::= outrageous | silly | blue | green | heavy | white | red | \
  127. #        black | yellow
  128. #  <IV>   ::= travel | travels | report | see | suffer
  129. #  <TV>   ::= hear | see | suffer
  130. #  <P>    ::= on | of
  131. #  <REL>  ::= that
  132. #
  133. ############################################################################
  134.  
  135. # I use ximage for debugging purposes.
  136. link structs, slashbal, rewrap, strip, stripcom#, ximage
  137.  
  138. record stats(edge_list, lhs_table, term_set)
  139. record chart(inactive, active)               # inactive - set; active - list
  140. record retval(no, item)
  141.  
  142. record edge(LHS, RHS, LEN, DONE, BEG, END, SEEN)
  143. record short_edge(LHS, RHS)
  144.  
  145. #
  146. # For debugging only.
  147. #
  148. #procedure main(a)
  149. #
  150. #    local res, filename, line
  151. #    # &trace := -1
  152. #    filename := \a[1] | "bnfs.byte"
  153. #    while line := read(&input) do {
  154. #    res := &null
  155. #        every res := parse_sentence(line, filename, "S") do {
  156. #            if res.no = 0 then
  157. #            write(stree(edge2tree(res.item)))
  158. ##            write(ximage(res.item))
  159. #        else if res.no = 1 then {
  160. #        write("hmmm")
  161. #        write(stree(edge2tree(res.item)))
  162. #        }
  163. #        }
  164. #    /res & write("can't parse ",line)
  165. #    }
  166. #
  167. #end
  168.  
  169.  
  170. #
  171. # parse_sentence:  string x string -> edge records
  172. #                  (s, filename) -> Es
  173. #     where s is a chunk of text presumed to constitute a sentence
  174. #     where filename is the name of a grammar file containing BNFs
  175. #     where Es are edge records containing possible parses of s
  176. #
  177. procedure parse_sentence(s, filename, start_symbol)
  178.  
  179.     local file, e, i, elist, ltbl, tset, ch, tokens, st, 
  180.         memb, new_e, token_set, none_found, active_modified
  181.     static master, old_filename
  182.     initial master := table()
  183.  
  184.     #
  185.     # Initialize and store stats for filename (if not already stored).
  186.     #
  187.     if not (filename == \old_filename) then {
  188.         file := open(filename, "r") | p_err(filename, 7)
  189.         #
  190.         # Read BNFs from file; turn them into edge structs, and
  191.         # store them all in a list; insert terminal symbols into a set.
  192.         #
  193.         elist := list(); ltbl := table(); tset := set()
  194.         every e := bnf_file_2_edges(file) do {
  195.             put(elist, e)                      # main edge list (active)
  196.             (/ltbl[e.LHS] := set([e])) | insert(ltbl[e.LHS], e) # index LHSs
  197.             every i := 1 to e.LEN do           # LEN holds length of e.RHS
  198.                 if /e.RHS[i].RHS then          # RHS for terminals is null
  199.                     insert(tset, e.RHS[i].LHS)
  200.         }
  201.         insert(master, filename, stats(elist, ltbl, tset))
  202.         old_filename := filename
  203.         close(file)
  204.     }
  205.     elist := fullcopy(master[filename].edge_list)
  206.     ltbl  := fullcopy(master[filename].lhs_table)
  207.     tset  := master[filename].term_set
  208.     
  209.     #
  210.     # Make edge list into the active section of chart; tokenize the
  211.     # sentence s & check for unrecognized terminals.
  212.     #
  213.     ch := chart(set(), elist)
  214.     tokens := tokenize(s)
  215.  
  216.     #
  217.     # Begin parse by entering all tokens in s into the inactive set
  218.     # in the chart as edges with no RHS (a NULL RHS is characteristic
  219.     # of all terminals).
  220.     #
  221.     token_set := set(tokens)
  222.     every i := 1 to *tokens do {
  223.         # Flag words not in the grammar as errors.
  224.         if not member(tset, tokens[i]) then
  225.             suspend retval(1, tokens[i])
  226.         # Now, give us an inactive edge corresponding to word i.
  227.         insert(ch.inactive, e := edge(tokens[i], &null, 1, 1, i, i+1))
  228.         # Insert word i into the LHS table.
  229.         (/ltbl[tokens[i]] := set([e])) | insert(ltbl[tokens[i]], e)
  230.     # Watch out for those empty RHSs.
  231.     insert(ch.inactive, e := edge("", &null, 1, 1, i, i))
  232.         (/ltbl[""] := set([e])) | insert(ltbl[""], e)
  233.     }
  234.     *tokens = 0 & i := 0
  235.     insert(ch.inactive, e := edge("", &null, 1, 1, i+1, i+1))
  236.     (/ltbl[""] := set([e])) | insert(ltbl[""], e)
  237.  
  238.     #
  239.     # Until no new active edges can be built, keep ploughing through
  240.     # the active edge list, trying to match unconfirmed members of their
  241.     # RHSs up with inactive edges.
  242.     #
  243.     until \none_found do {
  244. #    write(ximage(ch))
  245.         none_found := 1
  246.         every e := !ch.active do {
  247.             active_modified := &null
  248.             # keep track of inactive edges we've already tried
  249.             /e.SEEN := set()
  250.             #
  251.             # e.RHS[e.DONE+1] is the first unconfirmed category in the
  252.             # RHS of e; ltbl[e.RHS[e.DONE+1].LHS] are all edges having
  253.             # as their LHS the LHS of the first unconfirmed category in
  254.             # e's RHS; we simply intersect this set with the inactives,
  255.             # and then subtract out those we've seen before in connec-
  256.             # tion with this edge -
  257.             #
  258.             if *(st := \ltbl[e.RHS[e.DONE+1].LHS] ** ch.inactive -- e.SEEN) > 0
  259.             then {
  260.                 # record all the inactive edges being looked at as seen
  261.                 e.SEEN ++:= st
  262.                 every memb := !st do {
  263.             # make sure this inactive edge starts where the
  264.             # last confirmed edge in e.RHS ends!
  265.             if memb.BEG ~= \e.RHS[e.DONE].END then next
  266.             # set none_found to indicate we've created a new edge
  267.             else none_found := &null
  268.                     # create a new edge, having the LHS of e, the RHS of e,
  269.                     # the start point of e, the end point of st, and one more
  270.                     # confirmed RHS members than e
  271.                     new_e := edge(e.LHS, fullcopy(e.RHS),
  272.                   e.LEN, e.DONE+1, e.BEG, memb.END)
  273.                     new_e.RHS[new_e.DONE] := memb
  274.                     /new_e.BEG := memb.BEG
  275.                     if new_e.LEN = new_e.DONE then {      # it's inactive
  276.                         insert(ch.inactive, new_e)
  277.                         insert(ltbl[e.LHS], new_e)
  278.                         if new_e.BEG = 1 & new_e.END = (*tokens+1) then {
  279.                             if new_e.LHS == start_symbol  # complete parse
  280.                             then suspend retval(0, new_e)
  281.                         }
  282.                     } else {
  283.                         put(ch.active, new_e)            # it's active
  284.                         active_modified := 1
  285.                     }
  286.                 }
  287.             }
  288.             # restart if the ch.active list has been modified
  289.             if \active_modified then break next
  290.         }
  291.     }
  292.  
  293. end
  294.  
  295.  
  296. #
  297. # tokenize:  break up a sentence into constituent words, using spaces,
  298. #            tabs, and other punctuation as separators (we'll need to
  299. #            change this a bit later on to cover apostrophed words)
  300. #
  301. procedure tokenize(s)
  302.  
  303.     local l, word
  304.  
  305.     l := list()
  306.     s ? {
  307.         while tab(upto(&letters)) do
  308.             put(l, map(tab(many(&letters))))
  309.     }
  310.     return l
  311.  
  312. end
  313.  
  314.  
  315. #
  316. # edge2tree:  edge -> tree
  317. #             e -> t
  318. #
  319. #    where e is an edge structure (active or inactive; both are okay)
  320. #    where t is a tree like what's described in Ralph Griswold's
  321. #    structs library (IPL); I don't know about the 2nd ed. of
  322. #    Griswold & Griswold, but the structure is described in the 1st
  323. #    ed. in section 16.1
  324. #
  325. #    fails if, for some reason, the conversion can't be made (e.g. the
  326. #    edge structure has been screwed around with in some way)
  327. #
  328. procedure edge2tree(e)
  329.  
  330.     local memb, t
  331.  
  332.     t := [e.LHS]
  333.     \e.RHS | (return t)                                 # a terminal
  334.     type(e) == "edge" | (return put(t, []))             # An incomplete edge
  335.     every memb := !e.RHS do                             # has daughters.
  336.     put(t, edge2tree(memb))
  337.     return t
  338.  
  339. end
  340.  
  341.  
  342. #
  343. # bnf_file_2_edges: concatenate backslash-final lines & parse
  344. #
  345. procedure bnf_file_2_edges(f)
  346.  
  347.     local getline, line
  348.  
  349.     getline := create stripcom(!f)
  350.     while line := @getline do {
  351.         while line ?:= 1(tab(-2) || tab(slashupto('\\')), pos(-1)) || @getline
  352.         suspend bnf_2_edges(line)
  353.     }
  354.  
  355. end
  356.  
  357.  
  358. #
  359. # bnf_2_edges: string -> edge records
  360. #              s -> Es (a generator)
  361. #    where s is a CFPSG rule in BNF form
  362. #    where Es are edges
  363. #
  364. procedure bnf_2_edges(s)
  365.     
  366.     local tmp, RHS, LHS
  367.     #
  368.     # Break BNF-style CFPSG rule into LHS and RHS.  If there is more
  369.     # than one RHS (a la the | alternation op), suspend multiple re-
  370.     # sults.
  371.     #
  372.     s ? {
  373.     # tab upto the ::= sign
  374.     tmp := (tab(slashupto(':')) || ="::=") | p_err(s, 1)
  375.     # strip non-backslashed spaces, and extract LHS symbol
  376.     stripspaces(tmp) ? {
  377.         LHS := 1(tab(slashbal(':', '<', '>')), ="::=") | p_err(s, 1)
  378.         LHS ?:= strip(2(="<", tab(-1), =">"), '\\') | p_err(s, 2)
  379.         LHS == "" & p_err(s, 6)
  380.     }
  381.         every RHS := do_slash(tab(0) \ 1) do {
  382.             RHS := string_2_list(RHS)
  383.             suspend edge(LHS, RHS, *RHS, 0, &null, &null)
  384.         }
  385.     }
  386.  
  387. end
  388.  
  389.  
  390. #
  391. # string_2_list:  string -> list
  392. #                 s -> L
  393. #    where L is a list of partially constructed (short) edges, having
  394. #    only LHS and RHS; in the case of nonterminals, the RHS is set
  395. #    to 1, while for terminals the RHS is null (and remains that way
  396. #    throughout the parse)
  397. #
  398. procedure string_2_list(s)
  399.  
  400.     local tmp, RHS_list, LHS
  401.  
  402.     (s || "\x00") ? {
  403.     tab(many(' \t'))
  404.         pos(-1) & (return [short_edge("", &null)])
  405.         RHS_list := list()
  406.         repeat {
  407.         tab(many(' \t'))
  408.         pos(-1) & break
  409.             if match("<") then {
  410.                 tmp := ("" ~== tab(slashbal(&cset, '<', '>'))) | p_err(s, 4)
  411.         LHS := stripspaces(tmp)
  412.                 LHS ?:= strip(2(="<", tab(-1), =">"), '\\') | p_err(s, 4)
  413.         LHS == "" & p_err(s, 10)
  414.                 put(RHS_list, short_edge(LHS, 1))
  415.             } else {
  416.                 LHS := stripspaces(tab(slashupto(' <') | -1))
  417.                 slashupto('>', LHS) & p_err(s, 5)
  418.                 put(RHS_list, short_edge(strip(LHS, '\\'), &null))
  419.             }
  420.         }
  421.     }
  422.     return RHS_list
  423.  
  424. end
  425.  
  426.  
  427. #
  428. # slashupto:  cset x string x integer x integer -> integers
  429. #             (c, s, i, j) -> Is (a generator)
  430. #    where Is are the integer positions in s[i:j] before characters
  431. #    in c that is not preceded by a backslash escape
  432. #
  433. procedure slashupto(c, s, i, j)
  434.  
  435.     if /s := &subject
  436.     then /i := &pos
  437.     else /i := 1
  438.     /j := *s + 1
  439.     
  440.     /c := &cset
  441.     c ++:= '\\'
  442.     s[1:j] ? {
  443.         tab(i)
  444.         while tab(upto(c)) do {
  445.             if (="\\", move(1)) then next
  446.             suspend .&pos
  447.             move(1)
  448.         }
  449.     }
  450.  
  451. end
  452.  
  453.  
  454. #
  455. # fullcopy:  make full recursive copy of object
  456. #
  457. procedure fullcopy(obj)
  458.  
  459.     local retval, i, k
  460.  
  461.     case type(obj) of {
  462.         "co-expression"  : return obj
  463.         "cset"           : return obj
  464.         "file"           : return obj
  465.         "integer"        : return obj
  466.         "list"           : {
  467.             retval := list(*obj)
  468.             every i := 1 to *obj do
  469.                 retval[i] := fullcopy(obj[i])
  470.             return retval
  471.         }
  472.         "null"           :  return &null
  473.         "procedure"      :  return obj
  474.         "real"           :  return obj
  475.         "set"            :  {
  476.             retval := set()
  477.             every insert(retval, fullcopy(!obj))
  478.             return retval
  479.         }
  480.         "string"         :  return obj
  481.         "table"          :  {
  482.             retval := table(obj[[]])
  483.             every k := key(obj) do
  484.                 insert(retval, fullcopy(k), fullcopy(obj[k]))
  485.             return retval
  486.         }
  487.         # probably a record; if not, we're dealing with a new
  488.         # version of Icon or a nonstandard implementation, and
  489.     # we're screwed
  490.         default          :  {
  491.             retval := copy(obj)
  492.             every i := 1 to *obj do
  493.                 retval[i] := fullcopy(obj[i])
  494.             return retval
  495.         }
  496.     }
  497.  
  498. end
  499.  
  500.  
  501. #
  502. # do_slash:  string -> string(s)
  503. #     Given a|b suspend a then b.  Used in conjunction with do_parends().
  504. #
  505. procedure do_slash(s)
  506.  
  507.     local chunk
  508.     s ? {
  509.     while chunk := tab(slashbal('|', '(', ')')) do {
  510.         suspend do_parends(chunk)
  511.         move(1)
  512.     }
  513.     suspend do_parends(tab(0))
  514.     }
  515.  
  516. end
  517.  
  518.  
  519. #
  520. # do_parends:  string -> string(s)
  521. #    Given a(b)c suspend abc; given a(b|c)d suspend abd and acd, etc.
  522. #    Used in conjuction with do_slash().
  523. #
  524. procedure do_parends(s)
  525.  
  526.     local chunk, i, j
  527.     s ? {
  528.     if not (i := slashupto('(')) then {
  529.         chunk := tab(0)
  530.         slashupto(')') & p_err(s, 8)
  531.         suspend chunk
  532.     } else {
  533.         j := i + slashbal(')', '(', ')', s[i+1:0]) | p_err(s, 9)
  534.         suspend tab(i) ||
  535.         (move(1), do_slash(tab(j))) ||
  536.         (move(1), do_parends(tab(0)))
  537.     }
  538.     }
  539.  
  540. end
  541.  
  542.  
  543. #
  544. # p_err:  print error message to stderr & abort
  545. #
  546. procedure p_err(s, n)
  547.  
  548.     local i, msg
  549.     static errlist
  550.     initial {
  551.         errlist := [[1,  "malformed LHS"],
  552.                     [2,  "nonterminal lacks proper <> enclosure"],
  553.                     [3,  "missing left angle bracket"],
  554.                     [4,  "unmatched left angle bracket"],
  555.                     [5,  "unmatched right angle bracket"],
  556.             [6,  "empty symbol in LHS"],
  557.                     [7,  "unable to open file"],
  558.                     [8,  "unmatched right parenthesis"],
  559.                     [9,  "unmatched left parenthesis"],
  560.                     [10, "empty symbol in RHS"]
  561.                    ]
  562.     }
  563.     every i := 1 to *errlist do
  564.         if errlist[i][1] = n then msg := errlist[i][2]
  565.     writes(&errout, "error ", n, " (", msg, ") in \n")
  566.     every write("\t", rewrap(s) | rewrap())
  567.     exit(n)
  568.  
  569. end
  570.  
  571.  
  572. #
  573. # Remove non-backslashed spaces and tabs.
  574. #
  575. procedure stripspaces(s)
  576.  
  577.     local s2
  578.  
  579.     s2 := ""
  580.     s ? {
  581.         while s2 ||:= tab(slashupto(' \t')) do
  582.             tab(many(' \t'))
  583.         s2 ||:= tab(0)
  584.     }
  585.  
  586.     return s2
  587.  
  588. end
  589.  
  590.