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