#!/usr/local/bin/perl # Conversion of a Caml Light 0.7 file to Caml Special Light. # The conversion table $convtbl= "value val int_of_float truncate float_of_int float vect array fast_really_input unsafe_really_input io__exit exit vect_length Array.length make_vect Array.create make_matrix Array.create_matrix concat_vect Array.concat sub_vect Array.sub copy_vect Array.copy fill_vect Array.fill blit_vect Array.blit do_vect Array.iter map_vect Array.map vect_of_list Array.of_list list_of_vect Array.to_list int_of_char Char.code char_of_int Char.chr char_for_read Char.escaped fchar__char_of_int Char.unsafe_chr hashtbl__do_table Hashtbl.iter do_table Hashtbl.iter lexing__create_lexer_channel Lexing.from_channel lexing__create_lexer_string Lexing.from_string lexing__create_lexer Lexing.from_function lexing__get_lexeme Lexing.lexeme lexing__get_lexeme_char Lexing.lexeme_char lexing__get_lexeme_start Lexing.lexeme_start lexing__get_lexeme_end Lexing.lexeme_end create_lexer_channel Lexing.from_channel create_lexer_string Lexing.from_string create_lexer Lexing.from_function get_lexeme Lexing.lexeme get_lexeme_char Lexing.lexeme_char get_lexeme_start Lexing.lexeme_start get_lexeme_end Lexing.lexeme_end list_length List.length rev List.rev flatten List.flatten do_list List.iter map List.map it_list List.fold_left list_it List.fold_right do_list2 List.iter2 map2 List.map2 iter2 List.iter2 it_list2 List.fold_left2 list_it2 List.fold_right2 for_all List.for_all exists List.exists mem List.mem assoc List.assoc mem_assoc List.mem_assoc assq List.assq split List.split combine List.combine obj__obj Obj.t obj__repr Obj.repr obj__magic_obj Obj.magic obj__magic Obj.magic obj__is_block Obj.is_block obj__obj_tag Obj.tag obj__obj_size Obj.size obj__obj_field Obj.field obj__set_obj_field Obj.set_field obj__obj_block Obj.new_block obj__update Obj.update magic_obj Obj.magic magic Obj.magic is_block Obj.is_block obj_tag Obj.tag obj_size Obj.size obj_field Obj.field set_obj_field Obj.set_field obj_block Obj.new_block printexc__f Printexc.catch sort__sort Sort.list sort Sort.list string_length String.length nth_char String.get set_nth_char String.set sub_string String.sub create_string String.create make_string String.make fill_string String.fill blit_string String.blit string_for_read String.escaped fstring__nth_char String.unsafe_get fstring__set_nth_char String.unsafe_set fstring__blit_string String.unsafe_blit sys__Sys_error Sys_error sys__exit exit sys__command_line Sys.argv sys__O_RDONLY Sys.Open_rdonly sys__O_WRONLY Sys.Open_wronly sys__O_RDWR Sys.Open_rdwr sys__O_APPEND Sys.Open_append sys__O_CREAT Sys.Open_creat sys__O_TRUNC Sys.Open_trunc sys__O_EXCL Sys.Open_excl sys__O_BINARY Sys.Open_binary sys__O_TEXT Sys.Open_text sys__open Sys.open_desc sys__close Sys.close_desc sys__system_command Sys.command system_command Sys.command command_line Sys.argv O_RDONLY Sys.Open_rdonly O_WRONLY Sys.Open_wronly O_RDWR Sys.Open_rdwr O_APPEND Sys.Open_append O_CREAT Sys.Open_creat O_TRUNC Sys.Open_trunc O_EXCL Sys.Open_excl O_BINARY Sys.Open_binary O_TEXT Sys.Open_text"; # Initialize the table %conv %conv = split(/\s+/, $convtbl); # Parse options $_ = $ARGV[0]; $keep_semisemi = 1, shift if /^-semi/; # Open input. $infile = $ARGV[0]; open(IN, $infile) || die("Cannot open $infile"); $interface = ($infile =~ /\.mli$/); # If it's a .ml or .mll file: we must insert definitions from the .mli # before the first definition if ($infile =~ /^(.*)\.(ml|mll)$/ && open(INTERFACE, "$1.mli")) { # Copy and translate the header of the file (first comment and #open decls) # Stop at first definition $_ = ; if (/^\(\*/) { do convert(); while (! /\*\)/) { $_ = ; do convert(); } $_ = ; } while(/^$/ || /^#open / || /^{$/) { do convert(); $_ = ; } $saved = $_; $copy = 0; # Copy and translate manifest definitions from the .mli while() { $copy = 1 if /^type .*=/ || /^#open/ || /^exception/; $copy = 0 if /^type [^=]*$/ || /^value /; do convert() if $copy; } close(INTERFACE); $_ = $saved; # Finish translation of main file do convert(); while() { do convert(); } } else { # For other kinds of files (.mli, .mly), just copy as is while() { do convert(); } } close(IN); # Convert and print one line (in $_) sub convert { chop; # Double-semicolon if (! $keep_semisemi) { return if /^;;\s*$/; s/;;//; } # Identifiers that have been renamed s/([A-Za-z][A-Za-z0-9'_]*(__[A-Za-z][A-Za-z0-9'_]*)?)/$conv{$1} || $1/eg; # 'type glop == tau' s/((type|and)\s+(\(.*\)\s+|'[a-z]\s+)?[A-Za-z][A-Za-z0-9'_]*\s+)==/\1=/; # 'and' for values in .mli files -- what a terrible hack! if ($interface) { s/^ and\b/val/; } # Open if (s/#\s*open\s*"([^"]*)"/"open " . do capitalize($1)/e) { /open ([A-Za-z0-9_']+)/; return if $opened{$1}; $opened{$1} = 1; } # Module references s/([A-Za-z][A-Za-z0-9_']*)__/do capitalize($1) . "."/eg; # Character literals s/`([^\\]|\\[\\`ntbr]|\\[0-9][0-9][0-9])`/do convert_char($1)/eg; # Over! print $_, "\n"; } close(IN); close(OUT); # Capitalize a string sub capitalize { local ($_) = @_; m/^(.)(.*)/; $hd = $1; $tl = $2; $hd =~ tr/a-z/A-Z/; return $hd . $tl; } # Convert a character literal sub convert_char { local ($_) = @_; s/\\`/`/; s/'/\\'/; s/^/'/; s/$/'/; return $_; }