src/lib/repl.slate

   1 prototypes define: #REPL &parents: {Cloneable} &slots: {
   2   #parser -> (Parser newOn: '').
   3   #printer -> String writer.
   4   #resource -> DebugConsole.
   5   #originalNamespace -> lobby.
   6   #namespace -> lobby newSubSpace.
   7   #lineCount -> 0.
   8   #basePrompt -> '> '.
   9   #noviceMode -> False.
  10   #inputs -> (RingBuffer new &capacity: 10).
  11   #results -> (RingBuffer new &capacity: 10).
  12 }.
  13
  14 ns@(Namespace traits) inform: message &target
  15 [| *rest |
  16   target `defaultsTo: REPL resource.
  17   target writer ; (rest isEmpty ifTrue: [message] ifFalse: [#formatting sendTo: {message} ; rest]) ; '\n'.
  18   target writer flush.
  19 ].
  20
  21 ns@(Namespace traits) print: obj &target
  22 [
  23   target `defaultsTo: REPL resource.
  24   obj printOn: target writer.
  25   target writer ; '\n'.
  26   target writer flush.
  27 ].
  28
  29 ns@(Namespace traits) query: message &target
  30 "A simple way to ask input of the user on an ExternalResource (by default
  31 the Console) and return a Slate String response."
  32 [
  33   target `defaultsTo: REPL resource.
  34   target writer ; message.
  35   target writer flush.
  36   "Grabs the next line when it's available."
  37   [(response ::= target interactor upTo: $\n) isEmpty] whileTrue.
  38   target writer flush.
  39   response
  40 ].
  41
  42 ns@(Namespace traits) confirm: message &target
  43 "A simple way to ask a Boolean question of the user on an ExternalResource
  44 (by default the Console) and return a Slate Boolean answer."
  45 [
  46   response ::= (ns query: message ; ' (y/n) ') toLowercase.
  47   {'y'. 'yes'} anySatisfy: [| :option | option = response]
  48 ].
  49
  50 ns@(Namespace traits) doubleConfirm: message &target
  51 [
  52   (response ::= ns confirm: message &target: target)
  53     /\ [ns confirm: 'Are you sure?' &target: target]
  54 ].
  55
  56 REPL traits NamespaceMethods ::= Dictionary new.
  57 [| :assoc | REPL NamespaceMethods at: assoc key put: assoc value] for: {
  58   #pasteMode       -> [| :ns | ns repl parser parseInteractively := False].
  59   #interactiveMode -> [| :ns | ns repl parser parseInteractively := True].
  60   #it              -> [| :ns | ns it1].
  61   #it1             -> [| :ns | ns repl results first].
  62   #it2             -> [| :ns | ns repl results second].
  63   #it3             -> [| :ns | ns repl results third].
  64   #it4             -> [| :ns | ns repl results fourth].
  65   #it5             -> [| :ns | ns repl results fifth].
  66
  67   #in:             -> [| :nsold :ns | ns atSlotNamed: #parentNamespace := ns].
  68
  69   #?               -> [| :ns :obj | ns helpFor: obj].
  70
  71   #help            ->
  72   [| :ns &target |
  73     target `defaultsTo: ns repl resource.
  74     target writer ; 'The REPL is an interactive evaluator that parses expressions and prints their results back. It also keeps a return-value history and interaction messages:\n'
  75       ; 'it\n\tAnswers the last result.\n'
  76       ; 'itN\n\tAnswers the result from N (1..5) expressions ago in the history.\n'
  77       ; 'repl\n\tAnswers the current REPL and its properties.\n'
  78       ; 'pasteMode\n\t(Default) Evaluate only when a finished expression is followed by a period and newline.\n'
  79       ; 'interactiveMode\n\tEvaluate when newline is entered and the expression is complete.\n'
  80       ; 'inspect: obj\n\tStarts the interactive travelling inspector.\n'
  81       ; 'inform: \'message\'\n\tPrints a message on a single line.\n'
  82       ; 'query: \'message\'\n\tPrints a message, waiting on and answering a user response.\n'
  83       ; 'confirm: \'message\'\n\tPrints a question on a single line and answering a user boolean response.\n'
  84       ; 'resetOnStartup\n\tClears the history and line number on fresh runs of the VM.\n'
  85       ; 'help\n\tPrints this helpful message.\n'.
  86   ].
  87 }.
  88
  89 REPL traits define: #Workspace &parents: {Namespace}.
  90 "A separate Namespace type for REPL usage."
  91
  92 repl@(REPL traits) installMethods
  93 "This defines a number of namespace methods for convenient REPL access
  94 and control."
  95 [
  96   _@(repl namespace) repl "Answer the currently used REPL." [repl].
  97   ns@(repl namespace) ? [ns help].
  98   repl NamespaceMethods keysAndValuesDo:
  99     [| :selector :method | method asMethod: selector on: {repl namespace}].
 100 ].
 101
 102 repl@(REPL traits) removeMethods
 103 "This removes methods defined in installMethods."
 104 [
 105   [| :sel |
 106    (sel findOn: {repl namespace}) ifNotNilDo:
 107      [| :m | m removeFrom: {repl namespace}]] for: repl NamespaceMethods keySet
 108 ].
 109
 110 repl@(REPL traits) refreshWorkspace
 111 [
 112   repl namespace := repl Workspace newDelegatingTo: repl originalNamespace.
 113   repl installMethods.
 114   repl parser currentScope := repl parser currentScope for: repl namespace.
 115 ].
 116
 117 repl@(REPL traits) prompt
 118 [
 119   'slate[%@]%s' formatting, repl lineCount, repl basePrompt
 120 ].
 121
 122 repl@(REPL traits) newBasedOn: resource@(ExternalResource traits)
 123 "Answer a new REPL targetting the specified resource and reset it."
 124 [repl clone `>> [on: resource. reset. ]].
 125
 126 repl@(REPL traits) on: resource
 127 "Re-target the REPL to the specified resource."
 128 [
 129   repl resource := resource.
 130   repl refreshIO.
 131 ].
 132
 133 repl@(REPL traits) refreshIO
 134 [
 135   repl parser := repl parser newOn: repl resource reader.
 136   repl printer := repl resource writer.
 137 ].
 138
 139 repl@(REPL traits) reset
 140 "Clear out the line number and the evaluation result Collection."
 141 [
 142   repl lineCount := 0.
 143   repl inputs clear.
 144   repl results clear.
 145   repl refreshIO.
 146 ].
 147
 148 _@here interpretHook: block
 149 "The default set of restarts for any errors in a block of code."
 150 [
 151   block
 152     handlingCases:
 153       {
 154         Abort -> [| :_ | ^ Nil].
 155         Quit -> [| :_ |]
 156       }
 157 ].
 158
 159 repl@(REPL traits) enter
 160 "Sets up the convenient namespace methods and runs the interactive loop.
 161 This does not normally exit unless there is a serious error."
 162 [
 163   [repl refreshWorkspace.
 164    [repl on: repl resource.
 165     repl lineCount += 1.
 166     repl printer ; repl prompt.
 167     repl printer flush.
 168     repl namespace interpretHook:
 169       [| expr |
 170        [expr := repl parser next] on: Stream Exhaustion
 171          do: [| :c | c stream == repl resource reader ifTrue: [^ Nil]].
 172        repl inputs addFirst: expr.
 173        result ::= [expr evaluateIn: repl namespace] on: SeriousCondition do:
 174          [| :c |
 175           repl noviceMode ifTrue:
 176             [c describeOn: repl printer.
 177              c exit: Nil]].
 178        repl results addFirst: result.
 179        [result printOn: repl printer] on: SeriousCondition do:
 180          [| :c |
 181           repl printer newLine.
 182           warn: result printName ; ' (Printing failed)'.
 183           c exit: Nil]].
 184     repl printer newLine.
 185     repl printer flush.
 186     "repl namespace interpretHook: [currentProcess run &limit: 1000]"]
 187      loop] ensure: [repl removeMethods. Image startupActions removeKey: repl].
 188   repl
 189 ].
 190
 191 repl@(REPL traits) completionsFor: word
 192 "Answers an Array of all the possible complete Symbols defined in the system
 193 which the given word is a valid prefix of.
 194 TODO: Consult the recent literal frames for names.
 195 TODO: sort the results by some suitable precedence."
 196 [
 197   [| :result |
 198   globals Symbols keysDo:
 199     [| :key | (word isPrefixOf: key) ifTrue: [result nextPut: key]]]
 200    writingAs: #{}
 201 ].
 202
 203 repl@(REPL traits) start &namespace: ns &resource: r
 204 "Enter a new REPL instance on the resource."
 205 [
 206   (repl newBasedOn: (r `defaultsTo: repl resource)) `>> [namespace := ns. enter]
 207 ].
 208
 209 repl@(REPL traits) resetOnStartup
 210 "Adds a handler for Image startup to reset the REPL."
 211 [Image startupActions at: repl := [repl reset]].
 212
 213 ns@(Namespace traits) newREPL
 214 [
 215   REPL start &namespace: ns
 216 ].