home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / packs / tcll1 / gramanal.icn < prev    next >
Text File  |  2000-07-29  |  11KB  |  574 lines
  1. # GRAMANAL.ICN
  2. #
  3. #  LL(1)/LL(k) parser generator in Icon
  4. #    written by Dr. Thomas W. Christopher
  5. #
  6. #    generally useful grammar analysis routines
  7.  
  8. #    symbId is a string
  9.  
  10. record Symbol(
  11.     name,    # symbId
  12.     kind,    # string in
  13.         # { "Nonterminal","Terminal","ActionSymbol"}
  14.     minLeng)# integer, length of shortest terminal string
  15.         # that can be derived from this nonterminal
  16. record Production(
  17.     lhs,      # Symbol, left hand side
  18.     rhs,      # [ Symbol, ... ], right hand side
  19.     minLeng)  # minimum length of terminal string derivable from
  20.           # lhs using this production
  21.  
  22. global symbol        #table:symbId->Symbol
  23. global first        #table:Symbol->set(Symbol)
  24. global last        #table:Symbol->set(Symbol)
  25. global follow        #table:Symbol->set(Symbol)
  26. global productions    #table:Symbol->[Production,...]
  27. global selectionSet    #table:Production->Set(Symbol)
  28.             # set of symbols that choose this production
  29.             # if lhs is atop the stack
  30. global nonterminals    #set(Symbol)
  31. global terminals    #set(Symbol)
  32. global actions        #set(Symbol)
  33. global startSymbol    #Symbol
  34. global eoiSymbol    #Symbol, end of input
  35. global errorFile    #file
  36. global errorCount    #integer
  37. global warningCount    #integer
  38. global tooLong        #integer, too long for a sentence
  39. global defaultStartName    #string, default name of start symbol
  40.  
  41. #######################################################################
  42. #
  43. #    calls to create grammars
  44. #
  45.  
  46. procedure initGrammar(out)
  47. symbol := table()
  48. first := table()
  49. last := table()
  50. follow := table()
  51. productions := table()
  52. selectionSet := table()
  53. nonterminals := set()
  54. terminals := set()
  55. actions := set()
  56. fiducials := set()
  57. startSymbol := &null
  58. eoiSymbol := Symbol("EOI","Terminal")
  59. symbol["EOI"] := eoiSymbol
  60. errorFile := \out | &output
  61. errorCount := warningCount := 0
  62. tooLong := 10000
  63. defaultStartName := "start"
  64. return
  65. end
  66.  
  67. procedure error(e[])
  68. errorCount +:= 1
  69. writes(errorFile,"Error: ")
  70. every writes(!e)
  71. write()
  72. end
  73.  
  74. procedure warning(e[])
  75. warningCount +:= 1
  76. writes(errorFile,"Warning: ")
  77. every writes(!e)
  78. write()
  79. end
  80.  
  81. procedure declareProduction(lhs,rhs)
  82. #    lhs: symbId
  83. #    rhs: [symbId,...]
  84. local    n,    #Symbol, the left hand side
  85.     r,    #[Symbol,...], the right hand side
  86.     s    #symbId, name of rhs element
  87. if /symbol[lhs] then {
  88.     n := symbol[lhs] := Symbol(lhs,"Nonterminal")
  89.     insert(nonterminals,n)
  90. } else {
  91.     n := symbol[lhs]
  92.     /n.kind := "Nonterminal"
  93.     if n.kind ~==="Nonterminal" then {
  94.         error(lhs||" is both nonterminal and "||n.kind)
  95.         fail
  96.     }
  97. }
  98. r := []
  99. every s := !rhs do {
  100.     /symbol[s] := Symbol(s)
  101.     put(r,symbol[s])
  102. }
  103. /productions[n] := []
  104. put(productions[n],Production(n,r))
  105. return
  106. end
  107.  
  108. procedure declareAction(s)
  109. local t
  110. /symbol[s] := Symbol(s)
  111. t := symbol[s]
  112. /t.kind := "ActionSymbol"
  113. if t.kind ~== "ActionSymbol" then {
  114.     error(t.kind||" "||s||" being declared an ActionSymbol")
  115.     fail
  116. }
  117. insert(actions,t)
  118. return
  119. end
  120.  
  121. procedure declareStartSymbol(s)
  122. local n
  123. if \startSymbol then {
  124.     error(
  125.         "attempt to redeclare start symbol from "||
  126.         startSymbol.name||
  127.         " to "||
  128.         s)
  129.     fail
  130. }
  131. if n := \symbol[s] then {
  132.     /n.kind := "Nonterminal"
  133.     if n.kind ~== "Nonterminal" then {
  134.         error( "attempt to declare " ||
  135.             n.kind || " " ||
  136.             s || " as start symbol")
  137.         fail
  138.     }
  139.     startSymbol := n
  140.     return
  141. }
  142. startSymbol := Symbol(s,"Nonterminal")
  143. symbol[s] := startSymbol
  144. insert(nonterminals,startSymbol)
  145. /productions[startSymbol] := []
  146. return
  147. end
  148.  
  149. procedure declareEOI(s)
  150. local eoi
  151. if eoiSymbol.name == s then return
  152. if \symbol[s] then {
  153.     error(
  154.         "attempt to redeclare "||
  155.         symbol[s].kind||" "||
  156.         s||" as EOI symbol")
  157.     fail
  158. }
  159. remove(symbol,eoiSymbol.name)
  160. eoiSymbol.name := s
  161. symbol[s] := eoiSymbol
  162. return
  163. end
  164.  
  165. procedure finishDeclarations()
  166. local    s    #Symbol
  167.  
  168. insert(terminals,eoiSymbol)
  169.  
  170. #what if no start symbol specified? Create one.
  171. if /startSymbol then {
  172.     declareStartSymbol(defaultStartName)
  173. }
  174.  
  175. every s := !symbol do
  176.     case s.kind of {
  177.     &null : {
  178.         s.kind := "Terminal"
  179.         insert(terminals,s)
  180.         s.minLeng := 1
  181.         }
  182.     "Terminal": {
  183.         s.minLeng := 1
  184.         insert(terminals,s)
  185.         }
  186.     "ActionSymbol": {
  187.         s.minLeng := 0
  188.         insert(actions,s)
  189.         }
  190.     "Nonterminal": {
  191.         s.minLeng := tooLong
  192.         insert(nonterminals,s)
  193.         }
  194.     }
  195. return
  196. end
  197.  
  198. #######################################################################
  199. #
  200. #    local utility procedures
  201. #
  202.  
  203. # succeed returning s if s is a null-deriving symbol
  204. # (only valid after execution of findMinLeng() )
  205. #
  206. procedure isNullDeriving(s)
  207. if s.minLeng <= 0 then return s else fail
  208. end
  209.  
  210. # succeed returning symbol s only if s is the specified type of symbol
  211. procedure isNonterminal(s)
  212. return member(nonterminals,s)    #returning s
  213. end
  214.  
  215. procedure isTerminal(s)
  216. return member(terminals,s)    #returning s
  217. end
  218.  
  219. procedure isActionSymbol(s)
  220. return member(actions,s)    #returning s
  221. end
  222.  
  223. #######################################################################
  224. #
  225. #debugging & output routines
  226. #
  227.  
  228. procedure writeIndented(s,i,l,b)
  229. # write string s, indenting by i positions any overflow lines,
  230. # breaking after characters in set b (if practical), with overall
  231. # line length l
  232. #
  233. local j,k,r,h
  234. /l := 72    #default line length
  235. /i := 8        #default indent
  236. if /b := ' \t'    #default break set--white space
  237.     then l+:=1
  238. r := l - i    #remaining length after indent
  239. if r <= 1 then fail
  240. #cut off initial i chars (or all of string if it's short):
  241. s ?:= (h := tab(i+1 | 0) & tab(0))
  242. repeat {
  243.     # find a position j at which to cut the line:
  244.     j := -1
  245.     if *s>r then {s ? every k := upto(b) & k <= r & j := k}
  246.     write(h,s[1:j+1])
  247.     s := s[j+1:0]
  248.     if *s = 0 then break
  249.     h := repl(" ",i)
  250. }
  251. return
  252. end
  253.  
  254. procedure symbolToString(s)
  255. static nonIdChars
  256. initial nonIdChars:=~(&letters++&digits++'_')
  257. return if upto(nonIdChars,s) then "\"" || s || "\"" else s
  258. end
  259.  
  260. procedure productionToString(p)
  261. local s
  262. s := symbolToString(p.lhs.name) || " ="
  263. every s ||:= " " || symbolToString((!p.rhs).name)
  264. return s||"."
  265. end
  266.  
  267. procedure showProductions()
  268. local p,S,n,i
  269. write()
  270. write("Productions:")
  271. write("start:",startSymbol.name,",  EOI:",eoiSymbol.name)
  272. S:=table()
  273. every n:=!nonterminals do S[n.name]:=n
  274. S:=sort(S,1)
  275. every i:=1 to *S do S[i]:=S[i][2]
  276. every p := !productions[!S] do {
  277.     writeIndented(productionToString(p))
  278. }
  279. return
  280. end
  281.  
  282. procedure showSymbol(s)
  283.     write(s.name,": ",\s.kind|"Type undefined",
  284.         ", minLeng=",\s.minLeng|"Undefined")
  285. return
  286. end
  287.  
  288. procedure showSymbols()
  289. local s
  290. write()
  291. write("Symbols:")
  292. every s := !symbol do {
  293.     showSymbol(s)
  294. }
  295.  
  296. return
  297. end
  298.  
  299. procedure showSymbolSet(prefix,s)
  300. local t, i, L
  301. t:=set()
  302. every insert(t,(!s).name)
  303. L:=sort(t)
  304. prefix ||:= "{"
  305. every i := 1 to *L-1 do prefix ||:= symbolToString(L[i]) || ", "
  306. prefix ||:= symbolToString(L[-1])
  307. prefix ||:= "}"
  308. writeIndented(prefix)
  309.  
  310. return
  311. end
  312.  
  313. procedure showSelectionSets()
  314. local p,s,L
  315. write()
  316. write("selection sets:")
  317. L := sort(selectionSet,3)
  318. while p:=get(L) & s:=get(L) do {
  319.     showSymbolSet("selection[ "||productionToString(p)||" ] = ",s)
  320. }
  321. return
  322. end
  323.  
  324. procedure showSymbolSets(setName,s)
  325. local n,st,L
  326. L := sort(s,3)
  327. write()
  328. write(setName," sets:")
  329. while n := get(L) & st := get(L) do {
  330.     showSymbolSet(n.name||"=",st)
  331. }
  332. return
  333. end
  334.  
  335. procedure showFirstSets()
  336. showSymbolSets("first",first)
  337. return
  338. end
  339.  
  340. procedure showLastSets()
  341. showSymbolSets("last",last)
  342. return
  343. end
  344.  
  345. procedure showFollowSets()
  346. showSymbolSets("follow",follow)
  347. return
  348. end
  349.  
  350. #######################################################################
  351. #
  352. #    Grammar analysis
  353. #
  354.  
  355. # compute the min lengths of terminal strings that can be derived
  356. # from nonterminals and starting from particular productions.
  357. #
  358. procedure findMinLeng()
  359. local n, ns, p, s, changes, leng
  360.  
  361. every ns:=!symbol do case ns.kind of {
  362.     "Nonterminal":    ns.minLeng := tooLong
  363.     "Terminal":    ns.minLeng := 1
  364.     "ActionSymbol":    ns.minLeng := 0
  365.     }
  366. every p := !!productions do p.minLeng := tooLong
  367. ### showSymbols() ####
  368. changes := 1
  369. while \changes do {
  370.     changes := &null
  371.     every n := !nonterminals  do {
  372.         every p := !productions[n] do {
  373.             leng := 0
  374.             every s := !p.rhs do {
  375.                 leng +:= s.minLeng
  376.             }
  377.             p.minLeng := leng
  378.             ### showSymbol(n) ###
  379.             if n.minLeng > leng then {
  380.              changes := 1
  381.              n.minLeng := leng
  382.             }
  383.         }
  384.     }
  385. }
  386. return
  387. end
  388.  
  389. procedure checkMinLeng()
  390.  local n
  391.  every n := !nonterminals & n.minLeng >= tooLong do {
  392.     error(n.name," does not appear to derive a terminal string")
  393.  }
  394.  return
  395. end
  396.  
  397. #
  398. # compute transitive closure of a relation
  399. #
  400. procedure transitiveClosure(s)
  401. local n,r,i,k
  402.  
  403. every    k := key(s) &
  404.     i := key(s) &
  405.     member(s[i],k)
  406.   do {
  407.     s[i] ++:= s[k]
  408. }
  409. return
  410. end
  411.  
  412. #
  413. #    generate exposed symbols on rhs or in string
  414. #      "exposed" means preceded (Left) or followed (Right)
  415. #      by nullable nonterminal or action symbols
  416. #    includes all symbols, nonterminal, terminal and action
  417. #
  418. procedure exposedLeft(p)
  419.  local s
  420.  case type(p) of {
  421. "Symbol":    p:=[p]
  422. "Production":    p:=p.rhs
  423.  }
  424.  every  s := !p  do {
  425.      suspend s
  426.     if not isNullDeriving(s) then fail
  427.  }
  428.  fail
  429. end
  430.  
  431. procedure exposedRight(p)
  432.  local s
  433.  case type(p) of {
  434. "Symbol":    p:=[p]
  435. "Production":    p:=p.rhs
  436.  }
  437.  every s := p[*p to 1 by -1]  do {
  438.      suspend s
  439.     if not isNullDeriving(s) then fail
  440.  }
  441.  fail
  442. end
  443.  
  444. #
  445. #    Compute Accessible Sets
  446. #
  447.  
  448. procedure buildInitialAccessibleSets()
  449. local p, r, s
  450.  
  451. s:=table()
  452. every s[!nonterminals] := set()
  453. every p := !!productions do {
  454.     every r := !p.rhs do {
  455.         insert(s[p.lhs],r)
  456.     }
  457. }
  458. return s
  459. end
  460.  
  461. procedure findAccessibleSets()
  462. local s
  463. s := buildInitialAccessibleSets()
  464. transitiveClosure(s)
  465. return s
  466. end
  467.  
  468. procedure findAccessibleSymbols()
  469.  local st,a
  470.  a := findAccessibleSets()
  471.  st := a[startSymbol]
  472.  insert(st,startSymbol)
  473.  insert(st,eoiSymbol)
  474.  return st
  475. end
  476.  
  477. procedure checkAccessibility()
  478.  local s,st
  479.  st := findAccessibleSymbols()
  480.  every s := !(nonterminals|terminals|actions) do {
  481.     if not member(st,s) then
  482.        error(s.name,
  483.        " cannot appear in a sentential form")
  484.  }
  485.  return
  486. end
  487.  
  488. #
  489. #    Compute First Sets
  490. #
  491.  
  492. procedure initFirstSets()
  493. local p, r
  494.  
  495. first := table()
  496. every first[!nonterminals] := set()
  497.  
  498. every p := !!productions do {
  499.     every r := exposedLeft(p) do {
  500.         insert(first[p.lhs],r)
  501.     }
  502. }
  503. return
  504. end
  505.  
  506. procedure findFirstSets()
  507. initFirstSets()
  508. transitiveClosure(first)
  509. return
  510. end
  511.  
  512. #
  513. #    Compute last sets
  514. #
  515. procedure initLastSets()
  516. local p, r
  517.  
  518. last:=table()
  519. every last[!nonterminals] := set()
  520.  
  521. every p := !!productions do {
  522.     every r := exposedRight(p) do {
  523.         insert(last[p.lhs],r)
  524.     }
  525. }
  526. return
  527. end
  528.  
  529. procedure findLastSets()
  530. initLastSets()
  531. transitiveClosure(last)
  532. return
  533. end
  534.  
  535. procedure checkLnRRecursive()
  536.  local n
  537.  every n:= !nonterminals do {
  538.     if member(first[n],n) & member(last[n],n) then {
  539.         error(n.name," is both left and right recursive,",
  540.             " the grammar is ambiguous")
  541.     }
  542.  }
  543.  return
  544. end
  545.  
  546. procedure findFollowSets()
  547. local n, p, rhs, x, y, i, j
  548.  
  549. follow := table()
  550.  
  551. every n := !nonterminals do follow[n] := set()
  552.  
  553. every p := !productions[!nonterminals] &
  554.     rhs := p.rhs & *rhs>1
  555.   do {
  556.     every x := rhs[i:=1 to *rhs-1] & isNonterminal(x) do {
  557.       every y := rhs[j:=i+1 to *rhs] do {
  558.     every
  559.       insert(
  560.           follow[x|isNonterminal(!last[x])],
  561.           isTerminal(y|!\first[y])
  562.       )
  563.     if not isNullDeriving(y) then break #back to "every x" loop
  564.       }
  565.     }
  566. }
  567. every insert(
  568.     follow[isNonterminal(startSymbol|!last[startSymbol])],
  569.     eoiSymbol
  570.       )
  571. return
  572. end
  573.  
  574.