home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 1 / 1207 < prev    next >
Internet Message Format  |  1990-12-28  |  63KB
  1. From: brock@tuvie (Inst.f.Prakt.Info 1802)
  2. Newsgroups: alt.sources
  3. Subject: gray: a parser generator in forth
  4. Message-ID: <1545@tuvie>
  5. Date: 19 Apr 90 14:57:41 GMT
  6.  
  7.  
  8. This is Gray, a parser generator written in Forth.
  9. Gray runs on Tile Release 1, a Forth posted on alt.sources and
  10. comp.lang.forth in December 1989. It will not run 'as is' on any other
  11. Forth, but advice on porting is given. Gray generates recursive
  12. descent parsers.
  13.  
  14. Have fun, Anton
  15.  
  16. Don't reply to the poster, but to ertl@vip.at
  17.  
  18. #--------CUT---------CUT---------CUT---------CUT--------#
  19. #########################################################
  20. #                                                       #
  21. # This is a shell archive file.  To extract files:      #
  22. #                                                       #
  23. #    1) Make a directory for the files.                 #
  24. #    2) Write a file, such as "file.shar", containing   #
  25. #       this archive file into the directory.           #
  26. #    3) Type "sh file.shar".  Do not use csh.           #
  27. #                                                       #
  28. #########################################################
  29. #
  30. #
  31. echo Extracting README
  32. sed 's/^Z//' >README <<\STUNKYFLUFF
  33. Z$Id: README,v 1.1 90/04/18 14:18:42 ertl Exp $
  34. Z
  35. ZThis is the alpha-test version of Gray, a parser generator written in
  36. Zforth. It generates recursive descent parsers. Gray was not much
  37. Ztested and only by me.
  38. Z
  39. Z
  40. ZFILES
  41. Z
  42. ZREADME        You are reading it
  43. Zgray.f83    parser generator source file
  44. Zgray.doc    parser generator manual
  45. Zelse.f83    a very tiny example grammar
  46. Zoberon.f83    a medium-sized example grammar
  47. Zcalc.f83    an example interpreter
  48. Zmini.f83    an example compiler
  49. Ztest.mini    a program for mini ( computes the square )
  50. Zgraylist.f83    example extension for gray
  51. Z
  52. ZPORTING
  53. Z
  54. ZThe current version runs on TILE Release 1 (a Forth 83 by Mikael Patel
  55. Zwritten in C and posted on comp.lang.forth and alt.sources in December
  56. Z1989), but probably on no other forth (I do hope ANSI Forth will have
  57. Zconditional compilation). But it should be easy to port:
  58. Z
  59. Zremove the "#include" lines in the beginning
  60. Zchange the definition of ":," to suit your forth
  61. Zchange "bits/cell" and the subsequent cell words
  62. Zif your forth is not direct or indirect threaded, change "(compile)"
  63. Zyou may have to change "<builds-field" and words containing "c," on
  64. Zmachines with alignment restrictions (e.g. 68000)
  65. Z
  66. ZNow you should be able to run test programs, but to make Gray
  67. Zusable you need to add code for displaying the error location in the
  68. Zplaces indicated by "!!!" (There seems to be no way to get the error
  69. Zlocation on TILE).
  70. Z
  71. ZI made no effort to make the test programs portable, but I only expect
  72. Zproblems with mini and perhaps with calc.
  73. Z
  74. ZDEPENDENCIES
  75. Z
  76. ZApart from the problems mentioned in the section on porting there are
  77. Za few other noteworthy things:
  78. Z
  79. ZYour Forth should support long names
  80. ZGray needs a big return stack (e.g. ~360 cells for oberon). Adjust your
  81. ZForth-System (On TILE change RETURNSIZE in forth.c and recompile).
  82. Z
  83. ZCOPYRIGHT
  84. ZCopyright 1990 Martin Anton Ertl
  85. ZThis program is distributed WITHOUT ANY WARRANTY.
  86. ZSee gray.doc or gray.f83 for the license.
  87. STUNKYFLUFF
  88. #
  89. #
  90. echo Extracting calc.f83
  91. sed 's/^Z//' >calc.f83 <<\STUNKYFLUFF
  92. Z( $Id: calc.f83,v 1.1 90/04/18 14:18:57 ertl Exp $ )
  93. Z( Copyright 1990 Martin Anton Ertl )
  94. Z( This program is distributed WITHOUT ANY WARRANTY. )
  95. Z( See gray.doc or gray.f83 for the license. )
  96. Z( a little calculator )
  97. Z( a usage example: )
  98. Z( you: ? )
  99. Z( you: 2*3-5/4= )
  100. Z( calc: 5 )
  101. Z
  102. Z255 max-member ( the whole character set )
  103. Zvariable sym
  104. Z
  105. Z10 stack expected
  106. Z
  107. Z: testsym ( set -- f )
  108. Z dup expected push
  109. Z sym @ member? ;
  110. Z
  111. Z' testsym test-vector !
  112. Z
  113. Z: ?syntax-error ( f -- )
  114. Z not if
  115. Z  empty begin
  116. Z   expected top union
  117. Z   expected pop
  118. Z   expected clear? until
  119. Z  ." expected:" ['] emit apply-to-members abort
  120. Z endif ;
  121. Z
  122. Z: ?readnext ( f -- )
  123. Z ?syntax-error
  124. Z expected clear
  125. Z 0 begin
  126. Z  drop key
  127. Z  dup 32 = not until
  128. Z sym ! ;
  129. Z
  130. Z: init
  131. Z true ?readnext ;
  132. Z
  133. Z: t ( -- ) ( use: t c name )
  134. Z ( make terminal name with the token c )
  135. Z [compile] ascii singleton ['] ?readnext terminal ;
  136. Z
  137. Z: x ( set1 -- set2 )
  138. Z ( read a char from the input and include it in the set )
  139. Z [compile] ascii singleton union ;
  140. Z
  141. Z( make a terminal that accepts all digits )
  142. Zempty x 0 x 1 x 2 x 3 x 4 x 5 x 6 x 7 x 8 x 9 ' ?readnext terminal digit
  143. Z
  144. Zt ( "("
  145. Zt ) ")"
  146. Zt + "+"
  147. Zt - "-"
  148. Zt * "*"
  149. Zt / "/"
  150. Zt = "="
  151. Z
  152. Znonterminal expr
  153. Z
  154. Z(( {{ 0 }}
  155. Z   (( {{ 10 * sym @ ascii 0 - + }} digit )) ++
  156. Z)) <- num ( -- n )
  157. Z
  158. Z(( num
  159. Z|| "(" expr ")"
  160. Z)) <- factor ( -- n )
  161. Z
  162. Z(( factor (( "*" factor {{ * }}
  163. Z          || "/" factor {{ / }}
  164. Z          )) **
  165. Z)) <- term ( -- n )
  166. Z
  167. Z(( (( term
  168. Z   || "-" term {{ 0 swap - }} ))
  169. Z   (( "+" term {{ + }}
  170. Z   || "-" term {{ - }} )) **
  171. Z)) expr rule ( -- n )
  172. Z
  173. Z(( {{ init }} expr "=" {{ . }} )) parser ? ( -- )
  174. Z
  175. STUNKYFLUFF
  176. #
  177. #
  178. echo Extracting else.f83
  179. sed 's/^Z//' >else.f83 <<\STUNKYFLUFF
  180. Z( $Id: else.f83,v 1.1 90/04/18 14:19:20 ertl Exp $ )
  181. Z( Copyright 1990 Martin Anton Ertl )
  182. Z( This program is distributed WITHOUT ANY WARRANTY. )
  183. Z( See gray.doc or gray.f83 for the license. )
  184. Z( dangling else )
  185. Z( tests if gray finds ambiguity )
  186. Z
  187. Z10 max-member
  188. Z
  189. Z: token ( adr count -- )
  190. Z singleton ['] abort terminal ;
  191. Z
  192. Z0 token "if"
  193. Z1 token "then"
  194. Z2 token "else"
  195. Z3 token expr
  196. Z4 token other
  197. Z
  198. Znonterminal stmt
  199. Z(( other
  200. Z|| (( "if" expr "then" stmt (( "else" stmt )) ?? ))
  201. Z)) stmt rule
  202. Z
  203. Zstmt parser test
  204. Z
  205. STUNKYFLUFF
  206. #
  207. #
  208. echo Extracting gray.doc
  209. sed 's/^Z//' >gray.doc <<\STUNKYFLUFF
  210. Z$Id: gray.doc,v 1.1 90/04/18 14:28:06 ertl Exp $
  211. Z
  212. ZCopyright 1990 Martin Anton Ertl
  213. Z
  214. ZTERMS AND CONDITIONS FOR USE, COPYING, MODIFICATION AND DISTRIBUTION
  215. Z
  216. Z1. You may use this product provided that
  217. Z   a) you DO NOT USE IT FOR MILITARY PURPOSES; and
  218. Z   b) cause the terms of parapraph 1 to apply to any products
  219. Z   developed using this product and make these terms known to all
  220. Z   users of such product;
  221. ZBy using this product, you indicate the acceptance of the terms of
  222. Zthis paragraph.
  223. Z
  224. Z2. Except for the restrictions mentioned in paragraph 1, you may use
  225. Zthe Program.
  226. Z
  227. Z3. You may distribute verbatim or modified copies of this program,
  228. Zprovided that
  229. Z   a) you keep intact all copyright notices, this license, and the notices
  230. Z   referring to this license and to the absence of warranty; and
  231. Z   b) you cause any work that you distribute or publish that contains the
  232. Z   Program or part of it to be licensed to all third parties under the
  233. Z   terms of this license. You may not impose any further restriction
  234. Z   on the recipients exercise of the rights granted herein. Mere
  235. Z   aggregation of another independent work with the Program or its
  236. Z   derivative on a volume of storage or distribution medium does not
  237. Z   bring the other work under the scope of these terms; and
  238. Z   c) you cause the derivative to carry prominent notices saying that
  239. Z   you changed the Program.
  240. Z
  241. Z4. You may distribute the Program or its derivative in intermediate,
  242. Zobject or executable code, if you accompany it with the complete
  243. Zmachine-readable source code.
  244. Z
  245. Z5. By using, modifying, copying or distributing the Program you
  246. Zindicate your acceptance of this license and all its terms and
  247. Zconditions.
  248. Z
  249. Z6. This Program is provided WITHOUT WARRANTY of any kind, either
  250. Zexpress or implied, including, but not limited to, the implied
  251. Zwarranties of merchantability and fitness for a particular purpose. In
  252. Zno event, unless required by applicable law or agreed to in writing,
  253. Zwill any copyright holder, or any other party who may modify and or
  254. Zredistribute the Program, be liable to you for any damages, even if
  255. Zsuch holder or other party has been advised of the possibility of such
  256. Zdamages.
  257. Z
  258. ZEND OF TERMS AND CONDITIONS
  259. Z
  260. Z
  261. Z
  262. ZGRAY USERS MANUAL
  263. Z==== ===== ======
  264. Z
  265. ZTo understand this manual you should know Forth and language
  266. Zdescriptions in BNF or similar syntax notations. Apologies for my
  267. Zclumsy use of the English language.
  268. Z
  269. Z
  270. ZUSES FOR GRAY
  271. Z
  272. ZSyntactic Analysis of Programming Languages (parsers)
  273. ZIt should not be hard to generate parsers for most programming
  274. Zlanguages with Gray, but you will probably have to transform the
  275. Zgrammar (See the chapter on grammar massaging).
  276. Z
  277. ZLexical Analysis (scanners)
  278. ZAlthough it is possible to use Gray for scanning, it's probably
  279. Zoverkill and there may be better methods.
  280. Z
  281. Z
  282. ZGRAMMARS
  283. Z
  284. ZGrammars describe the syntax of languages. A parser generator
  285. Ztranslates grammars into parsers that can read all valid sentences
  286. Z(programs, if we are talking about programming languages) of the
  287. Zlanguage. Computer Scientists also say that the grammar derives the
  288. Zsentences. Some grammatical expressions (syntax expressions) derive
  289. Zthe empty sentence, which is denoted by 'eps'.
  290. Z
  291. ZThe following table shows Gray's syntax expressions (a, b, and c
  292. Zdenote such expressions)
  293. Z
  294. Zname        syntax        parses        example
  295. Z---------------------------------------------------------------
  296. Zconcatenation    (( a b ... ))    a, then b, ...    (( "begin" word-list "until" ))
  297. Zalternative    (( a || b ... ))    a or b ...    (( word || number ))
  298. Zeps        eps        eps        eps
  299. Zoption        a ??        zero or one a    (( "else" word-list )) ??
  300. Z*-repetition    a **        zero or more a    word **
  301. Z+-repetition    a ++        one or more a    char ++
  302. Znonterminal    name        See text    word-list
  303. Zterminal    name        See text    "begin"
  304. Zaction           {{ forth-code }}    eps        {{ . }}
  305. Z
  306. ZYou need not parenthesize a concatenation in an alternative;
  307. Z(( a b || c )) is the same as (( (( a b )) || c ))
  308. Z
  309. Z
  310. ZTerminals and the I/O Interface
  311. Z
  312. ZThe atomic units processed by a parser are the terminal symbols. They
  313. Zare delivered by the underlying input layer and can be as complex as
  314. Zyou like: single characters, words, etc.
  315. Z
  316. ZGray and its parsers distinguish terminal symbols by their tokens (A
  317. Ztoken is an unsigned number).
  318. Z
  319. ZThe input layer should read one symbol in advance to allow the parser
  320. Zto base decisions on the token of the next symbol.
  321. Z
  322. ZThe Interface to the input layer consists of
  323. Z
  324. Z1) the variable test-vector; there you should store the execution
  325. Zaddress (cfa) of a word (let's call it test?) with the stack effect
  326. Z( set -- f ). test? checks, if set contains the token of the next
  327. Zsymbol. You can use member? ( set u -- f ) to test u for membership in
  328. Zset.
  329. Z
  330. Z2) the defining-word terminal ( set cfa -- )
  331. Z    token singleton ' check&read terminal name 
  332. Zdeclares the word name, which can then be used in the grammar, where
  333. Ztoken's terminal symbol should be parsed. (Before you call singleton,
  334. Zor any other set words, you should declare the maximum set size (and
  335. Zthus the maximum token value) with max-member ( u -- ).) You have to
  336. Zdefine check&read ( f -- ) which later is built into the parser and
  337. Zcalled, when the symbol is to be parsed. At that time check&read must
  338. Zread the next symbol. check&read also checks for syntax errors, which
  339. Zare indicated by f being false (See the section on error handling).
  340. Zcheck&reads for special symbols, e.g.  numbers, probably will perform
  341. Zadditional functions, e.g. pushing the value of the number (then
  342. Zcheck&read's stack effect is ( f -- n )).
  343. Z
  344. Z
  345. ZNonterminals and Rules
  346. Z
  347. Z    a <- name        (1)
  348. Zor
  349. Z    nonterminal name    (2)
  350. Z    a name rule        (3)
  351. Zcan be used to define name as an abbreviation for a.
  352. Z(1) and (3) are rules for the nonterminal name, (1) and (2) are
  353. Zdeclarations. After its declaration name can be used instead of a.
  354. ZThis also allows recursive definitions.
  355. Z
  356. Z
  357. ZActions
  358. Z
  359. Zare needed to turn a simple parser into an interpreter or a compiler.
  360. ZFor parsing they behave like eps, but when they are parsed, they
  361. Zexecute forth code. Example: if "num" parses a number and pushes its
  362. Zvalue, then
  363. Z    (( num {{ . }} ))
  364. Zparses a number and prints it.
  365. Z
  366. ZYou may use the parameter stack as you like; therefore you should
  367. Zwrite stack comments for every rule. You can use the return stack, but
  368. Zthe action should have no overall return stack effect.
  369. Z
  370. Z
  371. ZParser
  372. Z
  373. ZYou can generate the parser called name for the syntax expression a
  374. Zwith the defining word parser:
  375. Z    a parser name
  376. ZAll nonterminals have to be defined; the generation may take a while
  377. Zif the grammar is large.
  378. Z
  379. Z
  380. ZDISAMBIGUATING RULES
  381. Z
  382. ZGrays parsers try to predict from the next token, which expression
  383. Zthey should parse. For some grammars this is not possible--there is an
  384. Zambiguity. Gray generates parsers anyway, but they probably won't
  385. Zparse every sentence of the language. In ambiguous cases the parsers
  386. Zdecide according to the following rules:
  387. ZIn an alternative the earlier branches have higher precedence, but an
  388. Zeps-derivation is chosen only if no branch begins with the current
  389. Ztoken.
  390. Z
  391. ZThe argument of options are rather parsed than not, but if it cannot
  392. Zbegin with the current token, it is skipped, even if it can parse eps.
  393. ZThis may seem unimportant, since the language remains the same, but if
  394. Zthere are actions to be executed, the results need not be what you
  395. Zwanted.
  396. Z
  397. ZThe operand of repetition is parsed as often as seems possible, but
  398. Zagain the repetition is left, if only empty sentences can be parsed.
  399. ZHowever, the argument of the +-repetition is parsed at least once.
  400. Z
  401. Z
  402. ZWARNINGS AND ERROR MESSAGES
  403. Z
  404. ZMost error messages tell you where they happened (This is not true
  405. Zfor the TILE implementation). For concatenations and alternatives the
  406. Zposition of "||" or "))" are displayed.
  407. Z
  408. ZErrors while reading the grammar
  409. Z
  410. Zno operand
  411. ZThere is no grammar expression between "((" and "))", "((" and "||",
  412. Z"||" and "||", or "||" and "))". Insert eps, if you want to parse the
  413. Zempty sentence.
  414. Z
  415. Zmultiple rules for nonterminal
  416. ZThere may be only one rule for every nonterminal. Use the alternative.
  417. Z
  418. ZError messages while generating the parser
  419. Z
  420. Zno rule for nonterminal
  421. ZA nonterminal was declared and used, but there is no rule for it.
  422. Z
  423. Zleft recursion 
  424. ZThe grammar contains a left recursion , i.e. the parser could recurse
  425. Zwithout having parsed a terminal symbol. This situation would lead
  426. Zinto an infinite recursion. Read the chapter on left recursion
  427. Zelimination.
  428. Z
  429. ZThe error message you should not see
  430. Z
  431. Zyou found a bug
  432. ZIndicates a bug in Gray. See the chapter on feature reports
  433. Z
  434. ZWarnings
  435. Z
  436. Zconflict: conflict-set
  437. Z(The conflict-set is printed as a sequence of numbers. If you want to
  438. Zprint it in a different way, store your token-printing word (token -- )
  439. Zin the variable print-token.) Parsers with conflicts often don't
  440. Zunderstand the language, i.e. they cannot parse all sentences.
  441. ZTherefore you should investigate every conflict carefully and take the
  442. Zappropriate actions (See the chapter on left factoring).
  443. Z
  444. ZIf the parser has to decide (e.g. between repeating another time or
  445. Znot), but there are tokens that both alternatives can begin with, then
  446. Zthere's a conflict and these tokens are the conflict set.
  447. Z    (( "a" ??  "a" ))
  448. Zshould parse "a" and "aa", but when the parser sees "a"'s token, it
  449. Zdoes not know, whether this is the first or the second a. Whatever
  450. Zdecision it makes, it might be wrong.
  451. Z
  452. Z
  453. ZThe other warnings are less severe; they indicate that there are
  454. Zseveral ways to derive eps. The resulting parser parses the same
  455. Zlanguage, but actions may be executed in a different way than you
  456. Zintended.
  457. Z
  458. Zwarning: two branches may be empty
  459. ZSeveral branches of an alternative can derive eps. The first is
  460. Zchosen.
  461. Z
  462. Zwarning: unnecessary option
  463. ZYou made an expression optional that already derives eps.
  464. Z
  465. Zwarning: *-repetition of optional term
  466. ZYou *-repeated an expression that can derive eps.
  467. Z
  468. Z
  469. ZMASSAGING GRAMMARS
  470. Z
  471. ZTo get rid of left recursions and conflicts you can change the
  472. Zgrammar to a new one that derives the same language but does not have
  473. Zthe problems. However, that's not always possible. I will give only
  474. Zsimple examples, you can find algorithms in the literature (e.g.
  475. ZAlfred V. Aho, Ravi Sethi, Jeffrey D. Ullman; Compilers. Principles,
  476. ZTechniques nad Tools; Addison-Wesley 1986).
  477. Z
  478. ZLeft recursion elimination
  479. Z
  480. ZSimple left recursions look like this:
  481. Z    nonterminal N
  482. Z    (( N a || b )) N rule
  483. ZN derives b, ba, baa, ..., and the sequence above can be replaced by
  484. Z    (( b  a ** )) <- N
  485. Z
  486. ZLeft factoring
  487. Z
  488. ZIn
  489. Z    (( a b || a c || d ))
  490. Zthere is a conflict between the first and the second branch. It can be
  491. Zresolved by postponing the decision:
  492. Z    (( a (( b || c )) || d ))
  493. ZOften the Situation is more complex and requires heavy transformations
  494. Zof the grammar, which makes it hard to read and difficult to use for
  495. Ztranslation purposes. You should investigate other ways to resolve
  496. Zconflicts, e.g. making the scanner more powerful.
  497. Z
  498. Z
  499. ZERROR HANDLING
  500. Z
  501. ZGray provides no special help for error handling. The simplest way is
  502. Zto print a meaningful error message, clean up and abort. One
  503. Zpossibility for meaningful messages is printing the set of symbols
  504. Zthat the parser expected. This set is the union of all the sets tested
  505. Zwith test? since reading the latest terminal-symbol. See calc.f83 for
  506. Zan example.
  507. Z
  508. ZA technique that allows the parser to continue when it encounters
  509. Zcommon errors are error rules (error productions). You extend the
  510. Zgrammar to allow the parser to parse sentences with common errors.
  511. ZWhen parsing an error the parser should print an error message.
  512. ZExample: Statements in Pascal are separated by semicolons:
  513. Z    (( statement (( ";" statement )) ** )) <- StatementSequence
  514. ZThis semicolon is often forgotten. If you don't want the compiler to
  515. Zabort just because of a missing ";", change the rule to
  516. Z    (( statement
  517. Z       (( (( ";" || {{ pascal-error ." ; inserted" }} )) statement ))
  518. Z    )) <- StatementSequence
  519. Z
  520. ZSee the literature for other error recovery techniques.
  521. Z
  522. Z
  523. ZTHE GUTS OF GRAY
  524. Z
  525. ZAs Forth programmer you will want to change or extend Gray. Here's a
  526. Zsmall overview to make it easier.
  527. Z
  528. ZWhen reading the grammar words like "terminal", "??", "<-" and "))"
  529. Zbuild an abstract syntax graph (ASG) of the grammar in memory. For
  530. Zmost grammar constructions one node is generated; to make later work
  531. Zeasier concatenation and alternative are translated into n-1 binary
  532. Znodes using the binary operators "concat" and "alt".
  533. Z
  534. Z"parser" generates the parser in two passes: "propagate" just computes
  535. Zthe follow sets (the follow set of an expression contains the tokens
  536. Zof the terminal symbol that can follow the expression. Follow sets are
  537. Zonly needed for recognizing conflicts). "pass2" computes the necessary
  538. Zfirst sets, detects errors and warnings and generates code for all
  539. Zrules (a first set contains the tokens of the terminals a grammar
  540. Zexpression can begin with. If the expression can derive eps, the
  541. Zfirst set also contains eps. Since Grays sets can only contain tokens,
  542. Zepsilon-derivations are indicated by the extra flag maybe-empty).
  543. ZFinally, "parser" generates code for the start expression (the operand
  544. Zof "parser").
  545. Z
  546. ZThere are small subpasses for first set computation ("compute") and
  547. Zcode generation ("generate"), that walk over the parts of the ASG that
  548. Zthey need. To save a lot of computation every ASG-node memoizes the
  549. Zresult of "compute". "compute" also detects left recursions and
  550. Zwarnings: A nonterminal comes up twice in a computation, iff there is
  551. Za left recursion. Therefore, to detect all left recursions, "compute"
  552. Zis called for every node.
  553. Z
  554. ZTo avoid obscure swap-drop-flip-flop-orgies I used a context stack (It
  555. Zhas nothing to do with forth's "context").  The ASG-node of the
  556. Zcurrent expression is on top of this stack and can be accessed with
  557. Z"this". You can access the fields of this node just by mentioning
  558. Ztheir names. This implies that for accessing such fields you have to
  559. Zpush the node on the context-stack first.
  560. Z
  561. ZAnother programming technique used in Gray are methods and maps.
  562. Z"compute", "generate", "propagate" and "pass2" have general functions
  563. Zas well as functions specific to the node type. The special code is
  564. Zcalled via an execution address table (map) that the "methods" field
  565. Zof "this" points to. Words defined with "method" automagically execute
  566. Zthis calling procedure.
  567. Z
  568. ZCode and data structure sharing impose a class hierarchy on the node
  569. Ztypes:
  570. Z
  571. Zsyntax-expr
  572. Z    terminal
  573. Z    eps
  574. Z    nt (nonterminal)
  575. Z    action
  576. Z    unary
  577. Z        option&repetition
  578. Z            option
  579. Z            repetition
  580. Z                *repetition
  581. Z                +repetition
  582. Z    binary
  583. Z        concatenation
  584. Z        alternative
  585. Z
  586. Z
  587. ZGLOSSARY
  588. Zdoesn't contain everything
  589. Z
  590. ZWords for building grammars
  591. ZWords shown in the table in the "grammars" chapter are not shown here.
  592. Z
  593. Zconcat    ( syntax-expr1 syntax-expr2 -- syntax-expr )
  594. Zalt    ( syntax-expr1 syntax-expr2 -- syntax-expr )
  595. Z    binary postfix operators for concatenation and alternative
  596. Z(-,-)    ( use: (- syntax-expr1 ... -);  -- syntax-expr )
  597. Z    another concatenation notation; same as (( syntax-expr1 ... ))
  598. Z(|,|)    ( use: (| syntax-expr1 ... |);  -- syntax-expr )
  599. Z    another alternative notation; same as (( syntax-expr1 || ... ))
  600. Zterminal ( use: terminal name; set check&read -- )
  601. Z    defines name ( -- syntax-expr ) as terminal with first-set
  602. Z    "set" and parse-time action check&read ( f -- ). See section
  603. Z    "Terminals and the I/O Interface". 
  604. Znonterminal ( use: nonterminal name;  -- )
  605. Z    declares name ( -- syntax-expr ) as nonterminal. See section
  606. Z    "Nonterminals and Rules".
  607. Zrule    ( syntax-expr nt -- )
  608. Z    makes "nt" an abbreviation for "syntax-expr".
  609. Z<-    ( use: <- name; syntax-expr -- )
  610. Z    defines "name" ( -- syntax-expr2 ) as abbreviation for
  611. Z    "syntax-expr".
  612. Z
  613. ZWords necessary for parser generation
  614. Z
  615. Zmax-member ( u -- )
  616. Z    declares u to be the maximum member of sets generated
  617. Z    later. Must be called before using any set word except
  618. Z    "member?" and thus before building a grammar.
  619. Ztest-vector ( a variable initially containing ' abort )
  620. Z    before you call "parser", you should store into test-vector
  621. Z    the execution address of a word ( set -- f ) that returns true
  622. Z    if the token of the current symbol is in "set". 
  623. Zparser    ( use: parser name; syntax-expr -- )
  624. Z    generates a parser for syntax-expr that you can call by
  625. Z    "name".
  626. Z
  627. ZSet words
  628. Z
  629. Zmax-member ( u -- )
  630. Z    declares u to be the maximum member of sets generated
  631. Z    later. Must be called before using any set word except
  632. Z    "member?".
  633. Zempty    ( -- set )
  634. Z    the empty set of the current size.
  635. Zsingleton ( u -- set )
  636. Z    makes a set that contains u and nothing else
  637. Zunion    ( set1 set2 -- set )
  638. Zintersection ( set1 set2 -- set )
  639. Z    set operations
  640. Zmember?    ( set u -- f )
  641. Z    returns true if u is in set
  642. Zsubset?    ( set1 set2 -- f )
  643. Z    returns true if every member of set1 is in set2
  644. Zdisjoint? ( set1 set2 -- f )
  645. Z    returns true if set1 and set2 heve no common members
  646. Zapply-to-members ( set [ u -- ] -- )
  647. Z    executes [ u -- ] for every member of set
  648. Z
  649. ZCompilation words
  650. Z
  651. Z:,    ( -- )
  652. Z    creates anonymous colon definition header
  653. Z(compile) ( execution-addr -- )
  654. Z    compiles the execution address, e.g.  ' word (compile)  is the
  655. Z    same as  compile word
  656. Zcompile-test ( set -- )
  657. Z    compiles a test for "set" using "test-vector"
  658. Z
  659. ZContext Management
  660. Z
  661. Znew-context ( syntax-expr -- )
  662. Zold-context ( -- )
  663. Z    push and pop respectively
  664. Zthis    ( -- syntax-expr )
  665. Z    the current syntax-expr, i.e. top of context-stack
  666. Z
  667. ZWarnings and Errors
  668. Z
  669. Z.in    ( -- )
  670. Z    print source location of "this", i.e. where the error
  671. Z    happened.
  672. Zgray-error ( -- )
  673. Z    prints the source location and aborts
  674. Zcheck-conflict ( set1 set2 -- )
  675. Z    prints a warning if set1 and set2 conflict (are not disjoint)
  676. Z    
  677. ZSyntax Expression Operations
  678. ZYou have to substitute a class name for ... in the following words.
  679. Z
  680. Zmake-syntax-expr ( map -- syntax-expr )
  681. Zmake-terminal ( first-set execution-addr -- syntax-expr )
  682. Zmake-binary ( syntax-expr1 syntax-expr2 map -- syntax-expr )
  683. Zmake-unary ( syntax-expr1 map -- syntax-expr2 )
  684. Zmake-nt ( syntax-expr -- nt )
  685. Zconcat, alt, ??, ++, **, etc.
  686. Z    allocate an ASG node and initialize it. "make-terminal" and
  687. Z    "make-nt" are anonymous versions of the defining words.
  688. Z
  689. Zcompute    ( syntax-expr -- first-set maybe-empty )
  690. Z    compute the first-set and maybe-empty of syntax-expr
  691. Zget-first ( syntax-expr -- first-set )
  692. Z    compute just the first set of syntax-expr
  693. Zcheck-cycle ( syntax-expr -- )
  694. Z    just check for left recursion
  695. Zpropagate ( follow-set syntax-expr -- )
  696. Z    add "follow-set" to the follow set of "syntax-expr" and its
  697. Z    children
  698. Zgenerate ( syntax-expr -- )
  699. Z    generate code for "syntax-expr"
  700. Zpass2    ( syntax-expr -- )
  701. Z    computes all necessary first sets, checks for left recursions
  702. Z    and conflicts and generates code for rules
  703. Z...-syntax-expr ( -- n )
  704. Z    a constant containing the length of a ... ASG node
  705. Z...-map    ( a "create"d word )
  706. Z    contains the method pointers for ...
  707. Zcompute-... ( -- first maybe-empty )
  708. Zpropagate-... ( follow-set -- )
  709. Zgenerate-... ( -- )
  710. Zpass2-... ( -- )
  711. Z    execute the ...-specific part of compute, propagate, generate
  712. Z    and pass2. The syntax-expr treated is "this".
  713. Z
  714. Z
  715. ZAN EXAMPLE OF AN EXTENSION
  716. Z
  717. ZIn Pascal and similar languages there are many expressions of the type
  718. Z    (( a  (( b a )) ** ))
  719. ZLet's call them lists. The experienced programmer will immediately
  720. Zfactor out the common things and introduce a new operator: &&, as in
  721. Z    a b &&
  722. ZYou can define this operator to be just an abbreviation:
  723. Z    : && ( syntax-expr1 syntax-expr2 -> syntax-expr3 )
  724. Z        over concat ** concat ;
  725. Z(I use concat here since the parenthesized notation needs more stack
  726. Zmanipulation.)
  727. ZWhen you use this operator, two pointers to syntax-expr1 are generated.
  728. ZThis is OK. Cycles, however, must contain nonterminals to avoid
  729. Zinfinite recursions in generate.
  730. ZThe definition of && is good enough for nearly everything, but for the
  731. Zsake of the example, let's do a version that generates
  732. Z    begin [ a generate ] ... test? while [ b generate ] repeat
  733. Zinstead of
  734. Z    [ a generate ] begin ... test? while [ b generate a generate ] repeat
  735. ZYou find the program described here in graylist.f83.
  736. Z"&&" makes a binary node with an additional field that is explained
  737. Zlater. Its map points to list-specific words that we have to define
  738. Znow:
  739. Z
  740. Z"generate-list" is the easiest, since we know already what it should
  741. Zdo. The only thing unknown is the set, that is to be tested: There
  742. Zshould be another repetition, if the next token is in the first set of
  743. Z( b a ). Thus, the set to be tested is the first set of b; if b can
  744. Zderive epsilon, b is transparent and the first-set of a has to be
  745. Zadded. Since no memory may be allocated while "generate"ing, set
  746. Zoperations like "union" are forbidden. Therefore the set is computed
  747. Zin pass2-list and stored in the field "test-set".
  748. Z
  749. ZThe next task is "compute-list". If a cannot derive epsilon, the first
  750. Zset of the expression is the first set of a. If a can derive epsilon,
  751. Zthe expression can begin with b and b's first set has to be added. The
  752. Zexpression derives epsilon, if a derives epsilon.
  753. Z
  754. Z"propagate-list" is quite different from "compute-list": The followset
  755. Zis passed in, and it must pass the follow-sets to a and b. If no
  756. Zoperand derives epsilon, the follow set of b is the first set of a and
  757. Zthe follow set of a is the first set of b united with the follow set
  758. Zof the whole expression. If an operand derives epsilon, its follow set
  759. Zshines through and must be added to the follow set of the other
  760. Zoperand.
  761. Z
  762. Z"pass2-list" has to recognize conflicts, compute test-set and call
  763. Z"pass2" for the operands. The latter task is the same for all binary
  764. Znodes and is performed by pass2-binary. There's a conflict, if a
  765. Zdecision has to be made and there are tokens that both alternatives
  766. Zbegin with. In our case the parser has to decide between another
  767. Zrepetition or ceasing to parse the expression. The sets of tokens that
  768. Zthese alternatives begin with are the test-set and the follow set of
  769. Zthe expression respectively. If these sets are not disjoint, then
  770. Zthere is a conflict and the intersection of these sets is the conflict
  771. Zset.
  772. Z
  773. Z
  774. ZKNOWN FEATURES
  775. Z
  776. ZAs usual in Forth, syntax error checking is minimal. You can find some
  777. Zerrors (e.g. missing parenthesis) by checking the stack for forgotten
  778. Zcells.
  779. ZWarnings and error messages are printed even if the problem cannot
  780. Zshow up due to the disambiguating rules.
  781. Z
  782. Z
  783. ZFEATURE REPORTS
  784. Z
  785. ZIf you find a new feature, mail a report to ertl@vip.at.
  786. ZIn this report you should describe the behaviour that constitutes the
  787. Zfeature and how to reproduce this behaviour (A program would be nice).
  788. Z
  789. Z
  790. ZAUTHOR
  791. Z
  792. ZM. Anton Ertl
  793. ZWiedner Hauptstrasse 141/1/7
  794. ZA-1050 WIEN
  795. ZAUSTRIA
  796. ZEmail:    ertl@vip.at
  797. Z    ...!mcsun!tuvie!vip!ertl
  798. Z    If that does not work, try: mae@alison.at
  799. ZIf you find Gray useful, you are encouraged to send me a contribution.
  800. ZSend it by international money order (to my address, or to the account
  801. Zno. 1100167 of Leopoldine Ertl at the "Oesterreichische
  802. ZPostsparkasse") or in cash, foreign checks cost me $6-$7 to convert
  803. Zinto cash.
  804. Z
  805. ZUPDATES
  806. Z
  807. ZIf you mail me your e-address, I will e-mail you updates, when they
  808. Zappear.
  809. STUNKYFLUFF
  810. #
  811. #
  812. echo Extracting gray.f83
  813. sed 's/^Z//' >gray.f83 <<\STUNKYFLUFF
  814. Z\ $Id: gray.f83,v 1.1 90/04/18 14:19:59 ertl Exp $ )
  815. Z\ Copyright 1990 Martin Anton Ertl
  816. Z\
  817. Z\ TERMS AND CONDITIONS FOR USE, COPYING, MODIFICATION AND DISTRIBUTION
  818. Z\ 
  819. Z\ 1. You may use this product provided that
  820. Z\    a) you DO NOT USE IT FOR MILITARY PURPOSES; and
  821. Z\    b) cause the terms of parapraph 1 to apply to any products
  822. Z\    developed using this product and make these terms known to all
  823. Z\    users of such product;
  824. Z\ By using this product, you indicate the acceptance of the terms of
  825. Z\ this paragraph.
  826. Z\ 
  827. Z\ 2. Except for the restrictions mentioned in paragraph 1, you may use
  828. Z\ the Program.
  829. Z\ 
  830. Z\ 3. You may distribute verbatim or modified copies of this program,
  831. Z\ provided that
  832. Z\    a) you keep intact all copyright notices, this license, and the notices
  833. Z\    referring to this license and to the absence of warranty; and
  834. Z\    b) you cause any work that you distribute or publish that contains the
  835. Z\    Program or part of it to be licensed to all third parties under the
  836. Z\    terms of this license. You may not impose any further restriction
  837. Z\    on the recipients exercise of the rights granted herein. Mere
  838. Z\    aggregation of another independent work with the Program or its
  839. Z\    derivative on a volume of storage or distribution medium does not
  840. Z\    bring the other work under the scope of these terms; and
  841. Z\    c) you cause the derivative to carry prominent notices saying that
  842. Z\    you changed the Program.
  843. Z\ 
  844. Z\ 4. You may distribute the Program or its derivative in intermediate,
  845. Z\ object or executable code, if you accompany it with the complete
  846. Z\ machine-readable source code.
  847. Z\ 
  848. Z\ 5. By using, modifying, copying or distributing the Program you
  849. Z\ indicate your acceptance of this license and all its terms and
  850. Z\ conditions.
  851. Z\ 
  852. Z\ 6. This Program is provided WITHOUT WARRANTY of any kind, either
  853. Z\ express or implied, including, but not limited to, the implied
  854. Z\ warranties of merchantability and fitness for a particular purpose. In
  855. Z\ no event, unless required by applicable law or agreed to in writing,
  856. Z\ will any copyright holder, or any other party who may modify and or
  857. Z\ redistribute the Program, be liable to you for any damages, even if
  858. Z\ such holder or other party has been advised of the possibility of such
  859. Z\ damages.
  860. Z\ END OF TERMS AND CONDITIONS )
  861. Z
  862. Z\ recursive descent parser generator )
  863. Z
  864. Z\ !! tile only )
  865. Z#include forth.f83
  866. Z#include structures.f83
  867. Z
  868. Z.( Loading gray ... Copyright 1990 Martin Anton Ertl; NO WARRANTY ) cr
  869. Z
  870. Z\ misc )
  871. Z: noop ;
  872. Z
  873. Z32 constant bits/cell \ !! implementation dependent )
  874. Z4 constant cell
  875. Z: cell+ 2+ 2+ ;
  876. Z: cells 2* 2* ;
  877. Z
  878. Z\ for fig-forth )
  879. Z\ : create \ use: create word )
  880. Z\          \ word: -- adr )
  881. Z\  0 variable -1 cells allot ;
  882. Z
  883. Z: c, \ c -- )
  884. Z here 1 allot c! ;
  885. Z
  886. Z\ : 2@ \ addr -- n1 n2 )
  887. Z\  dup cell+ @ swap @ ;
  888. Z
  889. Z\ : 2! \ n1 n2 addr -- )
  890. Z\  swap over ! cell+ ! ;
  891. Z
  892. Z\ : 2, \ n1 n2 -- )
  893. Z \  here 2 cells allot 2! ;
  894. Z
  895. Z: 2dup over over ;
  896. Z: 2drop drop drop ;
  897. Z
  898. Z: rdrop r> r> drop >r ;
  899. Z
  900. Z: endif [compile] then ; immediate
  901. Z
  902. Z: ?pairs ( n1 n2 -- )
  903. Z ( aborts, if the numbers are not equal )
  904. Z = not if
  905. Z  abort
  906. Z endif ;
  907. Z 
  908. Z: ', \ -- ) ( use: ', name )
  909. Z ' , ;
  910. Z
  911. Z0 constant false
  912. Zfalse not constant true
  913. Z
  914. Z: :, \ -- ) ( creates anonymous colon def header )
  915. Z\ !! implementation dependent )
  916. Z\ ( for sane forths: )
  917. Z\  [ ' noop @ ] literal , ;
  918. Z\ for tile )
  919. Z [ (structures) as ENTRY ] literal (structures) make
  920. Z COLON over +code !
  921. Z here swap +parameter ! ;
  922. Z
  923. Z: (compile) \ cfa -- )
  924. Z\ compiles the cfa, e.g. ' word <compile> is the same as compile word ) 
  925. Z\ !! implementation dependent )
  926. Z , ;
  927. Z\ here's an inefficient version that should work with all forths: )
  928. Z\ [compile] literal compile execute ; )
  929. Z
  930. Z
  931. Z\ stack administration )
  932. Z\ this implementation is completely unsafe )
  933. Z
  934. Z: stack \ n -- )
  935. Z\ use: n stack word )
  936. Z\ creates a stack called word with n cells )
  937. Z\ the first cell is the stackpointer )
  938. Z create here , cells allot ;
  939. Z
  940. Z: push \ n stack -- )
  941. Z cell over +! @ ! ;
  942. Z
  943. Z: top \ stack -- n )
  944. Z @ @ ;
  945. Z
  946. Z: pop \ stack -- )
  947. Z [ -1 cells ] literal swap +! ;
  948. Z
  949. Z: clear? \ stack -- f )
  950. Z dup @ = ;
  951. Z
  952. Z: clear \ stack -- )
  953. Z dup ! ;
  954. Z
  955. Z
  956. Z\ sets - represented as bit arrays )
  957. Z\ bits that represent no elements, must be 0 )
  958. Z\ all operations assume valid parameters )
  959. Z\ emements must be unsigned numbers )
  960. Z\ the max. element size must be declared with max-member )
  961. Z\ no checking is performed )
  962. Z\ set operations allot memory )
  963. Z
  964. Zcreate bit-table bits/cell cells allot
  965. Z\ this table contains a mask for every bit in a cell )
  966. Z: init-bit-table \ -- )
  967. Z 1 bits/cell 0 do
  968. Z  dup  bit-table i cells + !
  969. Z  dup +
  970. Z loop
  971. Z drop ;
  972. Zinit-bit-table forget init-bit-table
  973. Z
  974. Z: decode \ u -- w )
  975. Z\ returns a cell with bit# u set and everyting else clear )
  976. Z cells bit-table + @ ;
  977. Z
  978. Zvariable cells/set 0 cells/set !
  979. Zvariable empty-ptr 0 empty-ptr ! \ updatd by max-member )
  980. Z: empty \ -- set )
  981. Z empty-ptr @ ;
  982. Z
  983. Z: max-member \ u -- )
  984. Z\ declares u to be the maximum member of sets generated afterwards )
  985. Z\ must be called before using any set word except member?, add-member )
  986. Z bits/cell / 1+
  987. Z dup cells/set !
  988. Z here empty-ptr ! \ make empty set )
  989. Z 0 do 0 , loop ;
  990. Z
  991. Z: copy-set \ set1 -- set2 )
  992. Z\ makes a copy of set1 )
  993. Z here swap
  994. Z cells/set @ 0 do
  995. Z  dup @ ,
  996. Z  cell+ loop
  997. Z drop ;
  998. Z
  999. Z: normalize-bit-addr \ addr1 u1 -- addr2 u2 )
  1000. Z\ addr1*bits/cell+u1=addr2*bits/cell+u2, u2<bits/cell )
  1001. Z begin
  1002. Z  dup bits/cell u< not while
  1003. Z  bits/cell - swap cell+ swap
  1004. Z repeat ;
  1005. Z
  1006. Z: add-member \ u set -- )
  1007. Z\ changes set to include u )
  1008. Z swap normalize-bit-addr
  1009. Z decode
  1010. Z over @ or swap ! ;
  1011. Z
  1012. Z: singleton \ u -- set )
  1013. Z\ makes a set that contains u and nothing else )
  1014. Z empty copy-set swap over add-member ;
  1015. Z
  1016. Z: member? \ set u -- f )
  1017. Z\ returns true if u is in set )
  1018. Z normalize-bit-addr
  1019. Z decode
  1020. Z swap @ and
  1021. Z 0= not ;
  1022. Z
  1023. Z: binary-set-operation \ set1 set2 [w1 w2 -- w3] -- set )
  1024. Z\ creates set from set1 and set2 by applying [w1 w2 -- w3] on members )
  1025. Z\ e.g. ' or binary-set-operation  is the union operation )
  1026. Z here >r
  1027. Z cells/set @ 0 do >r
  1028. Z  over @ over @ r@ execute ,
  1029. Z  cell+ swap cell+ swap
  1030. Z r> loop
  1031. Z drop 2drop r> ;
  1032. Z
  1033. Z: union \ set1 set2 -- set )
  1034. Z ['] or binary-set-operation ;
  1035. Z
  1036. Z: intersection \ set1 set2 -- set )
  1037. Z ['] and binary-set-operation ;
  1038. Z
  1039. Z: binary-set-test? \ set1 set2 [w1 w2 -- w3] -- f )
  1040. Z\ returns true, if [w1 w2 -- w3] binary-set-operation returns empty )
  1041. Z\ e.g. set1 set2 ' and binary-set-test?  is true, if set1 and set2
  1042. Z\ are disjoint, i.e. they contain no common members )
  1043. Z >r true rot rot r>
  1044. Z cells/set @ 0 do >r
  1045. Z  over @ over @ r@ execute 0= not if
  1046. Z   rot drop false rot rot
  1047. Z  endif
  1048. Z  cell+ swap cell+ swap
  1049. Z r> loop
  1050. Z drop 2drop ;
  1051. Z
  1052. Z: notb&and \ w1 w2 -- w3 )
  1053. Z -1 xor and ;
  1054. Z
  1055. Z: subset? \ set1 set2 -- f )
  1056. Z\ returns true if every member of set1 is in set2 )
  1057. Z ['] notb&and binary-set-test? ;
  1058. Z
  1059. Z: disjoint? \ set1 set2 -- f )
  1060. Z\ returns true if set1 and set2 heve no common members )
  1061. Z ['] and binary-set-test? ;
  1062. Z
  1063. Z: apply-to-members \ set [ u -- ] -- )
  1064. Z\ executes [ u -- ] for every member of set )
  1065. Z cells/set @ bits/cell * 0 do
  1066. Z  over i member? if
  1067. Z   i over execute
  1068. Z  endif
  1069. Z loop
  1070. Z 2drop ;
  1071. Z
  1072. Z: union \ set1 set2 -- set )
  1073. Z\ just a little more space-efficient ) 
  1074. Z 2dup subset? if
  1075. Z  swap drop
  1076. Z else 2dup swap subset? if
  1077. Z  drop
  1078. Z else
  1079. Z  union
  1080. Z endif endif ;
  1081. Z
  1082. Z
  1083. Z\ tests )
  1084. Zvariable test-vector ' abort test-vector !
  1085. Z\ here you should store the execution address of a word ( set -- f )
  1086. Z\ that returns true if token of the current symbol is in set )
  1087. Z
  1088. Z: compile-test \ set -- )
  1089. Z [compile] literal
  1090. Z test-vector @ (compile) ;
  1091. Z
  1092. Z
  1093. Z\ context management )
  1094. Z500 stack context-stack
  1095. Z\ this stack holds the syntax-exprs currently being treated )
  1096. Z\ enlarge it, if your grammar is large and complex )
  1097. Zcontext-stack clear
  1098. Z
  1099. Z: this \ -- syntax-expr )
  1100. Z\ get current syntax-expr )
  1101. Z context-stack top ;
  1102. Z
  1103. Z: new-context \ syntax-expr -- )
  1104. Z context-stack push ;
  1105. Z
  1106. Z: old-context \ -- )
  1107. Z context-stack pop ;
  1108. Z
  1109. Z
  1110. Z\ structures )
  1111. Z: <builds-field \ n1 n2 -- n3 ) ( defining-word )
  1112. Z\ n1 is the offset of the field, n2 its length, n3 the offset of the
  1113. Z\ next field; creates a word that contains the offset )
  1114. Z create over , + ;
  1115. Z
  1116. Z0 constant struct
  1117. Z\ initial offset
  1118. Z
  1119. Z: context-var \ use: < offset > size context-var name < offset2 > )
  1120. Z\ name returns the address of the offset field of "this" )
  1121. Z <builds-field \ n1 n2 -- n3 )
  1122. Z does> \ -- addr )
  1123. Z  @ this + ;
  1124. Z
  1125. Z: context-const \ use: < offset > context-const name < offset2 > )
  1126. Z\ name returns the contents of the field of this at offset )
  1127. Z cell <builds-field \ n1 -- n2 )
  1128. Z does> \ -- n )
  1129. Z  @ this + @ ;
  1130. Z
  1131. Z
  1132. Z\ syntax-exprs )
  1133. Zstruct
  1134. Z context-const methods
  1135. Z        \ table of words applicable to the syntax-expr (a map)
  1136. Z 1 context-var mark-propagate \ used to ensure that "propagate" is
  1137. Z        \ called at least once for each syntax-expr )
  1138. Z 1 context-var mark-pass2
  1139. Z        \ make sure pass2 is called exactly once )
  1140. Z cell context-var first-set
  1141. Z        \ all tokens a nonempty path may begin with )
  1142. Z        \ if it's equal to 0, the first-set has not been computed yet )
  1143. Z 1 context-var maybe-empty
  1144. Z        \ true if the syntax-expr can derive eps )
  1145. Z cell context-var follow-set
  1146. Z    \ the tokens of the terminals that can follow the syntax-expr )
  1147. Z\ !!! 2 cells context-var source-location \ for error msgs )
  1148. Zconstant syntax-expr   \ length of a syntax-expr )
  1149. Z
  1150. Z: make-syntax-expr \ map -- syntax-expr )
  1151. Z\ allocate a syntax-expr and initialize it )
  1152. Z here swap , false c, false c,
  1153. Z 0 , false c, empty ,
  1154. Z\ !!! in @ line# @ 2, \ store source location )
  1155. Z ;
  1156. Z
  1157. Z
  1158. Z\ warnings and errors )
  1159. Z: .in \ -- )
  1160. Z\ prints where the error happened )
  1161. Z\ !!! source-location 2@ ."  in line " . ." column " . ;
  1162. Z ;
  1163. Z 
  1164. Z: gray-error .in abort ;
  1165. Z
  1166. Z: internal-error
  1167. Z cr ." you found a bug" gray-error ;
  1168. Z
  1169. Zvariable print-token ' . print-token !
  1170. Z\ contains execution address of a word < token -- > to print a token )
  1171. Z
  1172. Z: check-conflict \ set1 set2 -- )
  1173. Z\ print the intersection of set1 and set2 if it isn't empty )
  1174. Z 2dup disjoint? not if
  1175. Z  cr ." conflict:"
  1176. Z  intersection print-token @ apply-to-members
  1177. Z  .in
  1178. Z else
  1179. Z  2drop
  1180. Z endif ;
  1181. Z
  1182. Z
  1183. Z\ methods and maps )
  1184. Z: method \ use: < offset > method name < offset2 > )
  1185. Z\ executes the word whose execution address is stored in the field
  1186. Z\ at offset of a table pointed to by the "methods" field of "this" ) 
  1187. Z cell <builds-field \ n1 -- n2 )
  1188. Z does>
  1189. Z  @ methods + @ execute ;
  1190. Z
  1191. Z\ method table for syntax-exprs
  1192. Zstruct
  1193. Z method compute-method
  1194. Z method propagate-method
  1195. Z method generate-method
  1196. Z method pass2-method
  1197. Zconstant syntax-expr-methods
  1198. Z
  1199. Z
  1200. Z\ general routines )
  1201. Z: compute \ syntax-expr -- first-set maybe-empty )
  1202. Z\ compute the first-set and maybe-empty of a syntax-expr )
  1203. Z\ a bit of memoization is used here )
  1204. Z new-context
  1205. Z first-set @ 0= if
  1206. Z  compute-method
  1207. Z  maybe-empty c!
  1208. Z  first-set !
  1209. Z endif
  1210. Z first-set @ maybe-empty c@
  1211. Z old-context ;
  1212. Z
  1213. Z: get-first \ syntax-expr -- first-set )
  1214. Z compute drop ;
  1215. Z
  1216. Z: check-cycle \ syntax-expr -- )
  1217. Z\ just check for left recursion )
  1218. Z compute 2drop ;
  1219. Z
  1220. Z: propagate \ follow-set syntax-expr -- )
  1221. Z\ add follow-set to the follow set of syntax-expr and its children ) 
  1222. Z new-context
  1223. Z dup follow-set @ subset? not  \ would everything stay the same
  1224. Z mark-propagate c@ not or if   \ and was propagate here already
  1225. Z  true mark-propagate c!       \ NO, do propagate
  1226. Z  follow-set @ union dup follow-set !
  1227. Z  propagate-method
  1228. Z else
  1229. Z  drop
  1230. Z endif
  1231. Z old-context ;
  1232. Z
  1233. Z: generate \ syntax-expr -- )
  1234. Z\ this one gets things done )
  1235. Z new-context generate-method old-context ;
  1236. Z
  1237. Z: pass2 \ syntax-expr -- )
  1238. Z\ computes all necessary first sets, checks for left recursions
  1239. Z\ and conflicts and generates code for rules )
  1240. Z new-context
  1241. Z mark-pass2 c@ not if
  1242. Z  true mark-pass2 c!
  1243. Z  this check-cycle
  1244. Z  pass2-method
  1245. Z endif
  1246. Z old-context ;
  1247. Z
  1248. Z
  1249. Z\ main routine )
  1250. Z: parser \ syntax-expr -- )
  1251. Z\ use: syntax-expr parser xxx )
  1252. Z context-stack clear
  1253. Z empty over propagate
  1254. Z dup pass2
  1255. Z >r [compile] : r> generate [compile] ; ;
  1256. Z
  1257. Z
  1258. Z\ eps - empty syntax-expr )
  1259. Zcreate eps-map
  1260. Z', internal-error
  1261. Z', drop
  1262. Z', noop
  1263. Z', noop
  1264. Z
  1265. Zcreate eps1
  1266. Z\ the eps syntax-expr proper
  1267. Z eps-map make-syntax-expr
  1268. Zdrop
  1269. Z
  1270. Z: eps \ -- syntax-expr )
  1271. Z\ just adjusts eps1 and returns it
  1272. Z eps1 new-context
  1273. Z empty first-set ! ( empty changes due to max-member )
  1274. Z true maybe-empty c!
  1275. Z old-context
  1276. Z eps1 ;
  1277. Z
  1278. Z\ terminals )
  1279. Z\ a terminal is a syntax-expr with an extra field )
  1280. Zsyntax-expr
  1281. Z context-const check&next
  1282. Z        \ contains address of a word < f -- > that checks
  1283. Z        \ if f is true and reads the next terminal symbol )
  1284. Zconstant terminal-syntax-expr
  1285. Z
  1286. Z: generate-terminal \ -- )
  1287. Z this get-first compile-test
  1288. Z check&next (compile) ;
  1289. Z
  1290. Zcreate terminal-map
  1291. Z', internal-error
  1292. Z', drop
  1293. Z', generate-terminal
  1294. Z', noop
  1295. Z
  1296. Z: make-terminal \ first-set cfa -- syntax-expr )
  1297. Z terminal-map make-syntax-expr
  1298. Z new-context
  1299. Z ,
  1300. Z first-set !
  1301. Z this old-context ;
  1302. Z
  1303. Z: terminal \ first-set cfa -- )
  1304. Z create make-terminal drop ;
  1305. Z
  1306. Z
  1307. Z\ binary syntax-exprs )
  1308. Zsyntax-expr
  1309. Z context-const operand1
  1310. Z context-const operand2
  1311. Zconstant binary-syntax-expr
  1312. Z
  1313. Z: make-binary \ syntax-expr1 syntax-expr2 map -- syntax-expr )
  1314. Z make-syntax-expr rot , swap , ;
  1315. Z
  1316. Z: pass2-binary
  1317. Z operand1 pass2
  1318. Z operand2 pass2 ;
  1319. Z
  1320. Z
  1321. Z\ concatenations )
  1322. Z: compute-concatenation \ -- first maybe-empty )
  1323. Z operand1 compute dup if
  1324. Z  drop
  1325. Z  operand2 compute
  1326. Z  >r union r>
  1327. Z endif ;
  1328. Z
  1329. Z: propagate-concatenation \ follow-set -- )
  1330. Z operand2 compute if
  1331. Z  over union
  1332. Z endif \ follow follow1 )
  1333. Z operand1 propagate
  1334. Z operand2 propagate ;
  1335. Z
  1336. Z: generate-concatenation \ -- )
  1337. Z operand1 generate
  1338. Z operand2 generate ;
  1339. Z
  1340. Zcreate concatenation-map
  1341. Z', compute-concatenation
  1342. Z', propagate-concatenation
  1343. Z', generate-concatenation
  1344. Z', pass2-binary
  1345. Z
  1346. Z: concat \ syntax-expr1 syntax-expr2 -- syntax-expr )
  1347. Z concatenation-map make-binary ;
  1348. Z\ this is the actual concatenation operator )
  1349. Z\ but for safety and readability the parenthesised notation )
  1350. Z\ is preferred )
  1351. Z
  1352. Z
  1353. Z\ alternatives )
  1354. Z: compute-alternative \ -- first maybe-empty )
  1355. Z operand1 compute
  1356. Z operand2 compute
  1357. Z rot 2dup and if
  1358. Z  cr ." warning: two branches may be empty" .in endif
  1359. Z or >r union r> ;
  1360. Z
  1361. Z: propagate-alternative \ follow -- )
  1362. Z dup operand1 propagate
  1363. Z operand2 propagate ;
  1364. Z
  1365. Z: generate-alternative1 \ -- )
  1366. Z operand1 get-first compile-test
  1367. Z [compile] if
  1368. Z operand1 generate
  1369. Z [compile] else
  1370. Z operand2 generate
  1371. Z [compile] endif ;
  1372. Z
  1373. Z: generate-alternative2 \ -- )
  1374. Z operand1 get-first compile-test compile not
  1375. Z operand2 get-first compile-test compile and
  1376. Z [compile] if
  1377. Z operand2 generate
  1378. Z [compile] else
  1379. Z operand1 generate
  1380. Z [compile] endif ;
  1381. Z
  1382. Z: generate-alternative \ -- )
  1383. Z operand1 compute if
  1384. Z  generate-alternative2
  1385. Z else
  1386. Z  generate-alternative1
  1387. Z endif
  1388. Z drop ;
  1389. Z
  1390. Z: pass2-alternative \ -- )
  1391. Z this compute if
  1392. Z  follow-set @ check-conflict
  1393. Z else
  1394. Z  drop
  1395. Z endif
  1396. Z operand1 get-first operand2 get-first check-conflict
  1397. Z pass2-binary ;
  1398. Z
  1399. Zcreate alternative-map
  1400. Z', compute-alternative
  1401. Z', propagate-alternative
  1402. Z', generate-alternative
  1403. Z', pass2-alternative
  1404. Z
  1405. Z: alt \ syntax-expr1 syntax-expr2 -- syntax-expr )
  1406. Z alternative-map make-binary ;
  1407. Z\ this is the actual alternative operator )
  1408. Z\ but for safety and readability the parenthesised notation )
  1409. Z\ is preferred )
  1410. Z
  1411. Z
  1412. Z\ unary syntax-exprs )
  1413. Zsyntax-expr
  1414. Z context-const operand
  1415. Zconstant unary-syntax-expr
  1416. Z
  1417. Z: make-unary \ syntax-expr1 map -- syntax-expr2 )
  1418. Z make-syntax-expr swap , ;
  1419. Z
  1420. Z
  1421. Z\ options and repetitions )
  1422. Z: pass2-option&repetition \ -- )
  1423. Z follow-set @ operand get-first check-conflict
  1424. Z operand pass2 ;
  1425. Z
  1426. Z
  1427. Z\ options )
  1428. Z: compute-option \ -- set f )
  1429. Z operand compute if
  1430. Z  cr ." warning: unnessesary option" .in endif
  1431. Z true ;
  1432. Z
  1433. Z: propagate-option \ follow -- )
  1434. Z operand propagate ;
  1435. Z
  1436. Z: generate-option \ -- )
  1437. Z operand get-first compile-test
  1438. Z [compile] if
  1439. Z operand generate
  1440. Z [compile] endif ;
  1441. Z
  1442. Zcreate option-map
  1443. Z', compute-option
  1444. Z', propagate-option
  1445. Z', generate-option
  1446. Z', pass2-option&repetition
  1447. Z
  1448. Z: ?? \ syntax-expr1 -- syntax-expr2 )
  1449. Z option-map make-unary ;
  1450. Z
  1451. Z
  1452. Z\ repetitions )
  1453. Z: propagate-repetition \ follow-set -- )
  1454. Z operand get-first union operand propagate ;
  1455. Z
  1456. Z
  1457. Z\ *-repetitions )
  1458. Z: compute-*repetition \ -- set f )
  1459. Z operand compute if
  1460. Z  cr ." warning: *repetition of optional term" .in endif
  1461. Z true ;
  1462. Z
  1463. Z: generate-*repetition \ -- )
  1464. Z [compile] begin
  1465. Z operand get-first compile-test
  1466. Z [compile] while
  1467. Z operand generate
  1468. Z [compile] repeat ;
  1469. Z
  1470. Zcreate *repetition-map
  1471. Z', compute-*repetition
  1472. Z', propagate-repetition
  1473. Z', generate-*repetition
  1474. Z', pass2-option&repetition
  1475. Z
  1476. Z: ** \ syntax-expr1 -- syntax-expr2 )
  1477. Z *repetition-map make-unary ;
  1478. Z
  1479. Z
  1480. Z\ +-repetitions )
  1481. Z: compute-+repetition \ -- set f )
  1482. Z operand compute ;
  1483. Z
  1484. Z: generate-+repetition \ -- )
  1485. Z [compile] begin
  1486. Z operand generate
  1487. Z operand get-first compile-test
  1488. Z compile not [compile] until ;
  1489. Z
  1490. Zcreate +repetition-map
  1491. Z', compute-+repetition
  1492. Z', propagate-repetition
  1493. Z', generate-+repetition
  1494. Z', pass2-option&repetition
  1495. Z
  1496. Z: ++ \ syntax-expr1 -- syntax-expr2 )
  1497. Z +repetition-map make-unary ;
  1498. Z
  1499. Z
  1500. Z\ actions )
  1501. Zsyntax-expr
  1502. Z 0 context-var action
  1503. Zconstant action-syntax-expr
  1504. Z
  1505. Z: generate-action \ syntax-expr -- )
  1506. Z action (compile) ;
  1507. Z
  1508. Zcreate action-map
  1509. Z', internal-error
  1510. Z', drop
  1511. Z', generate-action
  1512. Z', noop
  1513. Z
  1514. Z: {{ \ -- syntax-expr )
  1515. Z action-map make-syntax-expr
  1516. Z new-context
  1517. Z empty first-set !
  1518. Z true maybe-empty c!
  1519. Z this old-context
  1520. Z \ ?exec !csp )
  1521. Z ] :, ;
  1522. Z
  1523. Z: }} \ syntax-expr -- syntax-expr )
  1524. Z \ ?csp )
  1525. Z compile exit
  1526. Z [compile] [
  1527. Z; immediate
  1528. Z
  1529. Z
  1530. Z\ nonterminals )
  1531. Zsyntax-expr
  1532. Z 1 context-var mark-compute
  1533. Z cell context-var rule-body \ in forth left side of rule )
  1534. Z cell context-var exec      \ cfa of code for rule )
  1535. Zconstant nt-syntax-expr
  1536. Z
  1537. Z: get-body \ -- syntax-expr )
  1538. Z\ get the body of the rule for the nt in "this" )
  1539. Z  rule-body @ if
  1540. Z   rule-body @
  1541. Z  else
  1542. Z   cr ." no rule for nonterminal" gray-error
  1543. Z  endif ;
  1544. Z
  1545. Z: compute-nt \ -- set f )
  1546. Z mark-compute c@ if
  1547. Z  cr ." left recursion" gray-error
  1548. Z else
  1549. Z  true mark-compute c!
  1550. Z  get-body compute
  1551. Z endif ;
  1552. Z
  1553. Z: propagate-nt \ follow-set -- )
  1554. Z  get-body propagate ;
  1555. Z
  1556. Z: code-nt \ -- )
  1557. Z\ generates the code for a rule )
  1558. Z here exec !
  1559. Z ] :,
  1560. Z get-body generate
  1561. Z compile exit [compile] [ ;
  1562. Z
  1563. Z: generate-nt \ -- )
  1564. Z\ generates a call to the code for the rule )
  1565. Z\ since the code needs not be generated yet, an indirect call is used )
  1566. Z exec [compile] literal
  1567. Z compile @
  1568. Z compile execute ;
  1569. Z
  1570. Z: pass2-nt \ -- )
  1571. Z\ apart from the usual duties, this pass2 also has to code-nt )
  1572. Z get-body pass2
  1573. Z code-nt ;
  1574. Z
  1575. Zcreate nt-map
  1576. Z', compute-nt
  1577. Z', propagate-nt
  1578. Z', generate-nt
  1579. Z', pass2-nt
  1580. Z
  1581. Z: make-nt \ syntax-expr -- nt )
  1582. Z nt-map make-syntax-expr
  1583. Z false c, swap , 0 , ;
  1584. Z
  1585. Z: <- \ use: syntax-expr <- xxx )
  1586. Z     \ xxx: -- syntax-expr )
  1587. Z create make-nt drop ;
  1588. Z
  1589. Z: nonterminal \ use: nonterminal xxx )
  1590. Z 0 <- ;       \ forward declaration )
  1591. Z
  1592. Z: rule \ syntax-expr nt -- )
  1593. Z\ makes a rule )
  1594. Z new-context
  1595. Z rule-body @ if
  1596. Z  ." multiple rules for nonterminal" gray-error endif
  1597. Z rule-body !
  1598. Z old-context ;
  1599. Z
  1600. Z
  1601. Z\ syntactic sugar )
  1602. Z: reduce \ 0 x1 ... [x2 x3 -- x4] -- x )
  1603. Z\ e.g. 0 5 6 7 ' + reduce  =  5 6 7 + +  =  18 )
  1604. Z >r dup 0= if
  1605. Z  ." no operand" abort
  1606. Z endif
  1607. Z begin
  1608. Z  over 0= not while
  1609. Z  r@ execute
  1610. Z repeat \ 0 x )
  1611. Z swap drop rdrop ;
  1612. Z
  1613. Z7 constant concatenation-id
  1614. Z: (- \ -- n 0 )
  1615. Z concatenation-id 0 ;
  1616. Z: -) \ n 0 syntax-expr1 syntax-expr2 .. -- syntax-expr )
  1617. Z ['] concat reduce
  1618. Z swap concatenation-id ?pairs ;
  1619. Z
  1620. Z8 constant alternative-id
  1621. Z: (| \ -- n 0 )
  1622. Z alternative-id 0 ;
  1623. Z: |) \ n 0 syntax-expr1 syntax-expr2 .. -- syntax-expr )
  1624. Z ['] alt reduce
  1625. Z swap alternative-id ?pairs ;
  1626. Z
  1627. Z: (( (| (- ;
  1628. Z: )) -) |) ;
  1629. Z: || -) (- ;
  1630. STUNKYFLUFF
  1631. #
  1632. #
  1633. echo Extracting graylist.f83
  1634. sed 's/^Z//' >graylist.f83 <<\STUNKYFLUFF
  1635. Z( $Id: graylist.f83,v 1.1 90/04/18 14:20:28 ertl Exp $ )
  1636. Z( Copyright 1990 Martin Anton Ertl )
  1637. Z( This program is distributed WITHOUT ANY WARRANTY. )
  1638. Z( See gray.doc or gray.f83 for the license. )
  1639. Z( list construct for parsing )
  1640. Z( a b && is the same as < a < b a > * > )
  1641. Z
  1642. Z( simple solution )
  1643. Z( : && \ syntax-expr1 syntax-expr2 -- syntax-expr3 )
  1644. Z( over concat ** concat ; )
  1645. Z
  1646. Zbinary-syntax-expr
  1647. Z cell context-var test-set
  1648. Zconstant list-syntax-expr
  1649. Z
  1650. Z: compute-list ( -- first follow )
  1651. Z operand1 compute dup if
  1652. Z  swap operand2 get-first union swap
  1653. Z endif ;
  1654. Z
  1655. Z: propagate-list ( follow -- )
  1656. Z operand2 compute if
  1657. Z  operand1 get-first union
  1658. Z endif
  1659. Z union
  1660. Z dup operand1 propagate ( follow1 )
  1661. Z operand1 compute if
  1662. Z  union
  1663. Z else
  1664. Z  swap drop
  1665. Z endif
  1666. Z operand2 propagate ;
  1667. Z
  1668. Z: generate-list ( -- )
  1669. Z [compile] begin
  1670. Z operand1 generate
  1671. Z test-set @ compile-test
  1672. Z [compile] while
  1673. Z operand2 generate
  1674. Z [compile] repeat ;
  1675. Z
  1676. Z: pass2-list ( -- )
  1677. Z operand2 compute if
  1678. Z  operand1 get-first union
  1679. Z endif
  1680. Z dup test-set !
  1681. Z follow-set @ check-conflict
  1682. Z pass2-binary ;
  1683. Z
  1684. Zcreate list-map
  1685. Z', compute-list
  1686. Z', propagate-list
  1687. Z', generate-list
  1688. Z', pass2-list
  1689. Z
  1690. Z: && ( syntax-expr1 syntax-expr2 -- syntax-expr3 )
  1691. Z list-map make-binary 0 , ;
  1692. Z
  1693. STUNKYFLUFF
  1694. #
  1695. #
  1696. echo Extracting mini.f83
  1697. sed 's/^Z//' >mini.f83 <<\STUNKYFLUFF
  1698. Z( $Id: mini.f83,v 1.1 90/04/18 14:21:23 ertl Exp $ )
  1699. Z( Copyright 1990 Martin Anton Ertl )
  1700. Z( This program is distributed WITHOUT ANY WARRANTY. )
  1701. Z( See gray.doc or gray.f83 for the license. )
  1702. Z( a small compiler )
  1703. Z( to compile a program type "mini" and then type in the program )
  1704. Z( This creates a new word, that you must call to execute the program )
  1705. Z( you have to type one symbol and one character after the end of the )
  1706. Z( mini program because of the lookahead of parser and scanner )
  1707. Z( you can then call the program by its name )
  1708. Z( mini programs take their input from the stack and write their )
  1709. Z( output with . )
  1710. Z#include gray.f83
  1711. Z#include graylist.f83
  1712. Z
  1713. Z.( Loading mini ... ) cr
  1714. Z
  1715. Z( scanner )
  1716. Z( it is implemented using gray to give an example )
  1717. Z( that's probably not the best way )
  1718. Z255 max-member ( the whole character set )
  1719. Z
  1720. Zvariable tokenval 0 tokenval !
  1721. Z: token ( -- ) ( use: token name ) ( name: -- n )
  1722. Z ( defines a token that returns a unique value )
  1723. Z tokenval @ constant
  1724. Z 1 tokenval +! ;
  1725. Z
  1726. Ztoken ";"
  1727. Ztoken ","
  1728. Ztoken ":="
  1729. Ztoken "="
  1730. Ztoken "#"
  1731. Ztoken ">"
  1732. Ztoken "+"
  1733. Ztoken "-"
  1734. Ztoken "*"
  1735. Ztoken "("
  1736. Ztoken ")"
  1737. Ztoken Ident
  1738. Ztoken Number
  1739. Z
  1740. Zvocabulary keywords keywords definitions
  1741. Ztoken PROGRAM
  1742. Ztoken VAR
  1743. Ztoken BEGIN
  1744. Ztoken END
  1745. Ztoken Read
  1746. Ztoken Write
  1747. Ztoken IF
  1748. Ztoken THEN
  1749. Ztoken WHILE
  1750. Ztoken DO
  1751. Zforth definitions
  1752. Z
  1753. Zvariable numval
  1754. Zvariable identp
  1755. Zvariable identlen
  1756. Z
  1757. Z: adds ( addr1 c -- addr1+1 )
  1758. Z ( accumulates char to string )
  1759. Z over c! 1+ ;
  1760. Z
  1761. Z: key/ident ( addr -- n )
  1762. Z ( checks string at addr for keyword and returns token value )
  1763. Z ['] keywords lookup if
  1764. Z  execute
  1765. Z else
  1766. Z  drop Ident
  1767. Z endif ;
  1768. Z
  1769. Zvariable ch
  1770. Z
  1771. Z: testchar? ( set -- f )
  1772. Z ch c@ member? ;
  1773. Z' testchar? test-vector !
  1774. Z
  1775. Z: ?nextchar ( f -- )
  1776. Z not abort" non-mini character or '=' missing after ':'"
  1777. Z key ch c! ;
  1778. Z
  1779. Z: .. ( c1 c2 -- set )
  1780. Z ( creates a set that includes the characters c, c1<=c<=c2 )
  1781. Z empty copy-set
  1782. Z swap 1+ rot do
  1783. Z  i over add-member
  1784. Z loop ;
  1785. Z
  1786. Z: ` ( -- terminal ) ( use: ` c )
  1787. Z ( creates anonymous terminal for the character c )
  1788. Z [compile] ascii singleton ['] ?nextchar make-terminal ;
  1789. Z
  1790. Zascii a ascii z ..  ascii A ascii Z ..  union  ' ?nextchar  terminal letter
  1791. Zascii 0 ascii 9 ..  ' ?nextchar  terminal digit
  1792. Z0 32 ..  ' ?nextchar  terminal space
  1793. Z
  1794. Z(( space **
  1795. Z   (( ` ;      {{ ";"  }}
  1796. Z   || ` ,      {{ ","  }}
  1797. Z   || ` : ` =  {{ ":=" }}
  1798. Z   || ` =      {{ "="  }}
  1799. Z   || ` #      {{ "#"  }}
  1800. Z   || ` >      {{ ">"  }}
  1801. Z   || ` +      {{ "+"  }}
  1802. Z   || ` -      {{ "-"  }}
  1803. Z   || ` *      {{ "*"  }}
  1804. Z   || ` (      {{ "("  }}
  1805. Z   || ` )      {{ ")"  }}
  1806. Z   || {{ 0 }}
  1807. Z      (( {{ 10 * ch c@ + ascii 0 - }} digit )) ++
  1808. Z      {{ numval !  Number }}
  1809. Z   || {{ here identp ! here ch c@ adds }} letter
  1810. Z      (( {{ ch c@ adds }} (( letter || digit )) )) **
  1811. Z      {{ 0 adds  here - identlen !  here key/ident }}
  1812. Z   ))
  1813. Z)) <- symbol
  1814. Z
  1815. Zsymbol parser scan
  1816. Z
  1817. Z
  1818. Z( parser )
  1819. Ztokenval @ 1- max-member
  1820. Z
  1821. Zvocabulary variables ( for mini variables )
  1822. Z
  1823. Zvariable sym
  1824. Z
  1825. Z: testsym? ( set -- f )
  1826. Z sym @ member? ;
  1827. Z' testsym? test-vector !
  1828. Z
  1829. Z: ?nextsym ( f -- )
  1830. Z not abort" syntax error"
  1831. Z scan sym ! ;
  1832. Z
  1833. Z: t ( n -- ) ( use: token t name )
  1834. Z singleton ['] ?nextsym terminal ;
  1835. Z
  1836. Z";" t ";"
  1837. Z"," t ","
  1838. Z":=" t ":="
  1839. Z"=" t "="
  1840. Z"#" t "#"
  1841. Z">" t ">"
  1842. Z"+" t "+"
  1843. Z"-" t "-"
  1844. Z"*" t "*"
  1845. Z"(" t "("
  1846. Z")" t ")"
  1847. ZIdent t Ident
  1848. ZNumber t number
  1849. ZPROGRAM t PROGRAM
  1850. ZVAR t VAR
  1851. ZBEGIN t BEGIN
  1852. ZEND t END
  1853. ZRead t "Read"
  1854. ZWrite t "Write"
  1855. ZIF t IF
  1856. ZTHEN t THEN
  1857. ZWHILE t WHILE
  1858. ZDO t DO
  1859. Z
  1860. Z: $prog ( addr -- )
  1861. Z ( defines colon-def with the whose name is pointed to by addr )
  1862. Z >r here 0 1 r> entry ] ;
  1863. Z
  1864. Z: $var ( addr -- )
  1865. Z ( defines variable with the name of the 0-terminated string at addr )
  1866. Z ( very tile-dependent )
  1867. Z ['] variables lookup abort" variable already defined"
  1868. Z >r 0 0 2 r> entry ;
  1869. Z
  1870. Z: getvar ( addr -- word )
  1871. Z ( get the execution address of the var whose name is pointed to by addr )
  1872. Z ['] variables lookup not abort" variable undefined" ;
  1873. Z
  1874. Z: <> ( n1 n2 -- f )
  1875. Z = not ;
  1876. Z
  1877. Znonterminal Stat
  1878. Znonterminal Expr
  1879. Z
  1880. Z(( {{ numval @ }} number )) <- Number
  1881. Z
  1882. Z\ (( {{ identp @ }} ident )) <- Ident
  1883. Z
  1884. Z(( Number {{ [compile] literal }}
  1885. Z|| {{ identp @ getvar (compile) compile @ }} Ident
  1886. Z|| "(" Expr ")"
  1887. Z)) <- Factor
  1888. Z
  1889. Z(( Factor (( "*" Factor {{ compile * }} )) ** )) <- Term
  1890. Z
  1891. Z(( Term  (( (( "+" {{ ['] + }} || "-" {{ ['] - }} )) Term {{ (compile) }} )) **
  1892. Z)) Expr rule
  1893. Z
  1894. Z(( Expr
  1895. Z   (( "=" {{ ['] = }} || "#" {{ ['] <> }} || ">" {{ ['] > }} ))
  1896. Z   Expr {{ (compile) }}
  1897. Z)) <- Cond
  1898. Z
  1899. ZStat ";" && ?? <- StatSeq
  1900. Z
  1901. Z(( "Read" {{ identp @ getvar (compile) compile ! }} Ident )) <- ReadStat
  1902. Z
  1903. Z(( "Write" Expr {{ compile . }} )) <- WriteStat
  1904. Z
  1905. Z(( {{ identp @ getvar }} Ident ":=" Expr {{ (compile) compile ! }}
  1906. Z)) <- AssStat
  1907. Z
  1908. Z(( IF Cond {{ [compile] if }} THEN StatSeq END {{ [compile] endif }}
  1909. Z)) <- IfStat
  1910. Z
  1911. Z(( {{ [compile] begin }} WHILE Cond {{ [compile] while }} DO
  1912. Z   StatSeq END {{ [compile] repeat }}
  1913. Z)) <- WhileStat
  1914. Z   
  1915. Z(( ReadStat || WriteStat || AssStat || IfStat || WhileStat )) Stat rule
  1916. Z
  1917. Z(( VAR {{ variables definitions }}
  1918. Z   (( {{ identp @ $var }} Ident )) "," &&
  1919. Z   {{ forth definitions }}
  1920. Z)) <- Decl
  1921. Z
  1922. Z(( PROGRAM {{ identp @ identlen @ allot }} Ident  Decl ??
  1923. Z   {{ $prog }} BEGIN StatSeq {{ [compile] ; }} END 
  1924. Z)) <- Program
  1925. Z
  1926. ZProgram parser parsemini
  1927. Z
  1928. Z: mini ( -- ) ( use: mini name )
  1929. Z true ?nextchar true ?nextsym parsemini ;
  1930. STUNKYFLUFF
  1931. #
  1932. #
  1933. echo Extracting oberon.f83
  1934. sed 's/^Z//' >oberon.f83 <<\STUNKYFLUFF
  1935. Z\ $Id: oberon.f83,v 1.1 90/04/18 14:21:47 ertl Exp $ )
  1936. Z( Copyright 1990 Martin Anton Ertl )
  1937. Z( This program is distributed WITHOUT ANY WARRANTY. )
  1938. Z( See gray.doc or gray.f83 for the license. )
  1939. Z\ parser for oberon )
  1940. Z\ i chose oberon, because it has a moderately complex grammar, )
  1941. Z\ not for its qualities as a language )
  1942. Z\ this is just a parser, without any semantic actions )
  1943. Z\ it was not tested )
  1944. Z\ the grammar was taken from: )
  1945. Z\ N.Wirth, The Programming Language Oberon, )
  1946. Z\ Software - Practice and Experience, 18, 671-690 (July 1988)
  1947. Z\ corrections appeared in the january 89 issue, i believe )
  1948. Z
  1949. Z\ space requirements on a 16-bit fig-forth using graylist.f83 )
  1950. Z\ grammar:         8104 bytes )
  1951. Z\ generated code:  3551 bytes )
  1952. Z\ generated total: 5719 bytes )
  1953. Z\ context-stack:    220 bytes )
  1954. Z\ return-stack:     720 bytes )
  1955. Z\ the data-stack is not critical- mine can only hold 60 cells )
  1956. Z\ if your return-stack cannot hold much, change the does> part )
  1957. Z\ of method: pop 3 cells off the return stack and save them )
  1958. Z\ elsewhere until after the execute )
  1959. Z\ generating the parser takes a while: 24.5 seconds on my 4Mhz 6502 system )
  1960. Z
  1961. Z\ the grammar contains four conflicts, which are all harmful, )
  1962. Z\ i.e. the generated parser will not parse all oberon programs )
  1963. Z\ in the qualident rule there is a confict between the two idents )
  1964. Z\ designator doesn't know, whether a "(" means a type guard or a procedure call)
  1965. Z\ Procedure- and ForwardDeclaration have a conflict in a DeclarationSequence )
  1966. Z\ in statement there's a classical conflict between assigment and ProcedureCall)
  1967. Z
  1968. Z63 max-member
  1969. Z
  1970. Zvariable tcount 0 tcount !
  1971. Z: t \ -- )
  1972. Z tcount @ singleton ['] abort terminal
  1973. Z 1 tcount +! ;
  1974. Z
  1975. Zt integer
  1976. Zt real
  1977. Zt CharConstant
  1978. Zt string
  1979. Zt ident
  1980. Zt "+"
  1981. Zt "-"
  1982. Zt "*"
  1983. Zt "/"
  1984. Zt "~"
  1985. Zt "&"
  1986. Zt "."
  1987. Zt ","
  1988. Zt ";"
  1989. Zt "|"
  1990. Zt "("
  1991. Zt ")"
  1992. Zt "["
  1993. Zt "]"
  1994. Zt ":="
  1995. Zt "^"
  1996. Zt "="
  1997. Zt "#"
  1998. Zt "<"
  1999. Zt ">"
  2000. Zt "<="
  2001. Zt ">="
  2002. Zt ":"
  2003. Zt ".."
  2004. Zt "{"
  2005. Zt "}"
  2006. Z
  2007. Zt ARRAY        t IN        t THEN
  2008. Zt BEGIN        t IS        t TO
  2009. Zt CASE         t LOOP      t TYPE
  2010. Zt CONST        t MOD       t UNTIL
  2011. Zt DEFINITION   t MODULE    t VAR
  2012. Zt DIV          t NIL       t WHILE
  2013. Zt DO           t OF        t WITH
  2014. Zt ELSE         t OR
  2015. Zt ELSIF        t POINTER
  2016. Zt END          t PROCEDURE
  2017. Zt EXIT         t RECORD
  2018. Zt IF           t REPEAT
  2019. Zt IMPORT       t RETURN
  2020. Z
  2021. Z: && \ syntax-expr1 syntax-expr2 -- syntax-expr3 )
  2022. Z over concat ** concat ; 
  2023. Z
  2024. Znonterminal factor
  2025. Znonterminal expression
  2026. Znonterminal type
  2027. Znonterminal statement
  2028. Znonterminal DeclarationSequence
  2029. Z
  2030. Z(( integer || real )) <- number
  2031. Z
  2032. Z(( (( ident "." )) ?? ident )) <- qualident
  2033. Z
  2034. Zexpression <- ConstExpression
  2035. Z(( ident "=" ConstExpression )) <- ConstantDeclaration
  2036. Z
  2037. ZConstExpression <- length
  2038. Z(( ARRAY length "," && OF type )) <- ArrayType
  2039. Z
  2040. Zident "," && <- IdentList
  2041. Z(( IdentList ":" type )) ?? <- FieldList
  2042. ZFieldList ";" && <- FieldListSequence
  2043. Zqualident <- BaseType
  2044. Z(( RECORD (( "(" BaseType ")" )) ?? FieldListSequence END )) <- RecordType
  2045. Z
  2046. Z(( POINTER TO type )) <- PointerType
  2047. Z
  2048. Z(( (( ARRAY OF )) ** qualident )) <- FormalType
  2049. Z(( "(" (( VAR ?? FormalType )) "," && ?? ")" (( ":" qualident )) ?? ))
  2050. Z <- FormalTypeList
  2051. Z(( PROCEDURE FormalTypeList ?? )) <- ProcedureType
  2052. Z
  2053. Z(( qualident || ArrayType || RecordType || PointerType || ProcedureType ))
  2054. Z type rule
  2055. Z(( ident "=" type )) <- TypeDeclaration
  2056. Z
  2057. Z(( IdentList ":" type )) <- VariableDeclaration
  2058. Z
  2059. Zexpression "," && <- ExpList
  2060. Z(( qualident (( "." ident || "[" ExpList "]" || "(" qualident ")" || "^" )) **
  2061. Z)) <- designator
  2062. Z
  2063. Z(( "(" ExpList ?? ")" )) <- ActualParameters
  2064. Z(( expression (( ".." expression )) ?? )) <- element
  2065. Z(( "{" element "," && ?? "}" )) <- set
  2066. Z(( number || CharConstant || string || NIL || set ||
  2067. Z   designator ActualParameters ?? || "(" expression ")" || "~" factor ))
  2068. Z factor rule
  2069. Z(( "*" || "/" || DIV || MOD || "&" )) <- MulOperator
  2070. Zfactor MulOperator && <- term
  2071. Z(( "+" || "-" || OR )) <- AddOperator
  2072. Z(( (( "+" || "-" )) ?? term AddOperator && )) <- SimpleExpression
  2073. Z(( "=" || "#" || "<" || "<=" || ">" || ">=" || IN || IS )) <- relation
  2074. Z(( SimpleExpression (( relation SimpleExpression )) ?? )) expression rule
  2075. Z
  2076. Z(( designator ":=" expression )) <- assignment
  2077. Z
  2078. Z(( designator ActualParameters ?? )) <- ProcedureCall
  2079. Z
  2080. Zstatement ";" && <- StatementSequence
  2081. Z
  2082. Z(( IF expression THEN StatementSequence
  2083. Z   (( ELSIF expression THEN StatementSequence )) **
  2084. Z   (( ELSE StatementSequence )) ??
  2085. Z   END
  2086. Z)) <- IfStatement
  2087. Z
  2088. Z(( ConstExpression (( ".." ConstExpression )) ?? )) <- CaseLabels
  2089. ZCaseLabels "," && <- CaseLabelList
  2090. Z(( CaseLabelList ":" StatementSequence )) ?? <- case
  2091. Z(( CASE expression OF case "|" && (( ELSE StatementSequence )) ?? END ))
  2092. Z<- CaseStatement
  2093. Z
  2094. Z(( WHILE expression DO StatementSequence END )) <- WhileStatement
  2095. Z
  2096. Z(( REPEAT StatementSequence UNTIL expression )) <- RepeatStatement
  2097. Z
  2098. Z(( LOOP StatementSequence END )) <- LoopStatement
  2099. Z
  2100. Z(( WITH qualident ":" qualident DO StatementSequence END )) <- WithStatement
  2101. Z
  2102. Z(( assignment || ProcedureCall ||
  2103. Z   IfStatement || CaseStatement || WhileStatement || RepeatStatement ||
  2104. Z   LoopStatement || WithStatement || EXIT || RETURN expression ??
  2105. Z)) ?? statement rule
  2106. Z
  2107. Z(( VAR ?? IdentList ":" FormalType )) <- FPSection
  2108. Z(( "(" FPSection ";" && ?? ")" (( ":" qualident )) ?? )) <- FormalParameters
  2109. Z
  2110. Z(( DeclarationSequence (( BEGIN StatementSequence )) ?? END )) <- ProcedureBody
  2111. Z(( PROCEDURE "*" ?? ident FormalParameters ?? )) <- ProcedureHeading
  2112. Z(( ProcedureHeading ";" ProcedureBody ident )) <- ProcedureDeclaration
  2113. Z(( PROCEDURE "^" ident FormalParameters ?? )) <- ForwardDeclaration
  2114. Z(( (( CONST (( ConstantDeclaration ";" )) ** )) ??
  2115. Z   (( TYPE (( TypeDeclaration ";" )) ** )) ??
  2116. Z   (( VAR (( VariableDeclaration ";" )) ** )) ??
  2117. Z   (( ProcedureDeclaration ";" || ForwardDeclaration ";" )) **
  2118. Z)) DeclarationSequence rule
  2119. Z
  2120. Z(( (( CONST (( ConstantDeclaration ";" )) ** )) ??
  2121. Z   (( TYPE (( TypeDeclaration ";" )) ** )) ??
  2122. Z   (( VAR (( VariableDeclaration ";" )) ** )) ??
  2123. Z   (( ProcedureHeading ";" )) **
  2124. Z)) <- DefSequence
  2125. Z(( ident (( ":" ident )) ?? )) <- import
  2126. Z(( IMPORT import "," && ";" )) <- ImportList
  2127. Z(( MODULE ident ";" ImportList ?? DeclarationSequence
  2128. Z    (( BEGIN StatementSequence )) ?? END ident "." )) <- module
  2129. Z(( DEFINITION ident ";" ImportList ?? DefSequence END ident "." )) <- definition
  2130. Z(( module || definition )) <- CompilationUnit
  2131. Z
  2132. ZCompilationUnit parser oberon
  2133. Z
  2134. STUNKYFLUFF
  2135. #
  2136. #
  2137. echo Extracting test.mini
  2138. sed 's/^Z//' >test.mini <<\STUNKYFLUFF
  2139. ZPROGRAM test
  2140. ZVAR laufVar, i, j, SUM
  2141. ZBEGIN
  2142. ZRead i;
  2143. ZlaufVar := i+1;
  2144. Zj := 0 - 1;
  2145. ZSUM := j;
  2146. ZWHILE laufVar > 0 DO
  2147. Z    j := j + 2;
  2148. Z    IF j#3 THEN SUM := SUM+j END;
  2149. Z    laufVar := laufVar -1
  2150. Z    END;
  2151. ZIF i+1 > 0 THEN j:=j-2 END;
  2152. ZIF i > 0 THEN SUM := 3+SUM END;
  2153. ZWrite SUM - (j - 2 * 2 + 11 + 9 - (3*5)) 
  2154. ZEND
  2155. Z 
  2156. Z
  2157. Z
  2158. STUNKYFLUFF
  2159. echo ALL DONE BUNKY!
  2160. exit 0
  2161.