home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #31 / NN_1992_31.iso / spool / comp / lang / icon / 563 < prev    next >
Encoding:
Internet Message Format  |  1993-01-03  |  23.2 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 4
  5. Message-ID: <1993Jan3.211956.28640@midway.uchicago.edu>
  6. Date: 3 Jan 93 21:19:56 GMT
  7. References: <1993Jan3.211757.28395@midway.uchicago.edu>
  8. Sender: news@uchinews.uchicago.edu (News System)
  9. Reply-To: goer@midway.uchicago.edu
  10. Organization: University of Chicago
  11. Lines: 800
  12.  
  13. ---- Cut Here and feed the following to sh ----
  14. #!/bin/sh
  15. # this is ibpag.04 (part 4 of a multipart archive)
  16. # do not concatenate these parts, unpack them in order with /bin/sh
  17. # file itokens.icn continued
  18. #
  19. if test ! -r _shar_seq_.tmp; then
  20.     echo 'Please unpack part 1 first!'
  21.     exit 1
  22. fi
  23. (read Scheck
  24.  if test "$Scheck" != 4; then
  25.     echo Please unpack part "$Scheck" next!
  26.     exit 1
  27.  else
  28.     exit 0
  29.  fi
  30. ) < _shar_seq_.tmp || exit 1
  31. if test ! -f _shar_wnt_.tmp; then
  32.     echo 'x - still skipping itokens.icn'
  33. else
  34. echo 'x - continuing file itokens.icn'
  35. sed 's/^X//' << 'SHAR_EOF' >> 'itokens.icn' &&
  36. X#      non-whitespace character, whitespace being defined as
  37. X#      membership of a given character in the whitespace argument (a
  38. X#      cset). 
  39. X#
  40. Xprocedure do_whitespace(getchar, whitespace)
  41. X
  42. X#   write(&errout, "it's junk")
  43. X    while any(whitespace, next_c) do
  44. X    next_c := @getchar
  45. X    return
  46. X
  47. Xend
  48. X
  49. X
  50. X#
  51. X#  do_identifier:  coexpression x table    -> TOK record
  52. X#                  (getchar, reserved_tbl) -> t
  53. X#
  54. X#      Where getchar is the coexpression that pops off characters from
  55. X#      the input stream, reserved_tbl is a table of reserved words
  56. X#      (keys = the string values, values = the names qua symbols in
  57. X#      the grammar), and t is a TOK record containing all subsequent
  58. X#      letters, digits, or underscores after next_c (which must be a
  59. X#      letter or underscore).  Note that next_c is global and gets
  60. X#      reset by do_identifier.
  61. X#
  62. Xprocedure do_identifier(getchar, reserved_tbl)
  63. X
  64. X    local token
  65. X    # global next_c
  66. X
  67. X#   write(&errout, "it's an indentifier")
  68. X    token := next_c
  69. X    while any(&letters ++ &digits ++ '_', next_c := @getchar)
  70. X    do token ||:= next_c
  71. X    return TOK(\reserved_tbl[token], token) | TOK("IDENT", token)
  72. X    
  73. Xend
  74. X
  75. X
  76. X#
  77. X#  do_operator:  coexpression x list      -> TOK record
  78. X#                getchar      x operators -> t
  79. X#
  80. X#      Where getchar is the coexpression that produces the next
  81. X#      character on the input stream, and t is a TOK record
  82. X#      describing the operator just scanned.  Calls recognop, which
  83. X#      creates a DFSA to recognize valid Icon operators.  Arg2
  84. X#      (operators) is the list of lists containing valid Icon operator
  85. X#      string values and names (see above).
  86. X#
  87. Xprocedure do_operator(getchar, operators)
  88. X
  89. X    local token, elem
  90. X
  91. X    token := next_c
  92. X
  93. X    # Go until recognop fails.
  94. X    while elem := recognop(operators, token, 1) do
  95. X    token ||:= (next_c := @getchar)
  96. X#   write(&errout, ximage(elem))
  97. X    if *\elem = 1 then
  98. X    return TOK(elem[1][2], elem[1][1])
  99. X    else fail
  100. X
  101. Xend
  102. X
  103. X
  104. Xrecord dfstn_state(b, e, tbl)
  105. Xrecord start_state(b, e, tbl, master_list)
  106. X#
  107. X#  recognop: list x string x integer -> list
  108. X#            (l, s, i)               -> l2
  109. X#
  110. X#      Where l is the list of lists created by the calling procedure
  111. X#      (each element contains a token string value, name, and
  112. X#      beginner/ender string), where s is a string possibly
  113. X#      corresponding to a token in the list, where i is the position
  114. X#      in the elements of l where the operator string values are
  115. X#      recorded, and where l2 is a list of elements from l that
  116. X#      contain operators for which string s is an exact match.
  117. X#      Fails if there are no operators that s is a prefix of, but
  118. X#      returns an empty list if there just aren't any that happen to
  119. X#      match exactly.
  120. X#
  121. X#      What this does is let the calling procedure just keep adding
  122. X#      characters to s until recognop fails, then check the last list
  123. X#      it returned to see if it is of length 1.  If it is, then it
  124. X#      contains list with the vital stats for the operator last
  125. X#      recognized.  If it is of length 0, then string s did not
  126. X#      contain any recognizable operator.
  127. X#
  128. Xprocedure recognop(l, s, i)
  129. X
  130. X    local   current_state, master_list, c, result, j
  131. X    static  dfstn_table
  132. X    initial dfstn_table := table()
  133. X
  134. X    /i := 1
  135. X    # See if we've created an automaton for l already.
  136. X    /dfstn_table[l] := start_state(1, *l, &null, &null) & {
  137. X    dfstn_table[l].master_list := sortf(l, i)
  138. X    }
  139. X
  140. X    current_state := dfstn_table[l]
  141. X    # Save master_list, as current_state will change later on.
  142. X    master_list   := current_state.master_list
  143. X
  144. X    s ? {
  145. X    while c := move(1) do {
  146. X
  147. X        # Null means that this part of the automaton isn't
  148. X        # complete.
  149. X        #
  150. X        if /current_state.tbl then
  151. X        create_arcs(master_list, i, current_state, &pos)
  152. X
  153. X        # If the table has been clobbered, then there are no arcs
  154. X        # leading out of the current state.  Fail.
  155. X        #
  156. X        if current_state.tbl === 0 then
  157. X        fail
  158. X        
  159. X#        write(&errout, "c = ", image(c))
  160. X#        write(&errout, "table for current state = ", 
  161. X#          ximage(current_state.tbl))
  162. X
  163. X        # If we get to here, the current state has arcs leading
  164. X        # out of it.  See if c is one of them.  If so, make the
  165. X        # node to which arc c is connected the current state.
  166. X        # Otherwise fail.
  167. X        #
  168. X        current_state := \current_state.tbl[c] | fail
  169. X    }
  170. X    }
  171. X
  172. X    # Return possible completions.
  173. X    #
  174. X    result := list()
  175. X    every j := current_state.b to current_state.e do {
  176. X    if *master_list[j][i] = *s then
  177. X        put(result, master_list[j])
  178. X    }
  179. X    # return empty list if nothing the right length is found
  180. X    return result
  181. X
  182. Xend
  183. X
  184. X
  185. X#
  186. X#  create_arcs:  fill out a table of arcs leading out of the current
  187. X#                state, and place that table in the tbl field for
  188. X#                current_state
  189. X#
  190. Xprocedure create_arcs(master_list, field, current_state, POS)
  191. X
  192. X    local elem, i, first_char, old_first_char
  193. X
  194. X    current_state.tbl := table()
  195. X    old_first_char := ""
  196. X    
  197. X    every elem := master_list[i := current_state.b to current_state.e][field]
  198. X    do {
  199. X    
  200. X    # Get the first character for the current position (note that
  201. X    # we're one character behind the calling routine; hence
  202. X    # POS-1).
  203. X    #
  204. X    first_char := elem[POS-1] | next
  205. X    
  206. X    # If we have a new first character, create a new arc out of
  207. X    # the current state.
  208. X    #
  209. X    if first_char ~== old_first_char then {
  210. X        # Store the start position for the current character.
  211. X        current_state.tbl[first_char] := dfstn_state(i)
  212. X        # Store the end position for the old character.
  213. X        (\current_state.tbl[old_first_char]).e := i-1
  214. X        old_first_char := first_char
  215. X    }
  216. X    }
  217. X    (\current_state.tbl[old_first_char]).e := i
  218. X
  219. X    # Clobber table with 0 if no arcs were added.
  220. X    current_state.tbl := (*current_state.tbl = 0)
  221. X    return current_state
  222. X
  223. Xend
  224. SHAR_EOF
  225. echo 'File itokens.icn is complete' &&
  226. true || echo 'restore of itokens.icn failed'
  227. rm -f _shar_wnt_.tmp
  228. fi
  229. # ============= debugme.icn ==============
  230. if test -f 'debugme.icn' -a X"$1" != X"-c"; then
  231.     echo 'x - skipping debugme.icn (File already exists)'
  232.     rm -f _shar_wnt_.tmp
  233. else
  234. > _shar_wnt_.tmp
  235. echo 'x - extracting debugme.icn (Text)'
  236. sed 's/^X//' << 'SHAR_EOF' > 'debugme.icn' &&
  237. Xlink structs
  238. X
  239. X#
  240. X# dump_lists:  file x list x list -> (null)
  241. X#              (f, gl, al)        -> (null)
  242. X#
  243. X#     Where f is an open file, gl is the goto list, and al is the
  244. X#     action list.  Writes to file f a human-readable dump of the goto
  245. X#     and action list.
  246. X#
  247. Xprocedure dump_lists(f, al, gl)
  248. X
  249. X    local TAB, look_list, red_list, i, sym, act
  250. X
  251. X    TAB := "\t"
  252. X    look_list := list()
  253. X    red_list := list()
  254. X
  255. X    every i := 1 to *al do {
  256. X    every INSERT(look_list, key(\al[i]))
  257. X    if /al[i] then
  258. X        write(&errout, "dump_lists:  warning!  state ", i, " is null")
  259. X    }
  260. X
  261. X    writes(f, TAB)
  262. X    every i := 1 to *look_list do
  263. X    writes(f, look_list[i], TAB)
  264. X    write(f)
  265. X    every i := 1 to *al do {
  266. X    writes(f, i, TAB)
  267. X    act := ""
  268. X    every sym := !look_list do {
  269. X        if \al[i][sym] then {
  270. X        # al[i][sym][1] will fail for the accept action; hence
  271. X        # the "".  Otherwise al[i][sym][1] selects that state
  272. X        # field of a SH or RE record.
  273. X        writes(f, map(type(al[i][sym])), al[i][sym][1] | "")
  274. X        if type(al[i][sym]) == "RE" then {
  275. X            INSERT(red_list, al[i][sym].sym)
  276. X            writes(f, al[i][sym].sym)
  277. X        }
  278. X        }
  279. X        writes(f,TAB)
  280. X    }
  281. X    write(f)
  282. X    }
  283. X    write(f)
  284. X
  285. X    writes(f, TAB)
  286. X    every i := 1 to *red_list do
  287. X    writes(f, red_list[i], TAB)
  288. X    write(f)
  289. X    every i := 1 to *gl do {
  290. X    writes(f, i, TAB)
  291. X    act := ""
  292. X    every sym := !red_list do {
  293. X        if \(\gl[i])[sym] then
  294. X        writes(f, gl[i][sym])
  295. X        writes(f, TAB)
  296. X    }
  297. X    write(f)
  298. X    }
  299. X
  300. Xend
  301. X
  302. X#
  303. X# INSERT:  set or list x record -> set or list
  304. X#        (sset, rec)          -> sset
  305. X#
  306. X#     Where sset is a homogenous set or list of records, rec is a
  307. X#     record, and the return value is sset, with rec added, iff an
  308. X#     equivalent record was not there already.  Otherwise, sset is
  309. X#     returned unchanged. INSERT(), _unlike insert(), FAILS IF REC
  310. X#     IS ALREADY PRESENT IN SSET.
  311. X#
  312. X#     This procedure is used by dump_lists() above.  If you delete
  313. X#     dump_lists(), delete this as well, as also Equiv() below.
  314. X#
  315. Xprocedure INSERT(sset, rec)
  316. X
  317. X    local addto, Eq
  318. X    #
  319. X    # Decide how to add members to sset, depending on its type.
  320. X    #
  321. X    case type(sset) of {
  322. X        "set"   : { addto := insert; Eq := equiv }
  323. X        "list"  : { addto := put; Eq := Equiv }
  324. X        default : stop("INSERT:  wrong type argument (",type(sset),")")
  325. X    }
  326. X
  327. X    # Rudumentary error check to be sure the object to be inserted
  328. X    # into sset is of the same time as the objects already there.
  329. X    #
  330. X    if *sset > 0 then
  331. X    type(rec) == type(sset[1]) |
  332. X        stop("INSERT:  unexpected type difference")
  333. X
  334. X    #
  335. X    # If a rec-like item isn't in sset, add it to sset.
  336. X    #
  337. X    if Eq(!sset, rec) then fail
  338. X    else return addto(sset, rec)
  339. X
  340. Xend
  341. X    
  342. X
  343. X#
  344. X# Equiv: struct x struct -> struct
  345. X#        (x1, x2)        -> x2
  346. X#
  347. X#     Where x1 and x2 are arbitrary structures.  Returns x2 if x1 and
  348. X#     x2 are structurally equivalent (even if not identical).  Taken
  349. X#     from the IPL file "structs.icn," and gutted so that it assumes
  350. X#     all structures are "ordered" (i.e. not sets or tables).  Has no
  351. X#     way of handling procedures or files, either.  (Pretty limited,
  352. X#     huh?)
  353. X#
  354. Xprocedure Equiv(x1, x2, done)
  355. X
  356. X   local code, i
  357. X
  358. X   if x1 === x2 then return x2        # Covers everything but structures.
  359. X   if type(x1) ~== type(x2) then fail    # Must be same type.
  360. X   if *x1 ~= *x2 then fail
  361. X
  362. X   image(x1) ? (code := (="record" | type(x1)))
  363. X   case code of {
  364. X       "list" | "record"    :
  365. X       every i := *x1 to 1 by -1 do
  366. X           Equiv(x1[i],x2[i]) | fail
  367. X       "set" | "table"      : stop("error:  Equiv used (wrongly) for equiv.")
  368. X       "procedure" | "file" : stop("error:  Equiv used (wrongly) for equiv.")
  369. X       default              : fail
  370. X   }
  371. X   return x2
  372. X
  373. Xend
  374. SHAR_EOF
  375. true || echo 'restore of debugme.icn failed'
  376. rm -f _shar_wnt_.tmp
  377. fi
  378. # ============= errors.icn ==============
  379. if test -f 'errors.icn' -a X"$1" != X"-c"; then
  380.     echo 'x - skipping errors.icn (File already exists)'
  381.     rm -f _shar_wnt_.tmp
  382. else
  383. > _shar_wnt_.tmp
  384. echo 'x - extracting errors.icn (Text)'
  385. sed 's/^X//' << 'SHAR_EOF' > 'errors.icn' &&
  386. X#
  387. X# oh_no:  print error message to stderr & abort
  388. X#
  389. Xprocedure oh_no(s, n)
  390. X
  391. X    local i, msg
  392. X    static errlist
  393. X    initial {
  394. X        errlist := [[1,  "malformed LHS"],
  395. X            [2,  "unexpected termination of right-hand side"],
  396. X                    [3,  "missing left parenthesis"],
  397. X                    [4,  "malformed start_symbol declaration"],
  398. X                    [5,  "unexpected end of input"],
  399. X            [6,  "invalid symbol spec in right-hand side"],
  400. X                    [7,  "rule declaration within another rule"],
  401. X            [8,  "procedure declaration within a rule"],
  402. X                    [9,  "unmatched left parenthesis"],
  403. X                    [10, "mangled right-hand side"],
  404. X            [11, "missing priority"],
  405. X            [12, "missing associativity"],
  406. X
  407. X            [50, "illegal conflict for nonassociative rules"],
  408. X            [51, "reduce/reduce conflict"],
  409. X            [52, "symbol lacks termination in the grammar"]
  410. X                   ]
  411. X    }
  412. X    every i := 1 to *errlist do
  413. X        if errlist[i][1] = n then msg := errlist[i][2]
  414. X    writes(&errout, "error ", n, " (", msg, ")")
  415. X    if \s then {
  416. X    write(&errout, ":  ")
  417. X    every write("\t", rewrap(s) | rewrap())
  418. X    }
  419. X    else write(&errout, "")
  420. X    exit(n)
  421. X
  422. Xend
  423. SHAR_EOF
  424. true || echo 'restore of errors.icn failed'
  425. rm -f _shar_wnt_.tmp
  426. fi
  427. # ============= slashupto.icn ==============
  428. if test -f 'slashupto.icn' -a X"$1" != X"-c"; then
  429.     echo 'x - skipping slashupto.icn (File already exists)'
  430.     rm -f _shar_wnt_.tmp
  431. else
  432. > _shar_wnt_.tmp
  433. echo 'x - extracting slashupto.icn (Text)'
  434. sed 's/^X//' << 'SHAR_EOF' > 'slashupto.icn' &&
  435. X############################################################################
  436. X#
  437. X#    Name:     slashupto.icn
  438. X#
  439. X#    Title:     slashupto (upto with backslash escaping)
  440. X#
  441. X#    Author:     Richard L. Goerwitz
  442. X#
  443. X#    Version: 1.2
  444. X#
  445. X############################################################################
  446. X#
  447. X#  Slashupto works just like upto, except that it ignores backslash
  448. X#  escaped characters.  I can't even begin to express how often I've
  449. X#  run into problems applying Icon's string scanning facilities to
  450. X#  to input that uses backslash escaping.  Normally, I tokenize first,
  451. X#  and then work with lists.  With slashupto() I can now postpone or
  452. X#  even eliminate the traditional tokenizing step, and let Icon's
  453. X#  string scanning facilities to more of the work.
  454. X#
  455. X#  If you're confused:
  456. X#
  457. X#  Typically UNIX utilities (and probably others) use backslashes to
  458. X#  "escape" (i.e. remove the special meaning of) metacharacters.  For
  459. X#  instance, UNIX shells normally accept "*" as a shorthand for "any
  460. X#  series of zero or more characters.  You can make the "*" a literal
  461. X#  "*," with no special meaning, by prepending a backslash.  The rou-
  462. X#  tine slashupto() understands these backslashing conventions.  You
  463. X#  can use it to find the "*" and other special characters because it
  464. X#  will ignore "escaped" characters.
  465. X#
  466. X############################################################################
  467. X#
  468. X#  Links: none
  469. X#
  470. X#  See also: slashbal.icn
  471. X#
  472. X############################################################################
  473. X
  474. X#
  475. X# slashupto:  cset x string x integer x integer -> integers
  476. X#             (c, s, i, j) -> Is (a generator)
  477. X#    where Is are the integer positions in s[i:j] before characters
  478. X#    in c that is not preceded by a backslash escape
  479. X#
  480. Xprocedure slashupto(c, s, i, j)
  481. X
  482. X    if /s := &subject
  483. X    then /i := &pos
  484. X    else /i := 1
  485. X    /j := *s + 1
  486. X    
  487. X    /c := &cset
  488. X    c ++:= '\\'
  489. X    s[1:j] ? {
  490. X        tab(i)
  491. X        while tab(upto(c)) do {
  492. X            if ="\\" then {
  493. X        move(1)
  494. X        next
  495. X        }
  496. X            suspend .&pos
  497. X            move(1)
  498. X        }
  499. X    }
  500. X
  501. Xend
  502. X
  503. SHAR_EOF
  504. true || echo 'restore of slashupto.icn failed'
  505. rm -f _shar_wnt_.tmp
  506. fi
  507. # ============= rewrap.icn ==============
  508. if test -f 'rewrap.icn' -a X"$1" != X"-c"; then
  509.     echo 'x - skipping rewrap.icn (File already exists)'
  510.     rm -f _shar_wnt_.tmp
  511. else
  512. > _shar_wnt_.tmp
  513. echo 'x - extracting rewrap.icn (Text)'
  514. sed 's/^X//' << 'SHAR_EOF' > 'rewrap.icn' &&
  515. X############################################################################
  516. X#
  517. X#    Name:     rewrap.icn
  518. X#
  519. X#    Title:     advanced line rewrap utility
  520. X#
  521. X#    Author:     Richard L. Goerwitz
  522. X#
  523. X#    Version: 1.4
  524. X#
  525. X############################################################################
  526. X#
  527. X#  The procedure rewrap(s,i), included in this file, reformats text
  528. X#  fed to it into strings < i in length.  Rewrap utilizes a static
  529. X#  buffer, so it can be called repeatedly with different s arguments,
  530. X#  and still produce homogenous output.  This buffer is flushed by
  531. X#  calling rewrap with a null first argument.  The default for
  532. X#  argument 2 (i) is 70.
  533. X#
  534. X#  Here's a simple example of how rewrap could be used.  The following
  535. X#  program reads the standard input, producing fully rewrapped output.
  536. X#
  537. X#  procedure main()
  538. X#      every write(rewrap(!&input))
  539. X#      write(rewrap())
  540. X#  end
  541. X#
  542. X#  Naturally, in practice you would want to do things like check for in-
  543. X#  dentation or blank lines in order to wrap only on a paragraph-by para-
  544. X#  graph basis, as in
  545. X#
  546. X#  procedure main()
  547. X#      while line := read(&input) do {
  548. X#          if line == "" then {
  549. X#              write("" ~== rewrap())
  550. X#              write(line)
  551. X#          } else {
  552. X#              if match("\t", line) then {
  553. X#                  write(rewrap())
  554. X#                  write(rewrap(line))
  555. X#              } else {
  556. X#                  write(rewrap(line))
  557. X#              }
  558. X#          }
  559. X#      }
  560. X#  end
  561. X#
  562. X#  Fill-prefixes can be implemented simply by prepending them to the
  563. X#  output of rewrap:
  564. X#
  565. X#      i := 70; fill_prefix := " > "
  566. X#      while line := read(input_file) do {
  567. X#          line ?:= (f_bit := tab(many('> ')) | "", tab(0))
  568. X#          write(fill_prefix || f_bit || rewrap(line, i - *fill_prefix))
  569. X#          etc.
  570. X#
  571. X#  Obviously, these examples are fairly simplistic.  Putting them to
  572. X#  actual use would certainly require a few environment-specific
  573. X#  modifications and/or extensions.  Still, I hope they offer some
  574. X#  indication of the kinds of applications rewrap might be used in.
  575. X# 
  576. X#  Note:  If you want leading and trailing tabs removed, map them to
  577. X#  spaces first.  Rewrap only fools with spaces, leaving tabs intact.
  578. X#  This can be changed easily enough, by running its input through the
  579. X#  Icon detab() function.
  580. X#
  581. X############################################################################
  582. X#
  583. X#  See also:  wrap.icn
  584. X#
  585. X############################################################################
  586. X
  587. X
  588. Xprocedure rewrap(s,i)
  589. X
  590. X    local extra_bit, line
  591. X    static old_line
  592. X    initial old_line := ""
  593. X
  594. X    # Default column to wrap on is 70.
  595. X    /i := 70
  596. X    # Flush buffer on null first argument.
  597. X    if /s then {
  598. X    extra_bit := old_line
  599. X    old_line := ""
  600. X    return "" ~== extra_bit
  601. X    }
  602. X
  603. X    # Prepend to s anything that is in the buffer (leftovers from the last s).
  604. X    s ?:= { tab(many(' ')); old_line || trim(tab(0)) }
  605. X
  606. X    # If the line isn't long enough, just add everything to old_line.
  607. X    if *s < i then old_line := s || " " & fail
  608. X
  609. X    s ? {
  610. X
  611. X    # While it is possible to find places to break s, do so.
  612. X    while any(' -',line := EndToFront(i),-1) do {
  613. X        # Clean up and suspend the last piece of s tabbed over.
  614. X        line ?:= (tab(many(' ')), trim(tab(0)))
  615. X            if *&subject - &pos + *line > i
  616. X        then suspend line
  617. X        else {
  618. X        old_line := ""
  619. X        return line || tab(0)
  620. X        }
  621. X    }
  622. X
  623. X    # Keep the extra section of s in a buffer.
  624. X    old_line := tab(0)
  625. X
  626. X    # If the reason the remaining section of s was unrewrapable was
  627. X    # that it was too long, and couldn't be broken up, then just return
  628. X    # the thing as-is.
  629. X    if *old_line > i then {
  630. X        old_line ? {
  631. X        if extra_bit := tab(upto(' -')+1) || (tab(many(' ')) | "")
  632. X        then old_line := tab(0)
  633. X        else extra_bit := old_line & old_line := ""
  634. X        return trim(extra_bit)
  635. X        }
  636. X    }
  637. X    # Otherwise, clean up the buffer for prepending to the next s.
  638. X    else {
  639. X        # If old_line is blank, then don't mess with it.  Otherwise,
  640. X        # add whatever is needed in order to link it with the next s.
  641. X        if old_line ~== "" then {
  642. X        # If old_line ends in a dash, then there's no need to add a
  643. X        # space to it.
  644. X        if old_line[-1] ~== "-"
  645. X        then old_line ||:= " "
  646. X        }
  647. X    }
  648. X    }
  649. X    
  650. Xend
  651. X
  652. X
  653. X
  654. Xprocedure EndToFront(i)
  655. X    # Goes with rewrap(s,i)
  656. X    *&subject+1 - &pos >= i | fail
  657. X    suspend &subject[.&pos:&pos <- &pos+i to &pos by -1]
  658. Xend
  659. SHAR_EOF
  660. true || echo 'restore of rewrap.icn failed'
  661. rm -f _shar_wnt_.tmp
  662. fi
  663. # ============= strip.icn ==============
  664. if test -f 'strip.icn' -a X"$1" != X"-c"; then
  665.     echo 'x - skipping strip.icn (File already exists)'
  666.     rm -f _shar_wnt_.tmp
  667. else
  668. > _shar_wnt_.tmp
  669. echo 'x - extracting strip.icn (Text)'
  670. sed 's/^X//' << 'SHAR_EOF' > 'strip.icn' &&
  671. X############################################################################
  672. X#
  673. X#    Name:     strip.icn
  674. X#
  675. X#    Title:     strip characters from a string
  676. X#
  677. X#    Author:     Richard L. Goerwitz
  678. X#
  679. X#    Version: 1.1
  680. X#
  681. X############################################################################
  682. X#  
  683. X#  strip(s,c)    - strip characters c from string s
  684. X#
  685. X############################################################################
  686. X#
  687. X#  Links: none
  688. X#
  689. X############################################################################
  690. X
  691. X
  692. Xprocedure strip(s,c)
  693. X
  694. X    # Return string s stripped of characters c.  Succeed whether
  695. X    # any characters c were found in s or not.
  696. X
  697. X    local s2
  698. X
  699. X    s2 := ""
  700. X    s ? {
  701. X    while s2 ||:= tab(upto(c))
  702. X    do tab(many(c))
  703. X    s2 ||:= tab(0)
  704. X    }
  705. X
  706. X    return s2
  707. X
  708. Xend
  709. SHAR_EOF
  710. true || echo 'restore of strip.icn failed'
  711. rm -f _shar_wnt_.tmp
  712. fi
  713. # ============= Makefile.dist ==============
  714. if test -f 'Makefile.dist' -a X"$1" != X"-c"; then
  715.     echo 'x - skipping Makefile.dist (File already exists)'
  716.     rm -f _shar_wnt_.tmp
  717. else
  718. > _shar_wnt_.tmp
  719. echo 'x - extracting Makefile.dist (Text)'
  720. sed 's/^X//' << 'SHAR_EOF' > 'Makefile.dist' &&
  721. X############################################################################
  722. X#
  723. X#    Name:     %M%
  724. X#
  725. X#    Title:     public makefile for IBPAG
  726. X#
  727. X#    Author:     Richard L. Goerwitz
  728. X#
  729. X#    Version: %I%
  730. X#
  731. X############################################################################
  732. X
  733. X#
  734. X# Change this only if you have some bizzarre naming conflict (which is
  735. X# very unlikely, given the quirky name!).
  736. X#
  737. XPROGNAME = ibpag
  738. X
  739. X
  740. X##########################################################################
  741. X#
  742. X#  User-modifiable section.  Read carefully!  You will almost
  743. X#  certainly have to change some settings here.
  744. X#
  745. X
  746. X#
  747. X# Destination directory for binaries.  Owner and group for public
  748. X# executables.  Leave the trailing slash off of directory name.
  749. X#
  750. X# DESTDIR = $(HOME)/bin
  751. XDESTDIR = /usr/local/bin
  752. X# OWNER = me
  753. XOWNER = root
  754. X# GROUP = my_group
  755. XGROUP = root
  756. X
  757. X#
  758. X# Name of your icon compiler and compiler flags.
  759. X#
  760. XICONC = /usr/icon/v8/bin/icont
  761. X# ICONC = /usr/icon/v8/bin/iconc
  762. X
  763. X#
  764. X# If you get messages like "out of X table space," then you have
  765. X# version 8.0 or less of the interpreter, and will need to adjust the
  766. X# various internal tables manually with -S arguments.  See the icont
  767. X# documentation.  Otherwise, no flags are strictly necessary.
  768. X#
  769. XIFLAGS = -u
  770. X
  771. X#
  772. X# Change these only if you're pretty sure of what you're doing.
  773. X#
  774. XSHELL = /bin/sh
  775. XMAKE = make
  776. X
  777. X
  778. X###########################################################################
  779. X#
  780. X#  Don't change anything below this line.
  781. X#
  782. X
  783. XSRC = $(PROGNAME).icn maketbls.icn preproc.icn itokens.icn debugme.icn \
  784. X    errors.icn slashupto.icn rewrap.icn strip.icn
  785. X
  786. X#
  787. X# Main target
  788. X#
  789. Xall: $(PROGNAME)
  790. X
  791. X$(PROGNAME): $(SRC)
  792. X    $(ICONC) $(IFLAGS) -o $(PROGNAME) $(SRC)
  793. X
  794. X#
  795. X# Cleanup
  796. X#
  797. Xclean:
  798. X    rm -f core *.u1 *.u2
  799. X
  800. Xclobber: clean
  801. X    -rm -f $(PROGNAME) *~
  802. SHAR_EOF
  803. true || echo 'restore of Makefile.dist failed'
  804. rm -f _shar_wnt_.tmp
  805. fi
  806. rm -f _shar_seq_.tmp
  807. echo You have unpacked the last part
  808. exit 0
  809. -- 
  810.  
  811.    -Richard L. Goerwitz              goer%midway@uchicago.bitnet
  812.    goer@midway.uchicago.edu          rutgers!oddjob!ellis!goer
  813.