5.22. Lexer
Start ocaml section to src/flx_prelex.mli[1
/1
]
1: # 4 "./lpsrc/flx_lexer.ipk"
2: val src_of_token : Flx_parse.token -> Flx_ast.srcref
3: val string_of_token : Flx_parse.token -> string
4: val name_of_token : Flx_parse.token -> string
5:
Start ocaml section to src/flx_prelex.ml[1
/1
]
1: # 10 "./lpsrc/flx_lexer.ipk"
2: open Flx_parse
3:
4: let string_of_string s = "\"" ^ Flx_string.c_quote_of_string s ^ "\""
5:
6: let string_of_token (tok :Flx_parse.token): string =
7: match tok with
8: | NAME (sr,s) -> s
9: | INTEGER (sr,t,i) -> Big_int.string_of_big_int i
10: | FLOAT (sr,t,v) -> v
11: | STRING (sr,s) -> Flx_string.c_quote_of_string s
12: | CSTRING (sr,s) -> Flx_string.c_quote_of_string s
13: | FSTRING (sr,s) -> Flx_string.c_quote_of_string s
14: | WSTRING (sr,s) -> Flx_string.c_quote_of_string s
15: | USTRING (sr,s) -> Flx_string.c_quote_of_string s
16: | USER10 (sr,op,fn) -> "op10 " ^ op
17: | USERLB (sr,_,lb) -> lb
18: | USERRB (sr,rb) -> rb
19: | USER_KEYWORD (sr,s) -> s
20: | USER_STATEMENT_KEYWORD (sr,s,_,_) -> s
21: | USER_STATEMENT_DRIVER (sr,s,_) -> s
22: | HASH_INCLUDE_FILES fs -> "include_files(" ^ String.concat "," fs ^ ")"
23: (*
24: | PARSE_ACTION sr -> "=>#"
25: *)
26:
27: | DOLLAR _ -> "$"
28: | QUEST _ -> "?"
29: | EXCLAMATION _ -> "!"
30: | LPAR _ -> "("
31: | RPAR _ -> ")"
32: | LSQB _ -> "["
33: | RSQB _ -> "]"
34: | LBRACE _ -> "{"
35: | RBRACE _ -> "}"
36: | COLON _ -> ":"
37: | COMMA _ -> ","
38: | SEMI _ -> ";"
39: | PLUS _ -> "+"
40: | MINUS _ -> "-"
41: | STAR _ -> "*"
42: | SLASH _ -> "/"
43: | VBAR _ -> "|"
44: | AMPER _ -> "&"
45: | LESS _ -> "<"
46: | GREATER _ -> ">"
47: | EQUAL _ -> "="
48: | DOT _ -> "."
49: | PERCENT _ -> "%"
50: | BACKQUOTE _ -> "`"
51: | TILDE _ -> "~"
52: | CIRCUMFLEX _ -> "^"
53: | HASH _ -> "#"
54: | ANDLESS _ -> "&<"
55: | ANDGREATER _ -> "&>"
56: | EQEQUAL _ -> "=="
57: | NOTEQUAL _ -> "!="
58: | LESSEQUAL _ -> "<="
59: | GREATEREQUAL _ -> ">="
60: | LEFTSHIFT _ -> "<<"
61: | RIGHTSHIFT _ -> ">>"
62: | STARSTAR _ -> "**"
63: | LESSCOLON _ -> "<:"
64: | COLONGREATER _ -> ":>"
65: | DOTDOT _ -> ".."
66: | COLONCOLON _ -> "::"
67: | PLUSPLUS _ -> "++"
68: | MINUSMINUS _ -> "--"
69: | PLUSEQUAL _ -> "+="
70: | MINUSEQUAL _ -> "-="
71: | STAREQUAL _ -> "*="
72: | SLASHEQUAL _ -> "/="
73: | PERCENTEQUAL _ -> "%="
74: | CARETEQUAL _ -> "^="
75: | VBAREQUAL _ -> "|="
76: | AMPEREQUAL _ -> "&="
77: | TILDEEQUAL _ -> "~="
78: | COLONEQUAL _ -> ":="
79: | RIGHTARROW _ -> "->"
80: | EQRIGHTARROW _ -> "=>"
81: | LEFTARROW _ -> "<-"
82: | LSQANGLE _ -> "[<"
83: | RSQANGLE _ -> ">]"
84: | LSQBAR _ -> "[|"
85: | RSQBAR _ -> "|]"
86: | AMPERAMPER _ -> "&&"
87: | VBARVBAR _ -> "||"
88: | SLOSHAMPER _ -> "\\&"
89: | SLOSHVBAR _ -> "\\|"
90: | SLOSHCIRCUMFLEX _ -> "\\^"
91: | HASHBANG _ -> "#!"
92: | LEFTSHIFTEQUAL _ -> "<<="
93: | RIGHTSHIFTEQUAL _ -> ">>="
94: | LEFTRIGHTARROW _ -> "<->"
95: | ANDEQEQUAL _ -> "&=="
96: | ANDNOTEQUAL _ -> "&!="
97: | ANDLESSEQUAL _ -> "&<="
98: | ANDGREATEREQUAL _ -> "&>="
99: | DOTDOTDOT _ -> "..."
100: | DOTRIGHTARROW _ -> ".->"
101: | LONGRIGHTARROW _ -> "-->"
102: | PARSE_ACTION _ -> "=>#"
103: | HASHBANGSLASH _ -> "#!/"
104: | ALL _ -> "all"
105: | ASSERT _ -> "assert"
106: | AXIOM _ -> "axiom"
107: | BODY _ -> "body"
108: | CALL _ -> "call"
109: | CASE _ -> "case"
110: | CASENO _ -> "caseno"
111: | CLASS _ -> "class"
112: | COMMENT_KEYWORD _ -> "comment"
113: | COMPOUND _ -> "compound"
114: | CONST _ -> "const"
115: | CCLASS _ -> "cclass"
116: | CSTRUCT _ -> "cstruct"
117: | CTOR _ -> "ctor"
118: | CTYPES _ -> "ctypes"
119: | DEF _ -> "def"
120: | DO _ -> "do"
121: | DONE _ -> "done"
122: | ELIF _ -> "elif"
123: | ELSE _ -> "else"
124: | ENDIF _ -> "endif"
125: | ENDMATCH _ -> "endmatch"
126: | ENUM _ -> "enum"
127: | EXPECT _ -> "expect"
128: | EXPORT _ -> "export"
129: | FOR _ -> "for"
130: | FORGET _ -> "forget"
131: | FORK _ -> "fork"
132: | FUNCTOR _ -> "functor"
133: | FUNCTION _ -> "fun"
134: | GOTO _ -> "goto"
135: | HEADER _ -> "header"
136: | IDENT _ -> "ident"
137: | INCLUDE _ -> "include"
138: | INCOMPLETE _ -> "incomplete"
139: | INF _ -> "inf"
140: | IN _ -> "in"
141: | IS _ -> "is"
142: | INHERIT _ -> "inherit"
143: | INLINE _ -> "inline"
144: | JUMP _ -> "jump"
145: | LET _ -> "let"
146: | LOOP _ -> "loop"
147: | LVAL _ -> "lval"
148: | MACRO _ -> "macro"
149: | MODULE _ -> "module"
150: | NAN _ -> "NaN"
151: | NEW _ -> "new"
152: | NOINLINE _ -> "noinline"
153: | NONTERM _ -> "nonterm"
154: | NORETURN _ -> "noreturn"
155: | NOT _ -> "not"
156: | OBJECT _ -> "obj"
157: | OPEN _ -> "open"
158: | PACKAGE _ -> "package"
159: | POD _ -> "pod"
160: | PRIVATE _ -> "private"
161: | PROCEDURE _ -> "proc"
162: | PROPERTY _ -> "property"
163: | REDUCE _ -> "reduce"
164: | RENAME _ -> "rename"
165: | REQUIRES _ -> "requires"
166: | RETURN _ -> "return"
167: | STRUCT _ -> "struct"
168: | THEN _ -> "then"
169: | TODO _ -> "todo"
170: | TO _ -> "to"
171: | TYPEDEF _ -> "typedef"
172: | TYPE _ -> "type"
173: | UNION _ -> "union"
174: | USE _ -> "use"
175: | VAL _ -> "val"
176: | VAR _ -> "var"
177: | WHEN _ -> "when"
178: | WITH _ -> "with"
179: | UNDERSCORE _ -> "_"
180: | GC_POINTER _ -> "_gc_pointer"
181: | GC_TYPE _ -> "_gc_type"
182: | SVC _ -> "_svc"
183: | DEREF _ -> "_deref"
184: | AND _ -> "and"
185: | AS _ -> "as"
186: | CALLBACK _ -> "callback"
187: | CODE _ -> "code"
188: | IF _ -> "if"
189: | ISIN _ -> "isin"
190: | MATCH _ -> "match"
191: | NOEXPAND _ -> "noexpand"
192: | OF _ -> "of"
193: | OR _ -> "or"
194: | PARSE _ -> "parse"
195: | REGEXP _ -> "regexp"
196: | REGLEX _ -> "reglex"
197: | REGMATCH _ -> "regmatch"
198: | THE _ -> "the"
199: | TYPEMATCH _ -> "typematch"
200: | EXPRESSION _ -> "expr"
201: | FLOAT_LITERAL _ -> "float_literal"
202: | INTEGER_LITERAL _ -> "integer_literal"
203: | STRING_LITERAL _ -> "string_literal"
204: | STATEMENT _ -> "statement"
205: | STATEMENTS _ -> "statements"
206: # 47 "./lpsrc/flx_lexer.ipk"
207: | COMMENT s -> s (* C style comment, includes the /* */ pair *)
208: | COMMENT_NEWLINE s -> "// " ^ s ^ "<NEWLINE>"
209: | WHITE i -> String.make i ' '
210: | NEWLINE -> "<NEWLINE>"
211: | ENDMARKER -> "<<EOF>>"
212: | ERRORTOKEN (sref,s) -> "<<ERROR '"^ s ^"'>>"
213: | SLOSH -> "\\"
214:
215: let name_of_token (tok :Flx_parse.token): string =
216: match tok with
217: | NAME (sr,s) -> "NAME"
218: | INTEGER (sr,t,i) -> "INTEGER"
219: | FLOAT (sr,t,v) -> "FLOAT"
220: | STRING (sr,s) -> "STRING"
221: | CSTRING (sr,s) -> "CSTRING"
222: | FSTRING (sr,s) -> "FSTRING"
223: | WSTRING (sr,s) -> "WSTRING"
224: | USTRING (sr,s) -> "USTRING"
225: | USER10 (sr,op,f) -> "USER10"
226: | USERLB _ -> "USERLB"
227: | USERRB _ -> "USERRB"
228: | USER_KEYWORD (sr,s) -> s
229: | USER_STATEMENT_KEYWORD (sr,s,_,_) -> s
230: | USER_STATEMENT_DRIVER (sr,s,_) -> s
231: | HASH_INCLUDE_FILES _ -> "HASH_INCLUDE_FILES"
232: (*
233: | PARSE_ACTION sr -> "PARSE_ACTION"
234: *)
235: | DOLLAR _ -> "DOLLAR"
236: | QUEST _ -> "QUEST"
237: | EXCLAMATION _ -> "EXCLAMATION"
238: | LPAR _ -> "LPAR"
239: | RPAR _ -> "RPAR"
240: | LSQB _ -> "LSQB"
241: | RSQB _ -> "RSQB"
242: | LBRACE _ -> "LBRACE"
243: | RBRACE _ -> "RBRACE"
244: | COLON _ -> "COLON"
245: | COMMA _ -> "COMMA"
246: | SEMI _ -> "SEMI"
247: | PLUS _ -> "PLUS"
248: | MINUS _ -> "MINUS"
249: | STAR _ -> "STAR"
250: | SLASH _ -> "SLASH"
251: | VBAR _ -> "VBAR"
252: | AMPER _ -> "AMPER"
253: | LESS _ -> "LESS"
254: | GREATER _ -> "GREATER"
255: | EQUAL _ -> "EQUAL"
256: | DOT _ -> "DOT"
257: | PERCENT _ -> "PERCENT"
258: | BACKQUOTE _ -> "BACKQUOTE"
259: | TILDE _ -> "TILDE"
260: | CIRCUMFLEX _ -> "CIRCUMFLEX"
261: | HASH _ -> "HASH"
262: | ANDLESS _ -> "ANDLESS"
263: | ANDGREATER _ -> "ANDGREATER"
264: | EQEQUAL _ -> "EQEQUAL"
265: | NOTEQUAL _ -> "NOTEQUAL"
266: | LESSEQUAL _ -> "LESSEQUAL"
267: | GREATEREQUAL _ -> "GREATEREQUAL"
268: | LEFTSHIFT _ -> "LEFTSHIFT"
269: | RIGHTSHIFT _ -> "RIGHTSHIFT"
270: | STARSTAR _ -> "STARSTAR"
271: | LESSCOLON _ -> "LESSCOLON"
272: | COLONGREATER _ -> "COLONGREATER"
273: | DOTDOT _ -> "DOTDOT"
274: | COLONCOLON _ -> "COLONCOLON"
275: | PLUSPLUS _ -> "PLUSPLUS"
276: | MINUSMINUS _ -> "MINUSMINUS"
277: | PLUSEQUAL _ -> "PLUSEQUAL"
278: | MINUSEQUAL _ -> "MINUSEQUAL"
279: | STAREQUAL _ -> "STAREQUAL"
280: | SLASHEQUAL _ -> "SLASHEQUAL"
281: | PERCENTEQUAL _ -> "PERCENTEQUAL"
282: | CARETEQUAL _ -> "CARETEQUAL"
283: | VBAREQUAL _ -> "VBAREQUAL"
284: | AMPEREQUAL _ -> "AMPEREQUAL"
285: | TILDEEQUAL _ -> "TILDEEQUAL"
286: | COLONEQUAL _ -> "COLONEQUAL"
287: | RIGHTARROW _ -> "RIGHTARROW"
288: | EQRIGHTARROW _ -> "EQRIGHTARROW"
289: | LEFTARROW _ -> "LEFTARROW"
290: | LSQANGLE _ -> "LSQANGLE"
291: | RSQANGLE _ -> "RSQANGLE"
292: | LSQBAR _ -> "LSQBAR"
293: | RSQBAR _ -> "RSQBAR"
294: | AMPERAMPER _ -> "AMPERAMPER"
295: | VBARVBAR _ -> "VBARVBAR"
296: | SLOSHAMPER _ -> "SLOSHAMPER"
297: | SLOSHVBAR _ -> "SLOSHVBAR"
298: | SLOSHCIRCUMFLEX _ -> "SLOSHCIRCUMFLEX"
299: | HASHBANG _ -> "HASHBANG"
300: | LEFTSHIFTEQUAL _ -> "LEFTSHIFTEQUAL"
301: | RIGHTSHIFTEQUAL _ -> "RIGHTSHIFTEQUAL"
302: | LEFTRIGHTARROW _ -> "LEFTRIGHTARROW"
303: | ANDEQEQUAL _ -> "ANDEQEQUAL"
304: | ANDNOTEQUAL _ -> "ANDNOTEQUAL"
305: | ANDLESSEQUAL _ -> "ANDLESSEQUAL"
306: | ANDGREATEREQUAL _ -> "ANDGREATEREQUAL"
307: | DOTDOTDOT _ -> "DOTDOTDOT"
308: | DOTRIGHTARROW _ -> "DOTRIGHTARROW"
309: | LONGRIGHTARROW _ -> "LONGRIGHTARROW"
310: | PARSE_ACTION _ -> "PARSE_ACTION"
311: | HASHBANGSLASH _ -> "HASHBANGSLASH"
312: | ALL _ -> "ALL"
313: | ASSERT _ -> "ASSERT"
314: | AXIOM _ -> "AXIOM"
315: | BODY _ -> "BODY"
316: | CALL _ -> "CALL"
317: | CASE _ -> "CASE"
318: | CASENO _ -> "CASENO"
319: | CLASS _ -> "CLASS"
320: | COMMENT_KEYWORD _ -> "COMMENT_KEYWORD"
321: | COMPOUND _ -> "COMPOUND"
322: | CONST _ -> "CONST"
323: | CCLASS _ -> "CCLASS"
324: | CSTRUCT _ -> "CSTRUCT"
325: | CTOR _ -> "CTOR"
326: | CTYPES _ -> "CTYPES"
327: | DEF _ -> "DEF"
328: | DO _ -> "DO"
329: | DONE _ -> "DONE"
330: | ELIF _ -> "ELIF"
331: | ELSE _ -> "ELSE"
332: | ENDIF _ -> "ENDIF"
333: | ENDMATCH _ -> "ENDMATCH"
334: | ENUM _ -> "ENUM"
335: | EXPECT _ -> "EXPECT"
336: | EXPORT _ -> "EXPORT"
337: | FOR _ -> "FOR"
338: | FORGET _ -> "FORGET"
339: | FORK _ -> "FORK"
340: | FUNCTOR _ -> "FUNCTOR"
341: | FUNCTION _ -> "FUNCTION"
342: | GOTO _ -> "GOTO"
343: | HEADER _ -> "HEADER"
344: | IDENT _ -> "IDENT"
345: | INCLUDE _ -> "INCLUDE"
346: | INCOMPLETE _ -> "INCOMPLETE"
347: | INF _ -> "INF"
348: | IN _ -> "IN"
349: | IS _ -> "IS"
350: | INHERIT _ -> "INHERIT"
351: | INLINE _ -> "INLINE"
352: | JUMP _ -> "JUMP"
353: | LET _ -> "LET"
354: | LOOP _ -> "LOOP"
355: | LVAL _ -> "LVAL"
356: | MACRO _ -> "MACRO"
357: | MODULE _ -> "MODULE"
358: | NAN _ -> "NAN"
359: | NEW _ -> "NEW"
360: | NOINLINE _ -> "NOINLINE"
361: | NONTERM _ -> "NONTERM"
362: | NORETURN _ -> "NORETURN"
363: | NOT _ -> "NOT"
364: | OBJECT _ -> "OBJECT"
365: | OPEN _ -> "OPEN"
366: | PACKAGE _ -> "PACKAGE"
367: | POD _ -> "POD"
368: | PRIVATE _ -> "PRIVATE"
369: | PROCEDURE _ -> "PROCEDURE"
370: | PROPERTY _ -> "PROPERTY"
371: | REDUCE _ -> "REDUCE"
372: | RENAME _ -> "RENAME"
373: | REQUIRES _ -> "REQUIRES"
374: | RETURN _ -> "RETURN"
375: | STRUCT _ -> "STRUCT"
376: | THEN _ -> "THEN"
377: | TODO _ -> "TODO"
378: | TO _ -> "TO"
379: | TYPEDEF _ -> "TYPEDEF"
380: | TYPE _ -> "TYPE"
381: | UNION _ -> "UNION"
382: | USE _ -> "USE"
383: | VAL _ -> "VAL"
384: | VAR _ -> "VAR"
385: | WHEN _ -> "WHEN"
386: | WITH _ -> "WITH"
387: | UNDERSCORE _ -> "UNDERSCORE"
388: | GC_POINTER _ -> "GC_POINTER"
389: | GC_TYPE _ -> "GC_TYPE"
390: | SVC _ -> "SVC"
391: | DEREF _ -> "DEREF"
392: | AND _ -> "AND"
393: | AS _ -> "AS"
394: | CALLBACK _ -> "CALLBACK"
395: | CODE _ -> "CODE"
396: | IF _ -> "IF"
397: | ISIN _ -> "ISIN"
398: | MATCH _ -> "MATCH"
399: | NOEXPAND _ -> "NOEXPAND"
400: | OF _ -> "OF"
401: | OR _ -> "OR"
402: | PARSE _ -> "PARSE"
403: | REGEXP _ -> "REGEXP"
404: | REGLEX _ -> "REGLEX"
405: | REGMATCH _ -> "REGMATCH"
406: | THE _ -> "THE"
407: | TYPEMATCH _ -> "TYPEMATCH"
408: | EXPRESSION _ -> "EXPRESSION"
409: | FLOAT_LITERAL _ -> "FLOAT_LITERAL"
410: | INTEGER_LITERAL _ -> "INTEGER_LITERAL"
411: | STRING_LITERAL _ -> "STRING_LITERAL"
412: | STATEMENT _ -> "STATEMENT"
413: | STATEMENTS _ -> "STATEMENTS"
414: # 87 "./lpsrc/flx_lexer.ipk"
415:
416: | COMMENT s -> "COMMENT"
417: | COMMENT_NEWLINE s -> "COMMENT_NEWLINE"
418: | WHITE i -> "WHITE"
419: | NEWLINE -> "NEWLINE"
420: | ENDMARKER -> "ENDMARKER"
421: | ERRORTOKEN (sref,s) -> "ERRORTOKEN"
422: | SLOSH -> "SLOSH"
423:
424: let src_of_token t = match t with
425: | NEWLINE
426: | COMMENT _
427: | COMMENT_NEWLINE _
428: | WHITE _
429: | ENDMARKER
430: | SLOSH
431: | HASH_INCLUDE_FILES _
432: -> ("",0,0,0)
433:
434: | NAME (s,_)
435: | INTEGER (s,_,_)
436: | FLOAT (s,_,_)
437: | STRING (s,_)
438: | CSTRING (s,_)
439: | FSTRING (s,_)
440: | WSTRING (s,_)
441: | USTRING (s,_)
442: | USER10 (s,_,_)
443: | USERLB (s,_,_)
444: | USERRB (s,_)
445: | USER_KEYWORD (s,_)
446: | USER_STATEMENT_KEYWORD (s,_,_,_)
447: | USER_STATEMENT_DRIVER (s,_,_)
448: (*
449: | PARSE_ACTION s
450: *)
451: | ERRORTOKEN (s,_)
452:
453: | DOLLAR s
454: | QUEST s
455: | EXCLAMATION s
456: | LPAR s
457: | RPAR s
458: | LSQB s
459: | RSQB s
460: | LBRACE s
461: | RBRACE s
462: | COLON s
463: | COMMA s
464: | SEMI s
465: | PLUS s
466: | MINUS s
467: | STAR s
468: | SLASH s
469: | VBAR s
470: | AMPER s
471: | LESS s
472: | GREATER s
473: | EQUAL s
474: | DOT s
475: | PERCENT s
476: | BACKQUOTE s
477: | TILDE s
478: | CIRCUMFLEX s
479: | HASH s
480: | ANDLESS s
481: | ANDGREATER s
482: | EQEQUAL s
483: | NOTEQUAL s
484: | LESSEQUAL s
485: | GREATEREQUAL s
486: | LEFTSHIFT s
487: | RIGHTSHIFT s
488: | STARSTAR s
489: | LESSCOLON s
490: | COLONGREATER s
491: | DOTDOT s
492: | COLONCOLON s
493: | PLUSPLUS s
494: | MINUSMINUS s
495: | PLUSEQUAL s
496: | MINUSEQUAL s
497: | STAREQUAL s
498: | SLASHEQUAL s
499: | PERCENTEQUAL s
500: | CARETEQUAL s
501: | VBAREQUAL s
502: | AMPEREQUAL s
503: | TILDEEQUAL s
504: | COLONEQUAL s
505: | RIGHTARROW s
506: | EQRIGHTARROW s
507: | LEFTARROW s
508: | LSQANGLE s
509: | RSQANGLE s
510: | LSQBAR s
511: | RSQBAR s
512: | AMPERAMPER s
513: | VBARVBAR s
514: | SLOSHAMPER s
515: | SLOSHVBAR s
516: | SLOSHCIRCUMFLEX s
517: | HASHBANG s
518: | LEFTSHIFTEQUAL s
519: | RIGHTSHIFTEQUAL s
520: | LEFTRIGHTARROW s
521: | ANDEQEQUAL s
522: | ANDNOTEQUAL s
523: | ANDLESSEQUAL s
524: | ANDGREATEREQUAL s
525: | DOTDOTDOT s
526: | DOTRIGHTARROW s
527: | LONGRIGHTARROW s
528: | PARSE_ACTION s
529: | HASHBANGSLASH s
530: | ALL s
531: | ASSERT s
532: | AXIOM s
533: | BODY s
534: | CALL s
535: | CASE s
536: | CASENO s
537: | CLASS s
538: | COMMENT_KEYWORD s
539: | COMPOUND s
540: | CONST s
541: | CCLASS s
542: | CSTRUCT s
543: | CTOR s
544: | CTYPES s
545: | DEF s
546: | DO s
547: | DONE s
548: | ELIF s
549: | ELSE s
550: | ENDIF s
551: | ENDMATCH s
552: | ENUM s
553: | EXPECT s
554: | EXPORT s
555: | FOR s
556: | FORGET s
557: | FORK s
558: | FUNCTOR s
559: | FUNCTION s
560: | GOTO s
561: | HEADER s
562: | IDENT s
563: | INCLUDE s
564: | INCOMPLETE s
565: | INF s
566: | IN s
567: | IS s
568: | INHERIT s
569: | INLINE s
570: | JUMP s
571: | LET s
572: | LOOP s
573: | LVAL s
574: | MACRO s
575: | MODULE s
576: | NAN s
577: | NEW s
578: | NOINLINE s
579: | NONTERM s
580: | NORETURN s
581: | NOT s
582: | OBJECT s
583: | OPEN s
584: | PACKAGE s
585: | POD s
586: | PRIVATE s
587: | PROCEDURE s
588: | PROPERTY s
589: | REDUCE s
590: | RENAME s
591: | REQUIRES s
592: | RETURN s
593: | STRUCT s
594: | THEN s
595: | TODO s
596: | TO s
597: | TYPEDEF s
598: | TYPE s
599: | UNION s
600: | USE s
601: | VAL s
602: | VAR s
603: | WHEN s
604: | WITH s
605: | UNDERSCORE s
606: | GC_POINTER s
607: | GC_TYPE s
608: | SVC s
609: | DEREF s
610: | AND s
611: | AS s
612: | CALLBACK s
613: | CODE s
614: | IF s
615: | ISIN s
616: | MATCH s
617: | NOEXPAND s
618: | OF s
619: | OR s
620: | PARSE s
621: | REGEXP s
622: | REGLEX s
623: | REGMATCH s
624: | THE s
625: | TYPEMATCH s
626: | EXPRESSION s
627: | FLOAT_LITERAL s
628: | INTEGER_LITERAL s
629: | STRING_LITERAL s
630: | STATEMENT s
631: | STATEMENTS s
632: # 137 "./lpsrc/flx_lexer.ipk"
633: -> s
634:
Start ocaml section to src/flx_lexstate.ml[1
/1
]
1: # 141 "./lpsrc/flx_lexer.ipk"
2: open Flx_util
3: open Flx_parse
4: open Flx_string
5: open Big_int
6: open Flx_exceptions
7: open Flx_ast
8: open List
9:
10: let special_tokens =
11: [
12: ("$",(fun (sr,s)-> DOLLAR sr));
13: ("?",(fun (sr,s)-> QUEST sr));
14: ("!",(fun (sr,s)-> EXCLAMATION sr));
15: ("(",(fun (sr,s)-> LPAR sr));
16: (")",(fun (sr,s)-> RPAR sr));
17: ("[",(fun (sr,s)-> LSQB sr));
18: ("]",(fun (sr,s)-> RSQB sr));
19: ("{",(fun (sr,s)-> LBRACE sr));
20: ("}",(fun (sr,s)-> RBRACE sr));
21: (":",(fun (sr,s)-> COLON sr));
22: (",",(fun (sr,s)-> COMMA sr));
23: (";",(fun (sr,s)-> SEMI sr));
24: ("+",(fun (sr,s)-> PLUS sr));
25: ("-",(fun (sr,s)-> MINUS sr));
26: ("*",(fun (sr,s)-> STAR sr));
27: ("/",(fun (sr,s)-> SLASH sr));
28: ("|",(fun (sr,s)-> VBAR sr));
29: ("&",(fun (sr,s)-> AMPER sr));
30: ("<",(fun (sr,s)-> LESS sr));
31: (">",(fun (sr,s)-> GREATER sr));
32: ("=",(fun (sr,s)-> EQUAL sr));
33: (".",(fun (sr,s)-> DOT sr));
34: ("%",(fun (sr,s)-> PERCENT sr));
35: ("`",(fun (sr,s)-> BACKQUOTE sr));
36: ("~",(fun (sr,s)-> TILDE sr));
37: ("^",(fun (sr,s)-> CIRCUMFLEX sr));
38: ("#",(fun (sr,s)-> HASH sr));
39: ("&<",(fun (sr,s)-> ANDLESS sr));
40: ("&>",(fun (sr,s)-> ANDGREATER sr));
41: ("==",(fun (sr,s)-> EQEQUAL sr));
42: ("!=",(fun (sr,s)-> NOTEQUAL sr));
43: ("<=",(fun (sr,s)-> LESSEQUAL sr));
44: (">=",(fun (sr,s)-> GREATEREQUAL sr));
45: ("<<",(fun (sr,s)-> LEFTSHIFT sr));
46: (">>",(fun (sr,s)-> RIGHTSHIFT sr));
47: ("**",(fun (sr,s)-> STARSTAR sr));
48: ("<:",(fun (sr,s)-> LESSCOLON sr));
49: (":>",(fun (sr,s)-> COLONGREATER sr));
50: ("..",(fun (sr,s)-> DOTDOT sr));
51: ("::",(fun (sr,s)-> COLONCOLON sr));
52: ("++",(fun (sr,s)-> PLUSPLUS sr));
53: ("--",(fun (sr,s)-> MINUSMINUS sr));
54: ("+=",(fun (sr,s)-> PLUSEQUAL sr));
55: ("-=",(fun (sr,s)-> MINUSEQUAL sr));
56: ("*=",(fun (sr,s)-> STAREQUAL sr));
57: ("/=",(fun (sr,s)-> SLASHEQUAL sr));
58: ("%=",(fun (sr,s)-> PERCENTEQUAL sr));
59: ("^=",(fun (sr,s)-> CARETEQUAL sr));
60: ("|=",(fun (sr,s)-> VBAREQUAL sr));
61: ("&=",(fun (sr,s)-> AMPEREQUAL sr));
62: ("~=",(fun (sr,s)-> TILDEEQUAL sr));
63: (":=",(fun (sr,s)-> COLONEQUAL sr));
64: ("->",(fun (sr,s)-> RIGHTARROW sr));
65: ("=>",(fun (sr,s)-> EQRIGHTARROW sr));
66: ("<-",(fun (sr,s)-> LEFTARROW sr));
67: ("[<",(fun (sr,s)-> LSQANGLE sr));
68: (">]",(fun (sr,s)-> RSQANGLE sr));
69: ("[|",(fun (sr,s)-> LSQBAR sr));
70: ("|]",(fun (sr,s)-> RSQBAR sr));
71: ("&&",(fun (sr,s)-> AMPERAMPER sr));
72: ("||",(fun (sr,s)-> VBARVBAR sr));
73: ("\\&",(fun (sr,s)-> SLOSHAMPER sr));
74: ("\\|",(fun (sr,s)-> SLOSHVBAR sr));
75: ("\\^",(fun (sr,s)-> SLOSHCIRCUMFLEX sr));
76: ("#!",(fun (sr,s)-> HASHBANG sr));
77: ("<<=",(fun (sr,s)-> LEFTSHIFTEQUAL sr));
78: (">>=",(fun (sr,s)-> RIGHTSHIFTEQUAL sr));
79: ("<->",(fun (sr,s)-> LEFTRIGHTARROW sr));
80: ("&==",(fun (sr,s)-> ANDEQEQUAL sr));
81: ("&!=",(fun (sr,s)-> ANDNOTEQUAL sr));
82: ("&<=",(fun (sr,s)-> ANDLESSEQUAL sr));
83: ("&>=",(fun (sr,s)-> ANDGREATEREQUAL sr));
84: ("...",(fun (sr,s)-> DOTDOTDOT sr));
85: (".->",(fun (sr,s)-> DOTRIGHTARROW sr));
86: ("-->",(fun (sr,s)-> LONGRIGHTARROW sr));
87: ("=>#",(fun (sr,s)-> PARSE_ACTION sr));
88: ("#!/",(fun (sr,s)-> HASHBANGSLASH sr));
89: # 160 "./lpsrc/flx_lexer.ipk"
90: ]
91:
92: let mk_std_tokens () =
93: let tk = Array.make 4 [] in
94: iter (fun (s,f) ->
95: let n = String.length s in
96: assert (n >0 && n <= 3);
97: tk.(n) <- (s,f) :: tk.(n)
98: )
99: special_tokens
100: ;
101: tk
102:
103: exception Duplicate_macro of string
104:
105: class comment_control =
106: object (self)
107: val mutable nesting_level = 0
108: val mutable text = ""
109:
110: method set_text s = text <- s; nesting_level <- 1
111: method append s = text <- text ^ s
112: method get_comment = text
113:
114: method incr = nesting_level <- nesting_level + 1
115: method decr = nesting_level <- nesting_level - 1
116: method get_nesting_level = nesting_level
117: end
118:
119: exception Found_file of string
120:
121: type condition_t = [
122: | `Processing
123: | `Skip_to_endif
124: | `Skip_to_else
125: | `Subscan
126: ]
127:
128: type location = {
129: mutable buf_pos : int;
130: mutable last_buf_pos : int;
131: mutable line_no : int;
132: mutable original_line_no : int;
133: }
134:
135: class file_control
136: (filename' : string)
137: (basedir': string)
138: (incdirs': string list)
139: =
140: object(self)
141: val mutable loc : location = { buf_pos = 0; last_buf_pos = 0; line_no = 1; original_line_no = 1; }
142: method get_loc = loc
143: method set_loc loc' = loc <- loc'
144:
145: (* this is the physical filename *)
146: val original_filename = filename'
147: val incdirs = incdirs'
148: val basedir = basedir'
149:
150: (* this is the generator file name, can be set with #line directive *)
151: val mutable filename = filename'
152: val mutable condition:condition_t list = [`Processing]
153: val macros : (string,string list * Flx_parse.token list) Hashtbl.t = Hashtbl.create 97
154:
155: method incr_lex_counters lexbuf =
156: loc.line_no <- loc.line_no + 1;
157: loc.original_line_no <- loc.original_line_no + 1;
158: loc.last_buf_pos <- loc.buf_pos;
159: loc.buf_pos <- Lexing.lexeme_end lexbuf
160:
161: method set_buf_pos x = loc.buf_pos <- x
162: method get_buf_pos = loc.buf_pos
163: method get_srcref lexbuf =
164: filename,
165: loc.line_no,
166: Lexing.lexeme_start lexbuf - loc.buf_pos + 1,
167: Lexing.lexeme_end lexbuf - loc.buf_pos
168:
169: method get_physical_srcref lexbuf =
170: original_filename,
171: loc.original_line_no,
172: Lexing.lexeme_start lexbuf - loc.buf_pos + 1,
173: Lexing.lexeme_end lexbuf - loc.buf_pos
174:
175: method incr n =
176: loc.line_no <- loc.line_no + n;
177: loc.original_line_no <- loc.original_line_no + n
178:
179: method set_line n lexbuf =
180: loc.line_no <- n;
181: loc.last_buf_pos <- loc.buf_pos;
182: loc.buf_pos <- Lexing.lexeme_end lexbuf;
183: (* this is a hack .. *)
184: loc.original_line_no <- loc.original_line_no + 1
185:
186: method set_filename f = filename <- f
187: method get_relative f =
188: let fn = Filename.concat basedir f in
189: if not (Sys.file_exists fn) then
190: failwith ("Relative include file \""^f^ "\" not found in "^basedir)
191: else fn
192:
193: method get_absolute f =
194: try
195: List.iter
196: (fun d ->
197: let f = Filename.concat d f in
198: if Sys.file_exists f
199: then raise (Found_file f)
200: )
201: incdirs
202: ;
203: failwith ("Library File <" ^ f ^ "> not found in path")
204: with Found_file s -> s
205:
206: method store_macro name params body =
207: Hashtbl.add macros name (params,body)
208:
209: method undef_macro name = Hashtbl.remove macros name
210:
211: method get_macro name =
212: try Some (Hashtbl.find macros name)
213: with Not_found -> None
214:
215: method get_macros = macros
216:
217: method get_incdirs = incdirs
218: method get_condition = List.hd condition
219: method push_condition c = condition <- (c :: condition)
220: method pop_condition = condition <- List.tl condition
221: method set_condition c = condition <- (c :: List.tl condition)
222: method condition_stack_length = List.length condition
223: end
224:
225: class lexer_state filename basedir incdirs expand_expr' =
226: object (self)
227: val expand_expr: string -> expr_t -> expr_t = expand_expr'
228:
229: val mutable include_files: string list = []
230:
231: val comment_ctrl = new comment_control
232: val file_ctrl = new file_control filename basedir incdirs
233: val mutable at_line_start = true
234:
235: val mutable keywords:
236: (string * (srcref * string -> Flx_parse.token)) list array
237: = [| [] |]
238:
239: val mutable symbols:
240: (string * (srcref * string -> Flx_parse.token)) list array
241: = mk_std_tokens ()
242:
243: val nonterminals:
244: (string, (token list * ast_term_t) list) Hashtbl.t
245: = Hashtbl.create 97
246:
247: val mutable brackets: ((string * string) * string) list = []
248:
249: method get_expand_expr = expand_expr
250: method get_include_files = include_files
251: method add_include_file f = include_files <- f :: include_files
252:
253: method get_symbols = symbols
254: method get_nonterminals = nonterminals
255: method get_brackets = brackets
256:
257: method is_at_line_start = at_line_start
258:
259: method inbody = at_line_start <- false
260: method get_srcref lexbuf = file_ctrl#get_srcref lexbuf
261: method get_physical_srcref lexbuf = file_ctrl#get_physical_srcref lexbuf
262: method string_of_srcref lexbuf =
263: match self#get_srcref lexbuf with
264: (filename, lineno, scol,ecol) ->
265: "File \"" ^ filename ^ "\"" ^
266: ", Line " ^ string_of_int lineno ^
267: ", Columns " ^ string_of_int scol ^
268: "-" ^ string_of_int ecol
269:
270: (* comments *)
271: method comment_level = comment_ctrl#get_nesting_level
272: method incr_comment = comment_ctrl#incr
273: method decr_comment = comment_ctrl#decr
274:
275: method set_comment text = comment_ctrl#set_text text
276: method append_comment text = comment_ctrl#append text
277: method get_comment = comment_ctrl#get_comment
278:
279: (* line counting *)
280: method newline lexbuf =
281: at_line_start <- true;
282: file_ctrl#incr_lex_counters lexbuf
283:
284: (* string decoders *)
285: method decode decoder (s : string) : string =
286: let lfcount s =
287: let n = ref 0 in
288: for i = 0 to (String.length s) - 1 do
289: if s.[i] = '\n' then incr n
290: done;
291: !n
292: in
293: file_ctrl#incr (lfcount s);
294: decoder s
295:
296: method set_line n lexbuf =
297: file_ctrl#set_line n lexbuf;
298: at_line_start <- true
299:
300: method set_filename f = file_ctrl#set_filename f
301:
302: method get_loc = file_ctrl#get_loc
303: method set_loc loc' = file_ctrl#set_loc loc'
304: method get_incdirs = file_ctrl#get_incdirs
305: method get_relative f = file_ctrl#get_relative f
306: method get_absolute f = file_ctrl#get_absolute f
307:
308: method get_condition = file_ctrl#get_condition
309: method push_condition c = file_ctrl#push_condition c
310: method pop_condition = file_ctrl#pop_condition
311: method set_condition c = file_ctrl#set_condition c
312: method condition_stack_length = file_ctrl#condition_stack_length
313:
314: method store_macro name parms body = file_ctrl#store_macro name parms body
315: method undef_macro name = file_ctrl#undef_macro name
316: method get_macro name = file_ctrl#get_macro name
317: method get_macros = file_ctrl#get_macros
318:
319: method add_macros (s:lexer_state) =
320: let h = self#get_macros in
321: Hashtbl.iter
322: (fun k v ->
323: if Hashtbl.mem h k
324: then raise (Duplicate_macro k)
325: else Hashtbl.add h k v
326: )
327: s#get_macros
328: ;
329:
330: (* append new keywords *)
331: let new_keywords = s#get_keywords in
332: let n = Array.length new_keywords in
333: if n > Array.length keywords then begin
334: let old_keywords = keywords in
335: keywords <- Array.make n [];
336: Array.blit old_keywords 0 keywords 0 (Array.length old_keywords)
337: end;
338: for i = 0 to Array.length new_keywords - 1 do
339: keywords.(i) <- new_keywords.(i) @ keywords.(i)
340: done
341: ;
342:
343: (* append new symbols *)
344: let new_symbols = s#get_symbols in
345: let n = Array.length new_symbols in
346: if n > Array.length symbols then begin
347: let old_symbols = symbols in
348: symbols <- Array.make n [];
349: Array.blit old_symbols 0 symbols 0 (Array.length old_symbols)
350: end;
351: for i = 0 to Array.length new_symbols - 1 do
352: symbols.(i) <- new_symbols.(i) @ symbols.(i)
353: done
354: ;
355:
356: brackets <- s#get_brackets @ brackets
357:
358: ;
359: Hashtbl.iter
360: (fun k ls ->
361: let old = try Hashtbl.find nonterminals k with Not_found -> [] in
362: Hashtbl.replace nonterminals k (ls @ old)
363: )
364: s#get_nonterminals
365:
366: method get_keywords = keywords
367:
368: method adjust_keyword_array n =
369: let m = Array.length keywords in
370: if m <= n then begin
371: let a = Array.make (n+1) [] in
372: Array.blit keywords 0 a 0 m;
373: keywords <- a
374: end
375:
376: method adjust_symbol_array n =
377: let m = Array.length symbols in
378: if m <= n then begin
379: let a = Array.make (n+1) [] in
380: Array.blit symbols 0 a 0 m;
381: symbols <- a
382: end
383:
384: method add_infix_symbol (prec:int) s f =
385: let n = String.length s in
386: self#adjust_symbol_array n;
387: let elt = s,(fun (sr,_) -> Flx_parse.USER10 (sr,s,f)) in
388: symbols.(n) <- elt :: symbols.(n)
389:
390: method add_infix_keyword (prec:int) s f =
391: let n = String.length s in
392: self#adjust_keyword_array n;
393: let elt = s,(fun (sr,_) -> Flx_parse.USER10 (sr,s,f)) in
394: keywords.(n) <- elt :: keywords.(n)
395:
396: method add_keyword (s:string) =
397: let n = String.length s in
398: self#adjust_keyword_array n;
399: let elt = s,(fun (sr,_) -> Flx_parse.USER_KEYWORD (sr,s)) in
400: keywords.(n) <- elt :: keywords.(n)
401:
402: method add_statement_keyword (s:string) (sr:range_srcref) (toks: Flx_parse.token list) (term:ast_term_t) =
403: let n = String.length s in
404: self#adjust_keyword_array n;
405: let tokss =
406: try match (assoc s keywords.(n)) (("",0,0,0), "") with
407: | Flx_parse.USER_STATEMENT_KEYWORD (_,_,tokss,_) -> (toks,term) :: tokss
408: | _ -> clierr sr "Conflicting meaning of keyword s"
409: with Not_found -> [toks,term]
410: in
411: let elt = s,(fun (sr,_) -> Flx_parse.USER_STATEMENT_KEYWORD (sr,s,tokss,nonterminals)) in
412: keywords.(n) <- elt :: remove_assoc s keywords.(n)
413:
414:
415: method add_nonterminal (s:string) (sr:range_srcref) (toks: Flx_parse.token list) (term:ast_term_t) =
416: let productions = try Hashtbl.find nonterminals s with Not_found -> [] in
417: Hashtbl.replace nonterminals s ((toks,term)::productions)
418:
419: method add_brackets tok1 tok2 f =
420: let n1 = String.length tok1 in
421: let n2 = String.length tok2 in
422: let n = max n1 n2 in
423: self#adjust_symbol_array n;
424: brackets <- ((tok1,tok2),f) :: brackets;
425: let rbs =
426: let rec aux fnmap brs = match brs with
427: | [] -> rev fnmap
428: | ((l,r),f) :: t ->
429: if l = tok1 then aux ((r,f)::fnmap) t
430: else aux fnmap t
431: in aux [] brackets
432: in
433: let elt = tok1,(fun (sr,_) -> Flx_parse.USERLB (sr,rbs,tok1)) in
434: symbols.(n1) <- elt :: symbols.(n1)
435: ;
436: let elt = tok2,(fun (sr,_) -> Flx_parse.USERRB (sr,tok2)) in
437: symbols.(n1) <- elt :: symbols.(n2)
438:
439: method tokenise_symbols lexbuf (s:string) : token list =
440: (* temporary hack *)
441: let sr = self#get_srcref lexbuf in
442: let rec tk tks s =
443: let m = String.length s in
444: let rec aux n =
445: if n = 0 then (* cannot match even first char *)
446: tk (ERRORTOKEN (sr,String.sub s 0 1)::tks) (String.sub s 1 (m-1))
447: else
448: let f =
449: try Some (assoc (String.sub s 0 n) symbols.(n))
450: with Not_found -> None
451: in
452: match f with
453: | None -> aux (n-1)
454: | Some f ->
455: (* next token *)
456: tk (f (sr,String.sub s 0 n) :: tks) (String.sub s n (m-n))
457: in
458: let n = String.length s in
459: if n = 0 then rev tks
460: else aux (min n (Array.length symbols - 1))
461: in
462: tk [] s
463: end
464:
Start ocaml section to src/flx_lexstate.mli[1
/1
]
1: # 537 "./lpsrc/flx_lexer.ipk"
2: open Flx_ast
3: open Flx_string
4: open Flx_parse
5:
6: exception Duplicate_macro of string
7:
8: class comment_control :
9: object
10: val mutable nesting_level : int
11: val mutable text : string
12: method append : string -> unit
13: method decr : unit
14: method get_comment : string
15: method get_nesting_level : int
16: method incr : unit
17: method set_text : string -> unit
18: end
19:
20: type condition_t = [
21: | `Processing
22: | `Skip_to_endif
23: | `Skip_to_else
24: | `Subscan
25: ]
26:
27: type location = {
28: mutable buf_pos : int;
29: mutable last_buf_pos : int;
30: mutable line_no : int;
31: mutable original_line_no : int;
32: }
33:
34:
35: class file_control :
36: string ->
37: string ->
38: string list ->
39: object
40: val mutable loc: location
41: val filename : string
42: val mutable condition : condition_t list
43: val macros : (string,string list * token list) Hashtbl.t
44:
45: method get_loc : location
46: method set_loc : location -> unit
47:
48: method get_buf_pos : int
49: method get_srcref : Lexing.lexbuf -> srcref
50: method get_physical_srcref : Lexing.lexbuf -> srcref
51: method incr : int -> unit
52: method incr_lex_counters : Lexing.lexbuf -> unit
53: method set_buf_pos : int -> unit
54: method set_line : int -> Lexing.lexbuf -> unit
55: method set_filename : string -> unit
56: method get_relative : string -> string
57: method get_incdirs : string list
58: method get_absolute : string -> string
59:
60: method get_condition : condition_t
61: method push_condition : condition_t -> unit
62: method pop_condition : unit
63: method set_condition : condition_t -> unit
64: method condition_stack_length : int
65:
66: method store_macro : string -> string list -> token list -> unit
67: method undef_macro : string -> unit
68: method get_macro : string -> (string list * token list) option
69: method get_macros : (string,string list * token list) Hashtbl.t
70: end
71:
72: class lexer_state :
73: string ->
74: string ->
75: string list ->
76: (string -> expr_t->expr_t) ->
77: object
78: val expand_expr : string -> expr_t -> expr_t
79: val comment_ctrl : comment_control
80: val file_ctrl : file_control
81:
82: val mutable symbols :
83: (string * (srcref * string -> token)) list array
84: val mutable keywords:
85: (string * (srcref * string -> token)) list array
86: val mutable brackets: ((string * string) * string) list
87: val nonterminals: (string, (token list *ast_term_t) list) Hashtbl.t
88: val mutable include_files : string list
89:
90: method get_expand_expr : string -> expr_t -> expr_t
91:
92: method add_include_file : string -> unit
93: method get_include_files : string list
94:
95: method append_comment : string -> unit
96: method comment_level : int
97: method decode : (string -> string) -> string -> string
98: method decr_comment : unit
99: method get_comment : string
100: method get_srcref : Lexing.lexbuf -> srcref
101: method get_physical_srcref : Lexing.lexbuf -> srcref
102: method incr_comment : unit
103: method newline : Lexing.lexbuf -> unit
104: method set_comment : string -> unit
105: method is_at_line_start : bool
106: method inbody: unit
107: method string_of_srcref : Lexing.lexbuf -> string
108: method set_line : int -> Lexing.lexbuf-> unit
109: method set_filename : string -> unit
110: method get_incdirs : string list
111: method get_relative : string -> string
112: method get_absolute : string -> string
113:
114: method get_condition : condition_t
115: method push_condition : condition_t -> unit
116: method pop_condition : unit
117: method set_condition : condition_t -> unit
118: method condition_stack_length : int
119: method get_loc : location
120: method set_loc : location -> unit
121:
122: method store_macro : string -> string list -> token list -> unit
123: method undef_macro : string -> unit
124: method get_macro : string -> (string list * token list) option
125: method get_macros : (string,string list * token list) Hashtbl.t
126: method add_macros : lexer_state -> unit
127: method adjust_symbol_array : int -> unit
128: method add_infix_symbol:
129: int -> string -> string -> unit
130:
131: method get_keywords:
132: (string * (srcref * string -> token)) list array
133:
134: method adjust_keyword_array : int -> unit
135:
136: method add_infix_keyword:
137: int -> string -> string -> unit
138: method add_keyword:
139: string -> unit
140:
141: method get_brackets:
142: ((string * string) * string) list
143:
144: method get_nonterminals:
145: (string, (token list *ast_term_t) list) Hashtbl.t
146:
147: method get_symbols:
148: (string * (srcref * string -> token)) list array
149:
150: method add_statement_keyword:
151: string -> range_srcref -> token list -> ast_term_t -> unit
152:
153: method add_nonterminal:
154: string -> range_srcref -> token list -> ast_term_t -> unit
155:
156: method add_brackets: string -> string -> string -> unit
157:
158: method tokenise_symbols : Lexing.lexbuf -> string -> token list
159: end
160:
Start ocaml section to src/flx_preproc.mli[1
/1
]
1: # 698 "./lpsrc/flx_lexer.ipk"
2: open Flx_ast
3: open Flx_parse
4: open Flx_lexstate
5: open Lexing
6:
7: val is_in_string : string -> char -> bool
8: val is_white : char -> bool
9: val is_digit : char -> bool
10: val strip_us : string -> string
11:
12: val pre_tokens_of_lexbuf :
13: (lexer_state -> lexbuf -> token list) ->
14: lexbuf -> lexer_state ->
15: token list
16:
17: val pre_tokens_of_string :
18: (lexer_state -> lexbuf -> token list) ->
19: string -> string ->
20: (string -> expr_t -> expr_t) ->
21: token list
22:
23: val line_directive :
24: lexer_state -> range_srcref -> string -> lexbuf ->
25: token list
26:
27: val include_directive :
28: bool ->
29: lexer_state -> range_srcref -> string ->
30: (lexer_state -> lexbuf -> token list) ->
31: token list
32:
33: val handle_preprocessor :
34: lexer_state -> lexbuf -> string ->
35: (lexer_state -> lexbuf -> token list) ->
36: location ->
37: Lexing.position ->
38: token list
39:
Start data section to src/flx_preproc.ml[1
/1
]
1: open Flx_util
2: open Flx_parse
3: open Flx_string
4: open Big_int
5: open Flx_exceptions
6: open Flx_lexstate
7: open List
8:
9: let substr = String.sub
10: let len = String.length
11:
12: let is_in_string s ch =
13: try
14: ignore(String.index s ch);
15: true
16: with Not_found ->
17: false
18:
19: let is_white = is_in_string " \t"
20: let is_digit = is_in_string "0123456789"
21:
22: let strip_us s =
23: let n = String.length s in
24: let x = Buffer.create n in
25: for i=0 to n - 1 do
26: match s.[i] with
27: | '_' -> ()
28: | c -> Buffer.add_char x c
29: done;
30: Buffer.contents x
31:
32:
33: let pre_tokens_of_lexbuf lexer buf state =
34: let rec get lst =
35: let ts = lexer state buf in
36: match ts with
37: | [Flx_parse.ENDMARKER] -> lst
38: | _ ->
39: match state#get_condition with
40: | `Processing | `Subscan ->
41: get (rev_append ts lst)
42: | _ ->
43: get lst
44: in
45: rev (get [])
46:
47: let pre_tokens_of_string lexer s filename expand_expr =
48: let state = new lexer_state filename "" [] expand_expr in
49: pre_tokens_of_lexbuf lexer (Lexing.from_string s) state
50:
51: let line_directive state sr s lexbuf =
52: let i = ref 0 in
53: let a =
54: let a = ref 0 in
55: while is_digit s.[!i] do
56: a := !a * 10 + dec_char2int s.[!i];
57: incr i
58: done;
59: !a
60: in
61: if !i = 0
62: then clierr sr "digits required after #line"
63: else begin
64: while is_white s.[!i] do incr i done;
65: if s.[!i] <> '\n'
66: then begin
67: if s.[!i]<>'"'
68: then clierr sr "double quote required after line number in #line"
69: else begin
70: incr i;
71: let j = !i in
72: while s.[!i]<>'"' && s.[!i]<>'\n' do incr i done;
73:
74: if s.[!i]='\n'
75: then clierr sr "double quote required after filename in #line directive"
76: else begin
77: let filename = String.sub s j (!i-j) in
78: state#set_filename filename;
79: state#set_line a lexbuf
80: end
81: end
82: end else begin
83: (* print_endline ("SETTING LINE " ^ string_of_int a); *)
84: state#set_line a lexbuf
85: end
86: end;
87: [NEWLINE]
88:
89:
90: (* output expansion of input in reverse order with exclusions *)
91: let rec expand' state exclude toks =
92: (* output expansion of input
93: in reverse order
94: with bindings and
95: with exclusions,
96: this function is tail rec and used as a loop
97: *)
98: let rec aux exclude inp out bindings =
99: match inp with
100: | [] -> out
101: | h :: ts ->
102: (* do not expand a symbol recursively *)
103: if mem h exclude
104: then aux exclude ts (h :: out) bindings
105: else
106: (* if it is a parameter name, replace by argument *)
107: let b =
108: try Some (assoc h bindings)
109: with Not_found -> None
110: in match b with
111: | Some x ->
112: (* note binding body is in reverse order *)
113: aux exclude ts (x @ out) bindings
114:
115: | None ->
116: match h with
117: | Flx_parse.NAME (sr,s) ->
118: begin match state#get_macro s with
119: (* not a macro : output it *)
120: | None -> aux exclude ts (h :: out) bindings
121:
122: (* argumentless macro : output expansion of body,
123: current bindings are ignored
124: *)
125: | Some ([], body) ->
126: let body = expand' state (h::exclude) body
127: in aux exclude ts (body @ out) bindings
128:
129: | Some (params,body) ->
130: failwith "Can't handle macros with arguments yet"
131: end
132: | _ -> aux exclude ts (h :: out) bindings
133:
134: in aux [] toks [] []
135:
136: let eval state toks =
137: let e = Flx_tok.parse_tokens Flx_parse.expression (toks @ [ENDMARKER]) in
138: let e = state#get_expand_expr "PREPROC_EVAL" e in
139: e
140:
141: let expand state toks = rev (expand' state [] toks)
142:
143: let eval_bool state sr toks =
144: let toks = expand state toks in
145: let e = eval state toks in
146: match e with
147: | `AST_typed_case (sr,v,`TYP_unitsum 2) ->
148: v = 1
149:
150: | x ->
151: clierr sr
152: (
153: "Preprocessor constant expression of boolean type required\n" ^
154: "Actually got:\n" ^
155: Flx_print.string_of_expr x
156: )
157:
158: let rec parse_params sr toks = match toks with
159: | NAME (_,id) :: COMMA _ :: ts ->
160: let args, body = parse_params sr toks in
161: id :: args, body
162:
163: | NAME (_,id) :: RPAR _ :: ts ->
164: [id], ts
165:
166: | RPAR _ :: ts -> [], ts
167:
168: | h :: _ ->
169: let sr = Flx_srcref.slift (Flx_prelex.src_of_token h) in
170: clierr sr "Malformed #define directive"
171: | [] ->
172: clierr sr "Malformed #define directive"
173:
174: let parse_macro_function state sr name toks =
175: let args, body = parse_params sr toks in
176: state#store_macro name args body
177:
178: let parse_macro_body state sr name toks =
179: match toks with
180: | LPAR _ :: ts -> parse_macro_function state sr name ts
181: | _ -> state#store_macro name [] toks
182:
183: let undef_directive state sr toks =
184: iter
185: begin function
186: | NAME (sr,name) -> state#undef_macro name
187: | h ->
188: let sr = Flx_srcref.slift (Flx_prelex.src_of_token h) in
189: clierr sr "#define requires identifier"
190: end
191: toks
192: ;
193: []
194:
195: let define_directive state sr toks =
196: match toks with
197: | NAME (sr,name) :: ts ->
198: let sr = Flx_srcref.slift sr in
199: begin match state#get_macro name with
200: | None ->
201: parse_macro_body state sr name ts;
202: []
203: | Some _ -> clierr sr ("Duplicate Macro definition for " ^ name)
204: end
205:
206: | h :: _ ->
207: let sr = Flx_srcref.slift (Flx_prelex.src_of_token h) in
208: clierr sr "#define requires identifier"
209: | [] ->
210: clierr sr "#define requires identifier"
211:
212: let infix_directive state sr toks =
213: match toks with
214: | [INTEGER (sr1,kind,v); STRING (sr2,tok); NAME (sr3,fn)] ->
215: if kind <> "int" then
216: clierr sr "#infix directive requires plain integer precedence"
217: ;
218: let j = Big_int.int_of_big_int v in
219: state#add_infix_symbol j tok fn;
220: []
221:
222: | [INTEGER (sr1,kind,v); NAME (sr2,tok); NAME (sr3,fn)] ->
223: if kind <> "int" then
224: clierr sr "#infix directive requires plain integer precedence"
225: ;
226: let j = Big_int.int_of_big_int v in
227: state#add_infix_keyword j tok fn;
228: []
229:
230: | _ ->
231: clierr sr "#infix directive has syntax #infix 99 \"..\" fname"
232:
233: let keyword_directive state sr toks =
234: let rec aux toks = match toks with
235: | NAME (sr,tok) :: t ->
236: state#add_keyword tok;
237: aux t
238: | [] -> []
239: | _ ->
240: clierr sr "#keyword directive has syntax #keyword id1 id2 ..."
241: in aux toks
242:
243: let action_split t =
244: let rec aux inp out = match inp with
245: | [] -> rev out, []
246: | PARSE_ACTION _ :: tail -> rev out, tail
247: | h :: t -> aux t (h::out)
248: in aux t []
249:
250: let statement_directive state sr toks =
251: let toks = Flx_keywords.retok_parser_tokens toks in
252: match toks with
253: | NAME (sr,tok) :: t
254: | USER_STATEMENT_KEYWORD (sr,tok,_,_) :: t ->
255: (*
256: print_endline ("Statement directive " ^ tok);
257: *)
258: let t1,t2 = action_split t in
259: let sts,_ =
260: match t2 with
261: | [] -> [],ENDMARKER
262: | _ -> Flx_tok.parse_tokens Flx_parse.statementsx (t2 @ [ENDMARKER])
263: in
264: (*
265: print_endline ("Action Statements " ^ catmap "\n" (Flx_print.string_of_statement 0) sts);
266: *)
267: state#add_statement_keyword tok (Flx_srcref.slift sr) t1 (`Statements_term sts);
268: []
269:
270: | _ ->
271: clierr sr "#statement directive has syntax #statement kw production"
272:
273: let nonterminal_directive state sr toks =
274: let toks = Flx_keywords.retok_parser_tokens toks in
275: match toks with
276: | NAME (sr,tok) :: t ->
277: (*
278: print_endline ("Adding nonterminal .." ^ tok);
279: *)
280: let t1,t2 = action_split t in
281: (*
282: print_endline ("Action Tokens: " ^ catmap ", " Flx_prelex.string_of_token t2);
283: *)
284: let expr = Flx_tok.parse_tokens Flx_parse.expression (t2 @ [ENDMARKER]) in
285: state#add_nonterminal tok (Flx_srcref.slift sr) t1 (`Expression_term expr);
286: []
287:
288: | _ ->
289: clierr sr "#nonterminal has syntax #nonterminal name production"
290:
291: let bracket_directive state sr toks =
292: match toks with
293: | [STRING (sr1,tok1); STRING (sr2,tok2); NAME (sr3,fn)] ->
294: state#add_brackets tok1 tok2 fn;
295: []
296:
297: | _ ->
298: clierr sr "#bracket directive has syntax #bracket \"lb\" \"rb\" fname"
299:
300: let if_directive state sr toks =
301: state#push_condition
302: (
303: match eval_bool state sr toks with
304: | true -> `Processing
305: | false -> `Skip_to_else
306: )
307: ;
308: []
309:
310: let ifdef_directive state sr toks =
311: begin match toks with
312: | NAME (sr,s) :: _ ->
313: begin match state#get_macro s with
314: | None -> state#push_condition `Skip_to_else
315: | Some _ -> state#push_condition `Processing
316: end
317: | _ -> clierr sr "#ifdef requires identifier"
318: end
319: ;
320: []
321:
322: let ifndef_directive state sr toks =
323: begin match toks with
324: | NAME (sr,s) :: _ ->
325: begin match state#get_macro s with
326: | None -> state#push_condition `Processing
327: | Some _ -> state#push_condition `Skip_to_else
328: end
329: | _ -> clierr sr "#ifndef requires identifier"
330: end
331: ;
332: []
333:
334: let else_directive state sr =
335: begin match state#get_condition with
336: | `Processing -> state#set_condition `Skip_to_endif
337: | `Skip_to_endif -> ()
338: | `Skip_to_else -> state#set_condition `Processing
339: | `Subscan -> syserr sr "unexpected else while subscanning"
340: end
341: ;
342: []
343:
344: let elif_directive state sr toks =
345: begin match state#get_condition with
346: | `Processing -> state#set_condition `Skip_to_endif
347: | `Skip_to_endif -> ()
348: | `Skip_to_else ->
349: state#set_condition
350: (
351: match eval_bool state sr toks with
352: | true -> `Processing
353: | false -> `Skip_to_else
354: )
355: | `Subscan -> syserr sr "unexpected elif while subscanning"
356: end
357: ;
358: []
359:
360:
361: let endif_directive state sr =
362: if state#condition_stack_length < 2
363: then
364: clierr sr "Unmatched endif"
365: else
366: state#pop_condition;
367: []
368:
369: let find_include_file state s sr =
370: if s.[0]<>'"' && s.[0]<>'<'
371: then clierr sr "'\"' or '<' required after #include"
372: ;
373: let rquote = if s.[0]='"' then '"' else '>' in
374: let i = ref 1 in
375: let j = !i in
376: while s.[!i]<>rquote && s.[!i]<>'\n' do incr i done
377: ;
378:
379: if s.[!i]='\n'
380: then clierr sr "double quote required after filename in #include directive"
381: ;
382: let filename = String.sub s j (!i-j) in
383: let filename=
384: if rquote = '"'
385: then state#get_relative filename
386: else state#get_absolute filename
387: in
388: (*
389: print_endline (
390: "//Resolved in path: \"" ^ filename ^ "\""
391: );
392: *)
393: filename
394:
395: let include_directive is_import state sr s pre_flx_lex =
396: let filename = find_include_file state s sr in
397: state#add_include_file filename;
398: let pre_tokens_of_filename filename =
399: let incdirs = state#get_incdirs in
400: let basedir = Filename.dirname filename in
401: let state' = new lexer_state filename basedir incdirs state#get_expand_expr in
402: let infile = open_in filename in
403: let src = Lexing.from_channel infile in
404: let toks = pre_tokens_of_lexbuf pre_flx_lex src state' in
405: close_in infile;
406: if is_import then begin
407: try state#add_macros state'
408: with Duplicate_macro k -> clierr sr
409: ("Duplicate Macro " ^ k ^ " imported")
410: end;
411: iter state#add_include_file state'#get_include_files;
412: toks
413: in
414: pre_tokens_of_filename filename
415:
416: let count_newlines s =
417: let n = ref 0 in
418: let len = ref 0 in
419: let last_len = ref 0 in
420: for i = 0 to String.length s - 1 do
421: if s.[i] = '\n' then begin incr n; last_len := !len; len := 0; end
422: else incr len
423: done;
424: !n,!last_len
425:
426: let handle_preprocessor state lexbuf s pre_flx_lex start_location start_position =
427: let linecount,last_line_len = count_newlines s in
428: let file,line1,col1,_ = state#get_srcref lexbuf in
429: let file',line1',_,_ = state#get_physical_srcref lexbuf in
430:
431: let next_line = line1+linecount in
432: let next_line' = line1'+linecount in
433: let sr = file,line1,col1,next_line-1,last_line_len+1 in
434: let sr' = file',line1',col1,next_line'-1,last_line_len+1 in
435: let saved_buf_pos = Lexing.lexeme_end lexbuf in
436: (*
437: print_endline ("PREPROCESSING: " ^ Flx_srcref.long_string_of_src sr);
438: print_endline ("Trailing buf pos = " ^ si saved_buf_pos);
439: *)
440: let ident,s' =
441:
442: (* .. note the string WILL end with a newline .. *)
443:
444: (* skip spaces *)
445: let i = ref 0 in
446: while is_white s.[!i] && (s.[!i] <> '\n') do incr i done;
447:
448: (* scan non-spaces, stop at #, white, or newline *)
449: let n = ref 0 in
450: while
451: not (is_white s.[!i + !n]) &&
452: not (s.[!i + !n]='\n') &&
453: not (s.[!i + !n]='#')
454: do incr n done;
455:
456: (* grab the preprocessor directive name *)
457: let ident = String.sub s !i !n in
458:
459: (* scan for next non-white *)
460: let j = ref (!i + !n) in
461: while is_white s.[!j] && (s.[!j] <> '\n') do incr j done;
462:
463: (* scan back from end of text for last non-white *)
464: n := String.length s - 1;
465: while !n > !j && is_white(s.[!n-1]) do decr n done;
466:
467: (* grab the text from after the directive name to the end *)
468: let ssl = !n - !j in
469: let rest = String.sub s !j ssl in
470: ident,rest
471: in
472:
473: (*
474: print_endline ("PREPRO i=" ^ ident^", t='"^s'^"',\ns='"^s^"'");
475: *)
476: match ident with
477:
478: (* THESE COMMANDS ARE WEIRD HANGOVERS FROM C WHICH
479: CANNOT HANDLE NORMAL TOKENISATION
480: *)
481: (* print a warning *)
482: | "error" ->
483: begin match state#get_condition with
484: | `Processing ->
485: print_endline ("#error " ^ s');
486: clierr2 sr sr' ("#error " ^ s')
487: | _ -> []
488: end
489:
490: | "warn" ->
491: let result =
492: match state#get_condition with
493: | `Processing ->
494: let desc = Flx_srcref.short_string_of_src sr in
495: print_endline desc
496: ;
497: if sr <> sr' then begin
498: let desc = Flx_srcref.short_string_of_src sr' in
499: print_endline ("Physical File:\n" ^ desc)
500: end
501: ;
502: print_endline ("#warn " ^ s');
503: print_endline "";
504: [NEWLINE]
505: | _ -> []
506: in
507: for i = 1 to linecount do state#newline lexbuf done;
508: result
509:
510: | "line" ->
511: line_directive state sr s' lexbuf
512:
513: | "include"
514: | "import" ->
515: let result =
516: let is_import = ident = "import" in
517: match state#get_condition with
518: | `Processing ->
519: include_directive is_import state sr s' pre_flx_lex
520: | _ -> []
521: in
522: for i = 1 to linecount do state#newline lexbuf done;
523: result
524:
525: (* THESE ONES USE ORDINARY TOKEN STREAM *)
526: | _ ->
527: let result =
528: let src = Lexing.from_string s in
529: (*
530: print_endline ("Start buf pos = " ^ si (start_position.Lexing.pos_cnum));
531: print_endline ("Start loc = " ^ si (start_location.buf_pos));
532: *)
533: state#push_condition `Subscan;
534:
535: (* hack the location to the start of the line *)
536: let b = start_location.buf_pos - start_position.Lexing.pos_cnum in
537: (*
538: print_endline ("Hacking column position to " ^ si b);
539: *)
540: state#set_loc {
541: buf_pos = b;
542: last_buf_pos = b;
543: line_no = line1;
544: original_line_no = line1';
545: };
546:
547: let toks = pre_tokens_of_lexbuf pre_flx_lex src state in
548:
549: state#pop_condition;
550:
551: (* use the special preprocessor token filter *)
552: let toks = Flx_lex1.translate_preprocessor toks in
553:
554: (*
555: iter (fun tok ->
556: let sr = Flx_srcref.slift (Flx_prelex.src_of_token tok) in
557: print_endline (Flx_srcref.long_string_of_src sr)
558: )
559: toks;
560: *)
561:
562: match toks with
563: | [] -> [] (* DUMMY *)
564: | h :: toks ->
565: let h = Flx_prelex.string_of_token h in
566: if h <> ident then
567: failwith (
568: "WOOPS, mismatch on directive name: ident=" ^
569: ident ^ ", head token = " ^
570: h
571: )
572: ;
573: match h with
574:
575: (* conditional compilation *)
576: | "if" -> if_directive state sr toks
577: | "ifdef" -> ifdef_directive state sr toks
578: | "ifndef" -> ifndef_directive state sr toks
579: | "else" -> else_directive state sr
580: | "elif" -> elif_directive state sr toks
581: | "endif" -> endif_directive state sr
582:
583: | _ -> match state#get_condition with
584: | `Skip_to_else
585: | `Skip_to_endif -> []
586: | `Subscan -> syserr sr "Unexpected preprocessor directive in subscan"
587:
588: (* these ones are only done if in processing mode *)
589: | `Processing ->
590: match h with
591:
592: | "define" ->
593: define_directive state sr toks
594:
595: | "undef" ->
596: undef_directive state sr toks
597:
598:
599: | "infix" ->
600: infix_directive state sr toks
601:
602: | "keyword" ->
603: keyword_directive state sr toks
604:
605: | "statement" ->
606: statement_directive state sr toks
607:
608: | "nonterminal" ->
609: nonterminal_directive state sr toks
610:
611: | "bracket" ->
612: bracket_directive state sr toks
613:
614: | _ ->
615: print_endline (state#string_of_srcref lexbuf);
616: print_endline
617: (
618: "LEXICAL ERROR: IGNORING UNKNOWN PREPROCESSOR DIRECTIVE \"" ^
619: ident ^ "\""
620: );
621: [NEWLINE]
622: in
623:
624: (* restore the location to the start of the next line *)
625: state#set_loc {
626: buf_pos = saved_buf_pos;
627: last_buf_pos = saved_buf_pos;
628: line_no = next_line;
629: original_line_no = next_line'
630: };
631: result
632:
633:
Start data section to src/flx_lex.mll[1
/1
]
1: {
2: open Flx_util
3: open Flx_parse
4: open Flx_string
5: open Big_int
6: open Flx_exceptions
7: open Flx_lexstate
8: open Flx_preproc
9:
10: let lexeme = Lexing.lexeme
11: let lexeme_start = Lexing.lexeme_start
12: let lexeme_end = Lexing.lexeme_end
13:
14: let substr = String.sub
15: let len = String.length
16:
17: (* string parsers *)
18: let decode_qstring s = let n = len s in unescape (substr s 0 (n-1))
19: let decode_dstring s = let n = len s in unescape (substr s 0 (n-1))
20: let decode_qqqstring s = let n = len s in unescape (substr s 0 (n-3))
21: let decode_dddstring s = let n = len s in unescape (substr s 0 (n-3))
22:
23: let decode_raw_qstring s = let n = len s in substr s 0 (n-1)
24: let decode_raw_dstring s = let n = len s in substr s 0 (n-1)
25: let decode_raw_qqqstring s = let n = len s in substr s 0 (n-3)
26: let decode_raw_dddstring s = let n = len s in substr s 0 (n-3)
27:
28: (* WARNING: hackery: adjust this when lex expression 'white'
29: is adjutsed
30: *)
31:
32: }
33:
34: (* ====================== REGULAR DEFINITIONS ============================ *)
35: (* special characters *)
36: let quote = '\''
37: let dquote = '"'
38: let slosh = '\\'
39: let linefeed = '\n'
40: let tab = '\t'
41: let space = ' '
42: let formfeed = '\012'
43: let vtab = '\011'
44: let carriage_return = '\013'
45: let underscore = '_'
46:
47: (* character sets *)
48: let bindigit = ['0'-'1']
49: let octdigit = ['0'-'7']
50: let digit = ['0'-'9']
51: let hexdigit = digit | ['A'-'F'] | ['a'-'f']
52: let lower = ['a'-'z']
53: let upper = ['A'-'Z']
54: (* let letter = lower | upper *)
55: let letter = lower | upper
56: let hichar = ['\128'-'\255']
57: let white = space | tab
58:
59: (* nasty: form control characters *)
60: let form_control = linefeed | carriage_return | vtab | formfeed
61: let newline_prefix = linefeed | carriage_return
62: let newline = formfeed | linefeed | carriage_return linefeed
63: let hash = '#'
64:
65: let ordinary = letter | digit | hichar |
66: '!' | '$' | '%' | '&' | '(' | ')' | '*' |
67: '+' | ',' | '-' | '.' | '/' | ':' | ';' | '<' |
68: '=' | '>' | '?' | '@' | '[' | ']' | '^' | '_' |
69: '`' | '{' | '|' | '}' | '~'
70:
71: (* any sequence of these characters makes one or more tokens *)
72: (* MISSING: # should be in here, but can't be supported atm
73: because preprocessor # uses a conditional, and just errors
74: out if the # isn't at the start of a line .. needs fixing,
75: not sure how to fix it
76: *)
77:
78: let symchar =
79: '!' | '$' | '%' | '&' | '(' | ')' | '*' |
80: '+' | ',' | '-' | '.' | '/' | ':' | ';' | '<' |
81: '=' | '>' | '?' | '@' | '[' | ']' | '^' |
82: '`' | '{' | '|' | '}' | '~' | '#' | '\\'
83:
84: let printable = ordinary | quote | dquote | slosh | hash
85:
86: (* identifiers *)
87: let ucn =
88: "\\u" hexdigit hexdigit hexdigit hexdigit
89: | "\\U" hexdigit hexdigit hexdigit hexdigit hexdigit hexdigit hexdigit hexdigit
90:
91: let prime = '\''
92: let idletter = letter | underscore | hichar | ucn
93: let identifier = idletter (idletter | digit | prime )*
94:
95: (* integers *)
96: let bin_lit = '0' ('b' | 'B') (underscore? bindigit) +
97: let oct_lit = '0' ('o' | 'O') (underscore? octdigit) +
98: let dec_lit = ('0' ('d' | 'D'))? digit (underscore? digit) *
99: let hex_lit = '0' ('x' | 'X') (underscore? hexdigit) +
100: let type_suffix =
101: 't'|'T'|'s'|'S'|'i'|'I'|'l'|'L'|'v'|'V'|"ll"|"LL"
102: | "i8" | "i16" | "i32" | "i64"
103: | "u8" | "u16" | "u32" | "u64"
104: | "I8" | "I16" | "I32" | "I64"
105: | "U8" | "U16" | "U32" | "U64"
106: let signind = 'u' | 'U'
107: let suffix = type_suffix? signind? | signind? type_suffix?
108: let int_lit = (bin_lit | oct_lit | dec_lit | hex_lit) suffix
109:
110: (* floats: Follows ISO C89, except that we allow underscores *)
111: let decimal_string = digit (underscore? digit) *
112: let hexadecimal_string = hexdigit (underscore? hexdigit) *
113:
114: let decimal_fractional_constant =
115: decimal_string '.' decimal_string?
116: | '.' decimal_string
117:
118: let hexadecimal_fractional_constant =
119: ("0x" |"0X")
120: (hexadecimal_string '.' hexadecimal_string?
121: | '.' hexadecimal_string)
122:
123: let decimal_exponent = ('E'|'e') ('+'|'-')? decimal_string
124: let binary_exponent = ('P'|'p') ('+'|'-')? decimal_string
125:
126: let floating_suffix = 'L' | 'l' | 'F' | 'f' | 'D' | 'd'
127: let floating_literal =
128: (
129: decimal_fractional_constant decimal_exponent? |
130: hexadecimal_fractional_constant binary_exponent?
131: )
132: floating_suffix?
133:
134: (* Python strings *)
135: let qqq = quote quote quote
136: let ddd = dquote dquote dquote
137:
138: let escape = slosh _
139:
140: let dddnormal = ordinary | hash | quote | escape | white | newline
141: let dddspecial = dddnormal | dquote dddnormal | dquote dquote dddnormal
142:
143: let qqqnormal = ordinary | hash | dquote | escape | white | newline
144: let qqqspecial = qqqnormal | quote qqqnormal | quote quote qqqnormal
145:
146: let raw_dddnormal = ordinary | hash | quote | slosh | white | newline
147: let raw_dddspecial = raw_dddnormal | dquote raw_dddnormal | dquote dquote raw_dddnormal
148:
149: let raw_qqqnormal = ordinary | hash | dquote | slosh | space | newline
150: let raw_qqqspecial = raw_qqqnormal | quote raw_qqqnormal | quote quote raw_qqqnormal
151:
152: let qstring = (ordinary | hash | dquote | escape | white) * quote
153: let dstring = (ordinary | hash | quote | escape | white) * dquote
154: let qqqstring = qqqspecial * qqq
155: let dddstring = dddspecial * ddd
156:
157: let raw = 'r' | 'R'
158: let see = 'c' | 'C'
159: let rqc = raw see | see raw
160:
161: let raw_qstring = (ordinary | hash | dquote | escape | white) * quote
162: let raw_dstring = (ordinary | hash | quote | escape | white) * dquote
163:
164: let raw_qqqstring = raw_qqqspecial * qqq
165: let raw_dddstring = raw_dddspecial * ddd
166:
167: let not_hash_or_newline = ordinary | quote | dquote | white | slosh
168: let not_newline = not_hash_or_newline | hash
169: let quoted_filename = dquote (ordinary | hash | quote | white | slosh)+ dquote
170:
171: (* ====================== PARSERS ============================ *)
172: (* string lexers *)
173: rule parse_qstring state = parse
174: | qstring {
175: state#inbody;
176: [STRING (
177: state#get_srcref lexbuf,
178: state#decode decode_qstring (lexeme lexbuf)
179: )]
180: }
181: | _ {
182: [ERRORTOKEN (
183: state#get_srcref lexbuf,
184: "' string"
185: )]
186: }
187:
188: and parse_dstring state = parse
189: | dstring {
190: state#inbody;
191: [STRING (
192: state#get_srcref lexbuf,
193: state#decode decode_dstring (lexeme lexbuf)
194: )]
195: }
196: | _ {
197: state#inbody;
198: [ERRORTOKEN (
199: state#get_srcref lexbuf,
200: "\" string"
201: )]
202: }
203:
204: and parse_qqqstring state = parse
205: | qqqstring {
206: state#inbody;
207: [STRING (
208: state#get_srcref lexbuf,
209: state#decode decode_qqqstring (lexeme lexbuf)
210: )]
211: }
212: | _ {
213: state#inbody;
214: [ERRORTOKEN (
215: state#get_srcref lexbuf,
216: "''' string"
217: )]
218: }
219:
220: and parse_dddstring state = parse
221: | dddstring {
222: state#inbody;
223: [STRING (
224: state#get_srcref lexbuf,
225: state#decode decode_dddstring (lexeme lexbuf)
226: )]
227: }
228: | _ {
229: state#inbody;
230: [ERRORTOKEN (
231: state#get_srcref lexbuf,
232: "\"\"\" string"
233: )]
234: }
235:
236: and parse_fqstring state = parse
237: | qstring {
238: state#inbody;
239: [FSTRING (
240: state#get_srcref lexbuf,
241: state#decode decode_qstring (lexeme lexbuf)
242: )]
243: }
244: | _ {
245: [ERRORTOKEN (
246: state#get_srcref lexbuf,
247: "' string"
248: )]
249: }
250:
251: and parse_fdstring state = parse
252: | dstring {
253: state#inbody;
254: [FSTRING (
255: state#get_srcref lexbuf,
256: state#decode decode_dstring (lexeme lexbuf)
257: )]
258: }
259: | _ {
260: state#inbody;
261: [ERRORTOKEN (
262: state#get_srcref lexbuf,
263: "\" string"
264: )]
265: }
266:
267: and parse_fqqqstring state = parse
268: | qqqstring {
269: state#inbody;
270: [FSTRING (
271: state#get_srcref lexbuf,
272: state#decode decode_qqqstring (lexeme lexbuf)
273: )]
274: }
275: | _ {
276: state#inbody;
277: [ERRORTOKEN (
278: state#get_srcref lexbuf,
279: "''' string"
280: )]
281: }
282:
283: and parse_fdddstring state = parse
284: | dddstring {
285: state#inbody;
286: [FSTRING (
287: state#get_srcref lexbuf,
288: state#decode decode_dddstring (lexeme lexbuf)
289: )]
290: }
291: | _ {
292: state#inbody;
293: [ERRORTOKEN (
294: state#get_srcref lexbuf,
295: "\"\"\" string"
296: )]
297: }
298:
299: and parse_cqstring state = parse
300: | qstring {
301: state#inbody;
302: [CSTRING (
303: state#get_srcref lexbuf,
304: state#decode decode_qstring (lexeme lexbuf)
305: )]
306: }
307: | _ {
308: [ERRORTOKEN (
309: state#get_srcref lexbuf,
310: "' string"
311: )]
312: }
313:
314: and parse_cdstring state = parse
315: | dstring {
316: state#inbody;
317: [CSTRING (
318: state#get_srcref lexbuf,
319: state#decode decode_dstring (lexeme lexbuf)
320: )]
321: }
322: | _ {
323: state#inbody;
324: [ERRORTOKEN (
325: state#get_srcref lexbuf,
326: "\" string"
327: )]
328: }
329:
330: and parse_cqqqstring state = parse
331: | qqqstring {
332: state#inbody;
333: [CSTRING (
334: state#get_srcref lexbuf,
335: state#decode decode_qqqstring (lexeme lexbuf)
336: )]
337: }
338: | _ {
339: state#inbody;
340: [ERRORTOKEN (
341: state#get_srcref lexbuf,
342: "''' string"
343: )]
344: }
345:
346: and parse_cdddstring state = parse
347: | dddstring {
348: state#inbody;
349: [CSTRING (
350: state#get_srcref lexbuf,
351: state#decode decode_dddstring (lexeme lexbuf)
352: )]
353: }
354: | _ {
355: state#inbody;
356: [ERRORTOKEN (
357: state#get_srcref lexbuf,
358: "\"\"\" string"
359: )]
360: }
361:
362: and parse_wqstring state = parse
363: | qstring {
364: state#inbody;
365: [WSTRING (
366: state#get_srcref lexbuf,
367: state#decode decode_qstring (lexeme lexbuf)
368: )]
369: }
370: | _ {
371: [ERRORTOKEN (
372: state#get_srcref lexbuf,
373: "' string"
374: )]
375: }
376:
377: and parse_wdstring state = parse
378: | dstring {
379: state#inbody;
380: [WSTRING (
381: state#get_srcref lexbuf,
382: state#decode decode_dstring (lexeme lexbuf)
383: )]
384: }
385: | _ {
386: state#inbody;
387: [ERRORTOKEN (
388: state#get_srcref lexbuf,
389: "\" string"
390: )]
391: }
392:
393: and parse_wqqqstring state = parse
394: | qqqstring {
395: state#inbody;
396: [WSTRING (
397: state#get_srcref lexbuf,
398: state#decode decode_qqqstring (lexeme lexbuf)
399: )]
400: }
401: | _ {
402: state#inbody;
403: [ERRORTOKEN (
404: state#get_srcref lexbuf,
405: "''' string"
406: )]
407: }
408:
409: and parse_wdddstring state = parse
410: | dddstring {
411: state#inbody;
412: [WSTRING (
413: state#get_srcref lexbuf,
414: state#decode decode_dddstring (lexeme lexbuf)
415: )]
416: }
417: | _ {
418: state#inbody;
419: [ERRORTOKEN (
420: state#get_srcref lexbuf,
421: "\"\"\" string"
422: )]
423: }
424:
425: and parse_uqstring state = parse
426: | qstring {
427: state#inbody;
428: [WSTRING (
429: state#get_srcref lexbuf,
430: state#decode decode_qstring (lexeme lexbuf)
431: )]
432: }
433: | _ {
434: [ERRORTOKEN (
435: state#get_srcref lexbuf,
436: "' string"
437: )]
438: }
439:
440: and parse_udstring state = parse
441: | dstring {
442: state#inbody;
443: [USTRING (
444: state#get_srcref lexbuf,
445: state#decode decode_dstring (lexeme lexbuf)
446: )]
447: }
448: | _ {
449: state#inbody;
450: [ERRORTOKEN (
451: state#get_srcref lexbuf,
452: "\" string"
453: )]
454: }
455:
456: and parse_uqqqstring state = parse
457: | qqqstring {
458: state#inbody;
459: [USTRING (
460: state#get_srcref lexbuf,
461: state#decode decode_qqqstring (lexeme lexbuf)
462: )]
463: }
464: | _ {
465: state#inbody;
466: [ERRORTOKEN (
467: state#get_srcref lexbuf,
468: "''' string"
469: )]
470: }
471:
472: and parse_udddstring state = parse
473: | dddstring {
474: state#inbody;
475: [USTRING (
476: state#get_srcref lexbuf,
477: state#decode decode_dddstring (lexeme lexbuf)
478: )]
479: }
480: | _ {
481: state#inbody;
482: [ERRORTOKEN (
483: state#get_srcref lexbuf,
484: "\"\"\" string"
485: )]
486: }
487:
488: and parse_raw_qstring state = parse
489: | raw_qstring {
490: state#inbody;
491: [STRING (
492: state#get_srcref lexbuf,
493: state#decode decode_raw_qstring (lexeme lexbuf)
494: )]
495: }
496: | _ {
497: state#inbody;
498: [ERRORTOKEN (
499: state#get_srcref lexbuf,
500: "raw ' string")]
501: }
502:
503: and parse_raw_dstring state = parse
504: | raw_dstring {
505: state#inbody;
506: [STRING (
507: state#get_srcref lexbuf,
508: state#decode decode_raw_dstring (lexeme lexbuf)
509: )]
510: }
511: | _ {
512: state#inbody;
513: [ERRORTOKEN (
514: state#get_srcref lexbuf,
515: "raw \" string"
516: )]
517: }
518:
519: and parse_raw_qqqstring state = parse
520: | raw_qqqstring {
521: state#inbody;
522: [STRING (
523: state#get_srcref lexbuf,
524: state#decode decode_raw_qqqstring (lexeme lexbuf)
525: )]
526: }
527: | _ { state#inbody;
528: [ERRORTOKEN (
529: state#get_srcref lexbuf,
530: "raw ''' string")] }
531:
532: and parse_raw_dddstring state = parse
533: | raw_dddstring {
534: state#inbody;
535: [STRING (
536: state#get_srcref lexbuf,
537: state#decode decode_raw_dddstring (lexeme lexbuf)
538: )]
539: }
540: | _ {
541: [ERRORTOKEN (
542: state#get_srcref lexbuf,
543: lexeme lexbuf)
544: ]
545: }
546:
547: and parse_raw_cqstring state = parse
548: | raw_qstring {
549: state#inbody;
550: [CSTRING (
551: state#get_srcref lexbuf,
552: state#decode decode_raw_qstring (lexeme lexbuf)
553: )]
554: }
555: | _ {
556: state#inbody;
557: [ERRORTOKEN (
558: state#get_srcref lexbuf,
559: "raw ' cstring")]
560: }
561:
562: and parse_raw_cdstring state = parse
563: | raw_dstring {
564: state#inbody;
565: [STRING (
566: state#get_srcref lexbuf,
567: state#decode decode_raw_dstring (lexeme lexbuf)
568: )]
569: }
570: | _ {
571: state#inbody;
572: [ERRORTOKEN (
573: state#get_srcref lexbuf,
574: "raw \" cstring"
575: )]
576: }
577:
578: and parse_raw_cqqqstring state = parse
579: | raw_qqqstring {
580: state#inbody;
581: [CSTRING (
582: state#get_srcref lexbuf,
583: state#decode decode_raw_qqqstring (lexeme lexbuf)
584: )]
585: }
586: | _ { state#inbody;
587: [ERRORTOKEN (
588: state#get_srcref lexbuf,
589: "raw ''' cstring")] }
590:
591: and parse_raw_cdddstring state = parse
592: | raw_dddstring {
593: state#inbody;
594: [CSTRING (
595: state#get_srcref lexbuf,
596: state#decode decode_raw_dddstring (lexeme lexbuf)
597: )]
598: }
599: | _ {
600: [ERRORTOKEN (
601: state#get_srcref lexbuf,
602: lexeme lexbuf)
603: ]
604: }
605:
606: and parse_hashbang state = parse
607: | not_newline * newline {
608: begin
609: state#newline lexbuf;
610: let lex = lexeme lexbuf in
611: let n = String.length lex in
612: [COMMENT_NEWLINE (String.sub lex 0 (n-1))]
613: end
614: }
615: | _ { [ERRORTOKEN (
616: state#get_srcref lexbuf,
617: lexeme lexbuf)] }
618:
619: and parse_C_comment state = parse
620: | "/*" {
621: state#append_comment (lexeme lexbuf);
622: state#incr_comment;
623: parse_C_comment state lexbuf
624: }
625: | newline {
626: state#newline lexbuf;
627: state#append_comment (lexeme lexbuf);
628: parse_C_comment state lexbuf
629: }
630: | "*/" {
631: state#append_comment (lexeme lexbuf);
632: state#decr_comment;
633: if state#comment_level > 0
634: then parse_C_comment state lexbuf
635: else ()
636: ;
637: state#inbody
638: }
639: | _ {
640: state#append_comment (lexeme lexbuf);
641: parse_C_comment state lexbuf
642: }
643:
644: and parse_line state = parse
645: | not_newline * newline
646: {
647: state#newline lexbuf;
648: lexeme lexbuf
649: }
650:
651: and parse_preprocessor state start_location start_position = parse
652: | ( not_newline* slosh space* newline)* not_newline* newline
653: | ( not_newline* hash space* newline) (not_hash_or_newline not_newline* newline)+
654: {
655: let toks = handle_preprocessor state lexbuf
656: (lexeme lexbuf) pre_flx_lex start_location start_position
657: in
658: toks
659: }
660:
661:
662: and pre_flx_lex state = parse
663: (* eof is not eaten up, so parent will find eof and emit ENDMARKER *)
664: | "//" not_newline * (newline | eof) {
665: state#newline lexbuf;
666: let lex = lexeme lexbuf in
667: let n = String.length lex in
668: [COMMENT_NEWLINE (String.sub lex 2 (n-3))]
669: }
670:
671: | "/*" {
672: state#set_comment (lexeme lexbuf);
673: parse_C_comment state lexbuf;
674: [COMMENT (state#get_comment)]
675: }
676:
677: | int_lit {
678: state#inbody;
679: let sr = state#get_srcref lexbuf in
680: let s = lexeme lexbuf in
681: let n = String.length s in
682: let converter, first =
683: if n>1 && s.[0]='0'
684: then
685: match s.[1] with
686: | 'b' | 'B' -> binbig_int_of_string,2
687: | 'o' | 'O' -> octbig_int_of_string,2
688: | 'd' | 'D' -> decbig_int_of_string,2
689: | 'x' | 'X' -> hexbig_int_of_string,2
690: | _ -> decbig_int_of_string,0
691: else decbig_int_of_string,0
692: in
693: let k = ref (n-1) in
694: let t =
695: if n >= 2 && s.[n-2]='i' && s.[n-1]='8'
696: then (k:=n-2; "int8")
697: else if n >= 2 && s.[n-2]='u' && s.[n-1]='8'
698: then (k:=n-2; "uint8")
699: else if n >= 3 && s.[n-3]='i' && s.[n-2]='1' && s.[n-1]='6'
700: then (k:=n-3; "int16")
701: else if n >= 3 && s.[n-3]='u' && s.[n-2]='1' && s.[n-1]='6'
702: then (k:=n-3; "uint16")
703:
704: else if n >= 3 && s.[n-3]='i' && s.[n-2]='3' && s.[n-1]='2'
705: then (k:=n-3; "int32")
706: else if n >= 3 && s.[n-3]='u' && s.[n-2]='3' && s.[n-1]='2'
707: then (k:=n-3; "uint32")
708:
709: else if n >= 3 && s.[n-3]='i' && s.[n-2]='6' && s.[n-1]='4'
710: then (k:=n-3; "int64")
711: else if n >= 3 && s.[n-3]='u' && s.[n-2]='6' && s.[n-1]='4'
712: then (k:=n-3; "uint64")
713:
714: else begin
715: let sign = ref "" in
716: let typ = ref "int" in
717: begin try while !k>first do
718: (match s.[!k] with
719: | 'u' | 'U' -> sign := "u"
720: | 't' | 'T' -> typ := "tiny"
721: | 's' | 'S' -> typ := "short"
722: | 'i' | 'I' -> typ := "int"
723: | 'l' | 'L' ->
724: typ :=
725: if !typ = "long" then "vlong" else "long"
726: | 'v' | 'V' -> typ := "vlong"
727: | _ -> raise Not_found
728: );
729: decr k
730: done with _ -> () end;
731: incr k;
732: !sign ^ !typ
733: end
734: in
735: let d = String.sub s first (!k-first) in
736: let v = (converter d) in
737: [INTEGER (sr, t, v)]
738: }
739:
740: | floating_literal {
741: state#inbody;
742: let str = lexeme lexbuf in
743: let n = String.length str in
744: let last_char = str.[n-1] in
745: match last_char with
746: | 'l'|'L' ->
747: [FLOAT (state#get_srcref lexbuf,"ldouble", strip_us (String.sub str 0 (n-1)))]
748: | 'f'|'F' ->
749: [FLOAT (state#get_srcref lexbuf,"float",strip_us (String.sub str 0 (n-1)))]
750: | _ ->
751: [FLOAT (state#get_srcref lexbuf,"double",strip_us str)]
752: }
753:
754: (* Python strings *)
755: | quote { state#inbody; parse_qstring state lexbuf }
756: | qqq { state#inbody; parse_qqqstring state lexbuf }
757: | dquote { state#inbody; parse_dstring state lexbuf }
758: | ddd { state#inbody; parse_dddstring state lexbuf }
759:
760: (* C strings: type char* *)
761: | ('c'|'C') quote { state#inbody; parse_cqstring state lexbuf }
762: | ('c'|'C') qqq { state#inbody; parse_cqqqstring state lexbuf }
763: | ('c'|'C') dquote { state#inbody; parse_cdstring state lexbuf }
764: | ('c'|'C') ddd { state#inbody; parse_cdddstring state lexbuf }
765:
766: (* Format strings *)
767: | ('f'|'F') quote { state#inbody; parse_fqstring state lexbuf }
768: | ('f'|'F') qqq { state#inbody; parse_fqqqstring state lexbuf }
769: | ('f'|'F') dquote { state#inbody; parse_fdstring state lexbuf }
770: | ('f'|'F') ddd { state#inbody; parse_fdddstring state lexbuf }
771:
772: (* wide strings *)
773: | ('w' | 'W') quote { state#inbody; parse_wqstring state lexbuf }
774: | ('w' | 'W') qqq { state#inbody; parse_wqqqstring state lexbuf }
775: | ('w' | 'W') dquote { state#inbody; parse_wdstring state lexbuf }
776: | ('w' | 'W') ddd { state#inbody; parse_wdddstring state lexbuf }
777:
778: (* UTF32 strings *)
779: | ('u' | 'U') quote { state#inbody; parse_uqstring state lexbuf }
780: | ('u' | 'U') qqq { state#inbody; parse_uqqqstring state lexbuf }
781: | ('u' | 'U') dquote { state#inbody; parse_udstring state lexbuf }
782: | ('u' | 'U') ddd { state#inbody; parse_udddstring state lexbuf }
783:
784: (* Python raw strings *)
785: | ('r'|'R') quote { state#inbody; parse_raw_qstring state lexbuf }
786: | ('r'|'R') qqq { state#inbody; parse_raw_qqqstring state lexbuf }
787: | ('r'|'R') dquote { state#inbody; parse_raw_dstring state lexbuf }
788: | ('r'|'R') ddd { state#inbody; parse_raw_dddstring state lexbuf }
789:
790: (* raw C strings: type char* *)
791: | rqc quote { state#inbody; parse_cqstring state lexbuf }
792: | rqc qqq { state#inbody; parse_cqqqstring state lexbuf }
793: | rqc dquote { state#inbody; parse_cdstring state lexbuf }
794: | rqc ddd { state#inbody; parse_cdddstring state lexbuf }
795:
796: (* this MUST be after strings, so raw strings take precedence
797: over identifiers, eg r'x' is a string, not an identifier,
798: but x'x' is an identifier .. yucky ..
799: *)
800: | identifier {
801: state#inbody;
802: let s = lexeme lexbuf in
803: let s' = Flx_id.utf8_to_ucn s in
804: let src = state#get_srcref lexbuf in
805: try [
806: let keywords = state#get_keywords in
807: let n = String.length s' in
808: if n >= Array.length keywords then raise Not_found;
809: let keywords = keywords.(n) in
810: (List.assoc s' keywords) (src,s')
811: ]
812: with Not_found ->
813: [Flx_keywords.map_flx_keywords src s']
814: }
815:
816: (* whitespace *)
817: | white + {
818: (* we do NOT say 'inbody' here: we want to accept
819: #directives with leading spaces
820: *)
821: let spaces=lexeme lexbuf in
822: let column = ref 0 in
823: let n = String.length spaces in
824: for i=0 to n-1 do match spaces.[i] with
825: | '\t' -> column := ((!column + 8) / 8) * 8
826: | ' ' -> incr column
827: | _ -> raise (Failure "Error in lexer, bad white space character")
828: done;
829: [WHITE (!column)]
830: }
831:
832: | slosh { [SLOSH] }
833:
834: | symchar + {
835: let atstart = state#is_at_line_start in
836: state#inbody;
837: let toks = state#tokenise_symbols lexbuf (lexeme lexbuf) in
838: match toks,atstart with
839: | [HASH _],true ->
840: let x = state#get_loc in
841: let y = lexbuf.Lexing.lex_curr_p in
842: parse_preprocessor state
843: { x with buf_pos = x.buf_pos }
844: { y with Lexing.pos_fname = y.Lexing.pos_fname }
845: lexbuf
846: | [HASHBANG _ | HASHBANGSLASH _ ],true ->
847: (*
848: print_endline "IGNORING HASHBANG";
849: *)
850: parse_hashbang state lexbuf
851: | _ -> toks
852:
853: }
854:
855: (* end of line *)
856: | newline {
857: state#newline lexbuf;
858: [NEWLINE ]
859: }
860:
861: (* end of file *)
862: | eof {
863: if state#get_condition = `Subscan then [ENDMARKER] else
864: if state#condition_stack_length <> 1
865: then
866: let sr = state#get_srcref lexbuf in
867: let sr = Flx_srcref.slift sr in
868: Flx_exceptions.clierr sr "Unmatched #if at end of file"
869: else
870: [ENDMARKER]
871: }
872:
873: (* Anything else is an error *)
874: | _ {
875: state#inbody;
876: [
877: ERRORTOKEN
878: (
879: state#get_srcref lexbuf, lexeme lexbuf
880: )
881: ]
882: }
883:
884: {
885: }
886:
Start ocaml section to src/flx_lex.mli[1
/1
]
1: # 2261 "./lpsrc/flx_lexer.ipk"
2: val pre_flx_lex :
3: Flx_lexstate.lexer_state ->
4: Lexing.lexbuf ->
5: Flx_parse.token list
6:
7: val parse_line :
8: Flx_lexstate.lexer_state ->
9: Lexing.lexbuf ->
10: string
11: