Skip to content
Permalink
master
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
Go to file
 
 
Cannot retrieve contributors at this time
(define-module ralph/repl/interactor
import: (ralph/stream
ralph/format-out
ralph/compiler/environment
ralph/compiler/reader
ralph/compiler/compile
(ws rename: ("createServer" create-server))
(readline
rename: ("createInterface" create-interface)))
export: (<interactor> start-interactor change-module))
(define-function make-interface ()
(create-interface
(%object "input" (%native "process.stdin")
"output" (%native "process.stdout"))))
(define-class <interactor> (<object>)
(current-line ""))
(define-method initialize ((interactor <interactor>))
(call-next-method)
(bind ((interface (make-interface)))
(set! (get interactor "interface")
interface)
(. interface
(on "close"
(method ()
(. (%native "process")
(exit 0)))))))
(define-function active? ((interactor <interactor>))
(true? (get interactor "connection")))
(define $incomplete (make-object))
(define-function read-line ((interactor <interactor>) line)
(bind ((input-stream (make <string-stream> string: line)))
(read input-stream (get interactor "current-environment")
eof-error?: #f
eof-value: $incomplete
if-incomplete: $incomplete)))
(define-function on-each-line ((interactor <interactor>) handler)
(. (get interactor "interface")
(on "line" handler)))
(define-function make-environment (name)
(bind ((env (make-module-environment name)))
(set! (get env "persistent?") #f)
;; TODO: use module description to specifiy imports
env))
(define-function send-command ((interactor <interactor>) type #rest data)
(. (get interactor "connection")
(send (as-json (apply make-object "type" type data)))))
(define-function perform-module-change ((interactor <interactor>) name)
(bind ((env (or (get interactor "environments" name)
(make-environment name))))
(set! (get interactor "envrionments" name) env)
(set! (get interactor "current-environment") env)))
(define-function change-module ((interactor <interactor>) name)
(perform-module-change interactor name)
(send-command interactor "change-module"
"name" name))
(define $handlers (make-plain-object))
(define-function handle-message ((interactor <interactor>) serialized-message)
(bind ((message (parse-json serialized-message)))
(if-bind (handler (get $handlers (get message "type")))
(handler interactor message))))
(define-function handle-connection ((interactor <interactor>) connection)
;; TODO: close current connection
(. connection (on "message"
(curry handle-message interactor)))
(. connection (on "close"
(curry handle-close interactor)))
(set! (get interactor "connection")
connection)
(change-module interactor "ralph/core")
(update-prompt! interactor))
(define-function handle-close ((interactor <interactor>))
(set! (get interactor "connection") #f)
(set! (get interactor "current-environment") #f)
(update-prompt! interactor))
(define-function start-server ((interactor <interactor>) port)
(bind ((server (create-server (%object "port" port)
(curry handle-connection interactor))))
(set! (get interactor "server") server)))
(define-function start-interactor ((interactor <interactor>) #key (port 2342))
(start-server interactor port)
(on-each-line interactor
(method (line)
(if (active? interactor)
(handle-line interactor line)
(begin
(format-out "[inactive]\n")
(update-prompt! interactor)))))
(update-prompt! interactor))
(define-function append-line! ((interactor <interactor>) line)
(set! (get interactor "current-line")
(concatenate (get interactor "current-line")
"\n" line)))
(define-function eval-in-module ((interactor <interactor>) code)
(send-command interactor "eval-in-module"
"code" code))
(set! (get $handlers "result")
(method (interactor message)
(bind-properties (result) message
(format-out "%s\n" result))
(update-prompt! interactor)))
(set! (get $handlers "exception")
(method (interactor message)
(bind-properties (stack) message
(format-out "%s\n" stack))
(update-prompt! interactor)))
(set! (get $handlers "change-module")
(method (interactor message)
(bind-properties (name) message
(perform-module-change interactor name))))
(define-function handle-line ((interactor <interactor>) line)
(append-line! interactor line)
(bind-properties (current-line current-environment)
interactor
(handler-case
(bind ((expression (read-line interactor current-line))
(incomplete? (== expression $incomplete)))
(set! (get interactor "incomplete?")
incomplete?)
(if incomplete?
(update-prompt! interactor)
(bind ((code (compile-to-string expression
current-environment)))
(eval-in-module interactor code)
(set! (get interactor "current-line") ""))))
((<error> condition: condition)
(format-out "%s\n" (get condition "stack"))
(set! current-line "")
(update-prompt! interactor)))))
(define-function current-module-name ((interactor <interactor>))
(if-bind (env (get interactor "current-environment"))
(get env "module" "name")))
(define-function set-prompt! ((interactor <interactor>) prompt)
(. (get interactor "interface")
("setPrompt" prompt)))
(define-function prompt! ((interactor <interactor>))
(. (get interactor "interface")
(prompt)))
(define-function update-prompt! ((interactor <interactor>))
(bind ((name (or (current-module-name interactor) "")))
(set-prompt! interactor
(if (get interactor "incomplete?")
(concatenate (repeat-string " " (- (size name) 2))
"... ")
(concatenate name "> ")))
(prompt! interactor)))