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