← Back to branch summary

~ubuntu-branches/debian/sid/ocaml/sid

« back to all changes in this revision

Viewing changes to parsing/lexer.mll

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-04-21 21:35:08 UTC
  • mfrom: (1.1.11 upstream) (12.1.14 sid)
  • Revision ID: james.westby@ubuntu.com-20110421213508-kg34453aqmb0moha
* Fixes related to -output-obj with g++ (in debian/patches):
  - add Declare-primitive-name-table-as-const-char
  - add Avoid-multiple-declarations-in-generated-.c-files-in
  - fix Embed-bytecode-in-C-object-when-using-custom: the closing
    brace for extern "C" { ... } was missing in some cases

Show diffs side-by-side

added added

removed removed

Lines of Context:
parsing/lexer.mll
10
10
(*                                                                     *)
11
11
(***********************************************************************)
12
12
 
13
 
(* $Id: lexer.mll 9079 2008-10-08 13:09:39Z doligez $ *)
 
13
(* $Id: lexer.mll 10250 2010-04-08 03:58:41Z garrigue $ *)
14
14
 
15
15
(* The lexer definition *)
16
16
 
156
156
  in
157
157
  Char.chr (val1 * 16 + val2)
158
158
 
 
159
(* To convert integer literals, allowing max_int + 1 (PR#4210) *)
 
160
 
 
161
let cvt_int_literal s =
 
162
  - int_of_string ("-" ^ s)
 
163
let cvt_int32_literal s =
 
164
  Int32.neg (Int32.of_string ("-" ^ String.sub s 0 (String.length s - 1)))
 
165
let cvt_int64_literal s =
 
166
  Int64.neg (Int64.of_string ("-" ^ String.sub s 0 (String.length s - 1)))
 
167
let cvt_nativeint_literal s =
 
168
  Nativeint.neg (Nativeint.of_string ("-" ^ String.sub s 0 (String.length s - 1)))
 
169
 
159
170
(* Remove underscores from float literals *)
160
171
 
161
172
let remove_underscores s =
239
250
      { token lexbuf }
240
251
  | "_"
241
252
      { UNDERSCORE }
242
 
  | "~"  { TILDE }
 
253
  | "~"
 
254
      { TILDE }
243
255
  | "~" lowercase identchar * ':'
244
256
      { let s = Lexing.lexeme lexbuf in
245
257
        let name = String.sub s 1 (String.length s - 2) in
264
276
      { UIDENT(Lexing.lexeme lexbuf) }       (* No capitalized keywords *)
265
277
  | int_literal
266
278
      { try
267
 
          INT (int_of_string(Lexing.lexeme lexbuf))
 
279
          INT (cvt_int_literal (Lexing.lexeme lexbuf))
268
280
        with Failure _ ->
269
281
          raise (Error(Literal_overflow "int", Location.curr lexbuf))
270
282
      }
271
283
  | float_literal
272
284
      { FLOAT (remove_underscores(Lexing.lexeme lexbuf)) }
273
285
  | int_literal "l"
274
 
      { let s = Lexing.lexeme lexbuf in
275
 
        try
276
 
          INT32 (Int32.of_string(String.sub s 0 (String.length s - 1)))
 
286
      { try
 
287
          INT32 (cvt_int32_literal (Lexing.lexeme lexbuf))
277
288
        with Failure _ ->
278
289
          raise (Error(Literal_overflow "int32", Location.curr lexbuf)) }
279
290
  | int_literal "L"
280
 
      { let s = Lexing.lexeme lexbuf in
281
 
        try
282
 
          INT64 (Int64.of_string(String.sub s 0 (String.length s - 1)))
 
291
      { try
 
292
          INT64 (cvt_int64_literal (Lexing.lexeme lexbuf))
283
293
        with Failure _ ->
284
294
          raise (Error(Literal_overflow "int64", Location.curr lexbuf)) }
285
295
  | int_literal "n"
286
 
      { let s = Lexing.lexeme lexbuf in
287
 
        try
288
 
          NATIVEINT
289
 
            (Nativeint.of_string(String.sub s 0 (String.length s - 1)))
 
296
      { try
 
297
          NATIVEINT (cvt_nativeint_literal (Lexing.lexeme lexbuf))
290
298
        with Failure _ ->
291
299
          raise (Error(Literal_overflow "nativeint", Location.curr lexbuf)) }
292
300
  | "\""
372
380
  | ">]" { GREATERRBRACKET }
373
381
  | "}"  { RBRACE }
374
382
  | ">}" { GREATERRBRACE }
 
383
  | "!"  { BANG }
375
384
 
376
385
  | "!=" { INFIXOP0 "!=" }
377
386
  | "+"  { PLUS }
 
387
  | "+." { PLUSDOT }
378
388
  | "-"  { MINUS }
379
389
  | "-." { MINUSDOT }
380
390
 
381
 
  | "!" symbolchar *
 
391
  | "!" symbolchar +
382
392
            { PREFIXOP(Lexing.lexeme lexbuf) }
383
393
  | ['~' '?'] symbolchar +
384
394
            { PREFIXOP(Lexing.lexeme lexbuf) }
481
491
        end
482
492
      }
483
493
  | newline
484
 
      { update_loc lexbuf None 1 false 0;
 
494
      { if not (in_comment ()) then
 
495
          Location.prerr_warning (Location.curr lexbuf) Warnings.Eol_in_string;
 
496
        update_loc lexbuf None 1 false 0;
485
497
        let s = Lexing.lexeme lexbuf in
486
498
        for i = 0 to String.length s - 1 do
487
499
          store_string_char s.[i];