Skip to content

Instantly share code, notes, and snippets.

@zoffixznet
Created August 18, 2016 14:50
Show Gist options
  • Save zoffixznet/872a809fe47d02ab6a079bf1ba2d3adf to your computer and use it in GitHub Desktop.
Save zoffixznet/872a809fe47d02ab6a079bf1ba2d3adf to your computer and use it in GitHub Desktop.
use nqp;
class REPL { ... }
do {
my $more-code-sentinel = {};
my sub sorted-set-insert(@values, $value) {
my $low = 0;
my $high = @values.end;
my $insert_pos = 0;
while $low <= $high {
my $middle = floor($low + ($high - $low) / 2);
my $middle_elem = @values[$middle];
if $middle == @values.end {
if $value eq $middle_elem {
return;
} elsif $value lt $middle_elem {
$high = $middle - 1;
} else {
$insert_pos = +@values;
last;
}
} else {
my $middle_plus_one_elem = @values[$middle + 1];
if $value eq $middle_elem || $value eq $middle_plus_one_elem {
return;
} elsif $value lt $middle_elem {
$high = $middle - 1;
} elsif $value gt $middle_plus_one_elem {
$low = $middle + 1;
} else {
$insert_pos = $middle + 1;
last;
}
}
}
splice(@values, $insert_pos, 0, $value);
}
my sub mkpath(IO::Path $full-path) {
my ( :$directory, *% ) := $full-path.parts;
my @parts = $*SPEC.splitdir($directory);
for [\~] @parts.map(* ~ '/') -> $path {
mkdir $path;
unless $path.IO ~~ :d {
fail "Unable to mkpath '$full-path': $path is not a directory";
}
}
}
my role ReadlineBehavior[$WHO] {
my &readline = $WHO<&readline>;
my &add_history = $WHO<&add_history>;
method repl-read(Mu \prompt) {
my $line = readline(prompt);
if $line.defined {
add_history($line);
}
$line
}
}
my role LinenoiseBehavior[$WHO] {
my &linenoise = $WHO<&linenoise>;
my &linenoiseHistoryAdd = $WHO<&linenoiseHistoryAdd>;
my &linenoiseSetCompletionCallback = $WHO<&linenoiseSetCompletionCallback>;
my &linenoiseAddCompletion = $WHO<&linenoiseAddCompletion>;
my &linenoiseHistoryLoad = $WHO<&linenoiseHistoryLoad>;
my &linenoiseHistorySave = $WHO<&linenoiseHistorySave>;
method completions-for-line(Str $line, int $cursor-index) { ... }
method history-file() returns Str { ... }
method init-line-editor {
linenoiseSetCompletionCallback(sub ($line, $c) {
eager self.completions-for-line($line, $line.chars).map(&linenoiseAddCompletion.assuming($c));
});
linenoiseHistoryLoad($.history-file);
}
method teardown-line-editor {
my $err = linenoiseHistorySave($.history-file);
if $err {
note "Couldn't save your history to $.history-file";
}
}
method repl-read(Mu \prompt) {
self.update-completions;
my $line = linenoise(prompt);
if $line.defined {
linenoiseHistoryAdd($line);
}
$line
}
}
my role FallbackBehavior {
method repl-read(Mu \prompt) {
print prompt;
get
}
}
my role Completions {
has @!completions = CORE::.keys.flatmap({
/^ "&"? $<word>=[\w* <.lower> \w*] $/ ?? ~$<word> !! []
}).sort;
method update-completions {
my $context := self.compiler.context;
return unless $context;
my $pad := nqp::ctxlexpad($context);
my $it := nqp::iterator($pad);
while $it {
my $e := nqp::shift($it);
my $k := nqp::iterkey_s($e);
my $m = $k ~~ /^ "&"? $<word>=[\w* <.lower> \w*] $/;
if $m {
my $word = ~$m<word>;
sorted-set-insert(@!completions, $word);
}
}
my $PACKAGE = self.compiler.eval('$?PACKAGE', :outer_ctx($context));
for $PACKAGE.WHO.keys -> $k {
sorted-set-insert(@!completions, $k);
}
}
method extract-last-word(Str $line) {
my $m = $line ~~ /^ $<prefix>=[.*?] <|w>$<last_word>=[\w*]$/;
( ~$m<prefix>, ~$m<last_word> )
}
method completions-for-line(Str $line, int $cursor-index) {
return @!completions unless $line;
# ignore $cursor-index until we have a backend that provides it
my ( $prefix, $word-at-cursor ) = self.extract-last-word($line);
# XXX this could be more efficient if we had a smarter starting index
gather for @!completions -> $word {
if $word ~~ /^ "$word-at-cursor" / {
take $prefix ~ $word;
}
}
}
}
class REPL {
also does Completions;
has Mu $.compiler;
has Bool $!multi-line-enabled;
has IO::Path $!history-file;
has $!save_ctx;
sub do-mixin($self, Str $module-name, $behavior, Str :$fallback) {
my Bool $problem = False;
try {
CATCH {
when X::CompUnit::UnsatisfiedDependency & { .specification ~~ /"$module-name"/ } {
# ignore it
}
default {
say "I ran into a problem while trying to set up $module-name: $_";
if $fallback {
say "Falling back to $fallback (if present)";
}
$problem = True;
}
}
my $module = do require ::($module-name);
my $new-self = $self but $behavior.^parameterize($module.WHO<EXPORT>.WHO<ALL>.WHO);
$new-self.?init-line-editor();
return ( $new-self, False );
}
( Any, $problem )
}
sub mixin-readline($self, |c) {
do-mixin($self, 'Readline', ReadlineBehavior, |c)
}
sub mixin-linenoise($self, |c) {
do-mixin($self, 'Linenoise', LinenoiseBehavior, |c)
}
sub mixin-line-editor($self) {
my $new-self;
my Bool $problem;
my %editor-to-mixin = (
:Linenoise(&mixin-linenoise),
:Readline(&mixin-readline),
:none(-> $self { ( $self but FallbackBehavior, False ) }),
);
if %*ENV<RAKUDO_LINE_EDITOR> -> $line-editor {
if %editor-to-mixin{$line-editor} -> $mixin {
( $new-self, $problem ) = $mixin($self);
if $new-self {
return $new-self;
} else {
unless $problem {
say "Could not find $line-editor module";
}
return $self but FallbackBehavior;
}
} else {
say "Unrecognized line editor '$line-editor'";
return $self but FallbackBehavior;
}
} else {
( $new-self, $problem ) = mixin-readline($self, :fallback<Linenoise>);
return $new-self if $new-self;
( $new-self, $problem ) = mixin-linenoise($self);
return $new-self if $new-self;
if $problem {
say 'Continuing without tab completions or line editor';
say 'You may want to consider using rlwrap for simple line editor functionality';
} else {
say 'You may want to `panda install Readline` or `panda install Linenoise` or use rlwrap for a line editor';
}
say '';
}
$self but FallbackBehavior
}
method new(Mu \compiler, Mu \adverbs) {
my $multi-line-enabled = !%*ENV<RAKUDO_DISABLE_MULTILINE>;
my $self = self.bless();
$self.init(compiler, $multi-line-enabled);
$self = mixin-line-editor($self);
$self
}
method init(Mu \compiler, $multi-line-enabled) {
$!compiler := compiler;
$!multi-line-enabled = $multi-line-enabled;
}
method teardown {
self.?teardown-line-editor;
}
method partial-eval(Mu \code, Mu \adverbs) {
my &needs_more_input = adverbs<needs_more_input>;
CATCH {
when X::Syntax::Missing {
if $!multi-line-enabled && .pos == code.chars {
return needs_more_input();
} else {
.throw;
}
}
when X::Comp::FailGoal {
if $!multi-line-enabled && .pos == code.chars {
return needs_more_input();
} else {
.throw;
}
}
}
self.compiler.eval(code, |%(adverbs))
}
method repl-eval($code, *%adverbs) {
my $needs_more_input = False;
%adverbs<needs_more_input> := sub () {
$needs_more_input = True;
};
my $result := self.partial-eval($code, %adverbs);
if $needs_more_input {
return $more-code-sentinel;
}
$result
}
method interactive_prompt() { '> ' }
method repl-loop(*%adverbs) {
say "To exit type 'exit' or '^D'";
my ($prompt, $code);
sub reset {
$code = "";
$prompt = self.interactive_prompt;
}
reset;
loop {
my $running = False;
my $repl-loop = start {
signal(SIGINT).tap: {
class X::REPL::Interrupt {}.new.throw
}
REPL: loop {
my $newcode = self.repl-read(~$prompt);
my $initial_out_position = $*OUT.tell;
# An undef $newcode implies ^D or similar
last unless $newcode.defined;
$code = $code ~ $newcode ~ "\n";
next if $code ~~ /^ <.ws> $/;
my $*CTXSAVE := self;
my $*MAIN_CTX;
$running = True;
my $output := self.repl-eval(
$code,
:outer_ctx($!save_ctx),
|%adverbs,
);
$running = False;
if self.input-incomplete($output) {
$prompt = '* ';
next;
}
$!save_ctx := $*MAIN_CTX if $*MAIN_CTX;
reset;
# Only print the result if there wasn't some other output
if $initial_out_position == $*OUT.tell {
self.repl-print($output);
}
CATCH {
say $_;
reset;
next REPL;
}
}
}
await Promise.allof($repl-loop);
next if $running and $repl-loop.result ~~ X::REPL::Interrupt;
}
self.teardown;
}
# Inside of the EVAL it does like caller.ctxsave
method ctxsave() {
$*MAIN_CTX := nqp::ctxcaller(nqp::ctx());
$*CTXSAVE := 0;
}
method input-incomplete(Mu $value) {
$value.WHERE == $more-code-sentinel.WHERE
}
method repl-print(Mu $value) {
say $value;
}
method history-file returns Str {
return ~$!history-file if $!history-file.defined;
$!history-file = do
if $*ENV<RAKUDO_HIST> {
IO::Path.new($*ENV<RAKUDO_HIST>)
} else {
IO::Path.new($*HOME).child('.perl6').child('rakudo-history')
}
try {
mkpath($!history-file);
CATCH {
when X::AdHoc & ({ .Str ~~ m:s/Unable to mkpath/ }) {
note "I ran into a problem trying to set up history: $_";
note 'Sorry, but history will not be saved at the end of your session';
}
}
}
~$!history-file
}
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment