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 {
  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 {
  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 X::CompUnit::UnsatisfiedDependency & { .specification ~~ /"$module-name"/ } {
  146. # ignore it
  147. }
  148. default {
  149. say "I ran into a problem while trying to set up $module-name: $_";
  150. if $fallback {
  151. say "Falling back to $fallback (if present)";
  152. }
  153. $problem = True;
  154. }
  155. }
  156. my $module = do require ::($module-name);
  157. my $new-self = $self but $behavior.^parameterize($module.WHO<EXPORT>.WHO<ALL>.WHO);
  158. $new-self.?init-line-editor();
  159. return ( $new-self, False );
  160. }
  161. ( Any, $problem )
  162. }
  163. sub mixin-readline($self, |c) {
  164. do-mixin($self, 'Readline', ReadlineBehavior, |c)
  165. }
  166. sub mixin-linenoise($self, |c) {
  167. do-mixin($self, 'Linenoise', LinenoiseBehavior, |c)
  168. }
  169. sub mixin-line-editor($self) {
  170. my %editor-to-mixin = (
  171. :Linenoise(&mixin-linenoise),
  172. :Readline(&mixin-readline),
  173. :none(-> $self { ( $self but FallbackBehavior, False ) }),
  174. );
  175. if %*ENV<RAKUDO_LINE_EDITOR> -> $line-editor {
  176. if !%editor-to-mixin{$line-editor} {
  177. say "Unrecognized line editor '$line-editor'";
  178. return $self but FallbackBehavior;
  179. }
  180. my $mixin = %editor-to-mixin{$line-editor};
  181. my ( $new-self, $problem ) = $mixin($self);
  182. return $new-self if $new-self;
  183. say "Could not find $line-editor module" unless $problem;
  184. return $self but FallbackBehavior;
  185. }
  186. my ( $new-self, $problem ) = mixin-readline($self, :fallback<Linenoise>);
  187. return $new-self if $new-self;
  188. ( $new-self, $problem ) = mixin-linenoise($self);
  189. return $new-self if $new-self;
  190. if $problem {
  191. say 'Continuing without tab completions or line editor';
  192. say 'You may want to consider using rlwrap for simple line editor functionality';
  193. } elsif !$*DISTRO.is-win {
  194. say 'You may want to `zef install Readline` or `zef install Linenoise` or use rlwrap for a line editor';
  195. }
  196. say '';
  197. $self but FallbackBehavior
  198. }
  199. method new(Mu \compiler, Mu \adverbs) {
  200. my $multi-line-enabled = !%*ENV<RAKUDO_DISABLE_MULTILINE>;
  201. my $self = self.bless();
  202. $self.init(compiler, $multi-line-enabled);
  203. $self = mixin-line-editor($self);
  204. $self
  205. }
  206. method init(Mu \compiler, $multi-line-enabled --> Nil) {
  207. $!compiler := compiler;
  208. $!multi-line-enabled = $multi-line-enabled;
  209. }
  210. method teardown {
  211. self.?teardown-line-editor;
  212. }
  213. method repl-eval($code, \exception, *%adverbs) {
  214. CATCH {
  215. when X::Syntax::Missing {
  216. return $!need-more-input
  217. if $!multi-line-enabled && .pos == $code.chars;
  218. .throw;
  219. }
  220. when X::Comp::FailGoal {
  221. return $!need-more-input
  222. if $!multi-line-enabled && .pos == $code.chars;
  223. .throw;
  224. }
  225. when X::ControlFlow::Return {
  226. return $!control-not-allowed;
  227. }
  228. default {
  229. exception = $_;
  230. return;
  231. }
  232. }
  233. CONTROL {
  234. when CX::Emit | CX::Take { .rethrow; }
  235. when CX::Warn { .gist.say; .resume; }
  236. return $!control-not-allowed;
  237. }
  238. self.compiler.eval($code, |%adverbs);
  239. }
  240. method interactive_prompt() { '> ' }
  241. method repl-loop(*%adverbs) {
  242. say "To exit type 'exit' or '^D'";
  243. my $prompt;
  244. my $code;
  245. sub reset(--> Nil) {
  246. $code = '';
  247. $prompt = self.interactive_prompt;
  248. }
  249. reset;
  250. REPL: loop {
  251. my $newcode = self.repl-read(~$prompt);
  252. my $initial_out_position = $*OUT.tell;
  253. # An undef $newcode implies ^D or similar
  254. if !$newcode.defined {
  255. last;
  256. }
  257. $code = $code ~ $newcode ~ "\n";
  258. if $code ~~ /^ <.ws> $/ {
  259. next;
  260. }
  261. my $*CTXSAVE := self;
  262. my $*MAIN_CTX;
  263. my $output is default(Nil) = self.repl-eval(
  264. $code,
  265. my $exception,
  266. :outer_ctx($!save_ctx),
  267. |%adverbs);
  268. if self.input-incomplete($output) {
  269. $prompt = '* ';
  270. next;
  271. }
  272. if self.input-toplevel-control($output) {
  273. say "Control flow commands not allowed in toplevel";
  274. reset;
  275. next;
  276. }
  277. if $*MAIN_CTX {
  278. $!save_ctx := $*MAIN_CTX;
  279. }
  280. reset;
  281. # Print the result if:
  282. # - there wasn't some other output
  283. # - the result is an *unhandled* Failure
  284. # - print an exception if one had occured
  285. if $exception.DEFINITE {
  286. self.repl-print($exception);
  287. }
  288. elsif $initial_out_position == $*OUT.tell
  289. or $output ~~ Failure and not $output.handled {
  290. self.repl-print($output);
  291. }
  292. # Why doesn't the catch-default in repl-eval catch all?
  293. CATCH {
  294. default { say $_; reset }
  295. }
  296. }
  297. self.teardown;
  298. }
  299. # Inside of the EVAL it does like caller.ctxsave
  300. method ctxsave(--> Nil) {
  301. $*MAIN_CTX := nqp::ctxcaller(nqp::ctx());
  302. $*CTXSAVE := 0;
  303. }
  304. method input-incomplete(Mu $value) {
  305. $value.WHERE == $!need-more-input.WHERE
  306. }
  307. method input-toplevel-control(Mu $value) {
  308. $value.WHERE == $!control-not-allowed.WHERE
  309. }
  310. method repl-print(Mu $value --> Nil) {
  311. say $value;
  312. CATCH {
  313. default { say $_ }
  314. }
  315. }
  316. method history-file(--> Str:D) {
  317. return $!history-file.absolute if $!history-file.defined;
  318. $!history-file = $*ENV<RAKUDO_HIST>
  319. ?? $*ENV<RAKUDO_HIST>.IO
  320. !! ($*HOME || $*TMPDIR).add('.perl6/rakudo-history');
  321. without mkdir $!history-file.parent {
  322. note "I ran into a problem trying to set up history: {.exception.message}";
  323. note 'Sorry, but history will not be saved at the end of your session';
  324. }
  325. $!history-file.absolute
  326. }
  327. }
  328. }