home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / misc / volume38 / ibpag2 / part01 < prev    next >
Encoding:
Text File  |  1993-07-12  |  54.4 KB  |  1,732 lines

  1. Newsgroups: comp.sources.misc
  2. From: goer@midway.uchicago.edu (Richard L. Goerwitz)
  3. Subject: v38i045:  ibpag2 - Icon-Based Parser Generator, Part01/05
  4. Message-ID: <csm-v38i045=ibpag2.233906@sparky.Sterling.COM>
  5. X-Md4-Signature: 83e10741e44515851ddc5808b75cb8f8
  6. Sender: kent@sparky.sterling.com (Kent Landfield)
  7. Reply-To: goer@midway.uchicago.edu
  8. Organization: University of Chicago
  9. Date: Tue, 13 Jul 1993 04:39:31 GMT
  10. Approved: kent@sparky.sterling.com
  11.  
  12. Submitted-by: goer@midway.uchicago.edu (Richard L. Goerwitz)
  13. Posting-number: Volume 38, Issue 45
  14. Archive-name: ibpag2/part01
  15. Environment: Icon
  16.  
  17. This shell archive contains an Icon-based parser generator that
  18. has pretty much the features one expects such systems to have (and
  19. a few extras as well).  Note that it is not written in C.  It is,
  20. as its title implies, an Icon program, and produces Icon-based
  21. automata.
  22.  
  23. Icon is a language particularly well suited to parsing, conversion,
  24. and other high-level language/text-processing chores.  So far no-
  25. one has written a full LR-based parser generator for Icon (mostly
  26. because it's so easy to write good parsers in it by hand).  There
  27. are some occasions where such a generator is useful, though, so I
  28. wrote Ibpag2 to fill the gap.
  29.  
  30. Ibpag2 uses a standard SLR table-generator algorithm, and a YACC-
  31. like input syntax.  For those wanting total YACC compatibility,
  32. there is an "iacc" preprocessor (someone suggested this name to
  33. me because it sounds a bit like "yacc" - especially to those who
  34. studied Latin :-)).  There is a README file containing an exten-
  35. sive nontechnical tutorial.
  36.  
  37. Note that Ibpag2 has a separate quasi-GLR parser subsystem, as well
  38. as a standard SLR one.  This means that, if need be, it can be used
  39. to recognize and manipulate any context-free language (unlike YACC).
  40. I label this parser subsysten "quasi-GLR" because it does not use a
  41. graph structured stack, the way Masaru Tomita's do.  It works out to
  42. be much faster than most chart parsers, but slower than strict Tom-
  43. ita parsers.  Doing things this way makes support of all the same
  44. directives, rules, and actions used in SLR mode easy to do in quasi-
  45. GLR mode as well.  The GLR subsystem is in early beta testing.
  46.  
  47. Ibpag2, taken as a straight SLR parser generator, is in late beta
  48. testing.  It's been posted to alt.sources, and has found a fair
  49. amount of off-site use.  I've also put together an extensive test
  50. suite here.  Still, it's not gotten the kind of heavy use that
  51. would make me feel safe with a non-beta release.
  52.  
  53. I maintain no special copyright over Ibpag2, and ask nothing of
  54. anyone who uses it.
  55.  
  56. -Richard Goerwitz
  57.  
  58. P.S.  I just graduated with a Ph.D. in Near Eastern Languages &
  59.       Civilizations, and am hunting hard for work, both in my own
  60.       field, and as a humanities computing specialist.  Given my
  61.       uncertain near future, I don't know precisely how much time
  62.       I'll have to work on Ibpag2.  Still, please send comments
  63.       and bug reports!
  64.  
  65. ---- Cut Here and feed the following to sh ----
  66. #! /bin/sh
  67. # This is a shell archive.  Remove anything before this line, then feed it
  68. # into a shell via "sh file" or similar.  To overwrite existing files,
  69. # type "sh file -c".
  70. # Contents:  ibreader.icn iiglrpar.lib rewrap.icn version.icn
  71. # Wrapped by kent@sparky on Sun Jul 11 18:51:50 1993
  72. PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
  73. echo If this archive is complete, you will see the following message:
  74. echo '          "shar: End of archive 1 (of 5)."'
  75. if test -f 'ibreader.icn' -a "${1}" != "-c" ; then 
  76.   echo shar: Will not clobber existing file \"'ibreader.icn'\"
  77. else
  78.   echo shar: Extracting \"'ibreader.icn'\" \(16970 characters\)
  79.   sed "s/^X//" >'ibreader.icn' <<'END_OF_FILE'
  80. X############################################################################
  81. X#
  82. X#    Name:     ibreader.icn
  83. X#
  84. X#    Title:     reader for Ibpag2 source files
  85. X#
  86. X#    Author:     Richard L. Goerwitz
  87. X#
  88. X#    Version: 1.27
  89. X#
  90. X############################################################################
  91. X#
  92. X#  This file contains a collection of procedures that 1) read in an
  93. X#  Ibpag2 source file, 2) output token defines, 3) emit action code,
  94. X#  and finally 4) pass a start symbol, list of productions, and token
  95. X#  table back to the calling procedure.  Described formally:
  96. X#
  97. X#      ibreader:  file x file x string  -> ib_grammar record
  98. X#                 (in,   out,   module) -> grammar
  99. X#
  100. X#  In is the input stream; out is the output stream; module is an
  101. X#  optional string that distinguishes this grammar from others that
  102. X#  might also be running simultaneously.  Grammar is an ib_grammar
  103. X#  record containing the start symbol in its first field and the
  104. X#  production list in its second.  Its third field contains a table
  105. X#  used to map integers to actual token names or character literals,
  106. X#  i.e. its keys are things like -1, 0, etc. and its values are things
  107. X#  like "error," "EOF," etc.
  108. X#
  109. X#  Note that if a module argument is supplied to ibreader(), one must
  110. X#  also be supplied to ibwriter().  See ibwriter.icn.
  111. X#
  112. X#  The format of the input file is highly reminiscent of YACC.  It
  113. X#  consists of three basic sections, the first two of which are
  114. X#  followed by %%.  See the main documentation to Ibpag2 for
  115. X#  specifics.  Major differences between Ibpag2 and YACC input format
  116. X#  include:
  117. X#
  118. X#      1) "$$ = x" constructs are replaced by "return x" (e.g. "$$ =
  119. X#         $1 + $3" -> "return $1 + $3")
  120. X#
  121. X#      2) all variables within a given action are, by default, local
  122. X#         to that action; i.e. they cannot be accessed by other
  123. X#         actions unless you declare them global elsewhere (e.g. in
  124. X#         the pass-through part of the declarations section %{ ... %})
  125. X#
  126. X#      3) the %union declaration is not needed by Ibpag
  127. X#
  128. X#      4) tokens and symbols are separated from each other by a comma
  129. X#         (e.g. %token '+', '-' and S : NP, VP)
  130. X#
  131. X#      5) epsilon is indicated by the keyword "epsilon" (e.g. REL :
  132. X#         epsilon)
  133. X#
  134. X#      6) both epsilon and error *may* be declared as %tokens for
  135. X#         reasons of precedence, although they retain hard-coded
  136. X#         internal values (-2 and -1, respectively)
  137. X#
  138. X#      7) all actions must follow the last RHS symbol of the rule they
  139. X#         apply to (preceded by an optional %prec directive); to
  140. X#         achieve S : NP { action1 }, VP { action2 }, insert a dummy
  141. X#         rule: S : NP, dummy, VP { action2 }; dummy : epsilon {
  142. X#         action1 } ;
  143. X#
  144. X#      8) YYERROR, YYACCEPT, yyclearin, and yyerrok are the same,
  145. X#         except they are written IIERROR, IIACCEPT, iiclearin, and
  146. X#         iierrok (i.e. "ii" replaces "yy")
  147. X#
  148. X#      9) Ibpag2's input files are tokenized like modified Icon files,
  149. X#         and, as a consequence, Icon's reserved words must not be
  150. X#         used as symbols (e.g. "if : if, then" is no go)
  151. X#
  152. X############################################################################
  153. X#
  154. X#  Links: ibtokens, escape
  155. X#
  156. X#  See also: ibwriter
  157. X#
  158. X############################################################################
  159. X
  160. X#link ibtokens, escape
  161. Xlink escape
  162. X
  163. Xrecord ib_grammar(start, rules, tbl)
  164. Xrecord tokstats(str, no, prec, assoc)
  165. X
  166. X# Declared in ibtokens.icn:
  167. X# global line_number
  168. X
  169. X#
  170. X# ibreader:  file x file x string x string        -> ib_grammar record
  171. X#            (in,   out,   module,  source_fname) -> grammar
  172. X#
  173. X#     Where in is an input stream, out is an output stream, module is
  174. X#     some string uniquely identifying this module (optional), and
  175. X#     where grammar is an ib_grammar record containing the start
  176. X#     symbol in its first field and a list of production records in
  177. X#     its second.  Source_fname is the string name of Ibpag2's input
  178. X#     grammar file.  Defaults to "source file."
  179. X#
  180. Xprocedure ibreader(in, out, module, source_fname)
  181. X
  182. X    local tmp, grammar, toktbl, next_token, next_token_no_nl,
  183. X    token, LHS, t
  184. X
  185. X    /source_fname    := "source file"
  186. X    grammar          := ib_grammar(&null, list(), table())
  187. X    toktbl           := table()
  188. X    next_token       := create ibtokens(in)
  189. X    next_token_no_nl := create 1(tmp := |@next_token, \tmp.sym)
  190. X    token            := @next_token_no_nl | iohno(4)
  191. X
  192. X    # Do the %{ $} and %token stuff, i.e. everything up to %%
  193. X    # (NEWSECT).
  194. X    #
  195. X    until token.sym == "NEWSECT" do {
  196. X    case token.sym of {
  197. X        default     : {
  198. X        iohno(48, "token "||image(token.str) ||"; line "|| line_number)
  199. X        }
  200. X        "SEMICOL"   :  {
  201. X        # Skip semicolon.  Get another token while we're at it.
  202. X        token := @next_token_no_nl | iohno(47, "line "||line_number)
  203. X        }
  204. X        "BEGGLOB" : {
  205. X        write(out, "\n$line ", line_number, " ", image(source_fname))
  206. X        # Copy token values to out until we reach "%}" (ENDGLOB).
  207. X        (token := copy_icon_stuff(next_token, out)).sym == "ENDGLOB"
  208. X        token := @next_token_no_nl
  209. X        }
  210. X        "MOD"     : {
  211. X        (token := @next_token_no_nl).sym == "IDENT" |
  212. X            iohno(30, "line " || line_number)
  213. X        #
  214. X        # Read in token declarations, set associativity and
  215. X        # precedences, and enter the tokens into toktbl.
  216. X        #
  217. X        token := {
  218. X            case token.str of {
  219. X             default  : iohno(30, "line " || line_number)
  220. X            "token"   : read_decl(next_token_no_nl, toktbl, &null)
  221. X            "right"   : read_decl(next_token_no_nl, toktbl, "r")
  222. X            "left"    : read_decl(next_token_no_nl, toktbl, "l")
  223. X            "nonassoc": read_decl(next_token_no_nl, toktbl, "n")
  224. X            "union"   : iohno(45, "line "|| line_number)
  225. X            "start"   : {
  226. X                (token := @next_token_no_nl).sym == "IDENT" |
  227. X                iohno(31, "line " || line_number)
  228. X                /grammar.start := token.str |
  229. X                iohno(32, "line " || line_number)
  230. X                @next_token_no_nl | iohno(4)
  231. X            }
  232. X            }
  233. X        }
  234. X        }
  235. X    }
  236. X    }
  237. X    # Skip past %% (NEWSECT) and semicolon (if present).
  238. X    token := @next_token_no_nl | iohno(47, "line "|| line_number)
  239. X    (token := token | @next_token_no_nl | iohno(4)).sym ~== "SEMICOL"
  240. X    token.sym == "NEWSECT" & iohno(47, "line "|| line_number)
  241. X
  242. X    #
  243. X    # Fetch start symbol if it wasn't defined above via %start; by
  244. X    # default the start symbol is the LHS of rule 1.
  245. X    #
  246. X    /grammar.start := token.str
  247. X
  248. X    # Having reached the end of the declarations section, we can now
  249. X    # copy out a define for each token number, not counting character
  250. X    # literals (which are stored as integers).  While we're at it,
  251. X    # create a table that maps token numbers back to character
  252. X    # literals and strings (for use in later verbose and debugging
  253. X    # displays).
  254. X    #
  255. X    write(out, "\n")
  256. X    every t := !toktbl do {
  257. X    if type(t.str) == "integer" then
  258. X        insert(grammar.tbl, t.no, image(char(t.str)))
  259. X    else {
  260. X        insert(grammar.tbl, t.no, t.str)
  261. X        write(out, "$define ", t.str, "\t", t.no)
  262. X    }
  263. X    }
  264. X
  265. X    # Now, finally, read in rules up until we reach EOF or %% (i.e.
  266. X    # NEWSECT).  EOF is signaled below by failure of read_RHS().
  267. X    #
  268. X    until token.sym == "NEWSECT" do {
  269. X    token.sym == "IDENT" | iohno(33, token.str ||" line "|| line_number)
  270. X    LHS := token.str
  271. X    token := @next_token_no_nl | iohno(4)
  272. X    token.sym == "COLON" | iohno(34, token.str ||" line "|| line_number)
  273. X    #
  274. X    # Read in RHS, then the action (if any) then the prec (if
  275. X    # any).  If we see a BAR, then repeat, re-using the same
  276. X    # left-hand side symbol.
  277. X    #
  278. X    while token := 
  279. X        read_RHS(next_token, next_token_no_nl, out, toktbl, LHS,
  280. X             grammar, module, source_fname) |
  281. X        # if read_RHS fails, we're at EOF
  282. X        break break
  283. X    do token.sym == "BAR" | break
  284. X    }
  285. X
  286. X    # Copy the remainder of the file to out as Icon code.
  287. X    write(out, "\n$line ", line_number, " ", image(source_fname))
  288. X    every copy_icon_stuff(next_token, out, "EOFX")
  289. X
  290. X    # Do final setup on the reverse token table.  This table will be
  291. X    # used later to map integers to their original names in verbose or
  292. X    # debugging displays.
  293. X    #
  294. X    insert(grammar.tbl,  0, "$")
  295. X
  296. X    return grammar
  297. X
  298. Xend
  299. X
  300. X
  301. X#
  302. X# copy_icon_stuff:  coexpression x file x string  -> ib_TOK records
  303. X#                   (next_token,   out,   except) -> token records
  304. X#
  305. X#     Copy Icon code to output stream, also suspending as we go.
  306. X#     Insert separators between tokens where needed.  Do not output
  307. X#     any token whose sym field matches except.  The point in
  308. X#     suspending tokens as we go is to enable the calling procedure to
  309. X#     look for signal tokens that indicate insertion or termination
  310. X#     points.
  311. X#
  312. Xprocedure copy_icon_stuff(next_token, out, except)
  313. X
  314. X    local separator, T
  315. X
  316. X    separator := ""
  317. X    while T := @next_token do {
  318. X    if \T.sym then suspend T
  319. X    if \T.sym == \except then next
  320. X    if any(&digits ++ &letters ++ '_.', \T.str, 1, 2) & \T.sym ~== "DOT"
  321. X    then writes(out, separator)
  322. X    writes(out, T.str)
  323. X    if any(&digits ++ &letters ++ '_.', \T.str, -1, 0) & \T.sym ~== "DOT"
  324. X    then separator := " " else separator := ""
  325. X    }
  326. X
  327. X    # unexpected EOF error
  328. X    (except === "EOFX") | iohno(4)
  329. X
  330. Xend
  331. X
  332. X
  333. X#
  334. X# read_decl:  coexpression     x table x string -> ib_TOK
  335. X#             (next_token_no_nl, toktbl, assoc) -> token
  336. X#
  337. X#     Read in token declarations, assigning them the correct
  338. X#     precedence and associativity.  Number the tokens for later
  339. X#     $define preprocessor directives.  When done, return the last
  340. X#     token processed.  Toktbl is the table that holds the stats for
  341. X#     each declared token.
  342. X#
  343. Xprocedure read_decl(next_token_no_nl, toktbl, assoc)
  344. X
  345. X    local   token, c
  346. X    static  token_no, prec
  347. X    initial {
  348. X    token_no := 256
  349. X    prec := 0
  350. X    }
  351. X
  352. X    # All tokens in this list have the same prec and assoc.
  353. X    # Precedence is determined by order.  Associativity is determined
  354. X    # by keyword in the calling procedure, and is passed as arg 3.
  355. X    #
  356. X    prec +:= 1
  357. X    assoc === ("n"|"r"|"l"|&null) | iohno(5, image(assoc))
  358. X
  359. X    # As long as we find commas and token names, keep on adding tokens
  360. X    # to the token table.  Return the unused token when done.  If we
  361. X    # reach EOF, there's been an error.
  362. X    #
  363. X    repeat {
  364. X    token := @next_token_no_nl | iohno(4)
  365. X    case token.sym of {
  366. X        default  : iohno(31, token.str ||" line "|| line_number)
  367. X        "CSETLIT" | "STRING": {
  368. X        # Enter character literals as integers.
  369. X        *escape(token.str[2:-1]) = 1 | iohno(49, token.str)
  370. X        c := ord(escape(token.str[2:-1]))
  371. X        toktbl[c] := tokstats(c, c, prec, assoc)
  372. X        }
  373. X        "IDENT"  : {
  374. X        case token.str of {
  375. X            "error"  :
  376. X            toktbl[token.str] := tokstats("error", -1, prec, assoc)
  377. X            "epsilon":
  378. X            toktbl[token.str] := tokstats("epsilon",-2,prec, assoc)
  379. X            default  : {
  380. X            # Enter TOKENs as string-keyed records in toktbl.
  381. X            token_no +:= 1
  382. X            toktbl[token.str] :=
  383. X                tokstats(token.str, token_no, prec, assoc)
  384. X            }
  385. X        }
  386. X        }
  387. X    }
  388. X    # As long as we're seeing commas, go back for more tokens.
  389. X    token := @next_token_no_nl | iohno(4)
  390. X    token.sym == "COMMA" | break
  391. X    }
  392. X
  393. X    # Skip past semicolon, if present (as set up now, it shouldn't be).
  394. X    (token := token | @next_token_no_nl | iohno(4)).sym ~== "SEMICOL"
  395. X    return token
  396. X
  397. Xend
  398. X
  399. X
  400. X#
  401. X# read_RHS:  coexpression x coexpression x file x table x
  402. X#            string x ib_grammar record x string x string -> token
  403. X#
  404. X#     Read_RHS goes through the RHS of rule definitions, inserting the
  405. X#     resulting productions into a master rule list.  At the same
  406. X#     time, it outputs the actions corresponding to those productions
  407. X#     as procedures that are given names corresponding to the numbers
  408. X#     of the productions.  I.e. production 1, if endowed with an {
  409. X#     action }, will correspond to procedure _1_.  Prec and assoc are
  410. X#     automatically set to that of the last RHS nonterminal, but this
  411. X#     may be changed explicitly by the %prec keyword, as in YACC.
  412. X#     Source_fname is the name of the source grammar file we're pro-
  413. X#     cessing (caller will give us some reasonable default if we're
  414. X#     reading &input).
  415. X#
  416. X#     Fails on EOF.
  417. X#
  418. Xprocedure read_RHS(next_token, next_token_no_nl, out, toktbl, LHS,
  419. X           grammar, module, source_fname)
  420. X
  421. X    local   token, rule, c
  422. X    static  rule_no
  423. X    initial rule_no := 0
  424. X
  425. X    rule_no +:= 1
  426. X    #                  LHS  RHS     POS    LOOK   no       prec   assoc
  427. X    rule := production(LHS, list(), &null, &null, rule_no, &null, &null)
  428. X    put(grammar.rules, rule)
  429. X
  430. X    # Read in RHS symbols.
  431. X    #
  432. X    repeat {
  433. X    token := @next_token_no_nl | iohno(4)
  434. X    case token.sym of {
  435. X        default  :
  436. X        iohno(35, "token "|| image(token.str)||"; line "|| line_number)
  437. X        "CSETLIT" | "STRING": {
  438. X        *escape(token.str[2:-1]) = 1 | iohno(49, token.str)
  439. X        c := ord(escape(token.str[2:-1]))
  440. X        if \toktbl[c] then {
  441. X            rule.prec  := toktbl[c].prec
  442. X            rule.assoc := toktbl[c].assoc
  443. X        }
  444. X        # literals not declared earlier will get caught here
  445. X        else insert(grammar.tbl, c, image(char(c)))
  446. X        put(rule.RHS, c)
  447. X        }
  448. X        "IDENT"  : {
  449. X        # If it's a terminal (i.e. a declared token), assign
  450. X        # this rule its precedence and associativity.  If it's
  451. X        # not in toktbl, then it's not a declared token....
  452. X        if \toktbl[token.str] then {
  453. X            rule.prec  := toktbl[token.str].prec
  454. X            rule.assoc := toktbl[token.str].assoc
  455. X            put(rule.RHS, toktbl[token.str].no)
  456. X            if toktbl[token.str].no = -2 then {
  457. X            *rule.RHS > 1 & iohno(44, "line ", line_number)
  458. X                rule.POS := 2
  459. X            }
  460. X        }
  461. X        # ...undeclared stuff.  Could be a nonterminal.  If
  462. X        # error and/or epsilon weren't declared as tokens,
  463. X        # they will get caught here, too.
  464. X        else {
  465. X            case token.str of {
  466. X            &null     : stop("What is going on here?")
  467. X            default   : put(rule.RHS, token.str)
  468. X            "error"   : {
  469. X                put(rule.RHS, -1)
  470. X                insert(grammar.tbl, -1, "error")
  471. X            }
  472. X            "epsilon" : {
  473. X                if *put(rule.RHS, -2) > 1
  474. X                then iohno(44, "line ", line_number)
  475. X                else rule.POS := 2
  476. X                insert(grammar.tbl, -2, "epsilon")
  477. X            }
  478. X            }
  479. X        }
  480. X        }
  481. X    }
  482. X    # Comma means:  Go back for another RHS symbol.
  483. X    token := @next_token_no_nl | fail
  484. X    token.sym == "COMMA" | break
  485. X    }
  486. X
  487. X    # Skip semicolon token, if present.
  488. X    (token := token | @next_token_no_nl | fail).sym ~== "SEMICOL"
  489. X
  490. X    # Read and set (optional) precedence.
  491. X    #
  492. X    if token.sym == "MOD" then {
  493. X    token := @next_token_no_nl | iohno(4)
  494. X    (token.sym == "IDENT" & token.str == "prec") |
  495. X        iohno(43, token.str || " line " || line_number)
  496. X    token := @next_token_no_nl | iohno(4)
  497. X    case token.sym of {
  498. X        "CSETLIT" | "STRING" : {
  499. X        *escape(token.str[2:-1]) = 1 | iohno(49, token.str)
  500. X        c := ord(escape(token.str[2:-1])) &
  501. X        rule.prec  := toktbl[c].prec &
  502. X        rule.assoc := toktbl[c].assoc
  503. X        }
  504. X        "IDENT"    : {
  505. X        \toktbl[token.str] |
  506. X            iohno(43, token.str || " line " || line_number)
  507. X        rule.prec  := toktbl[token.str].prec &
  508. X        rule.assoc := toktbl[token.str].assoc
  509. X        }
  510. X        default    : 1 = 4    # deliberate failure
  511. X    } | iohno(43, "line ", line_number)
  512. X    token := @next_token_no_nl | fail
  513. X    }
  514. X
  515. X    # Skip semicolon token, if present.
  516. X    (token := token | @next_token_no_nl | fail).sym ~== "SEMICOL"
  517. X
  518. X    # Read in (optional) action.
  519. X    #
  520. X    if token.sym == "LBRACE" then {
  521. X    write_action_as_procedure(next_token, out, rule,
  522. X                  module, source_fname)
  523. X    token := @next_token_no_nl | fail
  524. X    }
  525. X
  526. X    # Skip semicolon token, if present.
  527. X    (token := token | @next_token_no_nl | fail).sym ~== "SEMICOL"
  528. X    return token
  529. X
  530. Xend
  531. X
  532. X
  533. X#
  534. X# write_action_as_procedure
  535. X#
  536. Xprocedure write_action_as_procedure(next_token, out, rule,
  537. X                    module, source_fname)
  538. X
  539. X    local argstr, bracelevel, token, i, neg
  540. X
  541. X    /module := ""
  542. X     argstr := ""
  543. X    #
  544. X    # Decide the number of arguments based on the length of the RHS of
  545. X    # rule.  Exception: Epsilon productions are empty, and pop nothing
  546. X    # off the stack, so take zero args.
  547. X    #
  548. X    if rule.RHS[1] ~=== -2 then {
  549. X    every argstr ||:= "arg" || (1 to *rule.RHS) || ","
  550. X    argstr := trim(argstr, ',')
  551. X    }
  552. X    write(out, "procedure _", rule.no, "_", module, "(", argstr, ")")
  553. X    write(out, "\n$line ", line_number, " ", image(source_fname))
  554. X
  555. X    bracelevel := 1
  556. X    until bracelevel = 0 do {
  557. X    every token := copy_icon_stuff(next_token, out, "RHSARG") do {
  558. X        case token.sym of {
  559. X        default   : next
  560. X        "LBRACE"  : bracelevel +:= 1
  561. X        "RBRACE"  : bracelevel -:= 1
  562. X        "RHSARG"  : {
  563. X            until \ (token := @next_token).sym do
  564. X            writes(out, token.str)
  565. X            if neg := (token.sym == "MINUS") then
  566. X            until \ (token := @next_token).sym do 
  567. X                writes(out, token.str)
  568. X            else neg := &null
  569. X            token.sym == "INTLIT"  | iohno(37, "$"||token.str)
  570. X            if /neg & token.str ~== "0" then {
  571. X            token.str <= *rule.RHS | iohno(38, "$"||token.str)
  572. X            writes(out, " arg", token.str, " ")
  573. X            } else {
  574. X            # Code for $0, $-1, etc.
  575. X            #
  576. X            # Warning!  If the name of the stack is changed
  577. X            # in iiparse.lib, it has to be changed here, too.
  578. X            #
  579. X            i := abs(token.str)+1
  580. X            writes(out, " value_stack", module, "[", i, "] ")
  581. X            }
  582. X            }
  583. X        }
  584. X        if bracelevel = 0 then {
  585. X        write(out, "\nend\n")
  586. X        return token
  587. X        }
  588. X        }
  589. X    }
  590. X        
  591. X    iohno(39, "line "|| line_number)
  592. X
  593. Xend
  594. X
  595. END_OF_FILE
  596.   if test 16970 -ne `wc -c <'ibreader.icn'`; then
  597.     echo shar: \"'ibreader.icn'\" unpacked with wrong size!
  598.   fi
  599.   # end of 'ibreader.icn'
  600. fi
  601. if test -f 'iiglrpar.lib' -a "${1}" != "-c" ; then 
  602.   echo shar: Will not clobber existing file \"'iiglrpar.lib'\"
  603. else
  604.   echo shar: Extracting \"'iiglrpar.lib'\" \(26996 characters\)
  605.   sed "s/^X//" >'iiglrpar.lib' <<'END_OF_FILE'
  606. X############################################################################
  607. X#
  608. X#    Name:     iiglrpar.lib
  609. X#
  610. X#    Title:     Quasi-GLR parser code
  611. X#
  612. X#    Author:     Richard L. Goerwitz
  613. X#
  614. X#    Version: 1.18
  615. X#
  616. X############################################################################
  617. X#
  618. X#  This file contains quasi-GLR parser code for use by Ibpag2's
  619. X#  output.  See below on what I mean by "quasi-GLR."  Entry point is
  620. X#  iiparse(infile, fail_on_error).  Infile is the stream from which
  621. X#  input is to be taken.  Infile is passed as argument 1 to the
  622. X#  user-supplied lexical analyzer, iilex_module() (where _module is
  623. X#  the string supplied with the -m option to Ibpag2).  If
  624. X#  fail_on_error is nonnull, the parser, iiparse, will fail on errors,
  625. X#  rather than abort.  Iiparse() returns the top element on its value
  626. X#  stack on a successful parse (which can be handy).
  627. X#
  628. X#  Iilex_module() must suspend integers for tokens and may also set
  629. X#  iilval_module to the actual string values.  Tokens -2, -1, and 0
  630. X#  are reserved.  -2 is epsilon, and -1 is error.  0 is EOF, and is
  631. X#  automatically appended to the token stream when iilex_module, the
  632. X#  tokenizer, fails.  These values should not normally be returned by
  633. X#  the analyzer.  In general, it is a good idea to $include
  634. X#  iilex_module from your Ibpag2 source files, so that it can use the
  635. X#  symbolic %token names declared in the original Ibpag2 source file.
  636. X#  As implied above ("suspend"), iilex_module must be a generator,
  637. X#  failing on EOF.
  638. X#
  639. X#  If desired, you may include your own error-handling routine.  It
  640. X#  must be called iiparse_module (where _module is once again the
  641. X#  module name supplied to ibpag2 via the -m option).  The global
  642. X#  variable line_number_module is automatically defined below, so a
  643. X#  typical arrangement would be for the lexical analyzer to initialize
  644. X#  line_number_module to 0, and increment by 1 for each line read.
  645. X#  The error handler, iierror_module() can then display this variable.
  646. X#  Note that the error handler should accept a single string argument
  647. X#  (set by iiparse to describe the token on the input stream when the
  648. X#  error was encountered).
  649. X#
  650. X#  I label this parser "GLR" because it does support multiple parallel
  651. X#  parsers (like GLR parsers are supposed to).  I use the qualifier
  652. X#  "quasi," though, because it does not use a graph-structured stack.
  653. X#  Instead it copies both value and state stacks (in fact, the whole
  654. X#  parser environment) when creating new automata to handle
  655. X#  alternative parse paths.  Slower, yes.  But it enables the user to
  656. X#  use almost precisely the action and input format that is used for
  657. X#  the standard parser.
  658. X#
  659. X#  Note that iiparse(), as implemented here, may suspend multiple
  660. X#  results.  So be sure to call it in some context where multiple
  661. X#  results can be used (e.g. every parse := iiparse(&input, 1), or the
  662. X#  like).  Note also that when new parser "edges" get created, a
  663. X#  rather cumbersome recursive copy routine is used.  Sorry, but it's
  664. X#  necessary to prevent unintended side-effects.
  665. X#
  666. X############################################################################
  667. X#
  668. X#  The algorithm:
  669. X#
  670. X#      A = list of active parsers needing action lookup
  671. X#      S = list of parsers to be shifted
  672. X#      R = list of parsers to be reduced
  673. X#      B = list of parsers that "choked"
  674. X#
  675. X#      for every token on the input stream
  676. X#      begin
  677. X#        until length of R = 0 and length of A = 0
  678. X#        begin
  679. X#          - pop successive parsers off of A, and placing them in S,
  680. X#            R, or B, depending on parse table directives; suspend a 
  681. X#            result for each parser that has reached an accepting
  682. X#            state
  683. X#         -  pop successive parsers off of R, reducing them, and
  684. X#            placing them back in A; perform the action code
  685. X#            associated with each reduction
  686. X#        end
  687. X#        - pop successive parsers off of S, shifting them, and placing
  688. X#          them back in A; mark recovering parsers as recovered when
  689. X#          they have successfully shifted three tokens
  690. X#        if length of A = 0 and token not = EOF
  691. X#        then
  692. X#          - initiate error recovery on the parsers in B, i.e. for
  693. X#            each parser in B that is not already recovering, pop its
  694. X#            stack until error (-1) can legally be shifted, then shift
  695. X#            error, mark the parser as recovering from an error, and
  696. X#            place it back in A; if the parser is already recovering,
  697. X#            discard the current token
  698. X#        else
  699. X#          - clobber the parsers in B
  700. X#        end
  701. X#      end
  702. X#
  703. X#  Note that when a given active parser in A is being classified
  704. X#  as needing a reduction, shift, suspension, or entry into the error
  705. X#  list (B), more than one action may apply due to ambiguity in the
  706. X#  grammar.  At such points, the parser environment is duplicated,
  707. X#  once for each alternative pathway, and each of the new parsers is
  708. X#  then entered into the appropriate list (R or S; if accept is an
  709. X#  alternative, the classification routine suspends).
  710. X#
  711. X#  Note also that when performing the action code associated with
  712. X#  reductions, parsers may be reclassified as erroneous, accepting,
  713. X#  etc. via "semantic" directives like IIERROR and IIACCEPT.  See the
  714. X#  README file.  Multiple-result action code will cause new parser
  715. X#  threads to be created, just as ambiguities in the grammar do within
  716. X#  the classification routine above.
  717. X#
  718. X#############################################################################
  719. X#
  720. X#  See also: ibpag2.icn, iiparse.icn
  721. X#
  722. X############################################################################
  723. X
  724. X$$line 119 "iiglrpar.lib"
  725. X
  726. X$$ifndef IIDEBUG
  727. X    $$define $iidebug    1
  728. X    $$define show_new_forest    1
  729. X$$endif                # not IIDEBUG
  730. X
  731. X# These defines are output by Ibpag2 ahead of time (with the module
  732. X# name appended, if need be):
  733. X#
  734. X# IIERROR
  735. X# IIACCEPT
  736. X# iiprune     - GLR mode only
  737. X# iiisolate   - GLR mode only
  738. X# iierrok
  739. X# iiclearin
  740. X
  741. X# Parser environment + lookahead and pending action field.
  742. X#
  743. Xrecord $ib_pe(state_stack, value_stack, action, errors,
  744. X          recover_shifts, discards, clearin)
  745. X
  746. X# Warning!  If you change the name of the value stack, change it also
  747. X# in ibreader.icn, procedure write_action_as_procedure().
  748. X#
  749. Xglobal $iilval, $line_number, $state_stack, $value_stack,
  750. X    $iidirective, $ttbl, $errors
  751. X
  752. X#
  753. X# iiparse: file x   anything        -> ?s (a generator)
  754. X#          (stream, fail_on_error)  -> ?
  755. X#
  756. X#     Where stream is an open file, where fail_on_error is a switch
  757. X#     that (if nonnull) tells the iiparse to fail, rather than abort,
  758. X#     on error, and where ?s represent the user-defined results of a
  759. X#     completed parse of file, from the current location up to the
  760. X#     point where the parser executes an "accept" action.  Note that
  761. X#     iiparse, as implemented here, is a generator.
  762. X#
  763. Xprocedure $iiparse(stream, fail_on_error)
  764. X
  765. X    local token, actives, reducers, shifters, barfers
  766. X    #global ttbl, errors
  767. X    static atbl
  768. X    initial {
  769. X    atbl  := $atbl_insertion_point
  770. X    $ttbl := $ttbl_insertion_point
  771. X    $$line 166 "iiglrpar.lib"
  772. X    \$iilex | stop("no iilex tokenizer defined")
  773. X    }
  774. X
  775. X    actives  := [ $ib_pe([1], [], &null, 0) ]
  776. X    $state_stack := actives[1].state_stack
  777. X    $value_stack := actives[1].value_stack
  778. X    $errors := actives[1].errors
  779. X    reducers := list()
  780. X    shifters := list()
  781. X    # I get tired of bland error code.  We'll call the list of
  782. X    # parsers in an error state "barfers" :-).
  783. X    barfers  := list()
  784. X
  785. X    every token := $iilex(stream, fail_on_error) | 0
  786. X    do {
  787. X    until *actives = *reducers = 0
  788. X    do {
  789. X
  790. X        # Prune out parsers that are doing the same thing as some
  791. X        # other parser.
  792. X        #
  793. X        $$ifdef AUTO_PRUNE
  794. X        auto_prune(actives)
  795. X        $$endif
  796. X
  797. X        # Suspends $value_stack[1] on accept actions.  Otherwise,
  798. X        # puts parsers that need shifting into the shifters list,
  799. X        # parsers that need reducing into the reducers list, and
  800. X        # error-state parsers into the barfers list.  Creates new
  801. X        # parser environments as needed.
  802. X        #
  803. X        suspend $ib_action(atbl, token, actives, shifters,
  804. X                   reducers, barfers)
  805. X
  806. X        # Perform reductions.  If instructed via the iiaccept
  807. X        # macro, simulate an accept action, and suspend with a
  808. X        # result.
  809. X        #
  810. X        suspend $perform_reductions(token, actives, shifters,
  811. X                    reducers, barfers)
  812. X    }
  813. X
  814. X    # Shift token for every parser in the shifters list.  This
  815. X        # will create a bunch of new active parsers.
  816. X    #
  817. X    $perform_shifts(token, actives, shifters)
  818. X    #
  819. X    # If we get to here and have no actives, and we're not at the
  820. X    # end of the input stream, then we are at an error impasse.
  821. X    # Do formal error recovery.
  822. X    #
  823. X    if *actives = 0 & token ~=== 0 then {
  824. X        suspend $perform_barfs(atbl, token, actives, barfers,fail_on_error)
  825. X        #
  826. X        # If there *still* aren't any active parsers, we've
  827. X        # reached an impasse (or there are no error productions).
  828. X        # Abort.
  829. X        #
  830. X        if *actives = 0 then {
  831. X        if \fail_on_error then fail
  832. X        else stop()
  833. X        }
  834. X    }
  835. X    else {
  836. X        #
  837. X        # Parsers in an error state should be weeded out, since if
  838. X        # we get to here, we have some valid parsers still going.
  839. X        # I.e. only use them if there are *no* actives (see above).
  840. X        #
  841. X    $$ifdef IIDEBUG
  842. X        write(&errout, "+++ pruning ", *barfers, " erroneous parsers")
  843. X        while parser := pop(barfers)
  844. X        do $iidebug("p", token, &null, parser)
  845. X    $$else
  846. X        while pop(barfers)
  847. X    $$endif    #IIDEBUG
  848. X        }
  849. X    }
  850. X
  851. Xend
  852. X
  853. X
  854. X#
  855. X# ib_action
  856. X#
  857. Xprocedure $ib_action(atbl, token, actives, shifters, reducers,
  858. X             barfers)
  859. X
  860. X    local a, act, num, parser, new_parser
  861. X
  862. X    # While there is an active parser, take it off the actives list,
  863. X    # and...
  864. X    while parser := pop(actives) do {
  865. X
  866. X    # ...check for a valid action (if none, then there is an
  867. X    # error; put it into the barfers list).
  868. X    #
  869. X    if a := \ (\atbl[token])[parser.state_stack[1]]
  870. X    then {
  871. X        a ? {
  872. X        # Keep track of how many actions we've seen.
  873. X        num := 0
  874. X
  875. X        # Snip off successive actions.  If there's no
  876. X        # ambiguity, there will be only one action, & no
  877. X        # additional parser environments will be created.
  878. X        #
  879. X        while {
  880. X        $$ifdef COMPRESSED_TABLES
  881. X            # "\x80" is the accept action; uncompress_action
  882. X            # does its own move()ing
  883. X            act := $uncompress_action()
  884. X        $$else
  885. X            act := ="a" | {
  886. X            tab(any('sr')) || tab(upto('.<')) ||
  887. X                ((="<" || tab(find(">")+1)) | =".") ||
  888. X                tab(many(&digits))
  889. X            }
  890. X        $$endif    #COMPRESSED TABLES
  891. X        }
  892. X        do {
  893. X            # New parser environment only needed for num > 1.
  894. X            #
  895. X            if (num +:= 1) > 1 then {
  896. X            new_parser := $fullcopy(parser)
  897. X            show_new_forest("=== table conflict; new parser",
  898. X                actives, shifters, reducers, barfers, new_parser)
  899. X            }
  900. X            else new_parser := parser
  901. X            new_parser.action := act
  902. X
  903. X            # Classify the action as s, r, or a, and place i
  904. X            # the appropriate list (or suspend a result if a).
  905. X            #
  906. X            case act[1] of {
  907. X            "s"  : put(shifters, new_parser)
  908. X            "r"  : put(reducers, new_parser)
  909. X            "a"  : {
  910. X                $iidebug("a", token, ruleno, parser)
  911. X                suspend parser.value_stack[1]
  912. X            }
  913. X            }
  914. X        }
  915. X        }
  916. X    }
  917. X    else {
  918. X        #
  919. X        # Error.  Parser will get garbage collected before another
  920. X        # token is read from iilex, unless the parsers all fail -
  921. X        # in which case, error recovery will be tried.
  922. X        #
  923. X        $iidebug("e", token, &null, parser)
  924. X        put(barfers, parser)
  925. X    }
  926. X    }
  927. X
  928. Xend
  929. X
  930. X
  931. X#
  932. X# perform_reductions
  933. X#
  934. Xprocedure $perform_reductions(token, actives, shifters, reducers, barfers)
  935. X
  936. X    local parser, ruleno, newsym, rhsize, arglist, result, num,
  937. X    new_parser, tmp, p
  938. X    static gtbl
  939. X    initial {
  940. X    gtbl := $gtbl_insertion_point
  941. X    $$line 336 "iiglrpar.lib"
  942. X    }
  943. X
  944. X    while parser := get(reducers)
  945. X    do {
  946. X
  947. X    # Set up global state and value stacks, so that the action
  948. X    # code can access them.
  949. X    #
  950. X    $state_stack := parser.state_stack
  951. X    $value_stack := parser.value_stack
  952. X    $errors := parser.errors
  953. X
  954. X    # Finally, perform the given action:
  955. X    #
  956. X    parser.action ? {
  957. X        #
  958. X        # Reduce action format, e.g. r1<S>2 = reduce by rule 1
  959. X        # (LHS = S, RHS length = 2).
  960. X        #
  961. X        move(1)
  962. X        ruleno := integer(1(tab(find("<")), move(1)))
  963. X        newsym := 1(tab(find(">")), move(1))
  964. X        rhsize := integer(tab(many(&digits)))
  965. X        arglist := []
  966. X        every 1 to rhsize do {
  967. X        pop($state_stack)
  968. X        push(arglist, pop($value_stack))
  969. X        }
  970. X        # Gtbl is "backwards," i.e. token first, state second.
  971. X        # The value produced is the "goto" state.
  972. X        #
  973. X        push($state_stack, gtbl[newsym][$state_stack[1]])
  974. X        #
  975. X        # The actions are in procedures having the same name as
  976. X        # the number of their rule, bracketed by underscores, &
  977. X        # followed by the current module name.  If there is such a
  978. X        # procedure associated with the current reduce action,
  979. X        # call it.
  980. X        #
  981. X        if func := proc("_" || ruleno || "_" || $module)
  982. X        then {
  983. X        num := 0
  984. X        #
  985. X        # For every valid result from the action code for the
  986. X        # current reduction, create a new parser if need be
  987. X        # (i.e. if num > 1), and check iidirective.  Push the
  988. X        # result onto the stack of the new parser & put the
  989. X        # new parser into the actives list.
  990. X        #
  991. X        every result := func!arglist do {
  992. X            # For all but the first result, create a new parser.
  993. X            if (num +:= 1) > 1 then {
  994. X            new_parser := $fullcopy(parser)
  995. X            pop(new_parser.value_stack) # take off pushed result
  996. X            show_new_forest("=== multi-result action; new parser",
  997. X                actives, shifters, reducers, barfers, new_parser)
  998. X            }
  999. X            else new_parser := parser
  1000. X            #
  1001. X            # IIERROR, IIACCEPT, iierrok, iiisolate, and iiprune
  1002. X            # are all implemented using a switch on a global
  1003. X            # iidirective variable; see the $defines described
  1004. X            # above.
  1005. X            #
  1006. X            tmp := $iidirective
  1007. X            $iidirective := &null
  1008. X            case tmp of {
  1009. X            &null    : &null
  1010. X            "clearin": {
  1011. X                # see perform_shifts() below
  1012. X                new_parser.clearin := 1
  1013. X            }
  1014. X            "error"  : {
  1015. X                $iidebug("e", token, ruleno, new_parser)
  1016. X                put(barfers, new_parser)
  1017. X                next
  1018. X            }
  1019. X            "errok"  : {
  1020. X                new_parser.recover_shifts := &null
  1021. X                new_parser.discards := 0
  1022. X            }
  1023. X            "prune"  : {
  1024. X                # Garden path.
  1025. X                $iidebug("p", token, ruleno, new_parser)
  1026. X                break next
  1027. X            }
  1028. X            "isolate"  : {
  1029. X                # Prune all but the current parser.
  1030. X            $$ifdef IIDEBUG
  1031. X                write(&errout, "+++ isolating by pruning")
  1032. X                while p := pop(actives) do
  1033. X                $iidebug("p", token, ruleno, p)
  1034. X                while p := pop(reducers) do
  1035. X                $iidebug("p", token, ruleno, p)
  1036. X                while p := pop(shifters) do
  1037. X                $iidebug("p", token, ruleno, p)
  1038. X                while p := pop(barfers) do
  1039. X                $iidebug("p", token, ruleno, p)
  1040. X            $$else
  1041. X                while pop(actives)
  1042. X                while pop(reducers)
  1043. X                while pop(shifters)
  1044. X                while pop(barfers)
  1045. X            $$endif    #IIDEBUG
  1046. X                push(new_parser.value_stack, result)
  1047. X                $iidebug("r", token, ruleno, new_parser)
  1048. X                put(actives, new_parser)
  1049. X                break next
  1050. X            }
  1051. X            "accept" : {
  1052. X                $iidebug("a", token, ruleno, new_parser)
  1053. X                suspend arglist[-1] | &null
  1054. X                next
  1055. X            }
  1056. X            default  : stop("error: bad iidirective")
  1057. X            }
  1058. X            #
  1059. X            # Push result onto the new parser thread's value
  1060. X            # stack.
  1061. X            #
  1062. X            push(new_parser.value_stack, result)
  1063. X            $iidebug("r", token, ruleno, new_parser)
  1064. X            put(actives, new_parser)
  1065. X            #
  1066. X            # Action code must have the stack in its original
  1067. X            # form.  So restore the stack's old form before
  1068. X            # going back to the action code.
  1069. X            #
  1070. X            if num = 1 then
  1071. X            $value_stack := parser.value_stack[2:0]
  1072. X            }
  1073. X        #
  1074. X        # If the action code for this rule failed, push &null.
  1075. X        # But first check $iidirective.
  1076. X        #
  1077. X        if num = 0 then {
  1078. X            #
  1079. X            # Same $iidirective code as above repeated
  1080. X            # (inelegantly) because it accesses too many
  1081. X            # variables to be easily isolated.
  1082. X            #
  1083. X            tmp := $iidirective
  1084. X            $iidirective := &null
  1085. X            case tmp of {
  1086. X            &null    : &null
  1087. X            "clearin": {
  1088. X                # see perform_shifts() below
  1089. X                parser.clearin := 1
  1090. X            }
  1091. X            "error"  : {
  1092. X                $iidebug("e", token, ruleno, parser)
  1093. X                put(barfers, parser)
  1094. X                next
  1095. X            }
  1096. X            "errok"  : {
  1097. X                parser.recover_shifts := &null
  1098. X                parser.discards := 0
  1099. X            }
  1100. X            "prune"  : {
  1101. X                # Garden path.
  1102. X                $iidebug("p", token, ruleno, parser)
  1103. X                next # go back to enclosing while pop...
  1104. X            }
  1105. X            "isolate"  : {
  1106. X                # Prune all but the current parser.
  1107. X            $$ifdef IIDEBUG
  1108. X                write(&errout, "+++ isolating by pruning")
  1109. X                while p := pop(actives) do
  1110. X                $iidebug("p", token, ruleno, p)
  1111. X                while p := pop(reducers) do
  1112. X                $iidebug("p", token, ruleno, p)
  1113. X                while p := pop(shifters) do
  1114. X                $iidebug("p", token, ruleno, p)
  1115. X                while p := pop(barfers) do
  1116. X                $iidebug("p", token, ruleno, p)
  1117. X            $$else
  1118. X                while pop(actives)
  1119. X                while pop(reducers)
  1120. X                while pop(shifters)
  1121. X                while pop(barfers)
  1122. X            $$endif    #IIDEBUG
  1123. X            }
  1124. X            "accept" : {
  1125. X                $iidebug("a", token, ruleno, parser)
  1126. X                suspend arglist[-1] | &null
  1127. X                next
  1128. X            }
  1129. X            default  : stop("error: bad iidirective")
  1130. X            }
  1131. X            # Finally, push the result!
  1132. X            result := arglist[-1] | &null
  1133. X            push(parser.value_stack, result)
  1134. X            $iidebug("r", token, ruleno, parser)
  1135. X            put(actives, parser)
  1136. X        }
  1137. X        }
  1138. X        # If there is no action code for this rule...
  1139. X        else {
  1140. X        # ...push the value of the last RHS arg.
  1141. X        # For 0-length e-productions, push &null.
  1142. X        result := arglist[-1] | &null
  1143. X        push(parser.value_stack, result)
  1144. X        $iidebug("r", token, ruleno, parser)
  1145. X        put(actives, parser)
  1146. X        }
  1147. X    }
  1148. X    }
  1149. X
  1150. Xend
  1151. X
  1152. X
  1153. X#
  1154. X# perform_shifts
  1155. X#
  1156. Xprocedure $perform_shifts(token, actives, shifters)
  1157. X    
  1158. X    local parser, ruleno
  1159. X
  1160. X    *shifters = 0 & fail
  1161. X
  1162. X    while parser := pop(shifters) do {
  1163. X    #
  1164. X    # One of the iidirectives is iiclearin, i.e. clear the input
  1165. X    # token and try again on the next token.
  1166. X    #
  1167. X    \parser.clearin := &null & {
  1168. X        put(actives, parser)
  1169. X        next
  1170. X    }
  1171. X    parser.action ? {
  1172. X        #
  1173. X            # Shift action format, e.g. s2.1 = shift and go to state 2
  1174. X        # by rule 1.
  1175. X            #
  1176. X        move(1)
  1177. X        push(parser.state_stack, integer(tab(find("."))))
  1178. X        push(parser.value_stack, $iilval)
  1179. X        ="."; ruleno := integer(tab(many(&digits)))
  1180. X        $iidebug("s", token, ruleno, parser)
  1181. X        pos(0) | stop("malformed action:  ", act)
  1182. X        #
  1183. X        # If, while recovering, we can manage to shift 3 tokens,
  1184. X        # then we consider ourselves resynchronized.  Don't count
  1185. X        # the error token (-1).
  1186. X        #
  1187. X        if token ~= -1 then {
  1188. X        if \parser.recover_shifts +:= 1 then {
  1189. X            # 3 shifts make a successful recovery
  1190. X            if parser.recover_shifts > 3 then {
  1191. X            parser.recover_shifts := &null
  1192. X            parser.discards := 0
  1193. X            }
  1194. X        }
  1195. X        }
  1196. X    }
  1197. X    put(actives, parser)
  1198. X    }
  1199. X
  1200. X    return
  1201. X    
  1202. Xend
  1203. X
  1204. X
  1205. X#
  1206. X# perform_barfs
  1207. X#
  1208. Xprocedure $perform_barfs(atbl, token, actives, barfers, fail_on_error)
  1209. X
  1210. X    #
  1211. X    # Note how this procedure has its own local reducers and shifters
  1212. X    # list.  These are *not* passed from the parent environment!
  1213. X    #
  1214. X    local parser, count, reducers, shifters, recoverers
  1215. X
  1216. X    # To hold the list of parsers that need to shift error (-1).
  1217. X    recoverers := list()
  1218. X
  1219. X    count := 0
  1220. X    while parser := pop(barfers) do {
  1221. X    count +:= 1
  1222. X    if \parser.recover_shifts := 0 then {
  1223. X        #
  1224. X        # If we're already in an error state, discard the
  1225. X        # current token, and increment the number of discards
  1226. X        # we have made.  500 is too many; abort.
  1227. X        #
  1228. X        if (parser.discards +:= 1) > 500 then {
  1229. X        if proc($iierror)
  1230. X        then $iierror("fatal error: can't resynchronize")
  1231. X        else write(&errout, "fatal error: can't resynchronize")
  1232. X        if \fail_on_error then fail
  1233. X        else stop()
  1234. X        }
  1235. X        # try again on this one with the next token
  1236. X        put(actives, parser)
  1237. X    } else {
  1238. X        parser.errors +:= 1 # error count for this parser
  1239. X        parser.discards := parser.recover_shifts := 0
  1240. X        # If this is our first erroneous parser, print a message.
  1241. X        if count = 1 then {
  1242. X        if proc($iierror)
  1243. X        then $iierror(image(\$ttbl[token]) | image(token))
  1244. X        else write(&errout, "parse error")
  1245. X        }
  1246. X        #
  1247. X        # If error appears in a RHS, pop states until we get to a
  1248. X        # spot where error (-1) is a valid lookahead token:
  1249. X        #
  1250. X        if \$ttbl[-1] then {
  1251. X        until *parser.state_stack = 0 do {
  1252. X            if \atbl[-1][parser.state_stack[1]] then {
  1253. X            put(recoverers, parser)
  1254. X            break next
  1255. X            } else pop(parser.state_stack) & pop(parser.value_stack)
  1256. X        }
  1257. X        }
  1258. X        # If we get past here, the stack is now empty or there
  1259. X        # are no error productions.  Abandon this parser.
  1260. X        $iidebug("p", token, &null, parser)
  1261. X    }
  1262. X    }
  1263. X
  1264. X    # Parsers still recovering are in the actives list; those that
  1265. X    # need to shift error (-1) are in the recoverers list.  The
  1266. X    # following turns recoverers into actives:
  1267. X    #
  1268. X    if *recoverers > 0 then {
  1269. X    reducers := list()    # a scratch list
  1270. X    shifters := list()    # ditto
  1271. X    until *recoverers = *reducers = 0 do {
  1272. X        $$ifdef AUTO_PRUNE
  1273. X        auto_prune(actives)
  1274. X        $$endif
  1275. X        suspend $ib_action(atbl, -1, recoverers, shifters,
  1276. X                   reducers, barfers)
  1277. X        suspend $perform_reductions(-1, recoverers, shifters,
  1278. X                    reducers, barfers)
  1279. X    }
  1280. X    $perform_shifts(-1, recoverers, shifters)
  1281. X    every put(actives, !recoverers)
  1282. X    }
  1283. X
  1284. Xend
  1285. X
  1286. X
  1287. X$$ifdef IIDEBUG
  1288. X
  1289. Xrecord production(LHS, RHS, POS, LOOK, no, prec, assoc)
  1290. X#
  1291. X# iidebug
  1292. X#
  1293. Xprocedure $iidebug(action, token, ruleno, parser)
  1294. X
  1295. X    local p, t, state
  1296. X    static rule_list
  1297. X    initial {
  1298. X    rule_list := $rule_list_insertion_point
  1299. X    $$line 693 "iiglrpar.lib"
  1300. X    }
  1301. X
  1302. X    write(&errout, "---  In parser ", image(parser), ":")
  1303. X    case action of {
  1304. X    "a"     : writes(&errout, "accepting ")    &
  1305. X        state := parser.state_stack[1]
  1306. X    "e"     : writes(&errout, "***ERROR***\n") &
  1307. X              writes(&errout, "error action ") &
  1308. X        state := parser.state_stack[1]
  1309. X    "p"     : writes(&errout, "***PRUNING***\n") &
  1310. X              writes(&errout, "prune action ") &
  1311. X        state := parser.state_stack[1]
  1312. X    "r"     : writes(&errout, "reducing ")     &
  1313. X        state := parser.state_stack[2]
  1314. X    "s"     : writes(&errout, "shifting ")     &
  1315. X        state := parser.state_stack[2]
  1316. X    default : stop("malformed action argument to iidebug")
  1317. X    }
  1318. X
  1319. X    t := image(token) || (" (" || (\$ttbl[token] | "unknown") || ")")
  1320. X    writes(&errout, "on lookahead ", t, ", in state ", state)
  1321. X    if \ruleno then {
  1322. X    (p := !rule_list).no === ruleno &
  1323. X        write(&errout, "; rule ", $production_2_string(p, $ttbl))
  1324. X    }
  1325. X    # for errors, ruleno is null
  1326. X    else write(&errout)
  1327. X
  1328. X    write(&errout, "    state stack now: ")
  1329. X    every write(&errout, "\t", image(!parser.state_stack))
  1330. X    write(&errout, "    value stack now: ")
  1331. X    if *parser.value_stack > 0
  1332. X    then every write(&errout, "\t", image(!parser.value_stack))
  1333. X    else write(&errout, "\t(empty)")
  1334. X
  1335. X    return
  1336. X
  1337. Xend
  1338. X
  1339. X
  1340. X#
  1341. X# production_2_string:  production record -> string
  1342. X#                       p                 -> s
  1343. X#
  1344. X#     Stringizes an image of the LHS and RHS of production p in
  1345. X#     human-readable form.
  1346. X#
  1347. Xprocedure $production_2_string(p, ibtoktbl)
  1348. X
  1349. X    local s, m, t
  1350. X
  1351. X    s := image(p.LHS) || " -> "
  1352. X    every m := !p.RHS do {
  1353. X    if t := \ (\ibtoktbl)[m]
  1354. X    then s ||:= t || " "
  1355. X    else s ||:= image(m) || " "
  1356. X    }
  1357. X    # if the POS field is nonnull, print it
  1358. X    s ||:= "(POS = " || image(\p.POS) || ") "
  1359. X    # if the LOOK field is nonnull, print it, too
  1360. X    s ||:= "lookahead = " || image(\p.LOOK)
  1361. X
  1362. X    return trim(s)
  1363. X
  1364. Xend
  1365. X
  1366. X#
  1367. X# show_new_forest
  1368. X#
  1369. Xprocedure show_new_forest(msg, actives, shifters, reducers, barfers, parser)
  1370. X    write(&errout, msg)
  1371. X    write(&errout, "    List of active parsers:")
  1372. X    every write(&errout, "\t", image(!actives))
  1373. X    every write(&errout, "\t", image(!shifters))
  1374. X    every write(&errout, "\t", image(!reducers))
  1375. X    every write(&errout, "\t", image(!barfers), " (error)")
  1376. X    write(&errout, "\tnew -> ", image(parser))
  1377. Xend
  1378. X$$endif                # IIDEBUG
  1379. X
  1380. X
  1381. X$$ifdef COMPRESSED_TABLES
  1382. X
  1383. X#
  1384. X# uncompress_action
  1385. X#
  1386. Xprocedure $uncompress_action()
  1387. X
  1388. X    local next_chunk, full_action
  1389. X
  1390. X    next_chunk := create ord(!&subject[&pos:0])
  1391. X    case $in_ib_bits(next_chunk, 2) of {
  1392. X    0: {
  1393. X        full_action := "s"
  1394. X        full_action ||:= $in_ib_bits(next_chunk, 11)
  1395. X        full_action ||:= "."
  1396. X        full_action ||:= $in_ib_bits(next_chunk, 11)
  1397. X        move(3)
  1398. X    }
  1399. X    1: {
  1400. X        full_action := "r"
  1401. X        full_action ||:= $in_ib_bits(next_chunk, 11)
  1402. X        full_action ||:= "<"
  1403. X        full_action ||:= $in_ib_bits(next_chunk, 11)
  1404. X        full_action ||:= ">"
  1405. X        full_action ||:= $in_ib_bits(next_chunk, 8)
  1406. X        move(4)
  1407. X    }
  1408. X        2: {
  1409. X        full_action := "a"
  1410. X        move(1)
  1411. X    }
  1412. X    } | fail
  1413. X
  1414. X    return full_action
  1415. X
  1416. Xend
  1417. X
  1418. X
  1419. X#
  1420. X# in_ib_bits:  like inbits (IPL), but with coexpression for file
  1421. X#
  1422. Xprocedure $in_ib_bits(next_chunk, len)
  1423. X
  1424. X    local i, byte, old_byte_mask
  1425. X    static old_byte, old_len, byte_length
  1426. X    initial {
  1427. X    old_byte := old_len := 0
  1428. X    byte_length := 8
  1429. X    }
  1430. X
  1431. X    old_byte_mask := (0 < 2^old_len - 1) | 0
  1432. X    old_byte := iand(old_byte, old_byte_mask)
  1433. X    i := ishift(old_byte, len-old_len)
  1434. X
  1435. X    len -:= (len > old_len) | {
  1436. X    old_len -:= len
  1437. X    return i
  1438. X    }
  1439. X    
  1440. X    while byte := @next_chunk do {
  1441. X    i := ior(i, ishift(byte, len-byte_length))
  1442. X    len -:= (len > byte_length) | {
  1443. X        old_len := byte_length-len
  1444. X        old_byte := byte
  1445. X        return i
  1446. X    }
  1447. X    }
  1448. X
  1449. Xend
  1450. X
  1451. X$$endif                # COMPRESSED_TABLES
  1452. X
  1453. X#
  1454. X# fullcopy:  make full recursive copy of object obj
  1455. X#
  1456. Xprocedure $fullcopy(obj)
  1457. X
  1458. X    local retval, i, k
  1459. X
  1460. X    case type(obj) of {
  1461. X        "co-expression"  : return obj
  1462. X        "cset"           : return obj
  1463. X        "file"           : return obj
  1464. X        "integer"        : return obj
  1465. X        "list"           : {
  1466. X            retval := list(*obj)
  1467. X            every i := 1 to *obj do
  1468. X                retval[i] := $fullcopy(obj[i])
  1469. X            return retval
  1470. X        }
  1471. X        "null"           :  return &null
  1472. X        "procedure"      :  return obj
  1473. X        "real"           :  return obj
  1474. X        "set"            :  {
  1475. X            retval := set()
  1476. X            every insert(retval, $fullcopy(!obj))
  1477. X            return retval
  1478. X        }
  1479. X        "string"         :  return obj
  1480. X        "table"          :  {
  1481. X            retval := table(obj[[]])
  1482. X            every k := key(obj) do
  1483. X                insert(retval, $fullcopy(k), $fullcopy(obj[k]))
  1484. X            return retval
  1485. X        }
  1486. X        # probably a record; if not, we're dealing with a new
  1487. X        # version of Icon or a nonstandard implementation, and
  1488. X    # we're screwed
  1489. X        default          :  {
  1490. X            retval := copy(obj)
  1491. X            every i := 1 to *obj do
  1492. X                retval[i] := $fullcopy(obj[i])
  1493. X            return retval
  1494. X        }
  1495. X    }
  1496. X
  1497. Xend
  1498. X
  1499. X
  1500. X$$ifdef AUTO_PRUNE
  1501. Xprocedure auto_prune(actives)
  1502. X
  1503. X    new_actives := []
  1504. X    while parser1 := pop(actives) do {
  1505. X    every parser2 := actives[j := 1 to *actives] do {
  1506. X        parser1.state_stack[1] = parser2.state_stack[1] | next
  1507. X        *parser1.value_stack   = *parser2.value_stack   | next
  1508. X        every i := 1 to *parser1.value_stack do {
  1509. X        parser1.value_stack[i] === parser2.value_stack[i] | 
  1510. X            break next
  1511. X        }
  1512. X        if parser1.errors < parser2.errors then
  1513. X        actives[j] := parser1
  1514. X        break next
  1515. X    }
  1516. X    put(new_actives, parser1)
  1517. X    }
  1518. X
  1519. X    every put(actives, !new_actives)
  1520. X    return &null
  1521. X
  1522. Xend
  1523. X$$endif                # AUTO_PRUNE
  1524. END_OF_FILE
  1525.   if test 26996 -ne `wc -c <'iiglrpar.lib'`; then
  1526.     echo shar: \"'iiglrpar.lib'\" unpacked with wrong size!
  1527.   fi
  1528.   # end of 'iiglrpar.lib'
  1529. fi
  1530. if test -f 'rewrap.icn' -a "${1}" != "-c" ; then 
  1531.   echo shar: Will not clobber existing file \"'rewrap.icn'\"
  1532. else
  1533.   echo shar: Extracting \"'rewrap.icn'\" \(4314 characters\)
  1534.   sed "s/^X//" >'rewrap.icn' <<'END_OF_FILE'
  1535. X############################################################################
  1536. X#
  1537. X#    Name:     rewrap.icn
  1538. X#
  1539. X#    Title:     advanced line rewrap utility
  1540. X#
  1541. X#    Author:     Richard L. Goerwitz
  1542. X#
  1543. X#    Version: 1.4
  1544. X#
  1545. X############################################################################
  1546. X#
  1547. X#  The procedure rewrap(s,i), included in this file, reformats text
  1548. X#  fed to it into strings < i in length.  Rewrap utilizes a static
  1549. X#  buffer, so it can be called repeatedly with different s arguments,
  1550. X#  and still produce homogenous output.  This buffer is flushed by
  1551. X#  calling rewrap with a null first argument.  The default for
  1552. X#  argument 2 (i) is 70.
  1553. X#
  1554. X#  Here's a simple example of how rewrap could be used.  The following
  1555. X#  program reads the standard input, producing fully rewrapped output.
  1556. X#
  1557. X#  procedure main()
  1558. X#      every write(rewrap(!&input))
  1559. X#      write(rewrap())
  1560. X#  end
  1561. X#
  1562. X#  Naturally, in practice you would want to do things like check for in-
  1563. X#  dentation or blank lines in order to wrap only on a paragraph-by para-
  1564. X#  graph basis, as in
  1565. X#
  1566. X#  procedure main()
  1567. X#      while line := read(&input) do {
  1568. X#          if line == "" then {
  1569. X#              write("" ~== rewrap())
  1570. X#              write(line)
  1571. X#          } else {
  1572. X#              if match("\t", line) then {
  1573. X#                  write(rewrap())
  1574. X#                  write(rewrap(line))
  1575. X#              } else {
  1576. X#                  write(rewrap(line))
  1577. X#              }
  1578. X#          }
  1579. X#      }
  1580. X#  end
  1581. X#
  1582. X#  Fill-prefixes can be implemented simply by prepending them to the
  1583. X#  output of rewrap:
  1584. X#
  1585. X#      i := 70; fill_prefix := " > "
  1586. X#      while line := read(input_file) do {
  1587. X#          line ?:= (f_bit := tab(many('> ')) | "", tab(0))
  1588. X#          write(fill_prefix || f_bit || rewrap(line, i - *fill_prefix))
  1589. X#          etc.
  1590. X#
  1591. X#  Obviously, these examples are fairly simplistic.  Putting them to
  1592. X#  actual use would certainly require a few environment-specific
  1593. X#  modifications and/or extensions.  Still, I hope they offer some
  1594. X#  indication of the kinds of applications rewrap might be used in.
  1595. X# 
  1596. X#  Note:  If you want leading and trailing tabs removed, map them to
  1597. X#  spaces first.  Rewrap only fools with spaces, leaving tabs intact.
  1598. X#  This can be changed easily enough, by running its input through the
  1599. X#  Icon detab() function.
  1600. X#
  1601. X############################################################################
  1602. X#
  1603. X#  See also:  wrap.icn
  1604. X#
  1605. X############################################################################
  1606. X
  1607. X
  1608. Xprocedure rewrap(s,i)
  1609. X
  1610. X    local extra_bit, line
  1611. X    static old_line
  1612. X    initial old_line := ""
  1613. X
  1614. X    # Default column to wrap on is 70.
  1615. X    /i := 70
  1616. X    # Flush buffer on null first argument.
  1617. X    if /s then {
  1618. X    extra_bit := old_line
  1619. X    old_line := ""
  1620. X    return "" ~== extra_bit
  1621. X    }
  1622. X
  1623. X    # Prepend to s anything that is in the buffer (leftovers from the last s).
  1624. X    s ?:= { tab(many(' ')); old_line || trim(tab(0)) }
  1625. X
  1626. X    # If the line isn't long enough, just add everything to old_line.
  1627. X    if *s < i then old_line := s || " " & fail
  1628. X
  1629. X    s ? {
  1630. X
  1631. X    # While it is possible to find places to break s, do so.
  1632. X    while any(' -',line := EndToFront(i),-1) do {
  1633. X        # Clean up and suspend the last piece of s tabbed over.
  1634. X        line ?:= (tab(many(' ')), trim(tab(0)))
  1635. X            if *&subject - &pos + *line > i
  1636. X        then suspend line
  1637. X        else {
  1638. X        old_line := ""
  1639. X        return line || tab(0)
  1640. X        }
  1641. X    }
  1642. X
  1643. X    # Keep the extra section of s in a buffer.
  1644. X    old_line := tab(0)
  1645. X
  1646. X    # If the reason the remaining section of s was unrewrapable was
  1647. X    # that it was too long, and couldn't be broken up, then just return
  1648. X    # the thing as-is.
  1649. X    if *old_line > i then {
  1650. X        old_line ? {
  1651. X        if extra_bit := tab(upto(' -')+1) || (tab(many(' ')) | "")
  1652. X        then old_line := tab(0)
  1653. X        else extra_bit := old_line & old_line := ""
  1654. X        return trim(extra_bit)
  1655. X        }
  1656. X    }
  1657. X    # Otherwise, clean up the buffer for prepending to the next s.
  1658. X    else {
  1659. X        # If old_line is blank, then don't mess with it.  Otherwise,
  1660. X        # add whatever is needed in order to link it with the next s.
  1661. X        if old_line ~== "" then {
  1662. X        # If old_line ends in a dash, then there's no need to add a
  1663. X        # space to it.
  1664. X        if old_line[-1] ~== "-"
  1665. X        then old_line ||:= " "
  1666. X        }
  1667. X    }
  1668. X    }
  1669. X    
  1670. Xend
  1671. X
  1672. X
  1673. X
  1674. Xprocedure EndToFront(i)
  1675. X    # Goes with rewrap(s,i)
  1676. X    *&subject+1 - &pos >= i | fail
  1677. X    suspend &subject[.&pos:&pos <- &pos+i to &pos by -1]
  1678. Xend
  1679. END_OF_FILE
  1680.   if test 4314 -ne `wc -c <'rewrap.icn'`; then
  1681.     echo shar: \"'rewrap.icn'\" unpacked with wrong size!
  1682.   fi
  1683.   # end of 'rewrap.icn'
  1684. fi
  1685. if test -f 'version.icn' -a "${1}" != "-c" ; then 
  1686.   echo shar: Will not clobber existing file \"'version.icn'\"
  1687. else
  1688.   echo shar: Extracting \"'version.icn'\" \(439 characters\)
  1689.   sed "s/^X//" >'version.icn' <<'END_OF_FILE'
  1690. X############################################################################
  1691. X#
  1692. X#    Name:     version.icn
  1693. X#
  1694. X#    Title:     return Ibpag2 version number
  1695. X#
  1696. X#    Author:     Richard L. Goerwitz
  1697. X#
  1698. X#    Version: 1.10
  1699. X#
  1700. X############################################################################
  1701. X#
  1702. X#  See also: ibpag2.icn
  1703. X#
  1704. X############################################################################
  1705. X
  1706. Xprocedure ib_version()
  1707. X    return "Ibpag2, version 1.3.4"
  1708. Xend
  1709. END_OF_FILE
  1710.   if test 439 -ne `wc -c <'version.icn'`; then
  1711.     echo shar: \"'version.icn'\" unpacked with wrong size!
  1712.   fi
  1713.   # end of 'version.icn'
  1714. fi
  1715. echo shar: End of archive 1 \(of 5\).
  1716. cp /dev/null ark1isdone
  1717. MISSING=""
  1718. for I in 1 2 3 4 5 ; do
  1719.     if test ! -f ark${I}isdone ; then
  1720.     MISSING="${MISSING} ${I}"
  1721.     fi
  1722. done
  1723. if test "${MISSING}" = "" ; then
  1724.     echo You have unpacked all 5 archives.
  1725.     rm -f ark[1-9]isdone
  1726. else
  1727.     echo You still must unpack the following archives:
  1728.     echo "        " ${MISSING}
  1729. fi
  1730. exit 0
  1731. exit 0 # Just in case...
  1732.