#!/usr/bin/perl
# Copyright (C) 2008, The Perl Foundation.
# $Id: /mirror/trunk/languages/perl6/build/gen_junction_pir.pl 34872 2009-01-03T00:56:48.127804Z pmichaud  $

use strict;
use warnings;

my @binary = qw(
  infix:**
  infix:* infix:/ infix:% infix:div infix:mod
  infix:+ infix:-
  infix:~
  infix:== infix:!= infix:<  infix:>  infix:<= infix:>=
  infix:eq infix:ne infix:lt infix:gt infix:le infix:ge
  infix:<=> infix:leg infix:cmp infix:eqv infix:=:=
);

my @unary = qw(
  prefix:++ prefix:-- postfix:++ postfix:--
);

my $output = $ARGV[0] || '-';

open my $fh, "> $output" or die "Could not write $output: $!";

for (@unary) {
    print $fh qq(
        .namespace []
        .sub '$_' :multi('Junction')
            .param pmc x
            .tailcall '!DISPATCH_JUNCTION'('$_', x)
        .end
    );
}

for (@binary) {
    print $fh qq(
        .namespace []
        .sub '$_' :multi('Junction', _)
            .param pmc x
            .param pmc y
            .tailcall '!DISPATCH_JUNCTION'('$_', x, y)
        .end

        .sub '$_' :multi(_, 'Junction')
            .param pmc x
            .param pmc y
            .tailcall '!DISPATCH_JUNCTION'('$_', x, y)
        .end
    );
}

close $fh;
0;
