Repl server library (mattwparas#301)

* include web stuff

* checkpoint

* wip

* move repl to its own directory

* provide the repl function

* add some basic handling

* clean up function names

* some more handling

* move the web library to the wip directory

* wrap entrypoints in test mode

cogs/installer/parser.scm

@@ -18,9 +18,7 @@
              (into-hashmap)))
 
 (define (convert-path path)
-  (if (equal? (current-os!) "windows")
-      (string-replace path "/" "\\")
-      path))
+  (if (equal? (current-os!) "windows") (string-replace path "/" "\\") path))
 
 (define (parse-cog module [search-from #f])
   ;; TODO: This needs to handle relative paths
@@ -41,6 +39,7 @@
             ; (displayln "Searching in: " new-search-path)
             (parse-cog new-search-path))
 
+          ;; Try installing?
           (error! "Unable to locate the module " module))))
 
 ;; Parses a cog file directly into a hashmap
@@ -53,10 +52,7 @@
                         ;; TODO: Move this out - also make sure
                         (if (member (car p) '(dylibs dependencies))
                             (list (car p)
-                                  (map (lambda (spec)
-                                         (if (list? spec)
-                                             (apply hash spec)
-                                             spec))
+                                  (map (lambda (spec) (if (list? spec) (apply hash spec) spec))
                                        (cadr p)))
                             p)))
              (into-hashmap)))

cogs/repl/cog.scm

@@ -0,0 +1,9 @@
+(define package-name 'steel/repl)
+(define version "0.1.0")
+
+;; Core library, requires no dependencies
+(define dependencies '())
+
+;; Entrypoint in this case is a client that can connect
+;; to a repl server?
+(define entrypoint '(#:name "repl-connect" #:path "repl-client.scm"))

cogs/repl/repl-client.scm

@@ -0,0 +1,114 @@
+(require-builtin steel/tcp)
+(require-builtin #%private/steel/readline)
+
+(require "steel/sync")
+
+(define channels (channels/new))
+(define sender (channels-sender channels))
+(define receiver (channels-receiver channels))
+
+;; After every input if we should shutdown.
+(define shutdown (channels/new))
+(define shutdown-sender (channels-sender shutdown))
+(define shutdown-receiver (channels-receiver shutdown))
+
+(define MAGIC-START (string->bytes "%start-repl#%"))
+(define MAGIC-START-LENGTH (bytes-length MAGIC-START))
+
+(define (read-size buffer port)
+  (define next (read-byte port))
+  (if (equal? next #x0A)
+      (begin
+        (string->int (bytes->string/utf8 buffer)))
+      (begin
+        (bytes-push! buffer next)
+        (read-size buffer port))))
+
+;; Handle user input, forward, dump out things happening, continue.
+(define (repl-loop [host "0.0.0.0"] [port 8080])
+  (define stream (tcp-connect (string-append host ":" (int->string port))))
+  (define reader (tcp-stream-reader stream))
+  (define writer (tcp-stream-writer stream))
+
+  ;; Print out the startup message for the repl, and then
+  ;; we'll enter the event loop waiting for input.
+  (#%repl-display-startup)
+  (define rl (#%create-repl))
+
+  (define buffer (bytevector))
+
+  (define (loop)
+    (define next (read-char reader))
+    (cond
+      [(equal? next #\#)
+       (let ([maybe-magic (read-bytes MAGIC-START-LENGTH reader)])
+         (if (equal? maybe-magic MAGIC-START)
+             (let ([size (read-size buffer reader)])
+
+               (bytes-clear! buffer)
+
+               ;; Read the next value
+               (define next-value (read-bytes size reader))
+               (define value-as-string (bytes->string/utf8 next-value))
+
+               (unless (equal? "#<void>" value-as-string)
+                 (display "=> ")
+                 (display value-as-string)
+                 (newline))
+
+               (channel/send sender #t))
+             ;; Next should be the length, until the next newline
+             (begin
+               (write-char next (current-output-port))
+               (display (bytes->string/utf8 maybe-magic)))))]
+
+      [(eof-object? next)
+       (displayln "Connection closed.")
+       (return! void)]
+
+      [else (write-char next (current-output-port))])
+
+    ;; Remote repl... add bindings to readline?
+    ;; That could help?
+    ; (write-char (read-char reader) (current-output-port))
+
+    (loop))
+
+  (define (driver)
+    (with-handler (lambda (err)
+                    (displayln err)
+                    (channel/send shutdown-sender #t))
+                  (loop)))
+
+  (spawn-native-thread driver)
+
+  ;; Read input, send on the stream
+  (define (input-loop)
+    (define input (#%read-line rl))
+    (#%repl-add-history-entry rl input)
+
+    ;; Show the error, go again
+    (with-handler (lambda (err) (displayln err))
+                  (write (read (open-input-string input)) writer)
+                  (newline writer)
+                  ;; Selection. Wait on either an acknowledgement, or a shutdown?
+                  (define result (receivers-select receiver shutdown-receiver))
+                  (case result
+                    [(0) (input-loop)]
+                    [(1) (displayln "Shutting down")]
+                    [else void])))
+  (input-loop))
+
+(define (main)
+  ;; Fetch the args, check if there is a host provided.
+  ;; If not, default to the loop back host.
+  (define args (command-line))
+
+  (match (drop args 2)
+    [(list) (repl-loop)]
+    [(list "--port" port) (repl-loop "0.0.0.0" (string->int port))]
+    [(list "--host" host) (repl-loop host)]
+    [(list "--host" host "--port" port) (repl-loop host (string->int port))]))
+
+(unless (get-test-mode)
+  (main))

cogs/repl/repl.scm

@@ -0,0 +1,84 @@
+(require-builtin steel/tcp)
+(require "steel/sync")
+
+(provide repl-serve)
+
+;; Thread id -> TCP reader. Remove when finished.
+(define #%repl-manager (hash))
+
+(define (#%mark-connected tcp-stream)
+  (set! #%repl-manager (hash-insert #%repl-manager (current-thread-id) tcp-stream)))
+
+(define (#%set-thread-closed!)
+  (define connection (hash-get #%repl-manager (current-thread-id)))
+  ;; Close it all down
+  (tcp-shutdown! connection)
+  (set! #%repl-manager (hash-remove #%repl-manager (current-thread-id)))
+
+  ; (display "...Shutting down thread" (stdout))
+  ; (newline (stdout))
+  )
+
+(define (#%shutdown?)
+  (not (hash-contains? #%repl-manager (current-thread-id))))
+
+(define (quit)
+  ;; Attempt to set this thread closed no matter what.
+  (with-handler (lambda (_) void) (#%set-thread-closed!)))
+
+(define (repl-serve [port 8080] [thread-pool-size 2])
+  (define listener (tcp-listen (string-append "0.0.0.0:" (int->string port))))
+  (define tp (make-thread-pool thread-pool-size))
+
+  (while
+   #t
+   ;; Accept the stream
+   (define input-stream (tcp-accept listener))
+   (submit-task
+    tp
+    (lambda ()
+      ;; TODO: Set up dedicated logging stream, flushes on its own
+      ;; background thread?
+      (define reader-port (tcp-stream-buffered-reader input-stream))
+      (define writer-port (tcp-stream-writer input-stream))
+      ;; Continue to accept connections until this one disconnects
+      (define (repl-loop)
+        ;; Assume, that for now, we are comfortable with the fact
+        ;; that stdout / etc will get printed from the
+        (let ([expr (read reader-port)])
+
+          (unless (eof-object? expr)
+            ;; It is probably possible to just serialize the eventual
+            ;; error message directly, and send that over. That way
+            ;; the stack trace is maintained?
+            (define result (with-handler (lambda (err) (to-string err)) (eval expr)))
+
+            ;; Close the thread.
+            (when (#%shutdown?)
+              (close-output-port writer-port)
+              (close-input-port reader-port)
+              (return! #t))
+
+            ;; TODO: Merge this into one display call.
+            ;; It all has to come through in one fell swoop, such that
+            ;; return values are atomic on the output stream.
+            (define output-string (open-output-string))
+            (display result output-string)
+            (define formatted (get-output-string output-string))
+
+            ;; Don't send back a void, just have it be the length of 0
+            (display
+             (string-append "#%start-repl#%" (int->string (string-length formatted)) "\n" formatted))
+
+            (repl-loop))))
+
+      (#%mark-connected input-stream)
+
+      ;; Set up the repl to also grab std out
+      (parameterize ([current-output-port writer-port])
+        (repl-loop))
+
+      (displayln "Closing connection.")))))
+
+(unless (get-test-mode)
+  (repl-serve))

crates/steel-core/src/primitives/hashmaps.rs

@@ -36,7 +36,8 @@ pub(crate) fn hashmap_module() -> BuiltInModule {
         .register_native_fn_definition(VALUES_TO_VECTOR_DEFINITION)
         .register_native_fn_definition(CLEAR_DEFINITION)
         .register_native_fn_definition(HM_EMPTY_DEFINITION)
-        .register_native_fn_definition(HM_UNION_DEFINITION);
+        .register_native_fn_definition(HM_UNION_DEFINITION)
+        .register_native_fn_definition(HASH_REMOVE_DEFINITION);
     module
 }
 
@@ -108,6 +109,44 @@ pub fn hm_construct_keywords(args: &[SteelVal]) -> Result<SteelVal> {
     Ok(SteelVal::HashMapV(Gc::new(hm).into()))
 }
 
+/// Returns a new hashmap with the given key removed. Performs a functional
+/// update, so the old hash map is still available with the original key value pair.
+///
+/// (hash-remove map key) -> hash?
+///
+/// * map : hash?
+/// * key : any/c
+///
+/// # Examples
+/// ```scheme
+/// > (hash-remove (hash 'a 10 'b 20) 'a)
+///
+/// => '#hash(('b . 20))
+/// ```
+#[function(name = "hash-remove")]
+pub fn hash_remove(map: &mut SteelVal, key: SteelVal) -> Result<SteelVal> {
+    if key.is_hashable() {
+        if let SteelVal::HashMapV(SteelHashMap(ref mut m)) = map {
+            match Gc::get_mut(m) {
+                Some(m) => {
+                    m.remove(&key);
+                    Ok(std::mem::replace(map, SteelVal::Void))
+                }
+                None => {
+                    let mut m = m.unwrap();
+                    m.remove(&key);
+
+                    Ok(SteelVal::HashMapV(Gc::new(m).into()))
+                }
+            }
+        } else {
+            stop!(TypeMismatch => "hash-insert expects a hash map, found: {:?}", map);
+        }
+    } else {
+        stop!(TypeMismatch => "hash key not hashable: {:?}", key)
+    }
+}
+
 /// Returns a new hashmap with the additional key value pair added. Performs a functional update,
 /// so the old hash map is still accessible.
 ///

crates/steel-core/src/primitives/tcp.rs

@@ -23,6 +23,13 @@ pub fn tcp_connect(addr: SteelString) -> Result<SteelVal> {
     TcpStream::connect(addr.as_str())?.into_steelval()
 }
 
+#[function(name = "tcp-shutdown!")]
+pub fn tcp_close(stream: &SteelVal) -> Result<SteelVal> {
+    let writer = TcpStream::as_ref(stream)?.try_clone().unwrap();
+    writer.shutdown(std::net::Shutdown::Both)?;
+    Ok(SteelVal::Void)
+}
+
 #[function(name = "tcp-stream-writer")]
 pub fn tcp_input_port(stream: &SteelVal) -> Result<SteelVal> {
     let writer = TcpStream::as_ref(stream)?.try_clone().unwrap();
@@ -82,6 +89,7 @@ pub fn tcp_module() -> BuiltInModule {
 
     module
         .register_native_fn_definition(TCP_CONNECT_DEFINITION)
+        .register_native_fn_definition(TCP_CLOSE_DEFINITION)
         .register_native_fn_definition(TCP_INPUT_PORT_DEFINITION)
         .register_native_fn_definition(TCP_OUTPUT_PORT_DEFINITION)
         .register_native_fn_definition(TCP_BUFFERED_OUTPUT_PORT_DEFINITION)

crates/steel-core/src/scheme/modules/reader.scm

@@ -30,8 +30,15 @@
         (let ([next (finisher *reader*)])
           (if (void? next)
               (begin
-                (reader.reader-push-string *reader* (read-line-from-port (current-input-port)))
-                (read-impl finisher))
+                (let ([maybe-next-line (read-line-from-port (current-input-port))])
+                  (if (eof-object? maybe-next-line)
+                      (begin
+                        (set! *reader* (reader.new-reader))
+                        (error "missing closing parent - unexpected eof"))
+                      ;; If the next line is not empty,
+                      (begin
+                        (reader.reader-push-string *reader* maybe-next-line)
+                        (read-impl finisher)))))
               next))]
 
        [else next-line])]
@@ -42,7 +49,17 @@
      (let ([next (reader.reader-read-one *reader*)])
 
        (if (void? next)
+           ;; TODO: Share this code with the above
            (begin
-             (reader.reader-push-string *reader* (read-line-from-port (current-input-port)))
-             (read-impl finisher))
+             (let ([maybe-next-line (read-line-from-port (current-input-port))])
+               (if (eof-object? maybe-next-line)
+                   (begin
+                     ;; TODO: drain the reader - consider a separate function for this
+                     (set! *reader* (reader.new-reader))
+                     (error "missing closing parent - unexpected eof"))
+                   ;; If the next line is not empty,
+                   (begin
+                     (reader.reader-push-string *reader* maybe-next-line)
+                     (read-impl finisher)))))
+
            next))]))

crates/steel-core/src/steel_vm/primitives.rs

@@ -1624,6 +1624,7 @@ impl Reader {
                 Ok(SteelVal::Void)
             }
         } else {
+            // TODO: This needs to get fixed
             Ok(crate::primitives::ports::eof())
         }
     }

crates/steel-core/src/steel_vm/vm.rs

@@ -1057,7 +1057,10 @@ impl ContinuationMark {
 
                 #[cfg(debug_assertions)]
                 {
-                    debug_assert_eq!(open.closed_continuation.stack, continuation.stack);
+                    debug_assert_eq!(
+                        open.closed_continuation.stack.len(),
+                        continuation.stack.len()
+                    );
                     debug_assert_eq!(
                         open.closed_continuation.stack_frames.len(),
                         continuation.stack_frames.len()
@@ -1170,7 +1173,10 @@ impl Continuation {
                                 ctx.instructions,
                                 open.closed_continuation.instructions
                             );
-                            debug_assert_eq!(ctx.thread.stack, open.closed_continuation.stack);
+                            debug_assert_eq!(
+                                ctx.thread.stack.len(),
+                                open.closed_continuation.stack.len()
+                            );
 
                             debug_assert_eq!(ctx.pop_count, open.closed_continuation.pop_count);