ocaml/tools/convert

234 lines
7.7 KiB
Perl
Executable File

#!/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
$_ = <IN>;
if (/^\(\*/) {
do convert();
while (! /\*\)/) { $_ = <IN>; do convert(); }
$_ = <IN>;
}
while(/^$/ || /^#open / || /^{$/) {
do convert();
$_ = <IN>;
}
$saved = $_;
$copy = 0;
# Copy and translate manifest definitions from the .mli
while(<INTERFACE>) {
$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(<IN>) {
do convert();
}
} else {
# For other kinds of files (.mli, .mly), just copy as is
while(<IN>) {
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 $_;
}