Fetching contributors…
Cannot retrieve contributors at this time
executable file 91 lines (71 sloc) 2.16 KB
#!/usr/bin/env perl
# Copyright (c) 2015 Christian Jaeger,
# This is free software. See the file that came bundled
# with this file.
use strict; use warnings; use warnings FATAL => 'uninitialized';
use Function::Parameters ":strict";
# find modules from functional-perl working directory (not installed)
use Cwd 'abs_path';
our ($mydir, $myname); BEGIN {
my $location= (-l $0) ? abs_path ($0) : $0;
$location=~ /(.*?)([^\/]+?)_?\z/s or die "?";
($mydir, $myname)=($1,$2);
use lib "$mydir/../lib";
sub usage {
print "usage: $myname outpath numrows
Write some useless number series in CSV format.
Purpose: example and test for lazy list (streaming) code (check for
leaks/memory retention).
exit (@_ ? 1 : 0);
use Getopt::Long;
our $verbose=0;
GetOptions("verbose"=> \$verbose,
"help"=> sub{usage},
) or exit 1;
usage unless @ARGV==2;
our ($path,$numrows)=@ARGV;
use FP::Text::CSV qw(rows_to_csv_file);
use FP::List ":all";
use FP::Lazy ":all";
use FP::Stream ":all";
use FP::Ops qw(add);
use FP::fix;
use FP::uncurry;
fun fibs () {
# (Also see the [[fibs]] example script; unlike there, where
# global scope is used, here we don't use Keep around $fibs as
# it's correct when the local variable, which goes out of scope,
# is deleted)
my $fibs; $fibs=
cons 1, cons 1, lazy { $fibs->stream_zip_with (\&add, rest $fibs) };
#fun exps($base, $start)
sub exps; *exps= uncurry
fun ($base) {
fix fun ($rec, $x) {
lazy { cons $x, &$rec ($x * $base) }
fun series () {
my $a= 1.01;
my $b= 0.99;
my $ns= rest stream_iota;
my $as= exps $a, $a;
my $bs= exps $b, $b;
my $fibs= fibs;
([ "n", "$a^n", "$b^n", "fib" ],
stream_zip $ns, $as, $bs, $fibs)
fun page ($title, $rows) {
cons $title, $rows->take($numrows)
# Because of an unresolved issue (apparently in the Perl interpreter),
# the resulting stream has to be assigned to a lexical variable first,
# or the stream head would be held on to and the process would run out
# of memory:
my $page= page (series);
rows_to_csv_file $page, $path, +{eol=> "\n", sep_char=> ";"};