Skip to content
This repository
Browse code

[fix] stdlib/channels: always allow comparison of channels

  • Loading branch information...
commit 2ec1b623e0b0948f35fd14df02a83b0619341bd7 1 parent 666b425
François-Régis Sinot authored
20 opabsl/jsbsl/bslSession.js
@@ -363,10 +363,8 @@ var LowLevelPingLoop = {};
363 363 compare: function(to) {
364 364 if (to instanceof LocalChannel)
365 365 return compare_native(this.lchan_id, to.lchan_id);
366   - else if (to instanceof ServerChannel)
367   - return 1;
368 366 else
369   - return null;
  367 + return 1;
370 368 },
371 369
372 370 owner: function(){
@@ -524,9 +522,13 @@ var LowLevelPingLoop = {};
524 522
525 523
526 524 compare: function(to) {
527   - if(to instanceof CousinClientChannel &&
528   - this.cl_id == to.cl_id) return 0;
529   - return null;//Cousin client channels cannot be ordered
  525 + if(to instanceof CousinClientChannel)
  526 + return compare_native(this.cl_id == to.cl_id);
  527 + else
  528 + if(to instanceof LocalChannel)
  529 + return -1;
  530 + else // ServerChannel
  531 + return 1;
530 532 },
531 533
532 534 owner: function(){
@@ -950,12 +952,10 @@ var LowLevelPingLoop = {};
950 952 return false
951 953 }
952 954
953   -##register compare_channels_maybe : Session.private.native('msg, 'ctx), Session.private.native('msg, 'ctx) -> option(int)
  955 +##register compare_channels : Session.private.native('msg, 'ctx), Session.private.native('msg, 'ctx) -> int
954 956 ##args(ch1, ch2)
955 957 {
956   - var result = ch1.compare(ch2);
957   - if(result==null) return js_none;
958   - else return js_some(result);
  958 + return ch1.compare(ch2);
959 959 }
960 960
961 961 ##register llsend : Session.private.native('b, 'c), ('b -> RPC.Json.private.native), 'b, option('c) -> void
4 opabsl/mlbsl/bslSession.ml
@@ -1192,8 +1192,8 @@ let on_remove_cps chan f k =
1192 1192 ##register equals_channel : Session.private.native('msg, 'ctx), Session.private.native('msg, 'ctx) -> bool
1193 1193 let equals_channel a b = Channel.compare a b = 0
1194 1194
1195   -##register compare_channels_maybe : Session.private.native('msg, 'ctx), Session.private.native('msg, 'ctx) -> option(int)
1196   -let compare_channels_maybe a b = Some (Channel.compare a b) (*Server-side comparison of channels always works*)
  1195 +##register compare_channels : Session.private.native('msg, 'ctx), Session.private.native('msg, 'ctx) -> int
  1196 +let compare_channels a b = Channel.compare a b (*Server-side comparison of channels always works*)
1197 1197
1198 1198 ##register get_more : Session.private.native('msg, 'ctx) -> option('more)
1199 1199 let get_more chan =
12 stdlib/core/rpc/core/session.opa
@@ -157,14 +157,10 @@ type Session.entity = external
157 157 /**
158 158 * A partial order on channels
159 159 */
160   -compare_channel(a:channel('msg), b:channel('msg)): Order.comparison =
161   - compare_raw = %%BslSession.compare_channels_maybe%%
162   - match compare_raw(a, b) with
163   - | {none} -> {neq}
164   - | ~{some}-> Order.of_int(some) <: Order.comparison
165   -
166   -//TODO: Unsafe! We may need to find another mechanism for Network!
167   -channel_order = @nonexpansive(Order.make_unsafe(compare_channel)) : order(channel('message),Channel.order)
  160 +compare_channel(a:channel('msg), b:channel('msg)) : Order.ordering =
  161 + Order.of_int(%%BslSession.compare_channels%%(a, b))
  162 +
  163 +channel_order = @nonexpansive(Order.make(compare_channel)) : order(channel('message),Channel.order)
168 164
169 165 /** The Hlnet definitions for the protocol for "make_at" queries */
170 166 type make_at_query = (OpaType.ty, OpaType.ty, RPC.Json.json, RPC.Json.json)

0 comments on commit 2ec1b62

Please sign in to comment.
Something went wrong with that request. Please try again.