#
# Copyright (c) 2004-2019 Christian Jaeger, copying@christianjaeger.ch
#
# This is free software, offered under either the same terms as perl 5
# or the terms of the Artistic License version 2 or the terms of the
# MIT License (Expat version). See the file COPYING.md that came
# bundled with this file.
#

=head1 NAME

FP::Repl::Repl - read-eval-print loop

=head1 SYNOPSIS

 my $repl= new FP::Repl::Repl;
 $repl->set_prompt("foo> ");
 # ^ if left undefined, "$package$perhapslevel> " is used
 $repl->set_historypath("somefile"); # default is ~/.fp-repl_history
 $repl->set_env_PATH ($safe_PATH); # default in taint mode is
   # '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin',
   # $ENV{PATH} otherwise.
 $repl->run;
 # or $repl->run($skip)  to skip $skip levels

=head1 DESCRIPTION

Enters an interactive read-eval-print loop.  Term::ReadLine with
history is active.  The loop can be exited by typing ctl-d.  Entering
nothing re-evaluates the last entry.  Some autocompletion exists.

When the entered line starts with ':' or ',' (both characters are
equivalent), then it is interpreted as containing special commands or
modes. Enter ':h' or ':help' or ':?' (or the equivalents starting with
the comma like ',?', from now on whenever the text days ':' you can
also use the comma) to get a help text including the currently active
settings.

If the 'Maybe_keepResultIn' field is set to a string, the scalar with the
given mae is set to either an array holding all the result values (in
:l mode) or the result value (in :1 mode).

By default, in the :d and :s modes the results of a calculation are
carried over to the next entry in $VAR1 etc. as shown by the display
of the result. Those are lexical variables.

This does not turn on the Perl debugger, hence programs are not slowed
down.

=head1 FEATURES

Read the help text that is displayed by entering ":h", ",h", ":?" or
",?" in the repl.

=head1 TODO

 - 'A::Class-> ' method completion
 - for '$Foo ->bar<tab>' completion, if $Foo contains a valid class
   name, use it
 - maybe '$ans->[1]->' method completion

=head1 IDEAS

 - should stdout and stderr of the evaluation context go to the pager,
   too?
 - maybe handle ->SUPER:: completion?
 - differ between emptylistofcompletions (no &subs for example) (empty
   list) and no sigil there so dunno-how-to-complete (undef?,
   exception?, ??).
 - make package lexicals accessible when entering a package with :p

=head1 BUGS

Completion:

 - $ does not filter out scalars only, since perl is not able to do so
 - % and * make completion stop working unless you put a space after
   those sigils. (@ and & work as they should)
 - keep the last 10 or so completion lists, and use those in the ->
   case if the var's type could not be determined.

:V breaks view of :e and similar (shows CODE..)


=head1 SEE ALSO

L<FP::Repl>: easy wrapper

=head1 NOTE

This is alpha software! Read the status section in the package README
or on the L<website|http://functional-perl.org/>.

=cut


package FP::Repl::Repl;

use strict; use warnings; use warnings FATAL => 'uninitialized';

# Copy from FP::Repl::WithRepl, to prevent circular dependency.  This has
# to be at the top before any lexicals are defined! so that lexicals
# from this module are not active in the eval'ed code.

sub WithRepl_eval (&;$) {
    my ($arg, $maybe_package)=@_;
    if (ref $arg) {
        eval { &$arg() }
    } else {
        my $package= $maybe_package // caller;
        eval "package $package; $arg"
    }
}

use Chj::Class::methodnames;
use Chj::xoutpipe();
use Chj::xtmpfile;
use Chj::xperlfunc qw(xexec);
use Chj::xopen qw(fh_to_fh perhaps_xopen_read);
use POSIX;
use Chj::xhome qw(xeffectiveuserhome);
use Chj::singlequote 'singlequote';
use FP::HashSet qw(hashset_union);
use FP::Hash qw(hash_xref);
use FP::Repl::StackPlus;
use FP::Lazy;
use FP::Show;


sub maybe_tty {
    my $path= "/dev/tty";
    if (open my $fh, "+>", $path) {
        $fh
    } else {
        warn "opening '$path': $!";
        undef
    }
}


sub xone_nonwhitespace {
    my ($str)=@_;
    $str=~ /^\s*(\S+)\s*\z/s
        or die "exactly one non-quoted argument must be given";
    $1
}


my $HOME=xeffectiveuserhome;
our $maybe_historypath= "$HOME/.fp-repl_history";
our $maybe_settingspath= "$HOME/.fp-repl_settings";
our $maxHistLen= 100;
our $doCatchINT= 1;
our $doRepeatWhenEmpty= 1; 
our $doKeepResultsInVARX= 1;
our $pager= $ENV{PAGER} || "less";
our $mode_context= 'l';
our $mode_formatter= 'd';
our $mode_viewer= 'a';
our $mode_lexical_persistence= 'X';
our $maybe_env_path= '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin';

use Chj::Class::Array -fields=>
  -publica=> (
              'Maybe_historypath', # undef=none, but a default is set
              'Maybe_settingspath', # undef=none, but a default is set
              'MaxHistLen',
              'Maybe_prompt', # undef= build fresh one from package&level
              'Maybe_package', # undef= use caller's package
              'DoCatchINT',
              'DoRepeatWhenEmpty',
              'Maybe_keepResultIn',
              'DoKeepResultsInVARX',
              'Pager',
              'Mode_context', # char
              'Mode_formatter', # char
              'Mode_viewer', # char
              'Mode_lexical_persistence', # char
              'Maybe_input', # fh
              'Maybe_output', # fh
              'Maybe_env_PATH', # maybe string
             );

sub new {
    my $class=shift;
    my $self= $class->SUPER::new;
    $$self[Maybe_historypath]= $maybe_historypath;
    $$self[Maybe_settingspath]= $maybe_settingspath;
    $$self[MaxHistLen]= $maxHistLen;
    $$self[DoCatchINT]= $doCatchINT;
    $$self[DoRepeatWhenEmpty]= $doRepeatWhenEmpty;
    $$self[DoKeepResultsInVARX]= $doKeepResultsInVARX;
    $$self[Pager]= $pager;
    $$self[Mode_context]= $mode_context;
    $$self[Mode_formatter]= $mode_formatter;
    $$self[Mode_viewer]= $mode_viewer;
    $$self[Mode_lexical_persistence]= $mode_lexical_persistence;
    $$self[Maybe_env_PATH]= $maybe_env_path
        if ${^TAINT};
    $self
}

sub use_lexical_persistence {
    my $self=shift;
    hash_xref(+{m=>1, M=>1, x=>0, X=>0}, $self->mode_lexical_persistence)
}
sub use_strict_vars {
    my $self=shift;
    hash_xref(+{m=>1, M=>0, x=>1, X=>0}, $self->mode_lexical_persistence)
}

my $settings_version= "v2";
my $settings_fields=
  [
   # these should remain caller dependent:
   #maxHistLen
   #doCatchINT
   #doRepeatWhenEmpty
   #maybe_keepResultIn
   #doKeepResultsInVARX
   #pager
   qw(mode_context
      mode_formatter
      mode_viewer
      mode_lexical_persistence)
   ];

sub possibly_save_settings {
    my $self=shift;
    if (my $path= $self->maybe_settingspath) {
        my $f= xtmpfile $path;
        $f->xprint (join("\0",
                         $settings_version,
                         map {
                             $self->$_
                         }
                         @$settings_fields));
        $f->xclose;
        $f->xputback(0600);
    }
}

sub possibly_restore_settings {
    my $self=shift;
    if (my $path= $self->maybe_settingspath) {
        if (my ($f)= perhaps_xopen_read ($path)) {
            my @v= split /\0/, $f->xcontent;
            $f->xclose;
            if (shift (@v) eq $settings_version) {
                for (my $i=0; $i< @$settings_fields; $i++) {
                    my $method= "set_".$$settings_fields[$i];
                    $self->$method($v[$i]);
                }
            } else {
                warn "note: not reading settings of other version from '$path'";
            }
        }
    }
}

sub saving ($$) {
    my ($self,$proc)=@_;
    sub {
        &$proc(@_);
        $self->possibly_save_settings;
    }
}

# (move to some lib?)
sub splitpackage {
    my ($package)=@_; # may be partial.
    if ($package=~ /(.*)::(.*)/s) {
        ($1,$2)
    } else {
        ("",$package)
    }
}

my $PACKAGE= qr/\w+(?:::\w+)*/;

use FP::Repl::corefuncs();
our @builtins= FP::Repl::corefuncs;

# whether to use Data::Dumper in perl mode
our $Dumper_Useperl= 0;

sub __signalhandler { die "SIGINT\n" }

our $term; # local'ized but old value is reused if present.

our $current_history; # local'ized; array(s).


sub print_help {
    my $self= shift;
    my ($out)=@_;
    my $selection= sub {
        my ($meth,$val)=@_;
        my $method= "mode_$meth";
        $self->$method eq $val ? "->" : "  "
    };
    my $L= &$selection(context=> '1');
    my $l= &$selection(context=> 'l');
    my $p= &$selection(formatter=> 'p');
    my $s= &$selection(formatter=> 's');
    my $d= &$selection(formatter=> 'd');
    my $V= &$selection(viewer=> 'V');
    my $v= &$selection(viewer=> 'v');
    my $a= &$selection(viewer=> 'a');
    my $m= &$selection(lexical_persistence=> 'm');
    my $M= &$selection(lexical_persistence=> 'M');
    my $x= &$selection(lexical_persistence=> 'x');
    my $X= &$selection(lexical_persistence=> 'X');
    print $out qq{Repl help:
If a command line starts with a ':' or ',', then the remainder of the
line is interpreted as follows:

  package \$package    use \$package as new compilation package
  DIGITS              shorthand for 'f n', see below
  -                   same as 'f n' where n is the current frameno - 1
  +                   same as 'f n' where n is the current frameno + 1
                       (both are the same as 'f' if reaching the end)
  CMD args...         one-time command
  MODES code...       change some modes then evaluate code

CMD is one of:
   e [n]  print lexical environment at level n (default: 0)
           Note: currently this does *not* show the lexicals that were
           persisted when enabling m or M mode.
   b|bt   print back trace
   f [n]  move to stack frame number n (at start: 0)
           without n, shows the current frame again
   y [n]  alias for f
   q      quit the process (by calling `exit`)

MODES are a combination of these characters, which change the
previously used mode (indicated on the left):
  context:
$L 1  use scalar context
$l l  use list context (default)
  formatter:
$p p  print stringification
$s s  show from FP::Show (experimental, does not show data sharing)
$d d  Data::Dumper (default)
  viewer:
$V V  no pager
$v v  pipe to pager ($$self[Pager])
$a a  pipe to 'less --quit-if-one-screen --no-init' (default)
  lexical persistence:
   (Persisting lexicals means to carry over variables introduced with
   "my" into subsequent entries in the same repl. It prevents their
   values from being deallocated until new values are assigned or a
   new lexical with the same name is introduced. Currently these
   lexicals are carried over even when moving to another frame or
   package.)
$m m  persist lexicals, use strict 'vars'
$M M  persist lexicals, no strict 'vars'
$x x  do not persist lexicals, use strict 'vars'
$X X  do not persist lexicals, no strict 'vars' (default)

Other features:
  \$FP::Repl::Repl::args   is an array holding the arguments of the last subroutine call
                     that led to the currently selected frame
  \$FP::Repl::Repl::argsn  is an array holding the arguments of the subroutine call
                     that *leaves* the currently selected frame
};
}


sub formatter {
    my $self=shift;
    my ($terse)=@_; # true for :e viewing
    my $mode= $self->mode_formatter;
    $mode= "d" if ($terse and $mode eq "p");
    hash_xref
      (+{
         p=> sub {
             (
              join "",
              map {
                  (defined $_ ? $_ : 'undef'). "\n"
              } @_
             )
         },
         s=> sub {
             my $z=1;
             (
              join "",
              map {
                  my $VARX= ($$self[DoKeepResultsInVARX] and not $terse) ?
                    '$VAR'.$z++.' = '
                      : '';
                  $VARX . show($_). ";\n"
              } @_
             )
         },
         d=> sub {
             my @v= @_; # to survive into
             # WithRepl_eval below

             require Data::Dumper;
             my $res;
             WithRepl_eval {
                 local $Data::Dumper::Sortkeys= 1;
                 local $Data::Dumper::Terse= $terse;
                 local $Data::Dumper::Useperl= $Dumper_Useperl;
                 $res= Data::Dumper::Dumper(@v);
                 1
             } || do {
                 warn "Data::Dumper: ".show($@);
             };
             $res
         }
        },
       $mode);
}

sub viewers {
    my $self=shift;
    my ($OUTPUT,$ERROR)=@_;
    my $port_pager_with_options= sub {
        my ($maybe_pager, @options)=@_;
        sub {
            my ($printto)=@_;

            local $SIG{PIPE}="IGNORE";

            my $pagercmd= $maybe_pager // $self->pager;

            eval {
                # XX this now means that no options
                # can be passed in $ENV{PAGER} !
                # (stupid Perl btw). Ok hard code
                # 'less' instead perhaps!
                my $o= Chj::xoutpipe
                  (sub {
                       # set stdout and stderr in case they are
                       # redirected (stdin is the pipe)
                       my $out= fh_to_fh ($OUTPUT);
                       $out->xdup2(1);
                       $out->xdup2(2);
                       $ENV{PATH}= $self->maybe_env_PATH
                         if defined $self->maybe_env_PATH;
                       xexec $pagercmd, @options
                   });
                &$printto ($o);
                $o->xfinish;
                1
            } || do {
                my $estr= show($@);
                unless ($estr=~ /broken pipe/i) {
                    print $ERROR "error piping to pager ".
                      "$pagercmd: $estr\n"
                        or die $!;
                }
            };
        }
    };

    my $string_pager_with_options= sub {
        my $port_pager= &$port_pager_with_options (@_);
        sub {
            my ($v)=@_;
            &$port_pager (sub {
                              my ($o)=@_;
                              $o->xprint($v);
                          });
        }
    };

    my $choosepager= sub {
        my ($pager_with_options)= @_;
        hash_xref
          (+{
             V=> sub {
                 print $OUTPUT $_[0]
                   or die "print: $!";
             },
             v=> &$pager_with_options(),
             a=> &$pager_with_options
             (qw(less --quit-if-one-screen --no-init)),
            },
           $self->mode_viewer);
    };

    my $pager= sub {
        my ($pager_with_options)= @_;
        sub {
            my ($v)=@_;
            &$choosepager ($pager_with_options)->($v);
        }
    };

    (&$pager ($port_pager_with_options),
     &$pager ($string_pager_with_options))
}


our $use_warnings= q{use warnings; use warnings FATAL => 'uninitialized';};

sub eval_code {
    my $self= shift;
    @_==5 or die "wrong number of arguments";
    my ($code, $in_package, $maybe_lexicals, $maybe_kept_results,
        $maybe_lexical_persistence)=@_;

    # merge with previous results, if any
    my $maybe_kept_results_hash= sub {
        return unless $maybe_kept_results;
        my %r;
        for (my $i=0; $i<@$maybe_kept_results; $i++) {
            $r{'$VAR'.($i+1)}= \ ($$maybe_kept_results[$i]);
        }
        \%r
    };
    $maybe_lexicals=
      ($maybe_lexicals && $maybe_kept_results) ?
        hashset_union ($maybe_lexicals, &$maybe_kept_results_hash)
          : ($maybe_lexicals // &$maybe_kept_results_hash);

    my $use_method_signatures=
      $Method::Signatures::VERSION ? "use Method::Signatures" : "";
    my $use_functional_parameters_=
      $Function::Parameters::VERSION ? "use Function::Parameters ':strict'" : "";
    my $use_tail=
      $Sub::Call::Tail::VERSION ? "use Sub::Call::Tail" : "";
    my $use_autobox=
      @FP::autobox::ISA ? "use FP::autobox" : "";

    my $prelude=
      "package ".&$in_package().";".
      "use strict; ".
       ($self->use_strict_vars ? "" : "no strict 'vars'; ").
       "$use_warnings; ".
       "$use_method_signatures; $use_functional_parameters_; $use_tail; ".
       "$use_autobox; ";

    if (my $lp= $maybe_lexical_persistence) {
        my $allcode=
          $prelude.
          $code;
        if (defined $maybe_lexicals) {
            $lp->lexicals(hashset_union($lp->lexicals, $maybe_lexicals))
        }
        my $context= wantarray ? "list" : "scalar";
        $lp->context($context);
        WithRepl_eval { $lp->eval($allcode) }
    } else {
        my @v= sort keys %$maybe_lexicals
          if defined $maybe_lexicals;
        my $allcode=
          $prelude.
          (@v ? 'my ('.join(", ", @v).'); ' : '') .
          'sub {'.
              $code."\n".
          '}';
        my $thunk= &WithRepl_eval($allcode)
          // return;
        PadWalker::set_closed_over ($thunk, $maybe_lexicals)
            if defined $maybe_lexicals;
        WithRepl_eval { &$thunk() }
    }
}


sub _completion_function {
    my ($attribs, $package, $lexicals)=@_;
    sub {
        my ($text, $line, $start, $end) = @_;
        my $part= substr($line,0,$end);

        #reset to the default before deciding upon it:
        $attribs->{completion_append_character}=" ";

        my @matches= do {
            # arrow completion:
            my ($pre,$varnam,$brace,$alreadywritten);
            if (($pre,$varnam,$brace,$alreadywritten)=
                $part=~ /(.*)\$(\w+)\s*->\s*([{\[]\s*)?(\w*)\z/s
                or
                ($pre,$varnam,$brace,$alreadywritten)=
                $part=~ /(.*\$)\$(\w+)(?:\s+|(?:\s*([{\[]\s*)(\w*)))\z/s) {
                # need to know the class of that thing
                no strict 'refs';
                my $r;
                # try to get the value, or at least the package.
                my $val= do {
                    if (my $ref= $$lexicals{'$'.$varnam}) {
                        $$ref
                    } else {
                        my $v= $ { $package."::".$varnam };
                        if (defined $v) {
                            $v
                        } else {
                            # (if I could run code side-effect free... or
                            # compile-only and disassemble....)  Try to
                            # parse the perl myself
                            if ($part=~ /.* # force latest possible match (ok?)
                                (?:^|;)\s*
                                (?:(?:my|our)\s+)?
                                # ^ optional for no 'use strict'
                                \$$varnam
                                \s*=\s*
                                (?:new\w*\s+($PACKAGE)
                                |($PACKAGE)\s*->\s*new)
                                /sx) {
                                $r=$1;
                                1
                            } else {
                                0
                            }
                        }
                    }
                };
                if (defined $val) {
                    #warn "got value from \$$varnam";
                    if ($r||=ref($val)) {
                        if ($r eq 'HASH'
                            or ($brace
                                and UNIVERSAL::isa($val, 'HASH'))) {
                            # Could also check `$val->isa('HASH')` if
                            # we wanted to run isa overloads, but
                            # would we want to do that?

                            #("{")
                            #("{foo}","{bar}")
                            if ($brace) {
                                map {"$_}"} keys %$val
                            } else {
                                map {"{$_}"} keys %$val
                            }
                        }
                        elsif ($r eq 'ARRAY'
                               or ($brace
                                   and UNIVERSAL::isa($val, 'ARRAY'))) {
                            # ^ not sure this works here; see commit messages
                            ("[")
                        }
                        elsif ($r eq 'CODE') {
                            ("(")
                        }
                        elsif ($r eq 'SCALAR') {
                            ("SCALAR")##
                        }
                        elsif ($r eq 'IO') {
                            ("IO")##
                        }
                        elsif ($r eq 'GLOB') {
                            ("GLOB")##
                        }
                        else {
                            # object
                            my @a= methodnames($r);
                            grep {
                                # (no need to check for matching the
                                # already-written part of the string
                                # here (with something like
                                # /^\Q$alreadywritten\E/), why? Maybe
                                # $attribs->{completion_word} was
                                # deleted or?)

                                # exclude some of the possible methodnames:
                                # - all-uppercase when characters are contained.
                                not(/[A-Z]/ and uc($_) eq $_)
                            } @a
                        }
                    } else {
                        ()
                    }
                } else {
                    #warn "no value from \$$varnam";
                    ()
                }
            } elsif ($part=~ tr/"/"/ % 2) {
                # odd number of quotes means we are inside
                ()
            } elsif ($part=~ tr/'/'/ % 2) {
                # odd number of quotes means we are inside
                ()
            } elsif ($part=~ /(^|.)\s*(${PACKAGE}(?:::)?)\z/s
                     or
                     $part=~ /([\$\@\%\*\&])
                              \s*
                              (${PACKAGE}(?:::)?|)
                              # ^ accept the empty string
                              \z/sx) {
                # namespace completion
                my ($sigil,$partialpackage)=($1,$2);

                no strict 'refs';

                my ($upperpackage,$localpart)= splitpackage($partialpackage);
                #warn "upperpackage='$upperpackage', localpart='$localpart'\n";

                # if upperpackage is empty, it might also be a
                # non-fully qualified, i.e. local, partial identifier.
                
                my $globentry=
                  ($sigil and
                   +{
                     '$'=>'SCALAR',
                     '@'=>'ARRAY',
                     '%'=>'HASH',
                     # ^ (problem with readline library, with a space
                     # after % it works too; need better completion
                     # function than the one from gnu readline?) 
                     # (years later: what was this?)
                     '*'=>'SCALAR',
                     # ^ really 'GLOB', but that would make it
                     # invisible. SCALAR matches everything, which is
                     # what we want.
                     '&'=>'CODE'
                    }->{$sigil});
                #print $ERROR "<$globentry>";

                my $symbols_for_package= sub {
                    my ($package)=@_;
                    grep {
                        # only show 'usable' ones.
                        /^\w+(?:::)?\z/
                    } do {
                        if ($globentry) {
                            #print $ERROR ".$globentry.";
                            grep {
                                (/::\z/
                                 # either it's a namespace which we
                                 # want to see regardless of type, or:
                                 # type exists
                                 or
                                 *{ $package."::".$_ }{$globentry})
                            } keys %{ $package."::" }
                        } else {
                            keys %{ $package."::" }
                        }
                    }
                };
                my @a=
                  ($symbols_for_package->($upperpackage),

                   length($upperpackage) ?
                   () :
                   ($symbols_for_package->($package),
                    ($globentry ? () : @builtins),
                    # and lexicals:
                    map { /^\Q$sigil\E(.*)/s ? $1 : () } sort keys %$lexicals
                   ));

                #print Data::Dumper::Dumper(\@a);

                # Now, if it ends in ::, or even generally, care about
                # it not appending space on completion:
                $attribs->{completion_append_character}="";

                (
                 map {
                     if (/::\z/) {
                         $_
                     } else {
                         "$_ "
                     }
                 }
                 (length ($upperpackage) ?
                  map {
                      $upperpackage."::$_"
                  } @a
                  : @a)
                )
            } else {
                ()
            }
        };
        if (@matches) {
            #print $ERROR "<".join(",",@matches).">";

            $attribs->{completion_word}= \@matches;
            # (no sorting necessary)

            return
              $term->completion_matches
                ($text,
                 $attribs->{list_completion_function})
        } else {
            # restore defaults.
            $attribs->{completion_append_character}=" ";
            return ()
        }
    }
}

our ($maybe_input, $maybe_output); # dynamic parametrization of
                                   # filehandles

our $repl_level; # maybe number of repl layers above
our $args; # see '$FP::Repl::Repl::args' in help text
our $argsn; # see '$FP::Repl::Repl::argsn' in help text

# TODO: split this monstrosity into pieces.
sub run {
    my ($self, $maybe_skip)=@_;

    my $skip= $maybe_skip // 0;
    my $stack= FP::Repl::StackPlus->get ($skip + 1);

    local $repl_level= ($repl_level // -1) + 1;

    my $frameno= 0;

    my $get_package= sub {
        # (What is $$self[Maybe_package] for? Can set the maybe_prompt
        # independently. Security feature or just overengineering?
        # Ok, remember the ":p" setting; but why not use a lexical
        # within `run`? Ok how long-lived are the repl objects, same
        # duration? Then hm is the only reason for the object to be
        # able to set up things explicitely first? Thus is it ok after
        # all?)
        my $r= $$self[Maybe_package] || $stack->package($frameno);
        $r
    };

    my $oldsigint= $SIG{INT};
    # It seems this is the only way to make signal handlers work in
    # both perl 5.6 and 5.8:
    sigaction SIGINT,
      new POSIX::SigAction __PACKAGE__.'::__signalhandler'
        or die "Error setting SIGALRM handler: $!\n";

    {
        local $SIG{__DIE__};
        require Term::ReadLine;
    }
    # only start one readline instance, do not nest (doing otherwise
    # seems to lead to segfaults). okay?.
    local our $term = $term || new Term::ReadLine 'Repl';
    # This means that the history from nested repls will also show up
    # in the history of the parent repl. Not saved, but within the
    # readline instance. (Correct?)
    # XX: idea: add nesting level to history filename?

    my $attribs= $term->Attribs;

    my ($INPUT, $OUTPUT, $ERROR)= do {
        my $tty= lazy { maybe_tty };
        my $in= $self->maybe_input // $maybe_input // force($tty)
          // $term->IN // *STDIN;
        my $out= $self->maybe_output // $maybe_output // force($tty)
          // $term->OUT // *STDOUT;
        $term->newTTY ($in,$out);
        ($in,$out,$out)
    };
    # carry over input/output to subshells:
    local $maybe_input= $INPUT;
    local $maybe_output= $OUTPUT;

    my $printerror_frameno= sub {
        my $max = $stack->max_frameno;
        print $ERROR "frame number must be between 0..$max",
          (@_ ? ", got @_" : ()), "\n";
    };

    my ($view_with_port, $view_string)= $self->viewers ($OUTPUT,$ERROR);

    {
        my @history;
        local $current_history= \@history;
        # ^ this is what nested repl's will use to restore the history
        # in the $term object
        if (defined $$self[Maybe_historypath]) {
            # clean history of C based object before we re-add the
            # saved one:
            $term->clear_history;
            if (open my $hist, "<", $$self[Maybe_historypath]){
                @history= <$hist>;
                close $hist;
                for (@history){
                    chomp;
                    $term->addhistory($_);
                }
            }
        }
        # do not add input to history automatically (which allows me
        # to do it myself):
        $term->MinLine(undef);

        my $myreadline= sub {
          DO: {
              my $line;
              eval {
                  $line=
                      $term->readline
                      ($$self[Maybe_prompt] //
                       &$get_package()
                       .($repl_level ? " $repl_level":"")
                       .($frameno ? "/$frameno" : "")
                       ."> ");
                  1
              } || do {
                  if (!length ref($@) and $@=~ /^SIGINT\n/s) {
                      print $OUTPUT "\n";
                      redo DO;
                  } else {
                      die $@
                  }
              };
              return $line;
            }
        };

        # for repetitions:
        my $evaluator= sub { }; # noop

        my $maybe_kept_results;

        my $maybe_lexical_persistence;
        my $try_enable_lexical_persistence= sub {
            eval {
                require Eval::WithLexicals;
                $maybe_lexical_persistence= Eval::WithLexicals->new;
                eval { require strictures } or
                  $maybe_lexical_persistence->prelude("");
                1
            } || do {
                print $ERROR "Could not enable lexical persistence: ".show($@);
                0
            }
        };
        &$try_enable_lexical_persistence() if $self->use_lexical_persistence;

      READ: {
            while (1) {

                local $attribs->{attempted_completion_function}=
                  _completion_function ($attribs,
                                        &$get_package,
                                        $stack->perhaps_lexicals($frameno) // {});

                my $input = &$myreadline // last;

                if (length $input) {
                    my ($cmd,$rest)=
                      $input=~ /^ *[:,] *([?+-]|[a-zA-Z]+|\d+)(.*)/s ?
                        ($1,$2)
                          :(undef,$input);

                    if (defined $cmd) {

                        if ($cmd=~ /^\d+\z/) {
                            # hacky way to allow ":5" etc. as ":f 5"
                            $rest= "$cmd $rest";
                            $cmd= "f";
                        }

                        # handle commands
                        eval {

                            my $set_package= sub {
                                # (no package parsing, trust user)
                                $$self[Maybe_package]= xone_nonwhitespace($rest);
                                $rest=""; # XX HACK
                            };

                            my $help= sub { $self->print_help ($OUTPUT) };

                            my $bt= sub {
                                my ($maybe_frameno)=
                                  $rest=~ /^\s*(\d+)?\s*\z/
                                    or die "expecting digits or no argument, got '$cmd'";
                                local $FP::Lazy::allow_access= 1;
                                # ^ XX should be generalized, not just
                                # for FP::Lazy; or alternatively, use
                                # overload::StrVal instead of
                                # stringification in the backtrace
                                # library.
                                print $OUTPUT $stack->backtrace ($maybe_frameno
                                                                 // $frameno);
                                $rest=""; # XX HACK; also, really
                                          # silently drop stuff?
                            };

                            my $chooseframe= sub {
                                my ($maybe_frameno)= @_;
                                $rest= ""; # still the hack, right?
                                if (defined $maybe_frameno) {
                                    if ($maybe_frameno <= $stack->max_frameno) {
                                        $frameno= $maybe_frameno
                                    } else {
                                        &$printerror_frameno ($maybe_frameno);
                                        return;
                                    }
                                }
                                
                                # unset any explicit package as
                                # we want to use the one of the
                                # current frame
                                undef $$self[Maybe_package]; # even without frameno? mess

                                # Show the context: (XX same
                                # issue as with :e with overly
                                # long data (need viewer, but
                                # don't really want to, so should
                                # really use shortener)
                                print $OUTPUT $stack->desc($frameno, $self->mode_formatter),"\n";
                            };

                            my $select_frame= sub {
                                my ($maybe_frameno)=
                                  $rest=~ /^\s*(\d+)?\s*\z/
                                    or die "expecting frame number, ".
                                      "an integer, or nothing, got '$cmd'";
                                &$chooseframe ($maybe_frameno)
                            };

                            my %commands=
                                (
                                 h=> $help,
                                 help=> $help,
                                 '?'=> $help,
                                 '-'=> sub {
                                     &$chooseframe (($frameno > 0) ?
                                                    $frameno - 1 : undef)
                                 },
                                 '+'=> sub {
                                     &$chooseframe (($frameno < $stack->max_frameno) ?
                                                    $frameno + 1 : undef)
                                 },
                                 package=> $set_package,
                                 1=> saving ($self, sub { $$self[Mode_context]="1" }),
                                 l=> saving ($self, sub { $$self[Mode_context]="l" }),
                                 p=> saving ($self, sub { $$self[Mode_formatter]="p" }),
                                 s=> saving ($self, sub { $$self[Mode_formatter]="s" }),
                                 d=> saving ($self, sub { $$self[Mode_formatter]="d" }),
                                 V=> saving ($self, sub { $$self[Mode_viewer]="V" }),
                                 v=> saving ($self, sub { $$self[Mode_viewer]="v" }),
                                 a=> saving ($self, sub { $$self[Mode_viewer]="a" }),
                                 m=> saving ($self, sub {
                                                 &$try_enable_lexical_persistence() and
                                                   $$self[Mode_lexical_persistence]= "m"
                                               }),
                                 M=> saving ($self, sub {
                                                 &$try_enable_lexical_persistence() and
                                                   $$self[Mode_lexical_persistence]= "M"
                                               }),
                                 x=> saving ($self, sub {
                                                 undef $maybe_lexical_persistence;
                                                 $$self[Mode_lexical_persistence]= "x"
                                               }),
                                 X=> saving ($self, sub {
                                                 undef $maybe_lexical_persistence;
                                                 $$self[Mode_lexical_persistence]= "X"
                                               }),
                                 e=> sub {
                                     use Data::Dumper;
                                     # XX clean up: don't want i in the regex
                                     my ($maybe_frameno)=
                                         $rest=~ /^i?\s*(\d+)?\s*\z/
                                         or die "expecting digits or no argument, got '$cmd'";
                                     $rest=""; # can't s/// above when expecting value
                                     my $fno= $maybe_frameno // $frameno;
                                     if (my ($lexicals)=
                                         $stack->perhaps_lexicals($fno)) {
                                         &$view_with_port
                                           (sub {
                                                my ($o)=@_;
                                                my $format= $self->formatter(1);
                                                for my $key (sort keys %$lexicals) {
                                                    if ($key=~ /^\$/) {
                                                        $o->xprint
                                                          ("$key = ".
                                                           &$format(${$$lexicals{$key}}));
                                                    } else {
                                                        $o->xprint
                                                          ("\\$key = ".
                                                           &$format($$lexicals{$key}));
                                                    }
                                                }
                                            });
                                     } else {
                                         &$printerror_frameno ($fno);
                                     }
                                 },
                                 f=> $select_frame,
                                 y=> $select_frame,
                                 q=> sub {
                                     # XX change exit code depending
                                     # on how the repl was called?
                                     # Well, at least make it a config
                                     # field?
                                     exit 0
                                 },
                                 bt=> $bt,
                                 b=> $bt,
                                );

                            while (length $cmd) {
                                # XX why am I checking with and without chopping here?
                                if (my $sub= $commands{$cmd}) {
                                    &$sub;
                                    last;
                                } else {
                                    my $subcmd= chop $cmd;
                                    if (my $sub= $commands{$subcmd}) {
                                        &$sub;
                                        last; # XX why last? shouldn't we
                                              # continue with what's left of
                                              # $cmd ?
                                    } else {
                                        print $ERROR "unknown command "
                                          ."or mode: '$subcmd'\n";
                                        last;
                                    }
                                }
                            }

                            1
                        } || do {
                            print $ERROR "error handling command $cmd: ".show($@);
                            redo READ;
                        }
                    }

                    # build up evaluator
                    my $eval= do {
                        my $eval_= sub {
                            $self->eval_code
                              ($rest,
                               $get_package,
                               $stack->perhaps_lexicals($frameno) // {},
                               $maybe_kept_results,
                               $maybe_lexical_persistence)
                        };
                        hash_xref
                          (+{
                             1=> sub {
                                 ([ scalar &$eval_() ], $@)
                             },
                             l=> sub {
                                 ([ &$eval_() ], $@)
                             },
                            },
                           $self->mode_context);
                    };

                    my $format_vals= $self->formatter;

                    $evaluator= sub {
                        my ($results,$error)= do {
                            # make it possible for the code entered in
                            # the repl to access the arguments in the
                            # last call leading to this position by
                            # accessing $FP::Repl::Repl::args :
                            my $getframe= sub {
                                my ($i)=@_;
                                if (defined (my $frame= $stack->frame
                                             ($frameno + $i))) {
                                    $frame->args
                                } else {
                                    "TOP"
                                }
                            };
                            local $argsn = &$getframe(0);
                            local $args = &$getframe(1);
                            &$eval()
                        };

                        &$view_string(do {
                            if (ref $error or $error) {
                                my $err= (UNIVERSAL::can($error,"plain") ?
                                          # error in plaintext; XX:
                                          # change to better
                                          # thought-out protocol?
                                          $error->plain
                                          : show($error));
                                chomp $err;
                                $err."\n"; # no prefix? no safe way to differentiate.
                            } else {
                                if (my $varname= $$self[Maybe_keepResultIn]) {
                                    $varname= &$get_package()."::$varname"
                                      unless $varname=~ /::/;
                                    no strict 'refs';
                                    $$varname= $self->mode_context eq "1" ?
                                      $$results[0] : $results;
                                }
                                &$format_vals(@$results)
                            }
                        });
                        $maybe_kept_results= $results
                          if $$self[DoKeepResultsInVARX];
                    };

                    &$evaluator();

                } elsif ($$self[DoRepeatWhenEmpty]) {
                    &$evaluator();
                } else {
                    next;
                }

                if (length $input and
                    ((!defined $history[-1]) or $history[-1] ne $input)) {
                    push @history,$input;
                    chomp $input;
                    $term->addhistory($input);
                    #splice @history,0,@history-$$self[MaxHistLen] =();
                    if ($$self[MaxHistLen] >= 0){# <-prevent endless loop
                        shift @history while @history>$$self[MaxHistLen];
                    }
                }
            }
        }
        print $OUTPUT "\n";
        if (defined $$self[Maybe_historypath]) {
            eval {
                my $f= xtmpfile $$self[Maybe_historypath];
                $f->xprint("$_\n") for @history;
                $f->xclose;
                $f->xputback(0600);
            };
            if (ref $@ or $@) {
                warn "could not write history file: ".show($@)
            }
        }
        $SIG{INT}= defined($oldsigint)? $oldsigint : "DEFAULT";
        # (Is there no other return path from sub run? should I use
        # DESTROY objects for this? -> nope, no returns, but if
        # exceptions not trapped it would fail)
    }

    # restore previous history, if any
    if ($current_history) {
        $term->clear_history;
        for (@$current_history) {
            chomp;
            $term->addhistory($_);
        }
    }
}


end Chj::Class::Array;

# for backwards compatibility:
*set_maxhistlen= *set_maxHistLen{CODE};
*set_docatchint= *set_doCatchINT{CODE};
*set_dorepeatwhenempty= *set_doRepeatWhenEmpty{CODE};
*set_maybe_keepresultin= *set_maybe_keepResultIn{CODE};