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