diff options
author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2000-04-12 09:55:05 +0000 |
---|---|---|
committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2000-04-12 09:55:05 +0000 |
commit | 9625a4f35a08400d0f9d851d97d813cc9c2ce5ea (patch) | |
tree | 81d711dd350fb5cea8d60ea174f907608e305682 | |
parent | 80fcfd9313ef0c491e08c67393be5b3d7ab4f598 (diff) |
remplace ocaml2to3 obsolete par un convertisseur de 2.99 vers 3.00
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3065 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r-- | tools/.cvsignore | 4 | ||||
-rw-r--r-- | tools/.depend | 12 | ||||
-rw-r--r-- | tools/Makefile | 17 | ||||
-rw-r--r-- | tools/lexer299.mll | 472 | ||||
-rw-r--r-- | tools/ocaml299to3.ml | 122 | ||||
-rw-r--r-- | tools/ocaml2to3.mll | 243 |
6 files changed, 613 insertions, 257 deletions
diff --git a/tools/.cvsignore b/tools/.cvsignore index 18bf4db28..94b3f391a 100644 --- a/tools/.cvsignore +++ b/tools/.cvsignore @@ -11,6 +11,6 @@ ocamlmktop primreq ocamldumpobj keywords -ocaml2to3.ml -ocaml2to3 +lexer299.ml +ocaml299to3 diff --git a/tools/.depend b/tools/.depend index 6bd80f7c1..5bf8adb27 100644 --- a/tools/.depend +++ b/tools/.depend @@ -4,14 +4,18 @@ dumpapprox.cmx: ../asmcomp/clambda.cmx ../asmcomp/compilenv.cmx \ ../utils/config.cmx dumpobj.cmo: ../parsing/asttypes.cmi ../bytecomp/bytesections.cmi \ ../utils/config.cmi ../bytecomp/emitcode.cmi ../typing/ident.cmi \ - ../bytecomp/lambda.cmi ../bytecomp/opcodes.cmo opnames.cmo \ - ../utils/tbl.cmi + ../bytecomp/instruct.cmi ../bytecomp/lambda.cmi ../bytecomp/opcodes.cmo \ + opnames.cmo ../utils/tbl.cmi dumpobj.cmx: ../parsing/asttypes.cmi ../bytecomp/bytesections.cmx \ ../utils/config.cmx ../bytecomp/emitcode.cmx ../typing/ident.cmx \ - ../bytecomp/lambda.cmx ../bytecomp/opcodes.cmx opnames.cmx \ - ../utils/tbl.cmx + ../bytecomp/instruct.cmx ../bytecomp/lambda.cmx ../bytecomp/opcodes.cmx \ + opnames.cmx ../utils/tbl.cmx +lexer299.cmo: ../parsing/location.cmi ../utils/misc.cmi ../utils/warnings.cmi +lexer299.cmx: ../parsing/location.cmx ../utils/misc.cmx ../utils/warnings.cmx objinfo.cmo: ../utils/config.cmi ../bytecomp/emitcode.cmi objinfo.cmx: ../utils/config.cmx ../bytecomp/emitcode.cmx +ocaml299to3.cmo: lexer299.cmo +ocaml299to3.cmx: lexer299.cmx ocamlcp.cmo: ../driver/main_args.cmi ocamlcp.cmx: ../driver/main_args.cmx ocamldep.cmo: ../utils/clflags.cmo ../parsing/lexer.cmi \ diff --git a/tools/Makefile b/tools/Makefile index c449ab2ee..c5615cc25 100644 --- a/tools/Makefile +++ b/tools/Makefile @@ -22,7 +22,7 @@ INCLUDES=-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp \ COMPFLAGS=$(INCLUDES) LINKFLAGS=$(INCLUDES) -all: ocamldep ocamlprof ocamlcp ocamlmktop ocaml2to3 +all: ocamldep ocamlprof ocamlcp ocamlmktop ocaml299to3 # The dependency generator @@ -75,19 +75,20 @@ clean:: # Converter ocaml 2.04 to 3 -OCAML2TO3=ocaml2to3.cmo +OCAML299TO3= lexer299.cmo ocaml299to3.cmo +LIBRARY3= misc.cmo warnings.cmo linenum.cmo location.cmo -ocaml2to3: $(OCAML2TO3) - $(CAMLC) $(LINKFLAGS) -o ocaml2to3 $(OCAML2TO3) +ocaml299to3: $(OCAML299TO3) + $(CAMLC) $(LINKFLAGS) -o ocaml299to3 $(LIBRARY3) $(OCAML299TO3) -ocaml2to3.ml: ocaml2to3.mll - $(CAMLLEX) ocaml2to3.mll +lexer299.ml: lexer299.mll + $(CAMLLEX) lexer299.mll install:: - cp ocaml2to3 $(BINDIR)/ocaml2to3 + cp ocaml299to3 $(BINDIR)/ocaml299to3 clean:: - rm -f ocaml2to3 ocaml2to3.ml + rm -f ocaml299to3 lexer299.ml # The preprocessor for asm generators diff --git a/tools/lexer299.mll b/tools/lexer299.mll new file mode 100644 index 000000000..afdabbd6a --- /dev/null +++ b/tools/lexer299.mll @@ -0,0 +1,472 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* The lexer definition *) + +{ +open Misc + +type token = + AMPERAMPER + | AMPERSAND + | AND + | AS + | ASSERT + | BACKQUOTE + | BAR + | BARBAR + | BARRBRACKET + | BEGIN + | CHAR of (char) + | CLASS + | COLON + | COLONCOLON + | COLONEQUAL + | COLONGREATER + | COMMA + | CONSTRAINT + | DO + | DONE + | DOT + | DOTDOT + | DOWNTO + | ELSE + | END + | EOF + | EQUAL + | EXCEPTION + | EXTERNAL + | FALSE + | FLOAT of (string) + | FOR + | FUN + | FUNCTION + | FUNCTOR + | GREATER + | GREATERRBRACE + | GREATERRBRACKET + | IF + | IN + | INCLUDE + | INFIXOP0 of (string) + | INFIXOP1 of (string) + | INFIXOP2 of (string) + | INFIXOP3 of (string) + | INFIXOP4 of (string) + | INHERIT + | INITIALIZER + | INT of (int) + | LABEL of (string) + | LABELID of (string) + | LAZY + | LBRACE + | LBRACELESS + | LBRACKET + | LBRACKETBAR + | LBRACKETLESS + | LESS + | LESSMINUS + | LET + | LIDENT of (string) + | LPAREN + | MATCH + | METHOD + | MINUSGREATER + | MODULE + | MUTABLE + | NEW + | OBJECT + | OF + | OPEN + | OR + | PARSER + | PREFIXOP of (string) + | PRIVATE + | QUESTION + | QUESTION2 + | QUOTE + | RBRACE + | RBRACKET + | REC + | RPAREN + | SEMI + | SEMISEMI + | SHARP + | SIG + | STAR + | STRING of (string) + | STRUCT + | SUBTRACTIVE of (string) + | THEN + | TO + | TRUE + | TRY + | TYPE + | UIDENT of (string) + | UNDERSCORE + | VAL + | VIRTUAL + | WHEN + | WHILE + | WITH + +type error = + | Illegal_character of char + | Unterminated_comment + | Unterminated_string + | Unterminated_string_in_comment +;; + +exception Error of error * int * int + +(* The table of keywords *) + +let keyword_table = + create_hashtable 149 [ + "and", AND; + "as", AS; + "assert", ASSERT; + "begin", BEGIN; + "class", CLASS; + "constraint", CONSTRAINT; + "do", DO; + "done", DONE; + "downto", DOWNTO; + "else", ELSE; + "end", END; + "exception", EXCEPTION; + "external", EXTERNAL; + "false", FALSE; + "for", FOR; + "fun", FUN; + "function", FUNCTION; + "functor", FUNCTOR; + "if", IF; + "in", IN; + "include", INCLUDE; + "inherit", INHERIT; + "initializer", INITIALIZER; + "lazy", LAZY; + "let", LET; + "match", MATCH; + "method", METHOD; + "module", MODULE; + "mutable", MUTABLE; + "new", NEW; + "object", OBJECT; + "of", OF; + "open", OPEN; + "or", OR; + "parser", PARSER; + "private", PRIVATE; + "rec", REC; + "sig", SIG; + "struct", STRUCT; + "then", THEN; + "to", TO; + "true", TRUE; + "try", TRY; + "type", TYPE; + "val", VAL; + "virtual", VIRTUAL; + "when", WHEN; + "while", WHILE; + "with", WITH; + + "mod", INFIXOP3("mod"); + "land", INFIXOP3("land"); + "lor", INFIXOP3("lor"); + "lxor", INFIXOP3("lxor"); + "lsl", INFIXOP4("lsl"); + "lsr", INFIXOP4("lsr"); + "asr", INFIXOP4("asr") +] + +(* To buffer string literals *) + +let initial_string_buffer = String.create 256 +let string_buff = ref initial_string_buffer +let string_index = ref 0 + +let reset_string_buffer () = + string_buff := initial_string_buffer; + string_index := 0 + +let store_string_char c = + if !string_index >= String.length (!string_buff) then begin + let new_buff = String.create (String.length (!string_buff) * 2) in + String.blit (!string_buff) 0 new_buff 0 (String.length (!string_buff)); + string_buff := new_buff + end; + String.unsafe_set (!string_buff) (!string_index) c; + incr string_index + +let get_stored_string () = + let s = String.sub (!string_buff) 0 (!string_index) in + string_buff := initial_string_buffer; + s + +(* To translate escape sequences *) + +let char_for_backslash = + match Sys.os_type with + | "Unix" | "Win32" -> + begin function + | 'n' -> '\010' + | 'r' -> '\013' + | 'b' -> '\008' + | 't' -> '\009' + | c -> c + end + | "MacOS" -> + begin function + | 'n' -> '\013' + | 'r' -> '\010' + | 'b' -> '\008' + | 't' -> '\009' + | c -> c + end + | x -> fatal_error "Lexer: unknown system type" + +let char_for_decimal_code lexbuf i = + let c = 100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) + + 10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) + + (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in + Char.chr(c land 0xFF) + +(* To store the position of the beginning of a string and comment *) +let string_start_pos = ref 0;; +let comment_start_pos = ref [];; + +(* Error report *) + +open Format + +let report_error ppf = function + | Illegal_character c -> + fprintf ppf "Illegal character (%s)" (Char.escaped c) + | Unterminated_comment -> + fprintf ppf "Comment not terminated" + | Unterminated_string -> + fprintf ppf "String literal not terminated" + | Unterminated_string_in_comment -> + fprintf ppf "This comment contains an unterminated string literal" +;; + +} + +let blank = [' ' '\010' '\013' '\009' '\012'] +let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_'] +let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222'] +let identchar = + ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] +let symbolchar = + ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] +let symbolchar2 = + ['!' '$' '%' '&' '*' '+' '-' '.' '/' '<' '=' '>' '?' '@' '^' '|' '~'] +(* ['!' '$' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] *) +let decimal_literal = ['0'-'9']+ +let hex_literal = '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']+ +let oct_literal = '0' ['o' 'O'] ['0'-'7']+ +let bin_literal = '0' ['b' 'B'] ['0'-'1']+ +let float_literal = + ['0'-'9']+ ('.' ['0'-'9']* )? (['e' 'E'] ['+' '-']? ['0'-'9']+)? + +rule token = parse + blank + + { token lexbuf } + | "_" + { UNDERSCORE } + | lowercase identchar * ':' [ ^ ':' '=' '>'] + { let s = Lexing.lexeme lexbuf in + lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1; + LABEL (String.sub s 0 (String.length s - 2)) } +(* + | lowercase identchar * ':' + { let s = Lexing.lexeme lexbuf in + LABEL (String.sub s 0 (String.length s - 1)) } + | '%' lowercase identchar * +*) + | ':' lowercase identchar * + { let s = Lexing.lexeme lexbuf in + let l = String.length s - 1 in + LABELID (String.sub s 1 l) } + | lowercase identchar * + { let s = Lexing.lexeme lexbuf in + try + Hashtbl.find keyword_table s + with Not_found -> + LIDENT s } + | uppercase identchar * + { UIDENT(Lexing.lexeme lexbuf) } (* No capitalized keywords *) + | decimal_literal | hex_literal | oct_literal | bin_literal + { INT (int_of_string(Lexing.lexeme lexbuf)) } + | float_literal + { FLOAT (Lexing.lexeme lexbuf) } + | "\"" + { reset_string_buffer(); + let string_start = Lexing.lexeme_start lexbuf in + string_start_pos := string_start; + string lexbuf; + lexbuf.Lexing.lex_start_pos <- + string_start - lexbuf.Lexing.lex_abs_pos; + STRING (get_stored_string()) } + | "'" [^ '\\' '\''] "'" + { CHAR(Lexing.lexeme_char lexbuf 1) } + | "'" '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'" + { CHAR(char_for_backslash (Lexing.lexeme_char lexbuf 2)) } + | "'" '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" + { CHAR(char_for_decimal_code lexbuf 2) } + | "(*" + { comment_start_pos := [Lexing.lexeme_start lexbuf]; + comment lexbuf; + token lexbuf } + | "(*)" + { let loc = { Location.loc_start = Lexing.lexeme_start lexbuf; + Location.loc_end = Lexing.lexeme_end lexbuf - 1; + Location.loc_ghost = false } + and warn = Warnings.Comment "the start of a comment" + in + Location.prerr_warning loc warn; + comment_start_pos := [Lexing.lexeme_start lexbuf]; + comment lexbuf; + token lexbuf + } + | "*)" + { let loc = { Location.loc_start = Lexing.lexeme_start lexbuf; + Location.loc_end = Lexing.lexeme_end lexbuf; + Location.loc_ghost = false } + and warn = Warnings.Comment "not the end of a comment" + in + Location.prerr_warning loc warn; + lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1; + STAR + } + | "#" [' ' '\t']* ['0'-'9']+ [^ '\n' '\r'] * ('\n' | '\r' | "\r\n") + (* # linenum ... *) + { token lexbuf } + | "#" { SHARP } + | "&" { AMPERSAND } + | "&&" { AMPERAMPER } + | "`" { BACKQUOTE } + | "'" { QUOTE } + | "(" { LPAREN } + | ")" { RPAREN } + | "*" { STAR } + | "," { COMMA } + | "?" { QUESTION } + | "??" { QUESTION2 } + | "->" { MINUSGREATER } + | "." { DOT } + | ".." { DOTDOT } + | ":" { COLON } + | "::" { COLONCOLON } + | ":=" { COLONEQUAL } + | ":>" { COLONGREATER } + | ";" { SEMI } + | ";;" { SEMISEMI } + | "<" { LESS } + | "<-" { LESSMINUS } + | "=" { EQUAL } + | "[" { LBRACKET } + | "[|" { LBRACKETBAR } + | "[<" { LBRACKETLESS } + | "]" { RBRACKET } + | "{" { LBRACE } + | "{<" { LBRACELESS } + | "|" { BAR } + | "||" { BARBAR } + | "|]" { BARRBRACKET } + | ">" { GREATER } + | ">]" { GREATERRBRACKET } + | "}" { RBRACE } + | ">}" { GREATERRBRACE } + + | "!=" { INFIXOP0 "!=" } + | "-" { SUBTRACTIVE "-" } + | "-." { SUBTRACTIVE "-." } + + | ['!' '~'] symbolchar * + { PREFIXOP(Lexing.lexeme lexbuf) } + | '?' symbolchar2 * + { PREFIXOP(Lexing.lexeme lexbuf) } + | ['=' '<' '>' '|' '&' '$'] symbolchar * + { INFIXOP0(Lexing.lexeme lexbuf) } + | ['@' '^'] symbolchar * + { INFIXOP1(Lexing.lexeme lexbuf) } + | ['+' '-'] symbolchar * + { INFIXOP2(Lexing.lexeme lexbuf) } + | "**" symbolchar * + { INFIXOP4(Lexing.lexeme lexbuf) } + | ['*' '/' '%'] symbolchar * + { INFIXOP3(Lexing.lexeme lexbuf) } + | eof { EOF } + | _ + { raise (Error(Illegal_character ((Lexing.lexeme lexbuf).[0]), + Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) } + +and comment = parse + "(*" + { comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos; + comment lexbuf; + } + | "*)" + { match !comment_start_pos with + | [] -> assert false + | [x] -> () + | _ :: l -> comment_start_pos := l; + comment lexbuf; + } + | "\"" + { reset_string_buffer(); + string_start_pos := Lexing.lexeme_start lexbuf; + begin try string lexbuf + with Error (Unterminated_string, _, _) -> + let st = List.hd !comment_start_pos in + raise (Error (Unterminated_string_in_comment, st, st + 2)) + end; + string_buff := initial_string_buffer; + comment lexbuf } + | "''" + { comment lexbuf } + | "'" [^ '\\' '\''] "'" + { comment lexbuf } + | "'\\" ['\\' '\'' 'n' 't' 'b' 'r'] "'" + { comment lexbuf } + | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" + { comment lexbuf } + | eof + { let st = List.hd !comment_start_pos in + raise (Error (Unterminated_comment, st, st + 2)); + } + | _ + { comment lexbuf } + +and string = parse + '"' + { () } + | '\\' ("\010" | "\013" | "\013\010") [' ' '\009'] * + { string lexbuf } + | '\\' ['\\' '"' 'n' 't' 'b' 'r'] + { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1)); + string lexbuf } + | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] + { store_string_char(char_for_decimal_code lexbuf 1); + string lexbuf } + | eof + { raise (Error (Unterminated_string, + !string_start_pos, !string_start_pos+1)) } + | _ + { store_string_char(Lexing.lexeme_char lexbuf 0); + string lexbuf } diff --git a/tools/ocaml299to3.ml b/tools/ocaml299to3.ml new file mode 100644 index 000000000..c3f37ae44 --- /dev/null +++ b/tools/ocaml299to3.ml @@ -0,0 +1,122 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Jacques Garrigue, Kyoto University RIMS *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +open Lexer299 + +let input_buffer = Buffer.create 16383 +let input_function ic ~buf ~len = + let len = input ic ~buf ~pos:0 ~len in + Buffer.add_substring input_buffer buf ~pos:0 ~len; + len + +let output_buffer = Buffer.create 16383 + +let modified = ref false + +let convert buffer = + let input_pos = ref 0 in + let copy_input stop = + Buffer.add_substring output_buffer (Buffer.contents input_buffer) + ~pos:!input_pos ~len:(stop - !input_pos); + input_pos := stop + in + let last = ref (EOF, 0, 0) in + try while true do + let token = Lexer299.token buffer + and start = Lexing.lexeme_start buffer + and stop = Lexing.lexeme_end buffer + and last_token, last_start, last_stop = !last in + begin match token with + | LABEL l -> + begin match last_token with + | PREFIXOP "?(" -> + modified := true; + copy_input last_start; + Buffer.add_char output_buffer '?'; + Buffer.add_string output_buffer l; + Buffer.add_string output_buffer ":("; + input_pos := stop + | QUESTION | LPAREN | LBRACE | SEMI | MINUSGREATER + | EQUAL | COLON | COLONGREATER + | VAL | MUTABLE | EXTERNAL | METHOD | OF -> + () + | _ -> + modified := true; + copy_input start; + Buffer.add_char output_buffer '~'; + copy_input stop + end + | LABELID l -> + modified := true; + begin match last_token with + | PREFIXOP "?(" -> + copy_input last_start; + Buffer.add_string output_buffer "?("; + Buffer.add_string output_buffer l; + input_pos := stop + | QUESTION -> + copy_input last_stop; + Buffer.add_string output_buffer l; + input_pos := stop + | _ -> + copy_input start; + Buffer.add_char output_buffer '~'; + Buffer.add_string output_buffer l; + input_pos := stop + end + | EOF -> raise End_of_file + | _ -> () + end; + if last_token = QUESTION && token = LPAREN then + last := (PREFIXOP "?(", last_start, stop) + else + last := (token, start, stop) + done with + End_of_file -> + copy_input (Buffer.length input_buffer) + +let convert_file name = + let ic = open_in name in + Buffer.clear input_buffer; + Buffer.clear output_buffer; + modified := false; + begin + try convert (Lexing.from_function (input_function ic)); close_in ic + with exn -> close_in ic; raise exn + end; + if !modified then begin + let backup = name ^ ".bak" in + if Sys.file_exists backup then Sys.remove backup; + Sys.rename name backup; + let oc = open_out name in + Buffer.output_buffer oc output_buffer; + close_out oc + end + +let _ = + if Array.length Sys.argv < 2 || Sys.argv.(1) = "-h" || Sys.argv.(1) = "-help" + then begin + print_endline "Usage: ocaml299to3 <source file> ..."; + print_endline "Description:"; + print_endline + "Convert Objective Caml implementation or interface files to a syntax"; + print_endline + "compatible with version 3. Old files are renamed to <file>.bak."; + exit 0 + end; + for i = 1 to Array.length Sys.argv - 1 do + let name = Sys.argv.(i) in + prerr_endline ("Converting " ^ name); + Printexc.catch convert_file name + done diff --git a/tools/ocaml2to3.mll b/tools/ocaml2to3.mll deleted file mode 100644 index 89957b0c9..000000000 --- a/tools/ocaml2to3.mll +++ /dev/null @@ -1,243 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Jacques Garrigue, Kyoto University RIMS *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the Q Public License version 1.0. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -(* The lexer definition *) - -{ - -type error = - | Illegal_character - | Unterminated_comment - | Unterminated_string - | Unterminated_string_in_comment -;; - -exception Error of error * int * int - -(* To store the position of the beginning of a string and comment *) -let string_start_pos = ref 0 -and comment_start_pos = ref [] -;; - -(* Error report *) - -let report_error = function - Illegal_character -> - prerr_string "Illegal character" - | Unterminated_comment -> - prerr_string "Comment not terminated" - | Unterminated_string -> - prerr_string "String literal not terminated" - | Unterminated_string_in_comment -> - prerr_string "This comment contains an unterminated string literal" -;; - -let modified = ref false ;; - -let b = Buffer.create 1024 ;; - -} - -let blank = [' ' '\010' '\013' '\009' '\012'] -let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255' '_'] -let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222'] -let identchar = - ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] -let symbolchar = - ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] -let symbolchar2 = - ['!' '$' '%' '&' '*' '+' '-' '.' '/' '<' '=' '>' '?' '@' '^' '|' '~'] -let decimal_literal = ['0'-'9']+ -let hex_literal = '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']+ -let oct_literal = '0' ['o' 'O'] ['0'-'7']+ -let bin_literal = '0' ['b' 'B'] ['0'-'1']+ -let float_literal = - ['0'-'9']+ ('.' ['0'-'9']*)? (['e' 'E'] ['+' '-']? ['0'-'9']+)? - -rule token = parse - lowercase identchar * ':' [ ^ ':' '=' '>'] - { let s = Lexing.lexeme lexbuf in - lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 2; - Buffer.add_string b (String.sub s 0 (String.length s - 2)); - Buffer.add_string b " "; - modified := true; - token lexbuf } - | ':' lowercase identchar * - { let s = Lexing.lexeme lexbuf in - Buffer.add_string b ": "; - Buffer.add_string b (String.sub s 1 (String.length s - 1)); - modified := true; - token lexbuf } - | "\"" - { string_start_pos := Lexing.lexeme_start lexbuf; - Buffer.add_string b "\""; - string lexbuf; - token lexbuf } - | "(*" - { comment_start_pos := [Lexing.lexeme_start lexbuf]; - Buffer.add_string b "(*"; - comment lexbuf; - token lexbuf } - | "?" - { Buffer.add_string b "??"; - modified := true; - token lexbuf } - | blank + - | "_" - | lowercase identchar * - | uppercase identchar * - | decimal_literal | hex_literal | oct_literal | bin_literal - | float_literal - | "'" [^ '\\' '\''] "'" - | "'" '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'" - | "'" '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" - | "#" [' ' '\t']* ['0'-'9']+ [^ '\n' '\r'] * ('\n' | '\r' | "\r\n") - | "#" - | "&" - | "&&" - | "`" - | "'" - | "(" - | ")" - | "*" - | "," - | "??" - | "->" - | "." - | ".." - | ":" - | "::" - | ":=" - | ":>" - | ";" - | ";;" - | "<" - | "<-" - | "=" - | "[" - | "[|" - | "[<" - | "]" - | "{" - | "{=" - | "{<" - | "|" - | "||" - | "|]" - | ">" - | ">]" - | "}" - | ">}" - | "!=" - | "-" - | "-." - | ['!' '~'] symbolchar * - | '?' symbolchar2 * - | ['=' '<' '>' '|' '&' '$'] symbolchar * - | ['@' '^'] symbolchar * - | ['+' '-'] symbolchar * - | "**" symbolchar * - | ['*' '/' '%'] symbolchar * - { Buffer.add_string b (Lexing.lexeme lexbuf); - token lexbuf } - | eof { () } - | _ - { raise (Error(Illegal_character, - Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) } - -and comment = parse - "(*" - { comment_start_pos := Lexing.lexeme_start lexbuf :: !comment_start_pos; - Buffer.add_string b "(*"; - comment lexbuf; - } - | "*)" - { Buffer.add_string b "*)"; - match !comment_start_pos with - | [] -> assert false - | [x] -> () - | _ :: l -> comment_start_pos := l; - comment lexbuf; - } - | "\"" - { string_start_pos := Lexing.lexeme_start lexbuf; - Buffer.add_string b "\""; - begin try string lexbuf - with Error (Unterminated_string, _, _) -> - let st = List.hd !comment_start_pos in - raise (Error (Unterminated_string_in_comment, st, st + 2)) - end; - comment lexbuf } - | eof - { let st = List.hd !comment_start_pos in - raise (Error (Unterminated_comment, st, st + 2)); - } - | "''" - | "'" [^ '\\' '\''] "'" - | "'\\" ['\\' '\'' 'n' 't' 'b' 'r'] "'" - | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" - | _ - { Buffer.add_string b (Lexing.lexeme lexbuf); - comment lexbuf } - -and string = parse - '"' - { Buffer.add_char b '"' } - | eof - { raise (Error (Unterminated_string, - !string_start_pos, !string_start_pos+1)) } - | '\\' ("\010" | "\013" | "\013\010") [' ' '\009'] * - | '\\' ['\\' '"' 'n' 't' 'b' 'r'] - | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] - | _ - { Buffer.add_string b (Lexing.lexeme lexbuf); - string lexbuf } - -{ - -let convert_file name = - let ic = open_in name in - Buffer.clear b; - modified := false; - begin - try token (Lexing.from_channel ic); close_in ic - with exn -> close_in ic; raise exn - end; - if !modified then begin - let backup = name ^ ".bak" in - if Sys.file_exists backup then Sys.remove backup; - Sys.rename name backup; - let oc = open_out name in - Buffer.output_buffer oc b; - close_out oc - end - -let _ = - if Array.length Sys.argv < 2 || Sys.argv.(1) = "-h" || Sys.argv.(1) = "-help" - then begin - print_endline "Usage: ocaml2to3 <source file> ..."; - print_endline "Description:"; - print_endline - "Convert Objective Caml implementation or interface files to a syntax"; - print_endline - "compatible with version 3. Old files are renamed to <file>.bak."; - exit 0 - end; - for i = 1 to Array.length Sys.argv - 1 do - let name = Sys.argv.(i) in - prerr_endline ("Converting " ^ name); - Printexc.catch convert_file name - done - -} |