naml/make_tast_type.pl

   1 #!/usr/bin/perl
   2 # utility to convert a string representing an ocaml type to a string representing the Tast type construct
   3 # currently does only very very simple types, and makes a lot of assumptions
   4
   5 use strict;
   6
   7 my %typesub = (
   8         'int' => 'TyInt',
   9         'char' => 'TyChar',
  10         'float' => 'TyFloat',
  11         'exn' => 'TyExn',
  12         'string' => 'TyArray TyChar',
  13         'bool' => 'bool_ty',
  14         'unit' => 'unit_ty'
  15 );
  16
  17 sub do_base ($)
  18 {
  19         local $_ = shift;
  20         if (/^(.*)array$/)
  21         {
  22                 return "TyArray " . do_base($1)
  23         }
  24         elsif (exists $typesub{$_})
  25         {
  26                 return $typesub{$_}
  27         }
  28         else
  29         {
  30                 return $_
  31         }
  32 }
  33
  34 sub do_tuple ($)
  35 {
  36         local $_ = shift;
  37         my @t = split /\*/;
  38         if (@t > 1)
  39         {
  40                 return 'TyTuple [' . join('; ', map { do_base $_ } @t) . ']';
  41         }
  42         else
  43         {
  44                 return do_base @t[0];
  45         }
  46 }
  47
  48 sub do_fun ($)
  49 {
  50         local $_ = shift;
  51         my @t = split /->/;
  52         if (@t > 1)
  53         {
  54                 my $ret = pop @t;
  55                 my @args = map { do_tuple $_ } @t;
  56                 return 'TyFun ([' . join('; ', @args) . '], ' . do_tuple($ret) . ')';
  57         }
  58         else
  59         {
  60                 return do_tuple @t[0];
  61         }
  62 }
  63
  64 sub make_type ($)
  65 {
  66         local $_ = shift;
  67         s/\s//g; # it just gets in the way, and we don't support constructed types
  68         $_ = do_fun($_);
  69         my $a = 'a';
  70         while (/'$a/)
  71         {
  72                 s/'$a/$a/g;
  73                 $_ = "let $a = TyVar (new_symbol_string \"$a\") in $_";
  74                 $a++;
  75         }
  76         return $_;
  77 }
  78
  79 if (@ARGV)
  80 {
  81         print make_type("@ARGV"), "\n";
  82         exit;
  83 }
  84
  85 while (<>)
  86 {
  87         chomp;
  88         print make_type($_), "\n";
  89 }