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 / semgram.icn < prev    next >
Text File  |  2000-07-29  |  2KB  |  127 lines
  1. # Semantics routines called while parsing the input
  2. # grammar to TCLL1.
  3. #    (written by Thomas W. Christopher)
  4.  
  5. procedure FirstAlt()
  6. push(semanticsStack,[pop(semanticsStack)])
  7. return
  8. end
  9.  
  10. procedure NextAlt()
  11. local r
  12. r:=pop(semanticsStack)
  13. pop(semanticsStack)    # |
  14. put(semanticsStack[1],r)
  15. return
  16. end
  17.  
  18. procedure DeclAction()
  19. pop(semanticsStack)    # !
  20. declareAction(semanticsStack[1].body)
  21. return
  22. end
  23.  
  24. #procedure edit_rhs(rhs)
  25. #local s
  26. #r:=[]
  27. #every s:=!rhs do put(r,s.body)
  28. #return
  29. #end
  30.  
  31. global lhsymb
  32.  
  33. procedure DeclProduction()
  34. local i,a,r
  35. pop(semanticsStack)    # .
  36. a:=pop(semanticsStack)
  37. pop(semanticsStack)    # =
  38. i:=pop(semanticsStack)
  39. every r := !a do declareProduction(i,r)
  40. return
  41. end
  42.  
  43.  
  44. procedure Group()
  45. local a,lp,lhs,r
  46. pop(semanticsStack)
  47. a:=pop(semanticsStack)
  48. lp:=pop(semanticsStack)
  49.  
  50. lhs:=lhsymb||"_"||lp.line||"_"||lp.column
  51. every r := !a do declareProduction(lhs,r)
  52. push(semanticsStack,Token("ID",lhs,lp.line,lp.column))
  53. return
  54. end
  55.  
  56. procedure Option()
  57. local a,lp,lhs,r
  58. pop(semanticsStack)
  59. a:=pop(semanticsStack)
  60. lp:=pop(semanticsStack)
  61.  
  62. lhs:=lhsymb||"_"||lp.line||"_"||lp.column
  63. every r := !a do declareProduction(lhs,r)
  64. declareProduction(lhs,[])
  65. push(semanticsStack,Token("ID",lhs,lp.line,lp.column))
  66. return
  67. end
  68.  
  69. procedure Repeat()
  70. local a,lp,lhs,r
  71. pop(semanticsStack)
  72. a:=pop(semanticsStack)
  73. lp:=pop(semanticsStack)
  74.  
  75. lhs:=lhsymb||"_"||lp.line||"_"||lp.column
  76. every r := !a do declareProduction(lhs,r|||[lhs])
  77. declareProduction(lhs,[])
  78. push(semanticsStack,Token("ID",lhs,lp.line,lp.column))
  79. return
  80. end
  81.  
  82. procedure StartRHS()
  83. push(semanticsStack,[])
  84. return
  85. end
  86.  
  87. procedure ExtendRHS()
  88. local s
  89. s:=pop(semanticsStack).body
  90. put(semanticsStack[1],s)
  91. return
  92. end
  93.  
  94. procedure DeclLHS()
  95. lhsymb:=pop(semanticsStack).body
  96. push(semanticsStack,lhsymb)
  97. return
  98. end
  99.  
  100. procedure DeclSymbols()
  101. local l,r,s
  102. pop(semanticsStack)    # .
  103. r := pop(semanticsStack)
  104. pop(semanticsStack)    # :
  105. l := pop(semanticsStack)
  106. map(l,&ucase,&lcase) ?
  107.     if ="s" then {
  108.         if not (="tart"&pos(0)) then
  109.             warning(l,"--\"start\" assumed")
  110.         declareStartSymbol(r[1])
  111.     } else if ="e" then {
  112.         if not (="oi"&pos(0)) then
  113.             warning(l,"--\"EOI\" assumed")
  114.         declareEOI(r[1])
  115.     } else if ="f" then {
  116.         if not (="iducial") then
  117.             warning(l,"--\"fiducials\" assumed")
  118.         every declareFiducial(!r)
  119.     } else if ="a" then {
  120.         if not (="ction") then
  121.             warning(l,"--\"actions\" assumed")
  122.         every declareAction(!r)
  123.     } else error(l,"--unknown declaration")
  124. return
  125. end
  126.  
  127.