1. class REPL { ... }
  2. do {
  3. my sub sorted-set-insert(@values, $value) {
  4. my $low = 0;
  5. my $high = @values.end;
  6. my $insert_pos = 0;
  7. while $low <= $high {
  8. my $middle = floor($low + ($high - $low) / 2);
  9. my $middle_elem = @values[$middle];
  10. if $middle == @values.end {
  11. if $value eq $middle_elem {
  12. return;
  13. } elsif $value lt $middle_elem {
  14. $high = $middle - 1;
  15. } else {
  16. $insert_pos = +@values;
  17. last;
  18. }
  19. } else {
  20. my $middle_plus_one_elem = @values[$middle + 1];
  21. if $value eq $middle_elem || $value eq $middle_plus_one_elem {
  22. return;
  23. } elsif $value lt $middle_elem {
  24. $high = $middle - 1;
  25. } elsif $value gt $middle_plus_one_elem {
  26. $low = $middle + 1;
  27. } else {
  28. $insert_pos = $middle + 1;
  29. last;
  30. }
  31. }
  32. }
  33. splice(@values, $insert_pos, 0, $value);
  34. }
  35. my role ReadlineBehavior[$WHO] {
  36. my &readline = $WHO<&readline>;
  37. my &add_history = $WHO<&add_history>;
  38. my $Readline = try { require Readline }
  39. my $read = $Readline.new;
  40. if ! $*DISTRO.is-win {
  41. $read.read-init-file("/etc/inputrc");
  42. $read.read-init-file("~/.inputrc");
  43. }
  44. method init-line-editor {
  45. $read.read-history($.history-file);
  46. }
  47. method repl-read(Mu \prompt) {
  48. my $line = $read.readline(prompt);
  49. if $line.defined && $line.match(/\S/) {
  50. $read.add-history($line);
  51. $read.append-history(1, $.history-file);
  52. }
  53. $line
  54. }
  55. }
  56. my role LinenoiseBehavior[$WHO] {
  57. my &linenoise = $WHO<&linenoise>;
  58. my &linenoiseHistoryAdd = $WHO<&linenoiseHistoryAdd>;
  59. my &linenoiseSetCompletionCallback = $WHO<&linenoiseSetCompletionCallback>;
  60. my &linenoiseAddCompletion = $WHO<&linenoiseAddCompletion>;
  61. my &linenoiseHistoryLoad = $WHO<&linenoiseHistoryLoad>;
  62. my &linenoiseHistorySave = $WHO<&linenoiseHistorySave>;
  63. method completions-for-line(Str $line, int $cursor-index) { ... }
  64. method history-file(--> Str:D) { ... }
  65. method init-line-editor {
  66. linenoiseSetCompletionCallback(sub ($line, $c) {
  67. eager self.completions-for-line($line, $line.chars).map(&linenoiseAddCompletion.assuming($c));
  68. });
  69. linenoiseHistoryLoad($.history-file);
  70. }
  71. method teardown-line-editor {
  72. my $err = linenoiseHistorySave($.history-file);
  73. return if !$err;
  74. note "Couldn't save your history to $.history-file";
  75. }
  76. method repl-read(Mu \prompt) {
  77. self.update-completions;
  78. my $line = linenoise(prompt);
  79. if $line.defined && $line.match(/\S/) {
  80. linenoiseHistoryAdd($line);
  81. }
  82. $line
  83. }
  84. }
  85. my role FallbackBehavior {
  86. method repl-read(Mu \prompt) {
  87. print prompt;
  88. get
  89. }
  90. }
  91. my role Completions {
  92. # RT #129092: jvm can't do CORE::.keys
  93. has @!completions = $*VM.name eq 'jvm'
  94. ?? ()
  95. !! CORE::.keys.flatmap({
  96. /^ "&"? $<word>=[\w* <.lower> \w*] $/ ?? ~$<word> !! []
  97. }).sort;
  98. method update-completions(--> Nil) {
  99. my $context := self.compiler.context;
  100. return unless $context;
  101. my $pad := nqp::ctxlexpad($context);
  102. my $it := nqp::iterator($pad);
  103. while $it {
  104. my $k := nqp::iterkey_s(nqp::shift($it));
  105. my $m = $k ~~ /^ "&"? $<word>=[\w* <.lower> \w*] $/;
  106. next if !$m;
  107. my $word = ~$m<word>;
  108. sorted-set-insert(@!completions, $word);
  109. }
  110. my $PACKAGE = self.compiler.eval('$?PACKAGE', :outer_ctx($context));
  111. for $PACKAGE.WHO.keys -> $k {
  112. sorted-set-insert(@!completions, $k);
  113. }
  114. }
  115. method extract-last-word(Str $line) {
  116. my $m = $line ~~ /^ $<prefix>=[.*?] <|w>$<last_word>=[\w*]$/;
  117. return ( $line, '') unless $m;
  118. ( ~$m<prefix>, ~$m<last_word> )
  119. }
  120. method completions-for-line(Str $line, int $cursor-index) {
  121. return @!completions unless $line;
  122. # ignore $cursor-index until we have a backend that provides it
  123. my ( $prefix, $word-at-cursor ) = self.extract-last-word($line);
  124. # XXX this could be more efficient if we had a smarter starting index
  125. gather for @!completions -> $word {
  126. if $word ~~ /^ "$word-at-cursor" / {
  127. take $prefix ~ $word;
  128. }
  129. }
  130. }
  131. }
  132. class REPL {
  133. also does Completions;
  134. has Mu $.compiler;
  135. has Bool $!multi-line-enabled;
  136. has IO::Path $!history-file;
  137. has $!save_ctx;
  138. # Unique internal values for out-of-band eval results
  139. has $!need-more-input = {};
  140. has $!control-not-allowed = {};
  141. sub do-mixin($self, Str $module-name, $behavior, Str :$fallback) {
  142. my Bool $problem = False;
  143. try {
  144. CATCH {
  145. when {
  146. $_ ~~ X::CompUnit::UnsatisfiedDependency
  147. and .specification.Str.contains: $module-name
  148. } {
  149. # ignore it
  150. }
  151. default {
  152. say "I ran into a problem while trying to set up $module-name: $_";
  153. if $fallback {
  154. say "Falling back to $fallback (if present)";
  155. }
  156. $problem = True;
  157. }
  158. }
  159. my $module = do require ::($module-name);
  160. my $new-self = $self but $behavior.^parameterize($module.WHO<EXPORT>.WHO<ALL>.WHO);
  161. $new-self.?init-line-editor();
  162. return ( $new-self, False );
  163. }
  164. ( Any, $problem )
  165. }
  166. sub mixin-readline($self, |c) {
  167. do-mixin($self, 'Readline', ReadlineBehavior, |c)
  168. }
  169. sub mixin-linenoise($self, |c) {
  170. do-mixin($self, 'Linenoise', LinenoiseBehavior, |c)
  171. }
  172. sub mixin-line-editor($self) {
  173. my %editor-to-mixin = (
  174. :Linenoise(&mixin-linenoise),
  175. :Readline(&mixin-readline),
  176. :none(-> $self { ( $self but FallbackBehavior, False ) }),
  177. );
  178. if %*ENV<RAKUDO_LINE_EDITOR> -> $line-editor {
  179. if !%editor-to-mixin{$line-editor} {
  180. say "Unrecognized line editor '$line-editor'";
  181. return $self but FallbackBehavior;
  182. }
  183. my $mixin = %editor-to-mixin{$line-editor};
  184. my ( $new-self, $problem ) = $mixin($self);
  185. return $new-self if $new-self;
  186. say "Could not find $line-editor module" unless $problem;
  187. return $self but FallbackBehavior;
  188. }
  189. my ( $new-self, $problem ) = mixin-readline($self, :fallback<Linenoise>);
  190. return $new-self if $new-self;
  191. ( $new-self, $problem ) = mixin-linenoise($self);
  192. return $new-self if $new-self;
  193. if $problem {
  194. say 'Continuing without tab completions or line editor';
  195. say 'You may want to consider using rlwrap for simple line editor functionality';
  196. }
  197. elsif !$*DISTRO.is-win and !( %*ENV<_>:exists and %*ENV<_>.ends-with: 'rlwrap' ) {
  198. say 'You may want to `zef install Readline` or `zef install Linenoise` or use rlwrap for a line editor';
  199. }
  200. say '';
  201. $self but FallbackBehavior
  202. }
  203. method new(Mu \compiler, Mu \adverbs) {
  204. my $multi-line-enabled = !%*ENV<RAKUDO_DISABLE_MULTILINE>;
  205. my $self = self.bless();
  206. $self.init(compiler, $multi-line-enabled);
  207. $self = mixin-line-editor($self);
  208. $self
  209. }
  210. method init(Mu \compiler, $multi-line-enabled --> Nil) {
  211. $!compiler := compiler;
  212. $!multi-line-enabled = $multi-line-enabled;
  213. }
  214. method teardown {
  215. self.?teardown-line-editor;
  216. }
  217. method repl-eval($code, \exception, *%adverbs) {
  218. CATCH {
  219. when X::Syntax::Missing {
  220. return $!need-more-input
  221. if $!multi-line-enabled && .pos == $code.chars;
  222. .throw;
  223. }
  224. when X::Comp::FailGoal {
  225. return $!need-more-input
  226. if $!multi-line-enabled && .pos == $code.chars;
  227. .throw;
  228. }
  229. when X::ControlFlow::Return {
  230. return $!control-not-allowed;
  231. }
  232. default {
  233. exception = $_;
  234. return;
  235. }
  236. }
  237. CONTROL {
  238. when CX::Emit | CX::Take { .rethrow; }
  239. when CX::Warn { .gist.say; .resume; }
  240. return $!control-not-allowed;
  241. }
  242. self.compiler.eval($code, |%adverbs);
  243. }
  244. method interactive_prompt() { '> ' }
  245. method repl-loop(*%adverbs) {
  246. say "To exit type 'exit' or '^D'";
  247. my $prompt;
  248. my $code;
  249. sub reset(--> Nil) {
  250. $code = '';
  251. $prompt = self.interactive_prompt;
  252. }
  253. reset;
  254. REPL: loop {
  255. my $newcode = self.repl-read(~$prompt);
  256. my $initial_out_position = $*OUT.tell;
  257. # An undef $newcode implies ^D or similar
  258. if !$newcode.defined {
  259. last;
  260. }
  261. $code = $code ~ $newcode ~ "\n";
  262. if $code ~~ /^ <.ws> $/ {
  263. next;
  264. }
  265. my $*CTXSAVE := self;
  266. my $*MAIN_CTX;
  267. my $output is default(Nil) = self.repl-eval(
  268. $code,
  269. my $exception,
  270. :outer_ctx($!save_ctx),
  271. |%adverbs);
  272. if self.input-incomplete($output) {
  273. $prompt = '* ';
  274. next;
  275. }
  276. if self.input-toplevel-control($output) {
  277. say "Control flow commands not allowed in toplevel";
  278. reset;
  279. next;
  280. }
  281. if $*MAIN_CTX {
  282. $!save_ctx := $*MAIN_CTX;
  283. }
  284. reset;
  285. # Print the result if:
  286. # - there wasn't some other output
  287. # - the result is an *unhandled* Failure
  288. # - print an exception if one had occured
  289. if $exception.DEFINITE {
  290. self.repl-print($exception);
  291. }
  292. elsif $initial_out_position == $*OUT.tell
  293. or nqp::istype($output, Failure) and not $output.handled {
  294. self.repl-print($output);
  295. }
  296. # Why doesn't the catch-default in repl-eval catch all?
  297. CATCH {
  298. default { say $_; reset }
  299. }
  300. }
  301. self.teardown;
  302. }
  303. # Inside of the EVAL it does like caller.ctxsave
  304. method ctxsave(--> Nil) {
  305. $*MAIN_CTX := nqp::ctxcaller(nqp::ctx());
  306. $*CTXSAVE := 0;
  307. }
  308. method input-incomplete(Mu $value) {
  309. $value.WHERE == $!need-more-input.WHERE
  310. }
  311. method input-toplevel-control(Mu $value) {
  312. $value.WHERE == $!control-not-allowed.WHERE
  313. }
  314. method repl-print(Mu $value --> Nil) {
  315. say $value;
  316. CATCH {
  317. default { say $_ }
  318. }
  319. }
  320. method history-file(--> Str:D) {
  321. return $!history-file.absolute if $!history-file.defined;
  322. $!history-file = $*ENV<RAKUDO_HIST>
  323. ?? $*ENV<RAKUDO_HIST>.IO
  324. !! ($*HOME || $*TMPDIR).add('.perl6/rakudo-history');
  325. without mkdir $!history-file.parent {
  326. note "I ran into a problem trying to set up history: {.exception.message}";
  327. note 'Sorry, but history will not be saved at the end of your session';
  328. }
  329. $!history-file.absolute
  330. }
  331. }
  332. }