home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #31 / NN_1992_31.iso / spool / comp / lang / icon / 561 < prev    next >
Encoding:
Internet Message Format  |  1993-01-03  |  32.0 KB
  1. Path: sparky!uunet!spool.mu.edu!olivea!pagesat!spssig.spss.com!uchinews!ellis!goer
  2. From: goer@ellis.uchicago.edu (Richard L. Goerwitz)
  3. Newsgroups: comp.lang.icon
  4. Subject: parser generator, part 2
  5. Message-ID: <1993Jan3.211844.28467@midway.uchicago.edu>
  6. Date: 3 Jan 93 21:18:44 GMT
  7. Sender: news@uchinews.uchicago.edu (News System)
  8. Reply-To: goer@midway.uchicago.edu
  9. Organization: University of Chicago
  10. Lines: 926
  11.  
  12. ---- Cut Here and feed the following to sh ----
  13. #!/bin/sh
  14. # this is ibpag.02 (part 2 of a multipart archive)
  15. # do not concatenate these parts, unpack them in order with /bin/sh
  16. # file ibpag.icn continued
  17. #
  18. if test ! -r _shar_seq_.tmp; then
  19.     echo 'Please unpack part 1 first!'
  20.     exit 1
  21. fi
  22. (read Scheck
  23.  if test "$Scheck" != 2; then
  24.     echo Please unpack part "$Scheck" next!
  25.     exit 1
  26.  else
  27.     exit 0
  28.  fi
  29. ) < _shar_seq_.tmp || exit 1
  30. if test ! -f _shar_wnt_.tmp; then
  31.     echo 'x - still skipping ibpag.icn'
  32. else
  33. echo 'x - continuing file ibpag.icn'
  34. sed 's/^X//' << 'SHAR_EOF' >> 'ibpag.icn' &&
  35. X    write(f2, "\t\t    # be in, and push that state onto the state stack.")
  36. X    write(f2, "\t\t    #")
  37. X    write(f2, "\t\t    push(state_stack,")
  38. X    write(f2, "\t\t\t glst[state_stack[1]][act.sym])")
  39. X    write(f2, "\t\t    #")
  40. X    write(f2, "\t\t    # Call the code associated with the current")
  41. X    write(f2, "\t\t    # reduction, and push the result onto the stack.")
  42. X    write(f2, "\t\t    # For more results, push a coexpression instead.")
  43. X    write(f2, "\t\t    #")
  44. X    write(f2, "\t\t    push(value_stack, (proc(act.procname)!arglist)) | {")
  45. X    write(f2, "\t\t\t# On failure, return the stacks to the state")
  46. X    write(f2, "\t\t\t# they were just after the last reduction (i.e.")
  47. X    write(f2, "\t\t\t# before any tokens for the current production")
  48. X    write(f2, "\t\t\t# were pushed onto the stack).")
  49. X    write(f2, "\t\t\tpop(state_stack)")
  50. X    write(f2, "\t\t\treturn iparse_error(alst, state_stack, value_stack,")
  51. X    write(f2, "\t\t\t\t\t    token, next_token, err_state + 1)")
  52. X    write(f2, "\t\t    }")
  53. X    write(f2, "\t\t}")
  54. X    write(f2, "\t\t\"AC\"  :  {")
  55. X    write(f2, "\t\t    #")
  56. X    write(f2, "\t\t    # We're done.  Return the last result.")
  57. X    write(f2, "\t\t    #")
  58. X    write(f2, "\t\t    return value_stack[1]")
  59. X    write(f2, "\t        }")
  60. X    write(f2, "\t    }")
  61. X    write(f2, "\t}")
  62. X    write(f2, "    }")
  63. X    write(f2, "    write(&errout, \"iparse:  unexpected end of input\")")
  64. X    write(f2, "    fail")
  65. X    write(f2, "")
  66. X    write(f2, "end")
  67. X    write(f2, "")
  68. X    write(f2, "")
  69. X    write(f2, "#")
  70. X    write(f2, "# iparse_error:  list x list x list x TOK x coexpression x integer -> ?")
  71. X    write(f2, "#                (alst, state_stack, value_stack, token,")
  72. X    write(f2, "#\t\t\t                      next_token, err_state) -> ?")
  73. X    write(f2, "#")
  74. X    write(f2, "#     Where alst is the action list, where state_stack is the state")
  75. X    write(f2, "#     stack used by iparse, where value stack is the value stack used")
  76. X    write(f2, "#     by iparse, where token is the current lookahead TOK record,")
  77. X    write(f2, "#     where next_token is the coexpression from which we get our")
  78. X    write(f2, "#     tokens, and where err_state indicates how many recursive calls")
  79. X    write(f2, "#     we've made to the parser via the error handler without a")
  80. X    write(f2, "#     recovery.")
  81. X    write(f2, "#")
  82. X    write(f2, "#     Recursively calls iparse, attempting to restart the parser after")
  83. X    write(f2, "#     an error.  Increments global \"errors\" variable (a count of the")
  84. X    write(f2, "#     number of errors encountered, minus cascading series of errors).")
  85. X    write(f2, "#")
  86. X    write(f2, "procedure iparse_error(alst, state_stack, value_stack,")
  87. X    write(f2, "\t\t       token, next_token, err_state)")
  88. X    write(f2, "")
  89. X    write(f2, "    local sym, i, state_stack2, value_stack2, next_token2")
  90. X    write(f2, "    static tlst")
  91. X    write(f2, "    #global line_number, errors")
  92. X    write(f2, "    initial {")
  93. X    every lname := "tlst" do {
  94. X    encode(variable(lname)) ? {
  95. X        writes(f2, "\t", lname, " := decode(\"")
  96. X        if write(f2, move(47), "_") then {
  97. X        while write(f2, "\t    ",move(60), "_")
  98. X        write(f2, "\t    ", tab(0), "\")")
  99. X        }
  100. X        else write(f2, tab(0), "\")")
  101. X    }
  102. X    }
  103. X    write(f2, "    }")
  104. X    write(f2, "")
  105. X    write(f2, "    #")
  106. X    write(f2, "    # Check to see how many attempts we have made at a resync.  If")
  107. X    write(f2, "    # this is a new error series, increment the global \"errors\" count.")
  108. X    write(f2, "    #")
  109. X    write(f2, "    if err_state > 3 then {")
  110. X    write(f2, "\tif \\fail_on_error then fail")
  111. X    write(f2, "\telse stop(\"iparse_error:  unable to resync after error; aborting\")")
  112. X    write(f2, "    }")
  113. X    write(f2, "    if err_state = 1 then")
  114. X    write(f2, "\terrors +:= 1\t\t# errors is global")
  115. X    write(f2, "")
  116. X    write(f2, "    # If \"error\" is in tlst, then there are error productions in the")
  117. X    write(f2, "    # grammar.  See if we can back into one from here.  Don't try this")
  118. X    write(f2, "    # for error states greater than 1.  Otherwise we'll get a")
  119. X    write(f2, "    # cascading series of stack truncations.")
  120. X    write(f2, "    #")
  121. X    write(f2, "    if err_state = 1 then {")
  122. X    write(f2, "\tif member(tlst, \"error\") then {")
  123. X    write(f2, "\t    every i := 1 to 2 do {")
  124. X    write(f2, "\t\tif \\alst[state_stack[i]][\"error\"] then {")
  125. X    write(f2, "\t\t    state_stack2 := state_stack[i:0] | break")
  126. X    write(f2, "\t\t    value_stack2 := value_stack[i:0]")
  127. X    write(f2, "\t\t    next_token2  := create TOK(\"error\") | token | |@next_token")
  128. X    write(f2, "\t\t    return iparse(&null, state_stack2, value_stack2,")
  129. X    write(f2, "\t\t\t\t  next_token2, err_state)")
  130. X    write(f2, "\t\t}")
  131. X    write(f2, "\t    }")
  132. X    write(f2, "\t}")
  133. X    write(f2, "    }")
  134. X    write(f2, "")
  135. X    write(f2, "    if \\fail_on_error then fail")
  136. X    write(f2, "    #")
  137. X    write(f2, "    # Check to see if the grammar even has this pre-terminal.")
  138. X    write(f2, "    #")
  139. X    write(f2, "    if not member(tlst, token.sym) then {")
  140. X    write(f2, "\twrites(&errout, \"iparse_error:  unknown token, \", token.sym)")
  141. X    write(f2, "\twrite(\", in line \", 0 < \\line_number) | write()")
  142. X    write(f2, "    }")
  143. X    write(f2, "    # Only note the first in a series of cascading errors.")
  144. X    write(f2, "    else if err_state = 1 then {")
  145. X    write(f2, "\twrites(&errout, \"iparse_error:  syntax error\")")
  146. X    write(f2, "\twrite(\" line \", 0 < \\line_number) | write()")
  147. X    write(f2, "    }")
  148. X    write(f2, "")
  149. X    write(f2, "    #")
  150. X    write(f2, "    # Now, try to shift in the next input token to see if we can")
  151. X    write(f2, "    # resync the parser.  Stream argument is null because next_token")
  152. X    write(f2, "    # has already been created.")
  153. X    write(f2, "    #")
  154. X    write(f2, "    return iparse(&null, state_stack, value_stack, next_token, err_state)")
  155. X    write(f2, "")
  156. X    write(f2, "end")
  157. X    write(f2, "link structs")
  158. X    write(f2, "")
  159. X    write(f2, "#")
  160. X    write(f2, "# dump_lists:  file x list x list -> (null)")
  161. X    write(f2, "#              (f, gl, al)        -> (null)")
  162. X    write(f2, "#")
  163. X    write(f2, "#     Where f is an open file, gl is the goto list, and al is the")
  164. X    write(f2, "#     action list.  Writes to file f a human-readable dump of the goto")
  165. X    write(f2, "#     and action list.")
  166. X    write(f2, "#")
  167. X    write(f2, "procedure dump_lists(f, al, gl)")
  168. X    write(f2, "")
  169. X    write(f2, "    local TAB, look_list, red_list, i, sym, act")
  170. X    write(f2, "")
  171. X    write(f2, "    TAB := \"\\t\"")
  172. X    write(f2, "    look_list := list()")
  173. X    write(f2, "    red_list := list()")
  174. X    write(f2, "")
  175. X    write(f2, "    every i := 1 to *al do {")
  176. X    write(f2, "\tevery INSERT(look_list, key(\\al[i]))")
  177. X    write(f2, "\tif /al[i] then")
  178. X    write(f2, "\t    write(&errout, \"dump_lists:  warning!  state \", i, \" is null\")")
  179. X    write(f2, "    }")
  180. X    write(f2, "")
  181. X    write(f2, "    writes(f, TAB)")
  182. X    write(f2, "    every i := 1 to *look_list do")
  183. X    write(f2, "\twrites(f, look_list[i], TAB)")
  184. X    write(f2, "    write(f)")
  185. X    write(f2, "    every i := 1 to *al do {")
  186. X    write(f2, "\twrites(f, i, TAB)")
  187. X    write(f2, "\tact := \"\"")
  188. X    write(f2, "\tevery sym := !look_list do {")
  189. X    write(f2, "\t    if \\al[i][sym] then {")
  190. X    write(f2, "\t\t# al[i][sym][1] will fail for the accept action; hence")
  191. X    write(f2, "\t\t# the \"\".  Otherwise al[i][sym][1] selects that state")
  192. X    write(f2, "\t\t# field of a SH or RE record.")
  193. X    write(f2, "\t\twrites(f, map(type(al[i][sym])), al[i][sym][1] | \"\")")
  194. X    write(f2, "\t\tif type(al[i][sym]) == \"RE\" then {")
  195. X    write(f2, "\t\t    INSERT(red_list, al[i][sym].sym)")
  196. X    write(f2, "\t\t    writes(f, al[i][sym].sym)")
  197. X    write(f2, "\t\t}")
  198. X    write(f2, "\t    }")
  199. X    write(f2, "\t    writes(f,TAB)")
  200. X    write(f2, "\t}")
  201. X    write(f2, "\twrite(f)")
  202. X    write(f2, "    }")
  203. X    write(f2, "    write(f)")
  204. X    write(f2, "")
  205. X    write(f2, "    writes(f, TAB)")
  206. X    write(f2, "    every i := 1 to *red_list do")
  207. X    write(f2, "\twrites(f, red_list[i], TAB)")
  208. X    write(f2, "    write(f)")
  209. X    write(f2, "    every i := 1 to *gl do {")
  210. X    write(f2, "\twrites(f, i, TAB)")
  211. X    write(f2, "\tact := \"\"")
  212. X    write(f2, "\tevery sym := !red_list do {")
  213. X    write(f2, "\t    if \\(\\gl[i])[sym] then")
  214. X    write(f2, "\t\twrites(f, gl[i][sym])")
  215. X    write(f2, "\t    writes(f, TAB)")
  216. X    write(f2, "\t}")
  217. X    write(f2, "\twrite(f)")
  218. X    write(f2, "    }")
  219. X    write(f2, "")
  220. X    write(f2, "end")
  221. X    write(f2, "")
  222. X    write(f2, "#")
  223. X    write(f2, "# INSERT:  set or list x record -> set or list")
  224. X    write(f2, "# \t   (sset, rec)          -> sset")
  225. X    write(f2, "#")
  226. X    write(f2, "#     Where sset is a homogenous set or list of records, rec is a")
  227. X    write(f2, "#     record, and the return value is sset, with rec added, iff an")
  228. X    write(f2, "#     equivalent record was not there already.  Otherwise, sset is")
  229. X    write(f2, "#     returned unchanged. INSERT(), _unlike insert(), FAILS IF REC")
  230. X    write(f2, "#     IS ALREADY PRESENT IN SSET.")
  231. X    write(f2, "#")
  232. X    write(f2, "#     This procedure is used by dump_lists() above.  If you delete")
  233. X    write(f2, "#     dump_lists(), delete this as well, as also Equiv() below.")
  234. X    write(f2, "#")
  235. X    write(f2, "procedure INSERT(sset, rec)")
  236. X    write(f2, "")
  237. X    write(f2, "    local addto, Eq")
  238. X    write(f2, "    #")
  239. X    write(f2, "    # Decide how to add members to sset, depending on its type.")
  240. X    write(f2, "    #")
  241. X    write(f2, "\tcase type(sset) of {")
  242. X    write(f2, "\t    \"set\"   : { addto := insert; Eq := equiv }")
  243. X    write(f2, "\t    \"list\"  : { addto := put; Eq := Equiv }")
  244. X    write(f2, "\t    default : stop(\"INSERT:  wrong type argument (\",type(sset),\")\")")
  245. X    write(f2, "\t}")
  246. X    write(f2, "")
  247. X    write(f2, "    # Rudumentary error check to be sure the object to be inserted")
  248. X    write(f2, "    # into sset is of the same time as the objects already there.")
  249. X    write(f2, "    #")
  250. X    write(f2, "    if *sset > 0 then")
  251. X    write(f2, "\ttype(rec) == type(sset[1]) |")
  252. X    write(f2, "\t    stop(\"INSERT:  unexpected type difference\")")
  253. X    write(f2, "")
  254. X    write(f2, "    #")
  255. X    write(f2, "    # If a rec-like item isn't in sset, add it to sset.")
  256. X    write(f2, "    #")
  257. X    write(f2, "    if Eq(!sset, rec) then fail")
  258. X    write(f2, "    else return addto(sset, rec)")
  259. X    write(f2, "")
  260. X    write(f2, "end")
  261. X    write(f2, "\t")
  262. X    write(f2, "")
  263. X    write(f2, "#")
  264. X    write(f2, "# Equiv: struct x struct -> struct")
  265. X    write(f2, "#        (x1, x2)        -> x2")
  266. X    write(f2, "#")
  267. X    write(f2, "#     Where x1 and x2 are arbitrary structures.  Returns x2 if x1 and")
  268. X    write(f2, "#     x2 are structurally equivalent (even if not identical).  Taken")
  269. X    write(f2, "#     from the IPL file \"structs.icn,\" and gutted so that it assumes")
  270. X    write(f2, "#     all structures are \"ordered\" (i.e. not sets or tables).  Has no")
  271. X    write(f2, "#     way of handling procedures or files, either.  (Pretty limited,")
  272. X    write(f2, "#     huh?)")
  273. X    write(f2, "#")
  274. X    write(f2, "procedure Equiv(x1, x2, done)")
  275. X    write(f2, "")
  276. X    write(f2, "   local code, i")
  277. X    write(f2, "")
  278. X    write(f2, "   if x1 === x2 then return x2\t\t# Covers everything but structures.")
  279. X    write(f2, "   if type(x1) ~== type(x2) then fail\t# Must be same type.")
  280. X    write(f2, "   if *x1 ~= *x2 then fail")
  281. X    write(f2, "")
  282. X    write(f2, "   image(x1) ? (code := (=\"record\" | type(x1)))")
  283. X    write(f2, "   case code of {")
  284. X    write(f2, "       \"list\" | \"record\"    :")
  285. X    write(f2, "\t   every i := *x1 to 1 by -1 do")
  286. X    write(f2, "\t       Equiv(x1[i],x2[i]) | fail")
  287. X    write(f2, "       \"set\" | \"table\"      : stop(\"error:  Equiv used (wrongly) for equiv.\")")
  288. X    write(f2, "       \"procedure\" | \"file\" : stop(\"error:  Equiv used (wrongly) for equiv.\")")
  289. X    write(f2, "       default              : fail")
  290. X    write(f2, "   }")
  291. X    write(f2, "   return x2")
  292. X    write(f2, "")
  293. X    write(f2, "end")
  294. X
  295. X    if \DEBUG then
  296. X    dump_lists(&errout, alst, glst)
  297. X    if \VERBOSE then
  298. X    write(&errout, "Done.")
  299. X
  300. Xend
  301. SHAR_EOF
  302. echo 'File ibpag.icn is complete' &&
  303. true || echo 'restore of ibpag.icn failed'
  304. rm -f _shar_wnt_.tmp
  305. fi
  306. # ============= maketbls.icn ==============
  307. if test -f 'maketbls.icn' -a X"$1" != X"-c"; then
  308.     echo 'x - skipping maketbls.icn (File already exists)'
  309.     rm -f _shar_wnt_.tmp
  310. else
  311. > _shar_wnt_.tmp
  312. echo 'x - extracting maketbls.icn (Text)'
  313. sed 's/^X//' << 'SHAR_EOF' > 'maketbls.icn' &&
  314. X############################################################################
  315. X#
  316. X#    Name:     maketbls.icn
  317. X#
  318. X#    Title:     make (state & goto) tables for IBPAG
  319. X#
  320. X#    Author:     Richard L. Goerwitz
  321. X#
  322. X#    Version: 1.27
  323. X#
  324. X############################################################################
  325. X#
  326. X#  Given a table of productions (global, ptbl; see makeptbl.icn),
  327. X#  CONST_TABLE (below) creates a state and goto table, which ibpag.icn
  328. X#  then merges with the original source file.
  329. X#
  330. X############################################################################
  331. X#
  332. X#  Links: codeobj, rewrap
  333. X#
  334. X#  See also: ibpag.icn, preproc.icn
  335. X#
  336. X############################################################################
  337. X
  338. X# link codeobj, rewrap
  339. Xlink codeobj
  340. X
  341. Xrecord item(LHS, RHS, POS, LOOK, by_rule)
  342. Xrecord ACT(str, state, by_rule, POS, sym, size)
  343. X
  344. X# Declared in preproc.icn -
  345. X# record symbol(str, terminal)
  346. X# record rule(LHS, RHS, priority, associativity, procname)
  347. X
  348. X# start_symbol is set to "S" by default in CONST_STATES()
  349. Xglobal ptbl, alst, glst, start_symbol
  350. X# declared in ibpag.icn
  351. X# global DEBUG, VERBOSE
  352. X
  353. X#
  354. X# CONST_TABLE:  -> (null)
  355. X#
  356. X#     Operates entirely via side-effects.  Alst will become the action
  357. X#     list and glst will become the goto list.  The action list is
  358. X#     used to determine whether to shift, reduce, or accept; the goto
  359. X#     list indicates what state to go to after a reduction.  Their
  360. X#     format, in general, is: Offset = state; value = table of
  361. X#     directives.  They are, in other words, lists of tables.
  362. X#
  363. Xprocedure CONST_TABLE()
  364. X
  365. X    local C, i, j, l, it, act, next_state
  366. X    static big_item
  367. X    initial big_item :=
  368. X    item(start_symbol || "'", [symbol(start_symbol)], 2, "$", rule(,,1))
  369. X    
  370. X    C := CONST_STATES()
  371. X    alst := list(*C); every !alst := table()
  372. X    glst := list(*C); every !glst := table()
  373. X
  374. X    every l := C[i := 1 to *C] do {
  375. X    if \VERBOSE then
  376. X        write(&errout, "CONST_TABLE:  entering actions for state ", i)
  377. X    every it := !l do {
  378. X        # If we have a complete production, enter a reduce action
  379. X        # into the action list.  A special sub-case of reduce is
  380. X        # accept (which occurs when the state contains (S' -> S.,
  381. X        # $)).
  382. X        if it.POS > *it.RHS then {
  383. X        if Equiv(it, big_item)
  384. X        then act := ACT("accept", &null, it.by_rule, it.POS)
  385. X        else act := ACT("reduce", &null, it.by_rule, it.POS)
  386. X        # Check to see if we have a conflict; if so, resolve.
  387. X        if not (/alst[i][it.LOOK] := act) then
  388. X            resolve(alst, act, it.LOOK, i)
  389. X        }
  390. X        else {
  391. X        # If it's a terminal, see if GOTO_ITEMS for that
  392. X        # symbol and the current state = another state; if so,
  393. X        # enter shift + a jump to that state into the action
  394. X        # list.
  395. X        if \it.RHS[it.POS].terminal then {
  396. X            next_state := GOTO_ITEMS(l, it.RHS[it.POS])
  397. X            if Equiv(next_state, C[j := 1 to *C]) then {
  398. X#            C[j] := next_state
  399. X            # create an action to enter into the action list
  400. X            act := ACT("shift", j, it.by_rule, it.POS)
  401. X            # If the table entry is occupied, resolve conflict.
  402. X            if not (/alst[i][it.RHS[it.POS].str] := act) then 
  403. X                resolve(alst, act, it.RHS[it.POS].str, i)
  404. X            }
  405. X        }
  406. X        }
  407. X    }
  408. X    }
  409. X
  410. X    glst := list(*C)
  411. X    # Do we ever get conflicts here?
  412. X    every l := C[i := 1 to *C] do {
  413. X    if \VERBOSE then
  414. X        write(&errout, "CONST_TABLE:  entering gotos for state ", i)
  415. X    every it := !l do {
  416. X        \it.RHS[it.POS].terminal & next
  417. X        next_state := GOTO_ITEMS(l, it.RHS[it.POS])
  418. X        if Equiv(next_state, C[j := 1 to *C]) then {
  419. X#        C[j] := next_state
  420. X        # If the dot is at the end of the RHS, then we can't
  421. X        # enter any goto for that state.  There has to be a
  422. X        # nonterminal after the dot.
  423. X        if it.RHS[it.POS] then {
  424. X            /glst[i] := table()
  425. X            glst[i][it.RHS[it.POS].str] := j
  426. X        }
  427. X        }
  428. X    }
  429. X    }
  430. X
  431. X    return
  432. X    
  433. Xend
  434. X
  435. X
  436. X#
  437. X# resolve:  resolve conflicts in action list
  438. X#
  439. X#     Abort on reduce/reduce conflicts.  There is no reason why these
  440. X#     should be present in the grammar.  Resolve shift/reduce
  441. X#     conflicts in favor of a shift, in cases where the priorities are
  442. X#     the same, unless the first rule is left associative (which
  443. X#     implies a reduce).  Shift/reduce conflicts for rules without an
  444. X#     associativity are errors, and bring about termination of
  445. X#     processing.
  446. X#
  447. Xprocedure resolve(l, act, subscr, i)
  448. X
  449. X    if Equiv(l[i][subscr], act)
  450. X    then fail
  451. X    # Use the rule with the highest priority.
  452. X    if l[i][subscr].by_rule.priority ~= act.by_rule.priority then {
  453. X    if \VERBOSE then
  454. X        show_conflict(act, l[i][subscr], subscr, i)
  455. X    if l[i][subscr].by_rule.priority < act.by_rule.priority then {
  456. X        l[i][subscr] := act
  457. X        if \VERBOSE then
  458. X        write(&errout, "first rule's precedence is higher")
  459. X    } else {
  460. X        if \VERBOSE then
  461. X        write(&errout, "second rule's precedence is higher")
  462. X    }
  463. X    }
  464. X    # precedences are the same; resolve via associativity and defaults
  465. X    else {
  466. X    #
  467. X    # If the priorities are the same, then resolve the conflict or
  468. X    # abort.
  469. X    #
  470. X    # Still to be done:  Handle associativities.
  471. X    #
  472. X    case act.str of {
  473. X        "shift"   : {
  474. X        if l[i][subscr].str == "reduce" then {
  475. X            if \VERBOSE then {
  476. X            show_conflict(act, l[i][subscr], subscr, i)
  477. X            write(&errout, "first rule is ",
  478. X                  act.by_rule.associativity, " associative")
  479. X            if act.by_rule.associativity ~== 
  480. X                l[i][subscr].by_rule.associativity
  481. X            then write(&errout, "associativities differ!")
  482. X            }
  483. X            case act.by_rule.associativity of {
  484. X            "none" : oh_no(&null, 50)
  485. X            "left" : if \VERBOSE then
  486. X                write(&errout, "resolving in favor of reduce")
  487. X            "right": {
  488. X                l[i][subscr] := act
  489. X                if \VERBOSE then
  490. X                write(&errout, "resolving in favor of shift")
  491. X            }
  492. X            }
  493. X        }
  494. X        # else do nothing -
  495. X        # Shift-shift conflicts are not errors.  A shift is a
  496. X        # shift.
  497. X        }
  498. X        "reduce"  : {
  499. X        if l[i][subscr].str == "reduce" then {
  500. X            # Flag reduce-reduce conflicts as errors for now.
  501. X            # Yacc uses the first rule in the grammar.
  502. X            show_conflict(act, l[i][subscr], subscr, i)
  503. X            oh_no(&null, 51)
  504. X        }
  505. X        else {
  506. X            if \VERBOSE then {
  507. X            show_conflict(act, l[i][subscr], subscr, i)
  508. X            write(&errout, "first rule is ",
  509. X                  act.by_rule.associativity, " associative")
  510. X            if act.by_rule.associativity ~==
  511. X                l[i][subscr].by_rule.associativity
  512. X            then write(&errout, "associativities differ!")
  513. X            }
  514. X            case act.by_rule.associativity of {
  515. X            "none" : oh_no(&null, 50)
  516. X            "right": if \VERBOSE then
  517. X                write(&errout, "resolving in favor of shift")
  518. X            "left" : {
  519. X                l[i][subscr] := act
  520. X                if \VERBOSE then
  521. X                write(&errout, "resolving in favor of reduce")
  522. X            }
  523. X            }
  524. X        }
  525. X        }
  526. X    }
  527. X    }
  528. X    return
  529. X
  530. Xend
  531. X
  532. X
  533. X#
  534. X# CONST_STATES:  -> list of lists
  535. X#                -> C
  536. X#
  537. X#     Where C is a list of lists containing item records.  Each list
  538. X#     in C represents a state.  Uses the global table ptbl, which is
  539. X#     of the form keys = LHS, values = lists of rule records.
  540. X#
  541. X#     Calls itself recursively, and in this case takes one argument.
  542. X#     On the first call introduces the production (S' -> .S, $), which
  543. X#     is used as the first state in C from which the others are built.
  544. X#
  545. X#     Argument two (i) is used for recursive calls and should be
  546. X#     ignored.
  547. X#
  548. Xprocedure CONST_STATES(C, i)
  549. X
  550. X    local C2, it, sym, item_list, next_items
  551. X    # global ptbl, start_symbol
  552. X
  553. X    # write(&errout, "CONST_STATES:  performing closure on S'")
  554. X    /C  := [ CLOSURE([item(start_symbol || "'",
  555. X               [symbol(start_symbol)], 1, "$", rule(,,1))]) ]
  556. X    C2  := copy(C)
  557. X    /i := 0
  558. X
  559. X    every item_list := C[i := i+1 to *C] do {
  560. X    if \VERBOSE then
  561. X        write(&errout, "CONST_STATES:  examining item list #", i)
  562. X    if \DEBUG then
  563. X        write(&errout, item_list_2_string(C[i]))
  564. X    next_items := list()
  565. X    every it := !item_list do
  566. X        INSERT(next_items, it.RHS[it.POS])
  567. X    every sym := !next_items do
  568. X        INSERT(C2, GOTO_ITEMS(item_list, sym))
  569. X    }
  570. X    if *C2 > *C
  571. X    then return CONST_STATES(C2, i)
  572. X    else return C
  573. X
  574. Xend
  575. X
  576. X
  577. X#
  578. X# FIRST(RHS):  list of symbol records  -> set
  579. X#           (RHS)                   -> fset
  580. X#
  581. X#     Where RHS is the remaining symbols in some item after the "dot,"
  582. X#     where fset is a set of strings representing terminals beginning
  583. X#     sequences derivable from X.  (A production is a statement in the
  584. X#     grammar of the form LHS -> RHS, where LHS is a nonterminal
  585. X#     symbol, and RHS is a sequence of zero or more terminal or
  586. X#     nonterminal symbols; here productions are implemented via rule
  587. X#     records.)  If passed an empty RHS, FIRST returns another empty
  588. X#     list.
  589. X#
  590. X#     FIRST() uses the global grammar table ptbl.
  591. X#
  592. X#     The structure of ptbl: key = LHS (string), value = rule list
  593. X#     i.e. list of rule records).  Keys are always nonterminals, as
  594. X#     there is no need to record terminals (they appear only in the
  595. X#     RHS of rules).
  596. X#
  597. Xprocedure FIRST(RHS, seen)
  598. X
  599. X    local    X, fset, i, check_later_list, chunk
  600. X    #global  ptbl
  601. X
  602. X    # write(&errout, ximage(RHS))
  603. X    fset := set()
  604. X
  605. X    every X := !RHS do {
  606. X
  607. X    delete(fset, "")
  608. X
  609. X    # If X is a terminal symbol, just stick it into fset.
  610. X    if \X.terminal then
  611. X        insert(fset, X.str)
  612. X    else {
  613. X        #
  614. X        # X is not a terminal, check to see if X -> aA is a
  615. X        # production (where a is a terminal, and A is any series
  616. X        # of terminals, nonterminals, or nothing at all...).
  617. X        #
  618. X        /seen := set()
  619. X        insert(seen, X.str)
  620. X        check_later_list := []
  621. X        every i := 1 to *ptbl[X.str] do {
  622. X        if \ptbl[X.str][i].RHS[1].terminal
  623. X        then insert(fset, ptbl[X.str][i].RHS[1].str)
  624. X        else {
  625. X            if ptbl[X.str][i].RHS[1].str == X.str
  626. X            then INSERT(check_later_list, ptbl[X.str][i])
  627. X            else {
  628. X            member(seen, ptbl[X.str][i].RHS[1].str) & next
  629. X            #
  630. X            # For productions X -> Y1, Y2...Yn, where Y is a
  631. X            # nonterminal, compute FIRST recursively for the
  632. X            # list [Y1, Y2, ...].  If Y1 is equivalent to X,
  633. X            # then store that rule so that if FIRST(X)
  634. X            # otherwise contains an epsilon move, we can go
  635. X            # back and calculate FIRST(Y2), and so on.
  636. X            # Keep track of what nonterminals we've already
  637. X            # seen, so as not to calculate any twice.
  638. X            #
  639. X            fset ++:= FIRST(ptbl[X.str][i].RHS, seen)
  640. X            }
  641. X        }
  642. X        }
  643. X    }
  644. X    #
  645. X    # If fset contains e at this point, go back and try again,
  646. X    # then first try to compute FIRST() for elements 2 and later
  647. X    # of productions in the check_later_list.  Otherwise, try
  648. X    # computing FIRST for the next symbol in RHS.  If this fails,
  649. X    # then resign ourselves to e belonging in fset.
  650. X    #
  651. X    if not member(fset, "") then break
  652. X    else {
  653. X        every i := 1 to *check_later_list do {
  654. X        chunk := check_later_list[i].RHS[2:0] | next
  655. X        while (/chunk[1].terminal, chunk[1].str == X.str) do
  656. X            pop(chunk) | { break next }
  657. X        fset ++:= FIRST(chunk, seen)
  658. X        }
  659. X        next
  660. X    }
  661. X    }
  662. X
  663. X    # writes(&errout, "returning ")
  664. X    # every writes(&errout, !fset, " ")
  665. X    # write(&errout)
  666. X    return fset
  667. X
  668. Xend
  669. X
  670. X
  671. X#
  672. X# CLOSURE:  list         -> list
  673. X#        (item_list)  -> closure_list
  674. X#
  675. X#     Where item_list and closure_list are list of item records.
  676. X#     CLOSURE uses ptbl (global, created via makeptbl).  Ptbl is a
  677. X#     table, keys = LHS, values = lists of rule records.  CLOSURE
  678. X#     uses two additional arguments on recursive calls.  Don't use
  679. X#     them yourself!
  680. X#
  681. X#     CLOSURE breaks the items in item_list into smaller items,
  682. X#     and combines these with the items already in item_list, re-
  683. X#     turning a new list including both the members of item_list
  684. X#     and the new members.
  685. X#
  686. Xprocedure CLOSURE(item_list, i, added)
  687. X
  688. X    local it, terminals, terminal, tmpset, r, LHS
  689. X    #global ptbl
  690. X
  691. X    if \DEBUG then {
  692. X    write(&errout, "CLOSURE:  CLOSing item list")
  693. X    write(&errout, item_list_2_string(item_list))
  694. X    }
  695. X
  696. X    /i := 0
  697. X    /added := table()
  698. X    every it := item_list[i := i+1 to *item_list] do {
  699. X
  700. X    # write(&errout, "CLOSURE:  performing closure on item ", i)
  701. X    #
  702. X    # Put the as-yet unexpanded parts of item_list can be expanded
  703. X    # into new items, and add them to the full closure list.  Keep
  704. X    # track of LHSs we've already seen.  Loops are possible!
  705. X    #
  706. X    # If the dot stands before a terminal, then go to the next
  707. X    # item.
  708. X    repeat {
  709. X        if \it.RHS[it.POS].terminal then {
  710. X        #
  711. X            # If an epsilon move is next, then increment POS, and
  712. X            # look at it again.  If we leave the POS alone, then
  713. X            # later a shift action will be entered into the action
  714. X            # table for an epsilon token.  Since there are no
  715. X            # epsilon tokens, this will break our parse!
  716. X            #
  717. X        if it.RHS[it.POS].str == "" then {
  718. X            it.POS +:= 1
  719. X            next
  720. X        } else { break next }     # don't expand nonterminals!
  721. X        } else {
  722. X        #
  723. X            # If the "dot" is at the end of the RHS, it.RHS[it.POS]
  724. X        # will fail.  If it does fail, get the next it.  If it
  725. X        # succeeds, then just do a plain break and continue
  726. X        # with the expansion process.
  727. X        #
  728. X        if LHS := it.RHS[it.POS].str
  729. X        then break else { break next }
  730. X        }
  731. X    }
  732. X    # If we get to here, the dot is at a nonterminal, so expand!
  733. X    # Record LHSs we've alread seen.
  734. X    /added[LHS] := set()
  735. X
  736. X    # LHS is a string, RHS is a list of symbols; FIRST(X) returns
  737. X    # a list of strings (no need to use symbols here, since we
  738. X    # know everything in FIRST(X) is a terminal)
  739. X    #
  740. X    # write(ximage(ptbl)); write(ximage(LHS)); write(ximage(it))
  741. X    #
  742. X    tmpset := set()
  743. X    every r := !ptbl[LHS] do {
  744. X        # Change perhaps to:  if *it.RHS - it.POS = 0 then {
  745. X        # i.e. if the dot's at the end of the RHS...
  746. X        if *it.RHS[it.POS+1:0] = 0 then {
  747. X        #
  748. X        # Check to see if we've already done all the
  749. X        # productions for the current LHS and the lookahead
  750. X        # symbol being used.
  751. X        #
  752. X        member(added[LHS], it.LOOK) | {
  753. X            put(item_list, item(LHS, r.RHS, 1, it.LOOK, r))
  754. X            #
  755. X            # Keep track of lookahead symbols seen for this LHS.
  756. X            insert(tmpset, it.LOOK)
  757. X        }
  758. X        } else {
  759. X        terminals := FIRST(it.RHS[it.POS+1:0])
  760. X        if delete(terminals, member(terminals, "")) then {
  761. X            member(added[LHS], it.LOOK) | {
  762. X            put(item_list, item(LHS, r.RHS, 1, it.LOOK, r))
  763. X            insert(tmpset, it.LOOK)
  764. X            }
  765. X        }
  766. X        every terminal := !terminals do {
  767. X            member(added[LHS], terminal) | {
  768. X            put(item_list, item(LHS, r.RHS, 1, terminal, r))
  769. X            insert(tmpset, terminal)
  770. X            }
  771. X        }
  772. X        }
  773. X    }
  774. X    #
  775. X    # Record all the lookahead symbols seen for this LHS.  On
  776. X    # subsequent recursive calls, we won't bother to redo work
  777. X    # already done!  Afterwards, loop back for another item.
  778. X    #
  779. X    added[LHS] ++:= tmpset
  780. X    }
  781. X
  782. X    if *item_list > i then {
  783. X    if \DEBUG then
  784. X        write(&errout, "CLOSURE:  calling closure recursively")
  785. X    return CLOSURE(item_list, i, added)
  786. X    } else {
  787. X    # write(&errout, "CLOSURE:  finished recursive calls")
  788. X    #
  789. X    # Sortff sorts on field 5, then 4 (where the 5th field is the
  790. X    # same), then 3.  It can take any no. of args.  We only need
  791. X    # 3, though.  The sort order ensures that any time we perform
  792. X    # a closure on an item list, that item list will have a
  793. X    # consistent order.  This makes it possible to check whether a
  794. X    # given item list already exists using Equiv.
  795. X    return sortff(item_list, 5, 4, 3)
  796. X    }
  797. X
  798. Xend
  799. X
  800. X
  801. X#
  802. X# GOTO_ITEMS:  list x symbol record -> list
  803. X#              (item_list, X)       -> item_list_2
  804. X#
  805. X#     Where item_list_2 is the list of all items (A -> aX.b) where X
  806. X#     is a symbol, such that (A -> a.Xb) is in item_list.  Fails if
  807. X#     item.POS for every item in item_list is greater than *item.RHS;
  808. X#     fails also if X is not equivalent to any item.RHS[item.POS] in
  809. X#     item_list.
  810. X#
  811. Xprocedure GOTO_ITEMS(item_list, X)
  812. X
  813. X    local    it, it2, item_list_2
  814. X    static   item_terminal_table, item_nonterminal_table
  815. X    initial  {
  816. X    item_terminal_table    := table()
  817. X    item_nonterminal_table := table()
  818. X    }
  819. X
  820. X    # See if we've already performed this same calculation.
  821. X    #
  822. X    if \X.terminal
  823. X    then item_list_2 := \(\item_terminal_table[item_list])[X.str]
  824. X    else item_list_2 := \(\item_nonterminal_table[item_list])[X.str]
  825. X    if \item_list_2 then return item_list_2
  826. X
  827. X    item_list_2 := list()
  828. X    every it := !item_list do {
  829. X    # Subscripting operation fails if the dot's at end.
  830. X        if Equiv(it.RHS[it.POS], X)
  831. X    then {
  832. X        it2 := copy(it)
  833. X        it2.POS +:= 1
  834. X        put(item_list_2, it2)
  835. X    }
  836. X    }
  837. X
  838. X    item_list_2 := CLOSURE(item_list_2)
  839. X    #
  840. X    # Keep track of item lists and symbols we've already seen.
  841. X    #
  842. X    if \X.terminal then {
  843. X    /item_terminal_table[item_list] := table()
  844. X        /item_terminal_table[item_list][X.str] := item_list_2
  845. X    } else {
  846. X    /item_nonterminal_table[item_list] := table()
  847. X        /item_nonterminal_table[item_list][X.str] := item_list_2
  848. X    }
  849. X
  850. X    if *item_list_2 > 0 then
  851. X    return item_list_2
  852. X    else fail
  853. X
  854. Xend
  855. X
  856. X
  857. X#
  858. X# item_list_2_string:  item list -> string
  859. X#
  860. X#     Turn an item list into a human readable list of items, indented
  861. X#     four spaces from the left-hand margin.
  862. X#
  863. Xprocedure item_list_2_string(l)
  864. X
  865. X    local s
  866. X
  867. X    # Make sure we have the expected type entries in l.
  868. X    type(l[1]) == "item" |
  869. X    stop("error (item_list_2_string):  wrong type list")
  870. X
  871. X    s := ""
  872. X    every s ||:= "    " || rule_2_string(!l) || "\n"
  873. X    return trim(s, '\n')
  874. X
  875. Xend
  876. X
  877. X
  878. X#
  879. X# rule_2_string:  item or rule record -> string
  880. X#
  881. X#     Utility for making item and rule records human-readable.
  882. X#
  883. Xprocedure rule_2_string(r, action)
  884. X
  885. X    local r_string, sym
  886. X
  887. X    if r_string := \r.LHS || " ::= " then {
  888. X    every sym := !r.RHS do {
  889. X        if \sym.terminal
  890. X        then r_string ||:= sym.str || " "
  891. X        else r_string ||:= "<" || sym.str || "> "
  892. X    }
  893. X    }
  894. X    # Accept action has no left or right-hand side.
  895. X    else r_string := "(accept) "
  896. X
  897. X    if type(r) == "item"
  898. X    then r_string ||:= "POS "|| r.POS || "; lookahead " || r.LOOK
  899. X    else if \action
  900. X    then r_string ||:= "POS "|| action.POS || " (action = "|| action.str || ")"
  901. X
  902. X    return trim(r_string)
  903. X
  904. Xend
  905. X
  906. X
  907. X#
  908. X# show_conflict:  deep psychological thriller
  909. X#
  910. Xprocedure show_conflict(action1, action2, token, i)
  911. X
  912. X    write(&errout, "shift/reduce conflict, state ", i,
  913. X      ", lookahead ", token, ":")
  914. X    # action parameters may be null
  915. X    write(&errout, "\t1:  ",  rule_2_string(action1.by_rule, action1))
  916. X    write(&errout, "\t2:  ",  rule_2_string(action2.by_rule, action2))
  917. X
  918. Xend
  919. X
  920. X
  921. X#
  922. X# sortff:  like sortf() except takes unlimited no. of field args
  923. X#
  924. Xprocedure sortff(arglst[])
  925. X
  926. X    local sortfield, i, old_i
  927. SHAR_EOF
  928. true || echo 'restore of maketbls.icn failed'
  929. fi
  930. echo 'End of  part 2'
  931. echo 'File maketbls.icn is continued in part 3'
  932. echo 3 > _shar_seq_.tmp
  933. exit 0
  934. -- 
  935.  
  936.    -Richard L. Goerwitz              goer%midway@uchicago.bitnet
  937.    goer@midway.uchicago.edu          rutgers!oddjob!ellis!goer
  938.