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: 
End ocaml section to src/flx_prelex.mli[1]
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: 
End ocaml section to src/flx_prelex.ml[1]
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: 
End ocaml section to src/flx_lexstate.ml[1]
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: 
End ocaml section to src/flx_lexstate.mli[1]
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: 
End ocaml section to src/flx_preproc.mli[1]
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: 
End data section to src/flx_preproc.ml[1]
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: 
End data section to src/flx_lex.mll[1]
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: 
End ocaml section to src/flx_lex.mli[1]