console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

lol took me forever to understand lwt but finally have concurrency in the actor event processing handlers

Browse Source
This commit is contained in:
cqc
2021-10-07 14:07:26 -05:00
parent c8e9e1bd6c
commit 630ccb0a6f
7 changed files with 256 additions and 332 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
dune
View File

@ -2,11 +2,10 @@
(dev
(flags (:standard -warn-error -A))))
(executable
(name main)
(library
(name human)
(modes byte)
(modules main)
(link_flags (-linkall))
(modules human)
(libraries
topinf
lwt_ppx
@ -26,6 +25,8 @@
(modes byte)
(modules irc)
(libraries
human
lwt
fmt
topinf
lwt_ppx

307
main.ml → human.ml
View File

@ -22,8 +22,6 @@ module F = Fmt
module Input = struct
open CamomileLibrary
open Zed_edit
open CamomileLibrary
(** Type of key code. *)
type code =
@ -226,7 +224,6 @@ end
module Event = struct
open Tsdl
open CamomileLibrary
open Zed_edit
open Input
type mouse = int * int
@ -393,8 +390,6 @@ module Display = struct
open Tgles2
open Tsdl
open Gg
open CamomileLibrary
open Zed_edit
open Wall
module I = Image
module P = Path
@ -418,6 +413,7 @@ module Display = struct
(the Wall.image extents) *)
type image = box2 * Wall.image
type pane = state -> state * image
type actor = (Event.events -> pane Lwt.t) ref
let pane_empty s =
(s, (Box2.of_pts (Box2.o s.box) (Box2.o s.box), Image.empty))
@ -505,7 +501,7 @@ module Display = struct
Sdl.gl_swap_window frame.sdl_win ;
Ok ()
let display_frame frame actor =
let display_frame frame (actor : actor) =
(* create and fill event list *)
let convert_event ev =
match Event.event_of_sdlevent ev with
@ -519,18 +515,25 @@ module Display = struct
events := !events @ [convert_event ev]
done ) ;
handle_frame_events frame !events ;
if List.length !events > 0 then
if List.length !events > 0 then (
(* recompute the actor definition with the new events to return a new pane *)
frame.last_pane <- actor !events ;
!actor !events
>>= fun p ->
frame.last_pane <- p ;
(* call draw_pane because we should redraw now that we have updated *)
draw_pane frame frame.last_pane
ignore (draw_pane frame frame.last_pane) ;
Lwt.return_unit )
else Lwt.return_unit
let run frame render () =
let run frame actor () =
let frame = get_result frame in
Sdl.show_window frame.sdl_win ;
while not frame.quit do
ignore (display_frame frame render)
done ;
let rec loop () =
ignore (display_frame frame actor) ;
Lwt_main.yield ()
>>= fun () ->
if not frame.quit then loop () else Lwt.return_unit in
Lwt_main.run (loop ()) ;
print_endline "quit" ;
Sdl.hide_window frame.sdl_win ;
Sdl.gl_delete_context frame.gl ;
@ -660,32 +663,27 @@ end
module Panel = struct
open Display
open Wall
open Gg
type t =
{ mutable act: t -> Event.events -> t * Display.pane
{ mutable act: t -> Event.events -> (t * Display.pane) Lwt.t
; mutable subpanels: t list
; mutable tag: string }
type actor = Event.events -> Display.pane
let blank =
{ act= (fun panel _events -> (panel, Display.pane_empty))
{ act=
(fun panel _events -> Lwt.return (panel, Display.pane_empty))
; subpanels= []
; tag= "blank pane" }
let draw (pane : Display.pane) =
{ act= (fun panel _events -> (panel, pane))
{ act= (fun panel _events -> Lwt.return (panel, pane))
; subpanels= []
; tag= "draw-pane" }
let actor (panel : t) : Event.events -> Display.pane =
let enclosure = ref panel in
let actor (panel : t) : Event.events -> Display.pane Lwt.t =
fun events ->
let panel, pane = panel.act !enclosure events in
enclosure := panel ;
pane
panel.act panel events >>= fun (_panel, pane) -> Lwt.return pane
let filter_events ef p =
{p with act= (fun panel events -> p.act panel (ef events))}
@ -694,12 +692,13 @@ module Panel = struct
let vbox subpanels =
{ act=
(fun panel events ->
( panel
, pane_box Box2.tl_pt
Lwt_list.map_p
(fun subpanel ->
subpanel.act subpanel events
>>= fun (_panel, pane) -> Lwt.return pane )
panel.subpanels
>>= fun pl -> Lwt.return (panel, pane_box Box2.tl_pt pl) )
(* tl_pt is actually bl_pt in the Wall coordinate system *)
(List.map
(fun subpanel -> snd (subpanel.act subpanel events))
panel.subpanels ) ) )
; subpanels
; tag= "vertical-box" }
@ -707,12 +706,13 @@ module Panel = struct
let hbox subpanels =
{ act=
(fun panel events ->
( panel
, pane_box Box2.br_pt
Lwt_list.map_p
(fun subpanel ->
subpanel.act subpanel events
>>= fun (_panel, pane) -> Lwt.return pane )
panel.subpanels
>>= fun pl -> Lwt.return (panel, pane_box Box2.br_pt pl) )
(* br_pt is actually tr_pt in the Wall coordinate system *)
(List.map
(fun subpanel -> snd (subpanel.act subpanel events))
panel.subpanels ) ) )
; subpanels
; tag= "horizontal-box" }
@ -720,11 +720,12 @@ module Panel = struct
let obox subpanels =
{ act=
(fun panel events ->
( panel
, pane_box Box2.o
(List.map
(fun subpanel -> snd (subpanel.act subpanel events))
panel.subpanels ) ) )
Lwt_list.map_p
(fun subpanel ->
subpanel.act subpanel events
>>= fun (_panel, pane) -> Lwt.return pane )
panel.subpanels
>>= fun pl -> Lwt.return (panel, pane_box Box2.o pl) )
; subpanels
; tag= "origin-box" }
@ -843,10 +844,12 @@ module Panel = struct
; out_spaces=
(fun n -> add_symbolic_output_item sob (Output_spaces n)) }
let prettyprint ?(height = !g_text_height) fpp =
{ act= (fun panel _events -> (panel, draw_pp height fpp))
let prettyprint ?(height = !g_text_height) ?(tag = "pretty-print")
fpp =
{ act=
(fun panel _events -> Lwt.return (panel, draw_pp height fpp))
; subpanels= []
; tag= "pretty-print" }
; tag }
module Textedit = struct
let bindings =
@ -963,14 +966,13 @@ module Panel = struct
Format.pp_open_hvbox pp 0 ;
F.text pp before_cursor ;
Format.pp_open_stag pp
Display.(
Cursor (Wall.Color.v 0.99 0.99 0.125 0.3)) ;
(Cursor (Wall.Color.v 0.99 0.99 0.125 0.3)) ;
F.pf pp "" ;
Format.pp_close_stag pp () ;
F.text pp after_cursor ;
F.pf pp "@." ;
Format.pp_close_box pp () ) in
(panel, draw_textedit) )
Lwt.return (panel, draw_textedit) )
; subpanels= []
; tag= "textedit" }
@ -979,12 +981,14 @@ module Panel = struct
=
{ act=
(fun panel _events ->
Lwt.return
( panel
, draw_pp height (fun pp ->
Format.pp_open_hbox pp () ;
F.text pp
(List.fold_left
(fun s x -> Input.to_string_compact x ^ " " ^ s)
(fun s x ->
Input.to_string_compact x ^ " " ^ s )
"" b.last_keyseq ) ;
F.text pp "-> " ;
F.text pp
@ -996,7 +1000,8 @@ module Panel = struct
s
^ Input.Bind.(
match x with
| Zed a -> Zed_edit.name_of_action a
| Zed a ->
Zed_edit.name_of_action a
| Custom _ -> "Custom")
^ "; " )
a ""
@ -1038,7 +1043,7 @@ module Panel = struct
| Some text ->
Textedit.insert me.te text ;
(hbox panel.subpanels).act panel events
| None -> (panel, Display.pane_empty)
| None -> Lwt.return (panel, Display.pane_empty)
(* don't draw anything if modal isn't active *) )
; subpanels=
[ prettyprint (fun pp -> F.text pp me.prompt)
@ -1063,8 +1068,8 @@ module Toplevel = struct
let init () =
let sob = Format.make_symbolic_output_buffer () in
let ppf = Format.formatter_of_symbolic_output_buffer sob in
{eval= Topinf.init ppf; res= sob}
Topinf.ppf := Format.formatter_of_symbolic_output_buffer sob ;
{eval= !Topinf.eval; res= sob}
let eval t str =
let ppf = Format.formatter_of_symbolic_output_buffer t.res in
@ -1094,7 +1099,8 @@ module Store = struct
{ store: Istore.t
; mutable view: Istore.key
; mutable selection: Istore.key
; mutable editmode: bool }
; mutable editmode: bool
; sob: Format.symbolic_output_buffer }
let make_storeview ?(path = []) storepath branch =
Lwt_main.run
@ -1109,7 +1115,8 @@ module Store = struct
{ store
; view
; selection= Istore.Key.v [fst (List.hd viewlist)]
; editmode= false } )
; editmode= false
; sob= Format.make_symbolic_output_buffer () } )
let directives (top : Toplevel.t) sv =
let dir_use_key key_lid =
@ -1223,10 +1230,44 @@ module Store = struct
>>= function
| Some `Node -> Lwt.return_true | _ -> Lwt.return_false )
in
let update_storeview () =
ignore (Format.flush_symbolic_output_buffer sv.sob) ;
let pp = Format.formatter_of_symbolic_output_buffer sv.sob in
let rec draw_levels ?(indent = 0) (sel : Istore.key)
(tree : Istore.tree) : unit Lwt.t =
Istore.Tree.list tree []
>>= Lwt_list.iteri_s (fun _i (step, node) ->
Format.pp_open_box pp indent ;
if sel = [step] then (
Format.pp_open_stag pp
(Panel.Cursor (Wall.Color.v 0.99 0.99 0.125 0.3)) ;
F.pf pp "@," ;
Format.pp_close_stag pp () ) ;
Istore.Tree.kind node []
>>= fun k ->
( match k with
| Some `Contents ->
F.pf pp "- %s@." step ; Lwt.return_unit
| Some `Node ->
F.pf pp "> %s@." step ;
let subsel =
match Istore.Key.decons sel with
| Some (_tstep, subkey) -> subkey
| None -> [] in
Format.pp_open_vbox pp 0 ;
draw_levels ~indent:(indent + 1) subsel node
>>= fun () ->
Format.pp_close_box pp () ;
Lwt.return_unit
| None -> F.pf pp "ERROR: None" ; Lwt.return_unit )
>>= fun () ->
Format.pp_close_box pp () ;
Lwt.return_unit ) in
Istore.get_tree sv.store sv.view >>= draw_levels sv.selection
in
let update_textedit () =
Panel.Textedit.clear te ;
Lwt_main.run
( Istore.get_tree sv.store sv.view
Istore.get_tree sv.store sv.view
>>= fun t ->
Istore.Tree.kind t sv.selection
>>= function
@ -1238,7 +1279,7 @@ module Store = struct
| Some `Node ->
Panel.Textedit.insert te "Node..." ;
Lwt.return_unit
| None -> Lwt.return_unit ) in
| None -> Lwt.return_unit in
let navbinds =
let open Input.Bind in
let new_contents name content =
@ -1260,7 +1301,8 @@ module Store = struct
@@ add [([], Char 's')] [Custom (navigate sv `Next)]
@@ add [([], Char 'd')] [Custom (navigate sv `Sub)]
@@ add [([], Char 'a')] [Custom (navigate sv `Sup)]
@@ add [([], Char 'e')]
@@ add
[([], Char 'e')] (* enter edit mode *)
[ Custom
(fun () ->
if not (is_node sv.selection) then
@ -1305,19 +1347,20 @@ module Store = struct
[([], Char 'x')] (* execute contents/node *)
[ Custom
(fun () ->
Panel.Modal.start ~prompt:"!!Not implemented!!"
modalstate "" (fun _ -> ()) ) ]
Toplevel.eval top (Panel.Textedit.contents te) ) ]
empty in
let bindstate = Input.Bind.init navbinds in
{ act=
(fun panel events ->
if
( if
(not sv.editmode)
&& not (Panel.Modal.is_active modalstate)
then (
Input.Bind.process bindstate events ;
update_textedit () ) ;
(Panel.vbox panel.subpanels).act panel events )
Lwt.join [update_storeview (); update_textedit ()] )
else Lwt.return_unit )
>>= fun () -> (Panel.vbox panel.subpanels).act panel events
)
; subpanels=
[ Panel.filter_events
(fun ev ->
@ -1325,39 +1368,8 @@ module Store = struct
(Panel.Modal.panel modalstate)
; Panel.hbox
[ Panel.prettyprint (fun pp ->
let rec draw_levels ?(indent = 0)
(tree : Istore.tree) (sel : Istore.key) =
List.iteri
(fun _i (step, node) ->
Format.pp_open_box pp indent ;
if sel = [step] then (
Format.pp_open_stag pp
Display.(
Panel.Cursor
(Wall.Color.v 0.99 0.99 0.125 0.3)) ;
F.pf pp "@," ;
Format.pp_close_stag pp () ) ;
( match
Lwt_main.run (Istore.Tree.kind node [])
with
| Some `Contents -> F.pf pp "- %s@." step
| Some `Node ->
F.pf pp "> %s@." step ;
let subsel =
match Istore.Key.decons sel with
| Some (_tstep, subkey) -> subkey
| None -> [] in
Format.pp_open_vbox pp 0 ;
draw_levels ~indent:(indent + 1) node
subsel ;
Format.pp_close_box pp ()
| None -> F.pf pp "ERROR: None" ) ;
Format.pp_close_box pp () )
(Lwt_main.run (Istore.Tree.list tree [])) in
let root =
Lwt_main.run (Istore.get_tree sv.store sv.view)
in
draw_levels root sv.selection )
Panel.format_symbolic_output_buffer pp
(Format.get_symbolic_output_buffer sv.sob) )
; Panel.vbox
[ Panel.filter_events
(fun ev -> if sv.editmode then ev else [])
@ -1375,109 +1387,18 @@ module Store = struct
; tag= "store-editor" }
end
open Wall
open Gg
module I = Image
module P = Path
module Text = Wall_text
type top =
{ te: Panel.Textedit.t
; res: Format.symbolic_output_buffer
; mutable eval: Topinf.evalenv option
; mutable path: string list
; mutable histpath: string list
; storeview: Store.storeview }
let make_top storepath ?(branch = "current") () =
let t =
{ te= Panel.Textedit.make "" ()
; res= Format.make_symbolic_output_buffer ()
; eval= None
; path= ["init"]
; histpath= ["history"]
; storeview= Store.make_storeview storepath branch } in
Topinf.ppf := Format.formatter_of_symbolic_output_buffer t.res ;
(* Format.pp_set_formatter_out_functions Format.std_formatter
(out_funs_of_sob t.res) ;*)
Panel.Textedit.insert t.te
(Lwt_main.run (Store.Istore.get t.storeview.store t.path)) ;
t
let top_panel (t : top) =
let ppf = Format.formatter_of_symbolic_output_buffer t.res in
Topinf.ppf := ppf ;
let eval =
match t.eval with
(* HACK use Lazy.? *)
| None ->
let e =
match !Topinf.eval with
| Some e -> e
| None -> Topinf.init ppf in
t.eval <- Some e ;
e
| Some e -> e in
let eval () =
try
ignore
(Lwt_main.run
( Store.Istore.tree t.storeview.store
>>= fun tree ->
Store.Istore.Tree.add tree
(t.histpath @ ["input"])
(Panel.Textedit.contents t.te) ) ) ;
ignore (Format.flush_symbolic_output_buffer t.res) ;
eval ppf (Panel.Textedit.contents t.te ^ ";;") ;
(*HACK to prevent getting stuck in parser*)
let b = Buffer.create 69 in
Panel.format_symbolic_output_buffer
(Format.formatter_of_buffer b)
(Format.get_symbolic_output_buffer t.res) ;
ignore
(Lwt_main.run
( Store.Istore.tree t.storeview.store
>>= fun tree ->
Store.Istore.Tree.add tree
(t.histpath @ ["output"])
(Buffer.contents b) ) ) ;
ignore
(Lwt_main.run
(Store.Istore.set_exn t.storeview.store
~info:(Irmin_unix.info "history")
t.path
(Panel.Textedit.contents t.te) ) ) ;
Panel.Textedit.clear t.te
with e ->
F.pf ppf "Exception in pane_top//eval@." ;
Location.report_exception ppf e ;
F.epr "Exception in pane_top//eval@." in
t.te.keybind.bindings <-
Input.(
Bind.add
[([Ctrl], Code Enter)]
Bind.[Custom eval]
t.te.keybind.bindings) ;
Panel.(
vbox
[ Textedit.panel t.te
; prettyprint (fun pp ->
Format.pp_open_hovbox pp 0 ;
format_symbolic_output_buffer pp
(Format.get_symbolic_output_buffer t.res) ;
Format.pp_close_box pp () ;
F.flush pp () ) (*; draw_textedit_input height t.te *) ])
(*let top_1 = make_top "../rootstore" () *)
let () =
let actor =
let std_actor root_panel =
Panel.actor
(Panel.obox
[ Panel.draw (fun (s : Display.state) ->
(s, Display.fill_box (Display.gray 0.125) s.box) )
; Store.editor "../rootstore" ] ) in
Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) actor) ()
; root_panel ] )
let root_actor = ref (std_actor (Store.editor "../rootstore"))
let start () =
Display.(
run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) root_actor ())
(* Implement the "window management" as just toplevel defined functions that manipulate the window tree *)

6
init.ml
View File

@ -6,11 +6,13 @@ let print_directives () =
Format.printf "directive_info_table:@.";
Hashtbl.iter (fun n _ -> Format.printf "\t%s@." n) Topinf.directive_info_table;;
#directory "+compiler-libs";;
(*#directory "+compiler-libs";; *)
let print_modules () =
Format.printf "Env.fold_modules !Topinf.toplevel_env :\n";
Env.fold_modules (fun modname _ _ () -> Format.printf "\t%s@." modname) None !Topinf.toplevel_env ();;
(*print_modules ();;*)
#use_silently "main.ml";;
#use_silently "human.ml";;
start ();;

166
irc.ml
View File

@ -1,109 +1,109 @@
(*
when all you can do is type, making things more complicated than a list is hard?
we need to design this somehow before implementing it
really the graphical drawing / window management funcitons i think at this point.
features:
- message drafts? more like, if you send too many messages to someone all at once it will hold them so you can respond later and not flood people.......
- i mean really what you want is an editable stream, so you can stage messages for later
- because i mean, if this is a bicycle, and you can make it however you want, you can just fuck with the conversation thread with computer assistance instaed of just relying on your memory.
*)
open Lwt
module C = Irc_client_tls
module M = Irc_message
open Lwt_react
module F = Fmt
let host = ref "irc.hackint.org"
let port = ref 6697
let nick = ref "cqcaml"
let channel = ref "#freeside"
let message = "Hello, world! This is a test from ocaml-irc-client"
module Communicator = struct
type msg = {content: string; time: string; mutable seen: bool}
let output_channel_of_ppf ppf =
Lwt_io.make ~mode:Output (fun b o l ->
let s = String.sub (Lwt_bytes.to_string b) o l in
Fmt.pf ppf "%s" s ;
Lwt.return (String.length s) )
let create_msg ?(time = "<ts>") content =
{content; time; seen= false}
let callback connection result =
match result with
| Result.Ok ({M.command= M.Other _; _} as msg) ->
Lwt_io.printf "Got unknown message: %s\n" (M.to_string msg)
>>= fun () -> Lwt_io.flush Lwt_io.stdout
| Result.Ok ({M.command= M.PRIVMSG (_target, data); _} as msg) ->
Lwt_io.printf "Got message: %s\n" (M.to_string msg)
>>= fun () ->
Lwt_io.flush Lwt_io.stdout
>>= fun () ->
C.send_privmsg ~connection ~target:"cqc"
~message:("ack: " ^ data)
| Result.Ok msg ->
Lwt_io.printf "Got message: %s\n" (M.to_string msg)
>>= fun () -> Lwt_io.flush Lwt_io.stdout
| Result.Error e -> Lwt_io.printl e
type channel =
{ mutable name: string
; mutable content: msg list
; mutable sender: string -> unit }
let lwt_main () =
let add_msg (c : channel) msg = c.content <- msg :: c.content
type c = {mutable channel: channel; mutable subs: c list}
type protocol = Irc | Email | Rss | Mublog
let make_channel (c : c) ?(sender = fun _ -> ()) name =
c.subs <-
{channel= {name; content= []; sender}; subs= []} :: c.subs
let make () : c =
let c =
{ name= "top"
; content= [create_msg "Wecome to the Communicator"]
; sender= (fun _ -> ()) } in
c.sender <- (fun s -> c.content <- create_msg s :: c.content) ;
c.sender "Currently only IRC is implemented" ;
{channel= c; subs= []}
type connection = unit Lwt.t
module Irc = struct
module C = Irc_client_tls
module M = Irc_message
let connection (c : c) server port nick channels : unit Lwt.t =
let add_msg cn str = add_msg cn.channel (create_msg str) in
C.reconnect_loop ~after:30
~connect:(fun () ->
Lwt_io.printl "Connecting..."
>>= fun () ->
C.connect_by_name ~server:!host ~port:!port ~nick:!nick () )
>>= fun () -> C.connect_by_name ~server ~port ~nick () )
~f:(fun connection ->
Lwt_io.printl "Connected"
>>= fun () ->
Lwt_io.printl "send join msg"
>>= fun () ->
C.send_join ~connection ~channel:!channel
>>= fun () ->
C.send_privmsg ~connection ~target:!channel ~message )
~callback ()
Lwt_list.iter_p
(fun channel ->
let joiner = C.send_join ~connection ~channel in
(* make_channel c ~sender:(fun s ->
C.send_privmsg ~target:channel ~message:s) channel ; *)
joiner )
channels )
~callback:(fun _connection result ->
match result with
| Result.Ok ({M.command= M.Other _; _} as msg) ->
add_msg c
(F.str "Got unknown message: %s\n" (M.to_string msg)) ;
Lwt.return_unit
| Result.Ok ({M.command= M.PRIVMSG (target, data); _} as msg)
->
add_msg c
(F.str "Got PRIVMSG: target=%s, data=%s; %s\n" target
data (M.to_string msg) ) ;
Lwt.return_unit
| Result.Ok msg ->
add_msg c (M.to_string msg) ;
Lwt.return_unit
| Result.Error e -> Lwt_io.printl e )
()
end
module Panel = struct
let panel c =
Panel.prettyprint ~height:20. ~tag:"Communicator" (fun pp ->
F.pf pp " <><><> COMMUNICATOR <><><> @.@." ;
List.iter
(fun msg -> F.pf pp "[%s] %s@." msg.time msg.content)
c.channel.content )
end
end
let _ =
Lwt_main.run
(Lwt.catch lwt_main (fun e ->
Printf.printf "exception: %s\n" (Printexc.to_string e) ;
exit 1 ) )
let comm = Communicator.make () in
let hackint =
Communicator.Irc.connection comm "irc.hackint.org" 6697 "cqcaml"
["#CQC"] in
root_actor := std_actor (Communicator.Panel.panel comm) ;
Lwt.async (fun () -> hackint)
(* ocamlfind ocamlopt -package irc-client.lwt -linkpkg code.ml *)
(**
program starts...
- spawn connections to servers
- these connections will populate the Channel.t in a Channel.tree
(*open Lwt
module C = Irc_client_lwt
let host = "irc.hackint.org"
let port = 6697
let realname = "Demo IRC bot"
let nick = "cqcqcqcqc"
let username = nick
let channel = "#freeside"
let message = "Hello, world! This is a test from ocaml-irc-client"
let callback oc _connection result =
let open Irc_message in
match result with
| Result.Ok msg ->
Fmt.epr "irc msg: msg" ;
Lwt_io.fprintf oc "Got message: %s\n" (to_string msg)
| Result.Error e -> Lwt_io.fprintl oc e
let lwt_main =
let oc = output_channel_of_ppf !Topinf.ppf in
Lwt_unix.gethostbyname host
>>= fun he ->
C.connect
~addr:he.Lwt_unix.h_addr_list.(0)
~port ~username ~mode:0 ~realname ~nick ()
>>= fun connection ->
Lwt_io.fprintl oc "Connected"
>>= fun () ->
C.send_join ~connection ~channel
>>= fun () ->
C.send_privmsg ~connection ~target:channel ~message
>>= fun () ->
C.listen ~connection ~callback:(callback oc) ()
>>= fun () -> C.send_quit ~connection ()
let _ = Lwt_main.run lwt_main
*)
**)

0
komm.opam
View File

4
topinf.ml
View File

@ -44,7 +44,7 @@ let toplevel_value_bindings : Obj.t String.Map.t ref =
ref String.Map.empty
let ppf = ref Format.std_formatter
let eval = ref None
let eval = ref (fun _ _ -> ())
let getvalue name =
try String.Map.find name !toplevel_value_bindings
@ -2398,5 +2398,5 @@ let init ppf =
Location.input_phrase_buffer := Some phrase_buffer ;
Sys.catch_break true ;
run_hooks After_setup ;
eval := Some (eval_fun lb) ;
eval := eval_fun lb ;
eval_fun lb

2
topinf.mli
View File

@ -26,5 +26,5 @@ val add_directive :
val directive_info_table : (string, directive_info) Hashtbl.t
val ppf : Format.formatter ref
val eval : evalenv option ref
val eval : evalenv ref
val eval_value_path : Env.t -> Path.t -> Obj.t