Skip to content
This repository has been archived by the owner on Jul 18, 2020. It is now read-only.

Commit

Permalink
Browse files Browse the repository at this point in the history
Use readline inside repl task.
WIP: doesn't track done messages properly.
  • Loading branch information
technomancy committed Sep 11, 2013
1 parent 8851eb5 commit c9c4ad1
Show file tree
Hide file tree
Showing 6 changed files with 63 additions and 15 deletions.
2 changes: 1 addition & 1 deletion _tags
@@ -1 +1 @@
true:package(core),package(async),thread,annot,debugging
true:package(core),package(async),package(ctypes.foreign),thread,annot,debugging
25 changes: 13 additions & 12 deletions client.ml
Expand Up @@ -32,6 +32,16 @@ let send_input resp (r,w,p) result =
exit 0)
| None | Some _ -> eprintf " No session in need-input."

let remove_pending pending id =
Nrepl.debug ("-p " ^ String.concat ~sep:" " (Hashtbl.keys pending));
match id with
| Some Bencode.String(id) -> if Hashtbl.mem pending id then
Hashtbl.remove pending id
| None | Some _ -> eprintf " Unknown message id.\n%!"

let handle_done pending =
if Hashtbl.keys pending = ["init"] then exit 0

(* TODO: clarify what belongs here vs what goes in Nrepl *)
let rec handler (r,w,p) raw resp =
let handle actions k v = match (k, v) with
Expand All @@ -42,17 +52,6 @@ let rec handler (r,w,p) raw resp =
| ("session", _) | ("id", _) | ("ns", _) -> ()
| (k, v) -> printf " Unknown response: %s %s\n%!" k v in

let remove_pending pending id =
Nrepl.debug ("-p " ^ String.concat ~sep:" " (Hashtbl.keys pending));
match id with
| Some Bencode.String(id) -> if Hashtbl.mem pending id then
Hashtbl.remove pending id
| None | Some _ -> eprintf " Unknown message id.\n%!" in

let handle_done resp pending =
remove_pending pending (List.Assoc.find resp "id");
if Hashtbl.keys pending = ["init"] then exit 0 in

let rec execute_actions actions resp =
match resp with
| (k, Bencode.String v) :: tl ->
Expand All @@ -78,7 +77,9 @@ let rec handler (r,w,p) raw resp =
let handle_status resp status =
match status with
(* TODO: handle messages with multiple status fields by recuring on tl *)
| Bencode.String "done" :: tl -> handle_done resp p
| Bencode.String "done" :: tl ->
remove_pending p (List.Assoc.find resp "id");
handle_done p
| Bencode.String "eval-error" :: tl ->
Printf.eprintf "%s\n%!" "eval-error";
execute_actions Nrepl.print_all resp;
Expand Down
3 changes: 2 additions & 1 deletion grench.ml
Expand Up @@ -28,5 +28,6 @@ let () =
| Some ("main" :: args) -> Client.main (repl_port ".nrepl-port") args
| Some ["--leiningen-version"] | Some ["--lein-version"] ->
Lein.main ["version"]
| Some ["repl"] -> Lein.main ["run"; "-m"; "clojure.main/main"; "-r"]
| Some ["raw-repl"] -> Lein.main ["run"; "-m"; "clojure.main/main"; "-r"]
| Some ["repl"] -> Repl.main (repl_port ".nrepl-port")
| Some args -> Lein.main args
1 change: 0 additions & 1 deletion nrepl.ml
Expand Up @@ -79,7 +79,6 @@ let rec loop (r,w,p) handler buffer partial =
handle_responses handler (partial ^ just_read) in
loop (r,w,p) handler buffer partial in

debug "Receiving message";
Reader.read r buffer >>= parse_response handler buffer partial

let get_session buffer resp =
Expand Down
31 changes: 31 additions & 0 deletions readline.ml
@@ -0,0 +1,31 @@
open Ctypes
open Foreign

let libreadline = Dl.(dlopen ~filename:"libreadline.so" ~flags:[RTLD_NOW])

let readline = foreign "readline" (string @-> returning (ptr_opt char))
~from:libreadline

let add_history = foreign "add_history" (string @-> returning void)
~from:libreadline

let read prompt =
let rec strlen p n =
match !@(p +@ n) with
| '\000' -> n
| _ -> strlen p (n + 1) in

(* Ctypes needs help for some reason to convert char ptr to string *)
let string_of_char_ptr charp =
let length = strlen charp 0 in
let s = String.create length in
for i = 0 to length - 1 do
s.[i] <- !@ (charp +@ i)
done;
s in

(* TODO: teach readline that C-a shouldn't always go to BOL *)
match readline prompt with
| Some s -> let input = string_of_char_ptr s in
add_history input; Some input
| None -> None
16 changes: 16 additions & 0 deletions repl.ml
@@ -0,0 +1,16 @@
open Core.Std

let repl_message input session =
([("session", session);
("op", "eval");
("id", "repl-init");
("ns", "user");
("code", input)],
Nrepl.print_all)

let rec main port =
match Readline.read "> " with
| Some input -> let _ = Client.eval port [repl_message input] in main port
| None -> exit 0


0 comments on commit c9c4ad1

Please sign in to comment.