See the attached file. Save it anywhere, make it executable, that is all.
I had to make some last minute changes, hopefully this didn't break the code
which I didn't touch almost a year...
NOTE! I do not want to use any module/library, so it doesn't use File::Temp
and simply assumes that the temp dir is "/tmp"; you can change $TMPDIR at the
start if this is not correct on your system. fpp will create/remove a couple
of __FPP__.* files in this directory.
Currently it simply ignores import/library. If you want to put the FPP() code
into some.lib, you will need to use fpp_import/fpp_export instead.
IOW, import("file-with-FPP-code") won't work; fpp_import("file-with-FPP-code")
or fpp_library("file-with-FPP-code") should (mostly) work.
The search path for fpp_import/fpp_library is @INCDIR at the start of fpp,
you should probably change it if you want to use fpp_import/fpp_library.
Currently it blindly passes almost all options to /usr/bin/faust, so it will
randomly fail if faust outputs anything but C/C++ code in scalar mode.
Oleg.
#!/usr/bin/perl -w
use strict;
our $TMPDIR = '/tmp';
our @INCDIR = qw(/home/oleg/FAUST/LIB /home/oleg/FAUST/faust.git/libraries);
#------------------------------------------------------------------------------
package re;
our $bal_cur = '(?:\{(?:(?>[^\{\}]+)|(?-1))*\})';
our $bal_par = $bal_cur =~ tr/{}/()/r;
our $bal_sqr = $bal_cur =~ tr/{}/[]/r;
sub qr { my $r = join '',@_; qr/$r/; }
sub list { join '|', map "(?:$_)", @_; }
sub chop2($) { substr $_[0], +1,-1 }
sub chop2s($) { &chop2 =~ s/^\s+|\s+$//gr }
sub split_args(_)
{
my ($a, @a) = &chop2;
push @a, $& =~ s/^\s+|\s+$//gr
while $a =~ /(?: ($re::bal_par) | [^,])+/oxg;
return @a;
}
#------------------------------------------------------------------------------
package perl::core;
sub __z_expr($$) { $_[0] }
sub __z_pure($$) { &pp_cpp::zmap =~ /^\w+\[[^]]+\]$/ ? 1 : 0 }
sub __z_iota($$) { &pp_cpp::zmap =~ /\bIOTA\b/ ? 1 : 0 }
sub __z_item($$$)
{
my ($vec, $len, $idx) = @_;
$idx =~ s/^\(([+-]?\w+)\)$/$1/;
my $expr = &pp_cpp::zmap ||
return $vec eq '0' || $idx eq '0' && $len eq '0' ?
$vec : die "bad delay line: '$vec' [$idx]\n";
# my @inp = pp_cpp::inputs($expr);
# warn "WARN! delay line '$vec' inputs: @inp\n" if @inp;
$expr =~ /\[(\(\((?:dsp->)?IOTA\s*-\s*)?/g;
my $full = $1 ? "$idx + $len - " : "$idx - $len + ";
$expr =~ s/\G(\Q$len\E\b)?/defined $1 ? $idx : $full/er;
}
sub __l_len($) { 0 + &re::split_args }
sub __l_item($$)
{
my @l = re::split_args (my $l = shift);
@_ == 1 && $_[0] =~ /^\(?(\d+)\)?$/ && $1 < @l
or die "bad list item: $l\[@_]\n";
$l[$1];
}
sub __l_for(&$$$)
{
my ($l, $i, $v, $e) = @_;
my @l = re::split_args $l;
/\W/ and die "bad .for() arguments: ($i, $v, $e)\n"
for $i, $v;
my $re = qr/\b(?:($i)|($v))\b/;
join '; ', map $e =~ s/$re/$1?$_:$l[$_]/egr, 0..$#l;
}
#------------------------------------------------------------------------------
package pp_dsp;
our (%GLOB, %INST);
sub expand_perl; sub expand_perl
{
$_[0] =~ s/\$\.(\w+)($re::bal_par)/
my $f = can perl::core:: $1
or die "undefined perl func: $1$2\n";
ord '$' == ord prototype $f
? $f->(re::split_args expand_perl $2)
: expand_perl $f->(re::split_args $2)
/oegr;
}
sub __expand_fpp
{
my ($this, $code, $args) = @_;
my ($name, $uniq) = 0+$code;
sub expand; local *expand = sub
{
my ($once, $dict, $uarg) = shift;
if ($code->{uarg}) {
while (my ($n, $a) = each %{$code->{uarg}}) {
next if $args->[$n] eq $a;
die "can't rebind arg_$n from '$a' to
'$args->[$n]'\n";
}
}
if ($once) {
$uniq = $once->{'$'} ||= {};
$code = $once->{$name}, return $this
if $once->{$name};
}
$this->{$_} .= expand_perl +($code->{$_}//next) =~ s{\$(\w+)\b}{
my $n = $1;
$dict->{$n} ||= ($n =~ /\D/)
? ("$n\__" . ++($uniq->{$n}||='00'))
: ($uarg->{$n} = $args->[$n] // die)
}egr for @_;
if ($once) {
$code = $once->{$name} = {%$code};
$code->{uarg} = $uarg if $uarg;
delete @{$code}{@_};
if (my $vars = re::list keys %$dict) {
ref or s/\$($vars)\b/$dict->{$1}/g
for values %$code;
}
}
$this;
};
expand \%GLOB, qw(FILE);
expand \%INST, qw(DECL INIT LOOP POST);
expand undef, qw(file decl init loop post exec);
}
sub expand_fpp
{
my ($func, $args) = @_;
my ($code, $this) = ($func->{code}, {});
if ($func->{deps} && !$INST{0+$code}) {
__expand_fpp $this, $_ for @{$func->{deps}};
}
shift @$args if exists $func->{arg0};
__expand_fpp $this, $code, $args;
}
my (%STRN, %FUNC, %DEPS);
sub fix_strn(_)
{
defined (wantarray)
? $_[0] =~ s/\STRN!(\d+)\b/$STRN{$1}||die/egr
: $_[0] =~ s/\STRN!(\d+)\b/$STRN{$1}||die/eg;
}
sub mk_eval($$)
{
mk_ffunc(0,$_[0],'_int_',{eval => undef, code => {exec=>$_[1]}});
}
sub mk_ffunc
{
my ($pure, $narg, $type, $func) = @_;
$func = {code => {exec => $func}} unless ref $func;
if ($type =~ /^_(int|float)_$/) { $type = $1 }
else {
$func->{type} = $type;
$type = $type =~ /^(?:float|(?:(?:long\s+)?double)|quad)$/
? 'float' : 'int';
}
my $arg0 = '';
if (0) {
} elsif (!$pure && $narg) {
CORE::state $kSamp;
$arg0 = $kSamp ||= mk_eval 0, 'BUG';
} elsif ($pure && !$narg) {
$arg0 = '0';
}
if ($arg0 ne '') {
$narg++;
$func->{arg0} = undef;
$arg0 = "($arg0)";
}
CORE::state $uniq = '000';
my $name = 'fpp_func_' . ++$uniq;
$FUNC{$name} = $func;
my $args = join ',', qw(float) x $narg;
qq{ffunction($type $name($args),"","")$arg0}
}
sub push_fpp_bus
{
CORE::state $done; return if $done++;
my $b0 = mk_eval 0, '';
my $b1 = mk_eval 1, '$0';
my $b2 = mk_eval 2, '$0,$1';
print main::FAUST "// ======== <push>\n",
"_fpp_bus_(0) = $b0; _fpp_bus_(1) = $b1;\n",
"_fpp_bus_(n) = _, _fpp_bus_(n-1) : $b2;\n";
}
sub expand_args
{
my ($argn, $argz, $argl) = @_;
my $re_argn = join '|', keys %$argn;
while (/\$($re_argn)\b/g) {
my ($arg, $pos) = ($1, pos() - 1 - length $1);
my ($out, $type, $func, @args) = '$'.$argn->{$arg};
if (defined(my $z = $argz->{$arg})) {
($func, $type, @args) = ('__z_', 'dline', $out,$z);
if (/\G\s*($re::bal_sqr)/gc) {
($func, $type) = '__z_item';
my $i = re::chop2s $1;
push @args, "($i)";
}
}
elsif (exists $argl->{$arg}) {
@args = "($out)";
if (/\G\s*($re::bal_cur)/gc) {
$func = '__l_item';
my $i = re::chop2s $1;
push @args, "($i)";
} elsif (/\G\s*\./) {
($func, $type) = ('__l_', 'flist');
}
}
if ($type) {
my $err = '$'.$arg;
/\G\s*\.\s*(\w+)/gc or die "bad usage of $type arg:
'$err'\n";
$func .= $1; $err .= $&;
my $args = length prototype (can perl::core:: $func
or die "bad $type op:
'$err'\n");
if ($args -= @args) {
/\G\s*($re::bal_par)/gc or die "bad usage of
$type op: '$err'\n";
push @args, re::chop2 $1; $err .= $&;
$args == re::split_args $1 or die "bad $type op
argc: '$err'\n";
}
}
$out = "\$.$func(${\join',',@args})" if $func;
substr $_, $pos, pos() - $pos, $out;
pos = $pos;
}
}
sub parse_args
{
my $lambd;
my (%argn, %argz, %argl);
my (@args, @pass, @with);
s/^\s*($re::bal_par)//o or die "arglist";
for (re::split_args $1) {
my ($with, $argn,$argv, $m,$z,$l) = s/^=\s*//;
s/^(?=\D)(\w+)\s*// or die "bad arg: '$_'";
exists $argn{$argn = $argv = $1} and die "dup arg: '$1'";
if (s/\s*(?:($re::bal_sqr)|($re::bal_cur))$//) {
$1 ? ($z = re::chop2s $1) : ($l = re::chop2s $2);
$m = s/\s*:$//;
}
if (!$with and $with = s/^=\s*//) {
push @with, "$argn=$_; ";
} elsif ($m ||= ord $_ == ord ':') {
$argv = "($argn$_)";
} elsif (length) {
die "bad arg '$argn' modifier: '$_'";
}
if (defined $z) {
$argv = "$argv@(int($z))" if $z;
$argz{$argn} = $z =~ /\D/
? '$'.(-1 + push @pass, "int($z)")
: ($z || 0);
} elsif (defined $l) {
push_fpp_bus;
$argl{$argn} = undef;
my ($n, $a) = ("outputs($argv)", ", $argv");
if (length $l) {
$n = "int($l)";
$a = '', $with = 1 unless $with || $m;
}
$argv = "_fpp_bus_($n$a)";
}
$argn{$argn} = @pass;
push @pass, $argv;
if (!$with) {
push @args, $argn;
$lambd ||= $m || $z || defined $l;
}
}
if ($lambd || @pass > @args) {
$lambd = join ',', @args;
$lambd = "\\($lambd)." if $lambd;
$lambd .= '(' . join ',', @pass;
$lambd .= " with { @with}" if @with;
}
0+@pass, $lambd, %argn && sub {
expand_args \%argn, \%argz, \%argl;
};
}
sub parse_block
{
my ($zone, $re_z, $earg) = @_;
$_[1] = $re_z = qr/(.*?)(?:\b($re_z):|$)/s
unless ref $re_z;
s/^\s*($re::bal_cur)//o or die "body";
local $_ = re::chop2 $1;
/\$\s*[\W\d]\w*/x and die "bad sigil var: '$&'\n";
&$earg() if $earg;
for (my $code;;) {
/$re_z/g;
my ($c, $z) = ($1, $2);
for ($c) {
/\S/ or last;
s/^\s*$//mg;
s/^\n+//; s/\s*$/\n/;
s/^(\s*)// and s/^$1//mg;
$code->{$zone} .= $_;
}
$zone = $z || return $code;
}
}
sub parse_fpp
{
my ($narg, $lambd, $earg) = parse_args;
my $func;
if (s/^\s*\[//) {
s/(^.*)?\]// or die 'deps list';
$func->{deps} = [map {
/^\s*(?=\D)(\w+)\s*$/ or die "bad dep name: $_";
$DEPS{$1} || die "bad dep: $_";
} split ',', $1];
}
my $pure = s/^\s*pure\b//;
$func->{eval} = undef if s/^\s*eval\b//;
my @type; @type = map s/^\s+|\s+$//gr, split ',', $1
if s/^\s*(?=\S)([^\{]+)//;
CORE::state $re_zone =
'FILE|DECL|_INIT|INIT|file|decl|_init|init|LOOP|loop|POST|post|exec';
my $code = parse_block 'exec', $re_zone, $earg;
s/\s+/ /g, s/\s*;*\s*$/;/ for $code->{exec} // die 'no exec';
my ($type, $tuple);
if (@type <= 1) {
$type = $type[0] // '_float_';
} else {
CORE::state $uniq = '000';
$type = 'struct fpp_tuple_' . ++$uniq;
$code->{exec} =~ s/([^;]+);$/ ($type){$1 };/ or die;
my $sdef = join ' ', map "$type[$_] m_$_;", 0..$#type;
# OK, this is ugly, but lets do this here for now ...
$sdef =~ s/\b_int_\b/int/g; $sdef =~
s/\b_float_\b/$pp_cpp::O_FLOAT/g;
$code->{FILE} .= "$type { $sdef };\n";
$tuple = join ',', map {
mk_ffunc 0, 1, $type[$_], "((($type)\$0).m_$_)";
} 0..$#type;
}
$func->{code} = $code;
exists $func->{eval}
? ($code->{exec} =~ s/\s*;$//)
: ($code->{exec} = "({ $code->{exec} })");
my $ffunc = mk_ffunc $pure, $narg, $type, $func;
$ffunc = "$lambd : $ffunc)" if $lambd;
$ffunc = "($ffunc <: $tuple)" if $tuple;
$ffunc;
}
sub parse_dep
{
s/^\s*\(\s*(\w*)\s*\)// or die 'dep name';
my $name = $1;
CORE::state $re_zone = 'FILE|DECL|_INIT|INIT|LOOP|POST';
my $code = parse_block 'FILE', $re_zone;
if ($name) {
die 'redefined' if $DEPS{$name};
$DEPS{$name} = $code;
} else {
$DEPS{''}{$_} .= $code->{$_} for keys %$code;
}
s/^\s*;// ? '' : die 'expected ;';
}
sub parse_dsp
{
our $REGERROR;
s{
(" (*:string) (?:\\.|[^"])* (*SKIP) ") |
(?: \/\* (*:comment) (?:[^\*]+|\*(?!\/))* (*SKIP) \*\/) |
(?: \/\/ [^\n]*)
}{
if (defined $1) {
CORE::state $uniq = '000';
$STRN{++$uniq} = $1;
'STRN!' . $uniq;
}
}xegs;
die "unterminated $REGERROR" if $REGERROR && $REGERROR ne 1;
s/(?:\h*\n){3,}/\n\n/g; # unneeded
s{
\b (?:fpp_)(?:(import)|(library)) \b
(?: \s*\(\s* STRN!(\d+) \s*\)\s* (?(1);) )?
}{
my $n = $3 && $STRN{$3} //
do { /\G([^\n]*)/; die "syntax error: '$1'"; };
main::parse_file(re::chop2 $n, !$1);
}xeg;
my $dsp = ''; while (m{
\b (?:
__FPP (?{\&parse_dep}) |
FPP (?{\&parse_fpp})
) \b
}xo) {
substr $_, 0, length($`) + length($&), '';
$dsp .= fix_strn $`;
$dsp .= $^R->();
}
$dsp . fix_strn;
}
#------------------------------------------------------------------------------
package pp_cpp;
our ($O_FLOAT) = 'float';
my $THIS = 'dsp';
my $TYPE = '(?: int | float | double | quad)';
sub re_call { my $f = &re::list; "\\b($f)\\s*($re::bal_par)"; }
sub re_this { my $t = &re::list; "\\b(?:$THIS->)?($t)\\b"; }
sub re_cast
{
my $expr = "($_[0])";
my $cast = re::list "\\b $TYPE \\( $expr \\)",
"\\( $TYPE \\)+ $expr";
qr/(?| $cast )/x;
}
our (%ZMAP, $FILE, $DECL, $INIT, $EXEC);
sub uncast_one {
CORE::state $cast = re_cast '.*';
1 while s/\A\s* $cast \s*\z/$1/oxg;
}
sub uncast_all {
my $cast = re_cast $_[0];
for ($INIT, $EXEC) { 1 while s/$cast/$1/g; }
}
sub fix_types
{
my $funcs = shift;
my $ftype; while (my ($n, $f) = each %$funcs) {
$ftype->{$n} = exists $f->{eval} ? undef
: $f->{type} // next
}
uncast_all my $calls = re_call keys %{$ftype || return};
my (%vtype, @voids);
for ($INIT, $EXEC) {
$vtype{$1} = $ftype->{$2} // do {
push @voids, $1;
'void';
} while /\b (\w+) \s*=\s* $calls/xg;
}
%vtype or return;
uncast_all my $vtype = re_this keys %vtype;
s/\b $TYPE \s+ $vtype/$vtype{$1} $1/xg
for $DECL, $EXEC;
s/\h* $vtype \s* = \s* 0; \h*\n?//xg # TempPerm, ocpp only
for $INIT;
@voids or return;
my $voids = re_this @voids;
s/\h* void \s+ $voids \s*; \h*\n?//xg
for $DECL, $EXEC;
for ($INIT, $EXEC) {
s/$voids (?! \s*= )/_($1)/xg;
s/\h* (?:void\s+)? $voids \s*=\s* ([^;]+) \s*; \h*\n?
/_($1,($2))/xg;
}
}
sub mark_block($$_)
{
$_[2] =~ s/(?<=\{)(?=(\n\h*)\S)/$1#MARK $_[0]/ or die;
my $ind = $1;
$_[2] =~ s/(?=\n\h*\}$)/$ind#MARK $_[1]/ or die;
}
sub add_marks
{
$DECL =~ s/^(?=(\h*)\S)/$1#MARK CALL\n/m or die;
mark_block 'CALL', 'EXIT' for $INIT, $EXEC;
$EXEC =~ s/(\n\h*) (for \s* ($re::bal_par) \s*) ($re::bal_cur)/
my ($ind, $for, $block) = ($1,$2,$4);
mark_block 'LOOP', 'POST', $block;
$ind . "#MARK _CALL" .
$ind . $for . $block .
$ind . "#MARK _EXIT";
/oex or die;
fill_mark($EXEC, $_, '') for qw(CALL EXIT _CALL _EXIT);
}
sub fill_mark
{
my (undef, $mark, $code) = @_;
$code .= "\n" if $code ne '';
$_[0] =~ s/^(\h*)#MARK $mark\n/
my $i = $1;
$code =~ s|^(?=\h*\S)|$i|mgr;
/me or die;
}
sub expand_all
{
my ($extra, $funcs) = @_;
my %voids;
sub expand_void; local *expand_void = sub
{
return $voids{$_[0]} // die if @_==1;
$voids{$_[0]} = re::chop2 $_[1]; '';
};
my @extra = $extra;
sub expand_func; local *expand_func = sub
{
my ($name, $args) = @_;
s/\.0[fL]$// for @$args;
my $this = pp_dsp::expand_fpp $funcs->{$name}, $args;
# s/THIS/ for values %$this;
push @extra, $this if 1 < keys %$this;
return delete $this->{exec};
};
my $calls = re::qr re_call '_', keys %$funcs;
sub expand_code; local *expand_code = sub {
s/$calls/
my ($f, @a) = ($1, re::split_args $2);
uncast_one, expand_code for @a;
$f eq '_' ? expand_void @a
: expand_func $f,\@a;
/xge;
};
expand_code for $INIT, $EXEC;
sub collect; local *collect = sub {
join '', grep defined, map @$_{@_}, @extra;
};
add_marks;
$FILE .= collect qw(FILE file);
$FILE .= "\n" if $FILE ne "\n";
fill_mark $DECL, 'CALL', collect qw(DECL decl);
fill_mark $INIT, 'CALL', collect qw(_INIT _init);
fill_mark $INIT, 'EXIT', collect qw(INIT init);
fill_mark $EXEC, 'LOOP', collect qw(LOOP loop);
fill_mark $EXEC, 'POST', collect qw(POST post);
}
sub read_cpp
{
my ($fd, %items) = @_;
my ($is_c, $class, @code);
local $_;
sub getl; local *getl = sub {
push @code, $_ if defined;
defined ($_ = <$fd>);
};
sub mark; local *mark = sub {
push @code, $_ unless defined $_[1];
push @code, $_[1];
*{delete $items{$_[0]}} = \$code[-1];
undef $_;
};
while (getl) {
unless ($class) {
($class) = /^\s*\#define \s* FAUSTCLASS \s+(\w+)\s*$/x;
} elsif (/^\s*$/) {
mark -file, $_;
} elsif (/^\s*typedef \s+ struct \s* \{ \s*$/x) {
$is_c = 1;
last;
} elsif (/^\s*class \s+ $class \s*:\s* public \s+ (?:\w+)
\s*\{\s*$/x) {
$is_c = 0;
while (getl) { last if /^\s* private: \s*$/x }
last;
}
}
eof and die "can't find the start of dsp declaration";
mark -decl;
while (<$fd>) {
last if $is_c
? m/^\s* \} \s* $class \s*; \s*$/x
: m/^\s* public: \s*$/x;
$code[-1] .= $_;
}
eof and die "can't find the end of dsp declaration";
%items = map {$_.$class, $items{$_}} keys %items
if $is_c;
my $calls = re_call keys %items;
while (getl) {
# temporary hack
if (/^(\s*)instanceConstants\(/) {
(my $i, $_) = $_;
1 while getl && !/^\s*instanceClear/;
$_ .= $i; next;
}
my ($prot, $func, undef, $body)
= /^(.*? \b void \s+ $calls \s*) (\{ \s*\z)/x
or next;
$items{$func} or die "redefenition of $func()";
while (<$fd>) {
$body .= $_;
next unless /^\s* \} \s*$/x;
last if $body =~ /^($re::bal_cur)\s*\z/o;
}
eof and die "can't find the end of $func()";
mark $func, $prot.$body;
}
die "can't find funcs: ", join(',', map "$_()", keys %items)
if %items;
\@code;
}
# ----------------------------------------------------------------------------
my $ZVEC = '(?:\b(?:$THIS->)?[if][VR]ec\d+\b)';
my $TEMP = '(?:\b[if]Temp\d+\b)';
sub inputs
{
my %seen;
grep defined && !$seen{$_}++, $_[0] =~ /\b(?:
(?:$TYPE) | (?:$THIS) | (?:IOTA) | (?:[if]Const\d+) |
(?: (?:input|[if][VR]ec)\d+\b) |
((?=\D)\w+ (?! \(\s*[^\)] ))
)\b/oxg
}
sub __zmap($)
{
my $v = $_[0]; # 1==(() = ($v =~ /$ZVEC/og))
return $v if $v =~ /\b$ZVEC/og ? $v !~ //g : do {
my ($c, $t) = 0;
$v =~ s{($TEMP)}{defined($t = $ZMAP{$1}) ? (++$c, $t) : $1}oeg;
$c == 1;
};
}
sub build_zmap
{
for (split /(?:\h*;)?\n/, $EXEC) {
my ($l, $r) = /(.*\S) \s*=\s* (.*)/x
or next;
if (my ($t) = $l =~ /($TEMP)$/o) {
$ZMAP{$t} = __zmap $r || next;
} elsif (my ($v, $i) = $l =~ /($ZVEC)\[([^\]]+)\]$/o) {
$i eq 0 || $i =~ s/\bIOTA\b/(IOTA - 0)/ or next;
$ZMAP{$r} = $v."[$i]";
}
}
}
sub zmap($)
{
my $expr = $_[0]; $ZMAP{$expr} //= __zmap $expr;
}
# ----------------------------------------------------------------------------
sub opt_const
{
# TODO: can make $DECL empty, add_marks(DECL) will die.
# move the callsite somewhere else but after fix_type()
# which can remove a "void" var we can opt otherwise.
my $freq = $_[1] ? '' : 'fSamplingFreq';
my @temp = grep { $EXEC !~ /\b$_\b/ and $_ ne $freq }
$DECL =~ /\b$TYPE\s+(\w+);/oxg
or return;
my $decl = '';
my $temp = re::list @temp;
$DECL =~ s/\h*($TYPE\s+($temp);\h*\n)/$decl .= $1; ''/xeg;
$INIT =~ s/\b$THIS->($temp)\b/$1/xg; #if $IS_C
substr +($_[0]->{_INIT} //= ''),0,0, $decl."\n";
}
sub do_cpp
{
my ($fd, $extra, $funcs) = @_;
my $code = read_cpp $fd,
-file => \*FILE,
-decl => \*DECL,
instanceConstants => \*INIT,
compute => \*EXEC;
build_zmap;
fix_types $funcs;
opt_const $extra, 0;
expand_all $extra, $funcs;
pp_dsp::fix_strn for $FILE, $INIT, $EXEC;
$code;
}
#------------------------------------------------------------------------------
package main;
sub slurp_file
{
my ($name, $idir) = @_;
my $path; if (!$idir || $name =~ /^\.{0,2}\//) {
$path = $name if -f $name;
} else {
for (@$idir) {
my $n = "$_/$name";
$path = $n, last if -f $n;
}
}
$path // die "can't find file '$name'";
open my $fd, '<', $path or die "can't open file '$path': $!";
local $/; <$fd>;
}
sub parse_file
{
my ($name, $islib) = @_;
my ($isinc, $env) = defined $islib;
local $_;
if (defined $name) {
CORE::state %cache;
CORE::state $uniq = '00';
# import() after library() can't work anyway, but let's
# check $islib and return ''; this allows import(stdfaust)
# which does library(all) which in turn imports everything.
return $islib && $cache{$name} if exists $cache{$name};
$env = $cache{$name} = $islib && 'FPP_ENV_' . ++$uniq;
$_ = slurp_file $name, $isinc && \@INCDIR;
} else {
warn "reading from stdin ...\n" if -t STDIN;
$_ = do { local $/; <STDIN> };
$name = '<stdin>';
}
my $dsp = pp_dsp::parse_dsp;
print FAUST "\n" if tell FAUST;
print FAUST '// ======== ', $isinc?'INCLUDE: ':'CMDLINE: ', $name, "\n";
print FAUST $env, " = environment {\n" if $islib;
print FAUST $dsp;
print FAUST "};\n" if $islib;
$env;
}
sub usage
{
die "fpp: usage\n";
}
my @TMPF; END { unlink @TMPF }
sub main
{
my ($faust, $fmt, $ktf, @opt, @inp, $out) = 'faust';
while (defined($_ = shift)) {
if (ord != ord '-') { push @inp, $_; next; }
elsif ($_ eq '-k') { $ktf = 1; next; }
elsif ($_ eq '-fmt') { $fmt = shift // usage; next; }
elsif ($_ eq '-faust') { $faust = shift // usage;
next; }
elsif ($_ eq '-o') { $out = shift // usage; next; }
elsif (/^-(double|quad)$/) { $O_FLOAT = $1; }
push @opt, $_;
push @opt, shift // usage if /^
-mdlang | --mathdoc-lang |
-f | --fold |
-mns | --max-name-size |
-mcd | --max-copy-delay |
-a |
-cn | --class-name |
-scn | --super-class-name |
-pn | --process-name |
-t | --timeout |
-vs | --vec-size |
-lv | --loop-variant |
-lang | --language |
-A | --architecture-dir |
-I | --import-dir |
-L | --library |
-O | --output-dir |
-inj | --inject |
-fm | --fast-math
$/x;
}
-d -w $TMPDIR or die "ERR!! bad \$TMPDIR '$TMPDIR': $!\n";
my ($dsp, $cpp) = map "$TMPDIR/__FPP__.$_", qw(dsp cpp);
push @TMPF, $dsp, $cpp unless $ktf;
open FAUST, '>', $dsp or die "ERR!! can't open '$dsp': $!\n";
do { parse_file shift @inp} while @inp;
close FAUST;
unlink $cpp;
system $faust, @opt, $dsp, '-o', $cpp and die "\n";
open my$fd, '<', $cpp or die "ERR!! can't open '$cpp': $!\n";
my $code = pp_cpp::do_cpp $fd, $DEPS{''}, \%FUNC;
open STDOUT,'>', $out or die "ERR!! can't open '$out': $!\n"
if defined $out;
if (defined $fmt) {
$fmt eq 0 or usage;
print $FILE, $DECL, $INIT, $EXEC;
} else {
print @$code;
}
}
main @ARGV;
_______________________________________________
Faudiostream-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/faudiostream-devel
