/dylan/monday-parser.dylan

  1module: %wiki
  2author: Hannes Mehnert <hannes@mehnert.org>
  3synopsis: markup definition for dylan wiki
  4
  5define function extract-action
  6    (token-string :: <byte-string>,
  7     token-start :: <integer>, 	 
  8     token-end :: <integer>) 	 
  9 => (result :: <byte-string>); 	 
 10  copy-sequence(token-string, start: token-start, end: token-end);
 11end;
 12
 13define function count-chars
 14  (string :: <byte-string>,
 15   tstart :: <integer>,
 16   tend :: <integer>)
 17 => (res :: <integer>)
 18  tend - tstart
 19end;
 20
 21define constant $base-url = "/wiki/view.dsp?title=";
 22
 23define constant $wiki-tokens
 24  = simple-lexical-definition
 25      token EOF;
 26
 27      inert "([ ])+";
 28
 29      token LBRACKET = "\\[";
 30      token RBRACKET = "\\]";
 31
 32      token EQUALS = "(=)+",
 33        semantic-value-function: count-chars;
 34      token TILDES = "(~)+",
 35        semantic-value-function: count-chars;
 36      token TICKS = "(')+",
 37        semantic-value-function: count-chars;
 38
 39      token AMPERSAND = "&";
 40
 41      token HASHMARK = "#";
 42      token STAR = "*";
 43
 44      token FOUR-DASHES = "----", priority: 3;
 45
 46      token PIPE = "\\|";
 47
 48      token SMALLER = "<";
 49      token GREATER = ">";
 50
 51      token CLIST = "(\n|\r|\r\n)(\\*|#)", priority: 3;
 52      token PREFORMATTED = "(\r|\n|\r\n) ", priority: 3;
 53
 54      token NEWLINE = "(\n|\r|\r\n)";
 55      //todo: ignore spaces?!
 56
 57      token TEXT = "[a-zA-Z_-0-9\\.]+",
 58        semantic-value-function: extract-action;
 59
 60      token URL = "(http|ftp|https)://",
 61        semantic-value-function: extract-action;
 62end;
 63
 64define constant $wiki-productions
 65  = simple-grammar-productions
 66
 67     production description :: false-or(<string>) => [TEXT] (data)
 68       if (TEXT.size = 0) #f else TEXT end;
 69
 70     production wiki-page-name :: <string> => [TEXT] (data)
 71       TEXT;
 72
 73     production myurl :: <string> => [URL TEXT] (data)
 74       concatenate(URL, TEXT);
 75
 76     production external-link :: xml/<element> => [LBRACKET myurl RBRACKET] (data)
 77       with-xml() a(myurl, href => myurl) end;
 78
 79     production external-link :: xml/<element> => [LBRACKET myurl description RBRACKET] (data)
 80       with-xml() a(description, href => myurl) end;
 81
 82     production internal-link :: xml/<element> => [LBRACKET LBRACKET wiki-page-name RBRACKET RBRACKET] (data)
 83       with-xml() a(wiki-page-name, href => concatenate($base-url, wiki-page-name)) end;
 84
 85     production internal-link :: xml/<element> => [LBRACKET LBRACKET wiki-page-name PIPE description RBRACKET RBRACKET] (data)
 86       with-xml() a(description, href => concatenate($base-url, wiki-page-name)) end;
 87
 88     production header :: xml/<element> => [EQUALS more-wiki-text EQUALS], action:
 89       method (p :: <simple-parser>, data, s, e)
 90         let heading = max(p[0], p[2]);
 91         unless (p[0] = p[2])
 92           format-out("Unbalanced number of '=' in header %s, left: %d right: %d, using %d\n",
 93                      p[1], p[0], p[2], heading);
 94         end;
 95         make(xml/<element>,
 96              name: concatenate("h", integer-to-string(heading)),
 97              children: p[1]);
 98       end;
 99
100     production unnumbered-list :: xml/<element> => [STAR list-elements] (data)
101       format-out("Hit unnumbered-list %=\n", list-elements);
102       make(xml/<element>, name: "ul", children: list-elements);
103
104     production numbered-list :: xml/<element> => [HASHMARK list-elements] (data)
105       make(xml/<element>, name: "ol", children: list-elements);
106
107     production list-elements :: <collection> => [list-element more-list-elements] (data)
108       format-out("Hit list-elements\n");
109       add!(more-list-elements, list-element);
110
111     production more-list-elements :: <collection> => [CLIST list-element more-list-elements] (data)
112       format-out("Hit more-list-elements\n");
113       add!(more-list-elements | #(), list-element);
114
115     production more-list-elements :: <collection> => [] (data)
116       format-out("Hit more-list-elements, empty\n");
117       #();
118
119     production list-element :: xml/<element> => [wiki-text] (data)
120       format-out("Hit list-element %=\n", wiki-text);
121       make(xml/<element>, name: "li", children: wiki-text);
122
123     production simple-format :: xml/<xml> => [TICKS TEXT TICKS], action:
124       method (p :: <simple-parser>, data, s, e)
125         let ticks = max(p[0], p[2]);
126         unless (p[0] = p[2])
127           format-out("Unbalanced number of ' in TICKS %s, left: %d right: %d, using %d\n",
128                      p[1], p[0], p[2], ticks);
129         end;
130         let str = list(make(xml/<char-string>, text: p[1]));
131         if (ticks = 5)
132           make(xml/<element>, name: "b", children: list(make(xml/<element>, name: "i", children: str)));
133         else
134           let ele-name = if (ticks = 2) "i" elseif (ticks = 3) "b" end;
135           if (ele-name)
136             make(xml/<element>, name: ele-name, children: str);
137           else
138             str[0]
139           end;
140         end;
141       end;
142
143     production wiki-text :: <collection> => [TEXT more-wiki-text] (data)
144       add!(more-wiki-text, with-xml() text(TEXT) end);
145
146     production wiki-text :: <collection> => [internal-link more-wiki-text] (data)
147       add!(more-wiki-text, internal-link);
148
149     production wiki-text :: <collection> => [external-link more-wiki-text] (data)
150       add!(more-wiki-text, external-link);
151
152     production wiki-text :: <collection> => [simple-format more-wiki-text] (data)
153       add!(more-wiki-text, simple-format);
154
155     production more-wiki-text :: <collection> => [wiki-text] (data)
156       wiki-text;
157
158     production more-wiki-text :: <collection> => [] (data)
159       #();
160
161     production horizontal-line :: xml/<element> => [FOUR-DASHES] (data)
162       with-xml() hr end;
163
164     production preformat :: xml/<element> => [PREFORMATTED TEXT more-preformat] (data)
165        let pre-string = concatenate("\n ", TEXT, more-preformat);
166        make(xml/<element>,
167             name: "pre",
168             children: list(make(xml/<char-string>, text: pre-string)));
169
170     production more-preformat :: <string> => [TEXT more-preformat] (data)
171       concatenate(" ", TEXT, more-preformat);
172
173     production more-preformat :: <string> => [PREFORMATTED more-preformat] (data)
174       concatenate("\n", more-preformat);
175
176     production more-preformat :: <string> => [NEWLINE] (data)
177       "\n";
178
179     production line :: <collection> => [wiki-text] (data)
180       wiki-text;
181
182     production line :: <collection> => [header] (data)
183       list(header);
184
185     production line :: <collection> => [unnumbered-list] (data)
186       list(unnumbered-list);
187
188     production line :: <collection> => [numbered-list] (data)
189       list(numbered-list);
190
191     production line :: <collection> => [horizontal-line] (data)
192       list(horizontal-line);
193
194     production lines => [] (data)
195
196     production lines => [preformat lines] (data)
197       add!(data.my-real-data, preformat);
198
199     production lines => [line NEWLINE NEWLINE lines] (data)
200       add!(data.my-real-data, with-xml() p end);
201       do(curry(add!, data.my-real-data), line);
202
203     production lines => [line NEWLINE lines] (data)
204       do(curry(add!, data.my-real-data), line);
205end;
206
207define constant $wiki-parser-automaton
208  = simple-parser-automaton($wiki-tokens, $wiki-productions,
209                            #[#"lines"]);
210
211define function consume-token 	 
212    (consumer-data,
213     token-number :: <integer>,
214     token-name :: <object>,
215     semantic-value :: <object>,
216     start-position :: <integer>,
217     end-position :: <integer>)
218 => ();
219  //let srcloc
220  //  = range-source-location(consumer-data, start-position, end-position);
221  format-out("%d - %d: token %d: %= value %=\n",
222             start-position,
223             end-position,
224             token-number,
225             token-name,
226             semantic-value);
227  simple-parser-consume-token(consumer-data, token-number, token-name, semantic-value, start-position, end-position);
228end function;
229
230define sealed class <my-data> (<object>)
231  slot my-real-data = make(<stretchy-vector>);
232end;
233
234define function parse-wiki-markup (input :: <string>)
235  let rangemap = make(<source-location-rangemap>);
236  rangemap-add-line(rangemap, 0, 1);
237  if(input[0] = ' ')
238    input := concatenate("\n", input);
239  end;
240  unless(input[input.size - 1] = '\n')
241    input := add!(input, '\n')
242  end;
243  let scanner = make(<simple-lexical-scanner>,
244                     definition: $wiki-tokens,
245                     rangemap: rangemap);
246  let data = make(<my-data>);
247  let parser = make(<simple-parser>,
248                    automaton: $wiki-parser-automaton,
249                    start-symbol: #"lines",
250                    rangemap: rangemap,
251                    consumer-data: data);
252  format-out("before scan-tokens, input: %s\n", input);
253  scan-tokens(scanner,
254              simple-parser-consume-token,
255              //consume-token,
256              parser,
257              input,
258              end: input.size,
259              partial?: #f);
260  let end-position = scanner.scanner-source-position;
261  format-out("before consuming EOF at %d\n", end-position);
262  simple-parser-consume-token(parser, 0, #"EOF", parser, end-position, end-position);
263  format-out("data (%d) is %=\n", data.my-real-data.size, data.my-real-data);
264  reduce1(concatenate, (map(curry(as, <string>), reverse(data.my-real-data))));
265end;
266/*
267begin
268  parse-wiki-markup(" one\n two\n three\n foo");
269  parse-wiki-markup(" this is pre-text\n and another line");
270end;
271*/