overload.pl

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # Generate overload.h
   5 # This allows the order of overloading constants to be changed.
   6 #
   7
   8 BEGIN {
   9     # Get function prototypes
  10     require 'regen_lib.pl';
  11 }
  12
  13 use strict;
  14
  15 my (@enums, @names);
  16 while (<DATA>) {
  17   next if /^#/;
  18   next if /^$/;
  19   my ($enum, $name) = /^(\S+)\s+(\S+)/ or die "Can't parse $_";
  20   push @enums, $enum;
  21   push @names, $name;
  22 }
  23
  24 safer_unlink 'overload.h';
  25 die "overload.h: $!" unless open(H, ">overload.h");
  26 binmode H;
  27 select H;
  28 print <<'EOF';
  29 /* -*- buffer-read-only: t -*-
  30  *
  31  *    overload.h
  32  *
  33  *    Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall
  34  *    and others
  35  *
  36  *    You may distribute under the terms of either the GNU General Public
  37  *    License or the Artistic License, as specified in the README file.
  38  *
  39  *  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  40  *  This file is built by overload.pl
  41  */
  42
  43 enum {
  44 EOF
  45
  46 print "    ${_}_amg,\n", foreach @enums;
  47
  48 print <<'EOF';
  49     max_amg_code
  50     /* Do not leave a trailing comma here.  C9X allows it, C89 doesn't. */
  51 };
  52
  53
  54 #define NofAMmeth max_amg_code
  55 #define AMG_id2name(id) (PL_AMG_names[id]+1)
  56
  57 #ifdef DOINIT
  58 EXTCONST char * const PL_AMG_names[NofAMmeth] = {
  59   /* Names kept in the symbol table.  fallback => "()", the rest has
  60      "(" prepended.  The only other place in perl which knows about
  61      this convention is AMG_id2name (used for debugging output and
  62      'nomethod' only), the only other place which has it hardwired is
  63      overload.pm.  */
  64 EOF
  65
  66 my $last = pop @names;
  67 print "    \"$_\",\n" foreach map { s/(["\\"])/\\$1/g; $_ } @names;
  68
  69 print <<"EOT";
  70     "$last"
  71 };
  72 #else
  73 EXTCONST char * PL_AMG_names[NofAMmeth];
  74 #endif /* def INITAMAGIC */
  75 EOT
  76
  77 close H or die $!;
  78
  79 __DATA__
  80 # Fallback should be the first
  81 fallback        ()
  82
  83 # These 5 are the most common in the fallback switch statement in amagic_call
  84 to_sv           (${}
  85 to_av           (@{}
  86 to_hv           (%{}
  87 to_gv           (*{}
  88 to_cv           (&{}
  89
  90 # These have non-default cases in that switch statement
  91 inc             (++
  92 dec             (--
  93 bool_           (bool
  94 numer           (0+
  95 string          (""
  96 not             (!
  97 copy            (=
  98 abs             (abs
  99 neg             (neg
 100 iter            (<>
 101 int             (int
 102
 103 # These 12 feature in the next switch statement
 104 lt              (<
 105 le              (<=
 106 gt              (>
 107 ge              (>=
 108 eq              (==
 109 ne              (!=
 110 slt             (lt
 111 sle             (le
 112 sgt             (gt
 113 sge             (ge
 114 seq             (eq
 115 sne             (ne
 116
 117 nomethod        (nomethod
 118 add             (+
 119 add_ass         (+=
 120 subtr           (-
 121 subtr_ass       (-=
 122 mult            (*
 123 mult_ass        (*=
 124 div             (/
 125 div_ass         (/=
 126 modulo          (%
 127 modulo_ass      (%=
 128 pow             (**
 129 pow_ass         (**=
 130 lshift          (<<
 131 lshift_ass      (<<=
 132 rshift          (>>
 133 rshift_ass      (>>=
 134 band            (&
 135 band_ass        (&=
 136 bor             (|
 137 bor_ass         (|=
 138 bxor            (^
 139 bxor_ass        (^=
 140 ncmp            (<=>
 141 scmp            (cmp
 142 compl           (~
 143 atan2           (atan2
 144 cos             (cos
 145 sin             (sin
 146 exp             (exp
 147 log             (log
 148 sqrt            (sqrt
 149 repeat          (x
 150 repeat_ass      (x=
 151 concat          (.
 152 concat_ass      (.=
 153 smart           (~~
 154 # Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry
 155 DESTROY         DESTROY