%token CONST
%token VAR
%token IMP
%token FUN
%token LPAREN
%token RPAREN
%token APP

%nonassoc FUN
%nonassoc VAR CONST LPAREN
%left APP

%%

expr: CONST { my $litval = $_[1]; sub { $litval } }
    | VAR { my $varname = $_[1]; sub { my %args_ = @_; $args_{$varname} } }
    | FUN VAR IMP expr { my ($param, $term) = ($_[2], $_[4]); sub { my %args = @_; sub { $args{$param} = shift; $term->(%args) } } }
    | LPAREN expr RPAREN { $_[2] }
    | expr expr %prec APP { my ($op, $arg) = ($_[1], $_[2]); sub { my %args_ = @_; $op->(%args_)->($arg->(%args_)) } }
;

%%

##</code><code>##

#!/usr/bin/perl

# These are only decoration. The superiors hardly understand this.

use strict;
use warnings;

use Parse::Lex;
use utlc;

my @tokens = (
    qw (
        LPAREN      [\(]
        RPAREN      [\)]
        FUN         [\\\\]
        IMP         [.]
        VAR         [A-Za-z_][A-Za-z_0-9]*
        CONST       [1-9][0-9]*
    )
);

our $lexer = Parse::Lex->new(@tokens);
$lexer->skip('\s+');

sub lexana {
    my $token = $lexer->next;
    if (not $lexer->eoi) {
        return ($token->name, $token->text);
    } else {
        return ('', undef);
    }
}

# $lexer->from(\*STDIN);
$lexer->from('\f.(\x.(f (\y.x x y))) (\x.(f (\y.x x y)))');

my $parser = utlc->new();
my $expr = $parser->YYParse(yylex => \&lexana);

#print $expr->(), "\n";

# \f.\x.(=0 x) 1 (* x (f (- x 1)))
sub fac {
    my $f = shift;
    sub {
        my $x = shift;
        ($x) ? ($x * $f->($x - 1)) : (1)
    }
}

# \f.(\x.(f (\y.x x y))) (\x.(f (\y.x x y)))
print $expr->()->(\&fac)->(5), "\n";