gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.0 http://bit.ly/aNZBUp
Yoric has quit [Quit: Yoric]
Amorphous has quit [Ping timeout: 255 seconds]
Amorphous has joined #ocaml
boscop has quit [Ping timeout: 248 seconds]
enthymeme has quit [Quit: rcirc on GNU Emacs 23.1.1]
smerz has quit [Quit: Ex-Chat]
ymasory has joined #ocaml
_y_ has joined #ocaml
lopex has quit [Ping timeout: 248 seconds]
lopex has joined #ocaml
<_y_> I'm doing peephole optimization (about 50 patterns so far, some of them rather long, say 6 instructions in => 2 instructions out) over lists of structures containing variant types, as such:
<_y_> (* add reg32, 0 => {} *)
<_y_> | { pref = _; instr = ((Add|Sub),[GeneralReg(Gd(_));Immediate(Id(0l))]) }::
<_y_> xs ->
<_y_> bt xs
<_y_> (* mov esp, [esp] => pop esp *)
<_y_> | { pref = _; instr = (Mov,[GeneralReg(Gd(Esp));Memexpr(Md(Mem32(SS,Some(Esp),None,None)))]) }::
<_y_> xs ->
<_y_> bt ({ pref = []; instr = (Pop,[GeneralReg(Gd(Esp))]) }::xs)
<_y_> it's incredibly slow in the interpreter... I originally had it scanning the list and marking a bool ref if it changed anything, then scanning the list again if it changed, and then I changed it to a backtracking scheme where it throws exceptions to walk backwards the length of the longest pattern, then start again from there ... that didn't make much difference speed-wise
<_y_> from experimenting with the rule sets, the speed benefitted when the shortest patterns came first
<_y_> I was wondering if there's some way to tell OCaml that I don't care in which order the rules are applied (maybe that would speed it up), or, failing that, I'm soliciting advice on how to code this thing faster
ikaros has quit [Quit: Leave the magic to Houdini]
arubin has joined #ocaml
<mfp> _y_: you could have a look at the output with -dlambda or such, that would allow you to see what the pattern matching is being compiled to
<mfp> (there's no way to have ocamlc/ocamlopt reorder your patterns automatically --- I don't know if it is performing any optimizations already in some cases)
<_y_> thanks for the advice
<mfp> at any rate, as you found out, placing the most likely/shortest patterns first should help
_y_ has quit [Ping timeout: 276 seconds]
ymasory has quit [Quit: Leaving]
ymasory has joined #ocaml
ymasory has quit [Read error: Connection reset by peer]
ymasory has joined #ocaml
ulfdoz_ has joined #ocaml
ulfdoz has quit [Ping timeout: 248 seconds]
ulfdoz_ is now known as ulfdoz
dnolen has joined #ocaml
tauntaun has quit [Quit: Ex-Chat]
tauntaun has joined #ocaml
tauntaun has quit [Client Quit]
ymasory_ has joined #ocaml
<thelema> hcarty: actually, the svn of camlzip has a META file and a make target for findlib installation, it's just not make install
<thelema> mfp: patch to your seam carving to allow it to compile with current camlimages dpkg @ https://gist.github.com/885898
hto has quit [*.net *.split]
rixed has quit [*.net *.split]
brendan has quit [*.net *.split]
pantsd has quit [*.net *.split]
alpounet has quit [*.net *.split]
dgfitch has quit [*.net *.split]
emmanuelux has quit [*.net *.split]
philtor has quit [*.net *.split]
schmrkc has quit [*.net *.split]
flux has quit [*.net *.split]
Tianon has quit [*.net *.split]
cthuluh has quit [*.net *.split]
orbitz has quit [*.net *.split]
cods has quit [*.net *.split]
rossberg has quit [*.net *.split]
Tobu has quit [*.net *.split]
bitbckt has quit [*.net *.split]
svenl_ has quit [*.net *.split]
jld has quit [*.net *.split]
dnolen has quit [Quit: dnolen]
hto has joined #ocaml
rixed has joined #ocaml
brendan has joined #ocaml
pantsd has joined #ocaml
alpounet has joined #ocaml
dgfitch has joined #ocaml
ymasory has quit [Quit: Leaving]
emmanuelux has joined #ocaml
philtor has joined #ocaml
schmrkc has joined #ocaml
flux has joined #ocaml
Tianon has joined #ocaml
jld has joined #ocaml
cthuluh has joined #ocaml
orbitz has joined #ocaml
cods has joined #ocaml
rossberg has joined #ocaml
Tobu has joined #ocaml
bitbckt has joined #ocaml
svenl_ has joined #ocaml
tauntaun has joined #ocaml
tauntaun has quit [Client Quit]
ymasory_ is now known as ymasory
lopex has quit []
groovy2shoes has quit [Quit: groovy2shoes]
tauntaun has joined #ocaml
emmanuelux has quit [Remote host closed the connection]
emmanuelux has joined #ocaml
joewilliams_away is now known as joewilliams
tauntaun has quit [Quit: Ex-Chat]
emmanuelux has quit [Quit: =>[]]
emmanuelux has joined #ocaml
emmanuelux has quit [Client Quit]
emmanuelux has joined #ocaml
Associat0r has quit [Quit: Associat0r]
vivanov has quit [Ping timeout: 250 seconds]
dnolen has joined #ocaml
vivanov has joined #ocaml
<vivanov> i have two modules: 2nd module calls a function from the 1st module -- so i guess the 2nd module depends on the 1st. I have variables taking initial values in 1st module, and then altered in the 2nd. Does ocaml ensure that the 2nd module will get evaluated only after the 1st is done?
emmanuelux has quit [Remote host closed the connection]
emmanuelux has joined #ocaml
vivanov has quit [Ping timeout: 252 seconds]
<flux> ocaml ensures that the modules get evaluated in the order you link them
dnolen has quit [Quit: dnolen]
vivanov has joined #ocaml
vivanov has quit [Ping timeout: 260 seconds]
vivanov has joined #ocaml
vivanov has quit [Ping timeout: 252 seconds]
sepp2k1 has quit [Quit: Leaving.]
arubin has quit [Quit: arubin]
joewilliams is now known as joewilliams_away
ulfdoz has quit [Ping timeout: 248 seconds]
emmanuelux has quit [Read error: Operation timed out]
vivanov has joined #ocaml
joelr has joined #ocaml
Snark has joined #ocaml
larhat has joined #ocaml
vivanov has quit [Ping timeout: 260 seconds]
yezariaely has joined #ocaml
yezariaely has left #ocaml []
ttamttam has joined #ocaml
<joelr> goo dmorning
<joelr> good
avsm has joined #ocaml
<rproust> joelr: good morning
<joelr> rproust: any suggestions on my caml-list posting?
<joelr> rproust: https://gist.github.com/886552 <- this
<rproust> yeah
ttamttam has left #ocaml []
<rproust> Rep is a functor, not a module
<joelr> rproust: indeed
<rproust> you are trying to access a field of a module on a functor
<joelr> fair enough, how do i make this work?
<joelr> do you get the idea of what i'm trying to do?
<rproust> yeah
<joelr> to get a reply i want to dispatch on a request
<joelr> and a server is defined by its request/reply pairs
<rproust> just before let server = ...
bobry has joined #ocaml
<rproust> you should put "module R = Rep (Req)"
<joelr> technically, i don't have it right, because reply in the server has to be parameterized on the -same- request
<joelr> rproust: thanks, let me try this
<rproust> and then use R.dispatch
<rproust> Rep is the functor, Req is the argument and R is the result of the application of Rep on Req
<joelr> i understand now
<rproust> so Rep "has type" (quotes because the vocabulary is inexact) Request -> Toto (with Toto having the dispatch function)
<joelr> woot
<rproust> Req "has type" Request
<joelr> rproust: so how do i thank you on the mailing list?
<rproust> never mind
<rproust> you can send a message saying it has be solved
<joelr> allright, no kudos to rproust then on the list
<rproust> giving the solution
<rproust> there's another way to do what you want btw
<joelr> rproust: really?
<rproust> here what you use is : Request -> (Request -> Toto) -> Foo
<rproust> you can have Toto -> Foo
<rproust> giving has an argument Rep (Req)
<joelr> Toto being the variant wrapper around Request, i suppose
<rproust> 09:42 < rproust> so Rep "has type" (quotes because the vocabulary is inexact) Request -> Toto (with Toto having the dispatch function)\
<joelr> and Foo being Reply, right?
<joelr> i'm confused :(
<rproust> sry, I was doing a parallel btwn types and signatures which can be confusing
<joelr> i have request, variant type of request and reply
<rproust> what you do here, is that you pass a module and a functor
<joelr> yes, indeed
<rproust> and then you apply the functor to the module inside the "Server" functor
<joelr> i would prefer to pass two modules instead
<rproust> it is possible
<rproust> there's one thing though
<joelr> but the contstraint is that reply has to be parameterized on the request
<rproust> let me fork the github thingy
<joelr> let me update it first
<joelr> one sec
<joelr> ok
<joelr> done
<joelr> updated
<joelr> i'm trying to add a usage example to make it complete
<rproust> joelr: ok
<rproust> is this different from your real use case?
<rproust> because here, I don't see the point of passing Req as argument to Rep
<rproust> Req only includes Messages, which Rep does anyway
<rproust> I guess it is different
<joelr> well
<joelr> the point is that a reply is created based on a request
<joelr> but both request and reply are messages
<joelr> so they have common functions
<joelr> so, perhaps, what i'm trying to do is wrong but above is the spirit of what i want to achieve
<joelr> basically, a reply has to be tighly bound to -a- request
<joelr> so that the type system complains, for example, if you try to instantiate a server on a pair of request and reply that have not been "bound" together
<joelr> rproust: ^
<rproust> ok I get the Idea
<rproust> here is an idea: pass Message directly to the Server functor
<joelr> message?
<rproust> the Message module
<joelr> rproust: what does that give me?
<joelr> rproust: and add dispatch to message itself?
<rproust> no
<joelr> where would dispatch live then?
<rproust> you move the code from the Reply functor to the Server functor
<joelr> what code?
<rproust> module Server (M:Message) = struct let dispatch = … let _ = while true do … end
<joelr> hmm...
<rproust> the Reply functor is only a "module type"? There's no implementation?
<joelr> reply and request are classes generated by thrift
Yoric has joined #ocaml
<joelr> no, this is wrong
<joelr> type obj = private < write : Protocol.t -> unit; .. >
<joelr> this is how obj is defined now
<joelr> which allows me to use thrift-generated classes
<rproust> ok
<joelr> the issue is that there many request/reply pairs and the encapsulation into variant is custom for each message
<joelr> and so the dispatch is also custom to each request and reply implementation because the variant types are different
<joelr> right?
<rproust> so you have an external lib that gives you values. You convert these values to a variant type for pattern matching and all.
<joelr> correct
<rproust> what functions depends on this variant?
<rproust> dispatch?
<joelr> yes
<joelr> but dispatch belongs to the "paired" reply type
<joelr> or message type
ikaros has joined #ocaml
<joelr> or maybe not paired but "some other"
<rproust> there's a weirdness in your code
<joelr> yes?
<rproust> you include Message in both Request and Reply
<joelr> yes, because they are both messages
<rproust> so in Server there are *two* variant types
<joelr> you can make them, convert them to a variant, read and dump/print them
<rproust> is it what you want?
<joelr> technically yes because there may be pattern-matching to do on the reply
<rproust> do you want the server to have only *one* variant types or *two*?
<joelr> two is fine
<joelr> i want my pattern matching
<joelr> which is why i put the variant in message as opposed to reply or request
<rproust> you want to pattern match on the answer and on the reply, and the *two* pattern matching work on different types? (replies and requests are have different variants?)
<joelr> no, no
<rproust> ok
<rproust> requests ane reply have an identical variant type?
<joelr> i would like to be able to reserve the means to do pattern patching in the server for purposes other than dispatching
<joelr> dispatching, i.e. taking some action and creating a reply i'm only doing for the reply at the moment
<joelr> replies and requests are different variants
<rproust> ok
<joelr> based on different class types, thus different variants, thus variant in message
<rproust> so the weirdness is explained and is not a weirdness at all…
<joelr> as well as convert
<joelr> weird by design? :-)
<rproust> no no
<joelr> i'm starting to understand why the first thing people ask when trying to help is "what are you trying to accomplish?"
<joelr> :D
<rproust> I though that reqs and reps had the same type
<joelr> oh, no
<rproust> it's ok
<joelr> different messages
<joelr> and dispatch creates a reply based on a request
<rproust> ok
<rproust> so your code should work for what you are trying to do
<joelr> probably. the problem i have now is that i can't instantiate my modules
<joelr> let me paste
<rproust> now that I get the idea, I may be able to give better answers next time
<rproust> go on
<joelr> updated gist
<joelr> this is how i create my request
<joelr> err, define request
<joelr> dummy of course
<rproust> yeah, always start with dummy
<joelr> but now how do i define a reply and instantiate a server? obviously, i should do M = Server (MyRequest)
<joelr> but how do i plug in the reply?
<joelr> and define the reply in the first place
vivanov has joined #ocaml
<joelr> ah! i was missing functor in MyReply
<rproust> joelr: updated
<joelr> i actually have everything in the same file, so no X for me but this gives an error
<rproust> yeah
<joelr> on instantiation of server
<rproust> yeah
<rproust> a problem of types of Req and Resp and all
<joelr> let me try to fix that
<rproust> it's a problem of types being abstracted out
<joelr> yes, let me make them different
<rproust> no, it'll always be abstracted by your abstract interfaces, what you need is to put a "with" indication in the signatures of the instantiation
<joelr> how do you do that?
<rproust> I fixed Req's instantiation, I'm not sure how to do it with Resp because of it's functor
<rproust> (there my be syntax errors, I didn't check
<joelr> right
<joelr> i think it's the server instantiation that doesn't work
<joelr> maybe that's what you meant
larhat has left #ocaml []
larhat has joined #ocaml
<rproust> the server part is more difficult
<rproust> what you can do is: build a Req module and build a Resp functor retaining the necessary Req entries
jonafan_ has joined #ocaml
<joelr> rproust: right... i'll give it a shot. need to step out for an hour.
<joelr> rproust: thanks for your help!
<rproust> joelr: you're welcome
jonafan has quit [Ping timeout: 240 seconds]
<rproust> joelr: when you're back, take a look at https://gist.github.com/886595
<joelr> how do you instantiate that? does it compile?
myu2 has quit [Ping timeout: 250 seconds]
<joelr> rproust: back in an hour
joelr has quit [Quit: joelr]
<rproust> k
avsm has quit [Quit: Leaving.]
myu2 has joined #ocaml
_andre has joined #ocaml
Associat0r has joined #ocaml
Associat0r has quit [Client Quit]
boscop has joined #ocaml
avsm has joined #ocaml
Associat0r has joined #ocaml
avsm has quit [Client Quit]
thomasga has quit [Ping timeout: 276 seconds]
joelr has joined #ocaml
thomasga has joined #ocaml
avsm has joined #ocaml
Associat0r has quit [Quit: Associat0r]
joelr has quit [Quit: joelr]
adlsaks has joined #ocaml
Cyanure has quit [Remote host closed the connection]
thomasga has quit [Quit: Leaving.]
bobry has quit [Quit: Leaving]
tauntaun has joined #ocaml
edwin has joined #ocaml
explodus has quit [Ping timeout: 276 seconds]
explodus has joined #ocaml
dnolen has joined #ocaml
joelr has joined #ocaml
<joelr> rproust: i'm back
adlsaks has quit [Ping timeout: 264 seconds]
tauntaun has quit [Quit: Ex-Chat]
ymasory has quit [Quit: Leaving]
<joelr> rproust: why REPLY_FUNCTOR?
joewilliams_away is now known as joewilliams
tauntaun has joined #ocaml
vivanov has quit [Ping timeout: 250 seconds]
vivanov has joined #ocaml
Kakadu has joined #ocaml
<Kakadu> hi!
<thelema> hi
<Kakadu> how to write function with signature < .. > as 'a -> <..> as 'b -> unit
<Kakadu> where object 'b is subclass of object 'a ?
<thelema> I don't think ocaml's type system can represent this. What are you trying to do?
<Kakadu> I think about statically typing QT signals and slots
<thelema> so 'a and 'b aren't arbitrary objects, but 'b is the base type and 'a is the supertype?
<Kakadu> if signal and slot represen like classes where ocaml methods are C++ arguments
<Kakadu> thelema: maybe 'a and 'b can be not classes
<thelema> 'a slot -> 'a signal -> unit?
<Kakadu> thelema: mmmmmmmmmm, nice!
<joelr> <- is still fighting functors
<thelema> joelr: I bet. Maybe try writing it without functors, and functorizing one step at a time by incremental refactoring
<joelr> thelema: not possible, i think. do you read the caml-list?
<thelema> yes
<thelema> I've seen your posts.
<joelr> thelema: i don't know how to write that -not- as a functor, e.g. how not to specialize a reply on the request
<thelema> you claim that your construction can't be defunctorized by forward substituting functor parameters into the functorized module?
<joelr> ugh
<joelr> i have trouble with the 2nd half of your sentence
<thelema> given a functor F(X) -> Y
<thelema> and a module of type X
<thelema> one can produce a defunctorized F by replacing Y.X.foo with foo from X
<joelr> right, i thought that's what it was
<thelema> similar to how non-recursive functions can be turned into regular code by inlining their arguments.
<joelr> but that doesn't make sense in the final implementation i'm seeking.
<joelr> it doesn't implement the concept if i fix the request and reply, for example
<thelema> because you want to have multiple request and reply modes?
<thelema> try writing it with a single request/reply mode, and then de-inline the request and reply code into a functor
<joelr> i want to have multiple request and reply pairs
<joelr> thelema: i'm hoping that the example i posted to the list is small and self-containted enough for suggestions
<joelr> thelema: do you have any?
<thelema> gmail is "still working" to load the message
<joelr> ouch
<joelr> let me paste it
lopex has joined #ocaml
<thelema> for your last example, you have to specifically cast 1 to obj in MyRequest
<thelema> L41: let make () = (1 :> obj)
<joelr> trying
<thelema> L50: let make () = (2 :> obj)
<joelr> thelema: did you try compiling that?
<thelema> no
<joelr> it doesn't work
<thelema> :(
<joelr> Error: This expression has type int but an expression was expected of type obj
joewilliams is now known as joewilliams_away
<joelr> thelema: checking, thanks
<joelr> thelema: so all i needed was to explicitly state that myrequest and reply are of type request and reply... interesting
<joelr> thelema: thanks a lot!
<thelema> no, that was just a debugging tool to typecheck them before applying them to the functor
<thelema> the real problem was the private on the obj types
<thelema> (and a typo on MyReply.dispatch - it was "B" before)
<joelr> thelema: i put that in so that the various functions in the module use the same type
dnolen has quit [Quit: dnolen]
<joelr> i thought that's what private does
<joelr> e.g. the obj in message is always the same obj
<joelr> i guess i'll have to re-read about private row types again
<thelema> if you want to assert Request.obj = reply.obj, that's different
<thelema> to do that, it's L24: module Server (Req : Request) (REP : Reply with type obj = Req.obj) =
<thelema> (or syntax similar to that
<joelr> no, request.obj != reply.obj
<thelema> ok.
<joelr> they are separate types
<thelema> n/m then
<joelr> i do want to make sure that the request type that Reply was specialized with is the same as Req
<joelr> perhaps that's managed automatically for me
<joelr> and the compiler will give an error
ftrvxmtrx has quit [Ping timeout: 250 seconds]
emmanuelux has joined #ocaml
<hcarty> thelema: I saw that camlzip has a META file in Subversion - is that the version available to odb, or does odb have the official 1.0.4 release?
* thelema checks
<thelema> my tarball is named camlzip-1.04, so I think it's the official release
<thelema> yes, no META file in it.
ftrvxmtrx has joined #ocaml
<thelema> should probably remove camlzip from the list of available packages
jonafan__ has joined #ocaml
<joelr> thelema: a small follow-up question, if i may
emmanuelux has quit [Ping timeout: 248 seconds]
<joelr> thelema: in module MyReply, assuming that you wrote ' let dispatch = function | A -> 1 | B -> 2', how do you get hold of the constructors from MyRequest to be able to match on them?
<thelema> Req.A, Req.B
<joelr> thelema: that was my first thought
<joelr> thelema: but they are unbound
<joelr> maybe because MyReply knows about a generic Request rather than a specific MyRequest?
<thelema> because Req doesn't expose them - Request exposes an abstract variant
jonafan_ has quit [Ping timeout: 276 seconds]
<joelr> thelema: what is the solution then? list variants outside the module as, say req_variant and then in the module type variant = req_variant? is there a better way?
Kakadu has quit [Quit: Page closed]
<thelema> don't even need type variant in modules if it's defined externally
<thelema> Is variant going to be a plain enum, or will it have data attached to some variants?
<joelr> the variant wraps the objects
<joelr> so it's always A of <class type> | B of <another class type>
<joelr> thelema: i think the variant needs to be in the modules as it's used by the convert function
<joelr> in each module
<thelema> it needs to be accessible to the modules, it doesn't need to be in them.
<joelr> Values do not match: val convert : 'a -> request_variant is not included in val convert : obj -> variant
<thelema> if it's constant across the whole thing, it shouldn't be duplicated in each submodule
<thelema> request_variant != variant
<joelr> thelema: it's not a constant. each reply, request, etc. have their own variant
<joelr> the convert function wraps a variant particular to a message around that message
<joelr> that's the idea
<hcarty> Wow... Jane St. defines ( ~% ) = sprintf
<thelema> hcarty: rubyish.
<hcarty> That's an interesting piece of shorthand
<hcarty> thelema: Oh, really? I suppose that makes some sense then
<thelema> hcarty: "%d:%d" ~% 2 4
robinnn has joined #ocaml
robinn has joined #ocaml
<thelema> joelr: ick. good luck.
<hcarty> I have "say" defined as a wrapper around printf, and "warn" as eprintf
<hcarty> thelema: Except that the ~ means it's a prefix operator
<hcarty> So it's ~% "%d:%d" 2 4
<joelr> thelema: impossible?
<thelema> joelr: just messy
<joelr> thelema: why?
<joelr> conceptually nice, no?
<thelema> joelr: maybe I've still not got the big picture, as I'm not familiar with ZeroMQ or Thrift
<thelema> "I have request and reply messages in my system and replies are created (dispatched) based on their request pair."
<joelr> thelema: thrift creates classes for messages and i don't want to deal with classes.
<thelema> what request pair?
<joelr> the one reply was specialized on
<thelema> ok, what is a request pair
<joelr> the one with the variant type that's passed to reply's dispatch
<joelr> right?
<thelema> still don't get it. You have sending programs and receiving programs, and want to send some sort of object from one to the other, right?
<thelema> and this code goes in a "server" that handles getting data from the sender to the receiver?
* mfp also strugging w/ the big picture
<joelr> well
<joelr> no, i'm sending binary data or strings. the objects thrift creates for my messages take care of serialization
<thelema> some sort of object = strings, no problem
<joelr> i'm trying to hide the overall networking mechanism (server) such that users don't need to care about it
<joelr> thelema: thrift creates objects that serialize their fields to a string or deserialize from it. or from binary data.
<thelema> you want to write a library that allows users to send data to this library and it comes out in the right place?
rien has joined #ocaml
<joelr> here, let me paste the working code i have right now, one i'm trying to improve upon. maybe that will explain it.
<mfp> OK, if I'm getting this, the problem is that you want to send a sum type, but thrift only knows about objects --- so you end up having to send an object having (nullable) fields of each possible type?
sepp2k has joined #ocaml
<joelr> mfp, thelema: ^
<joelr> mfp: i just want to deal with variants
<joelr> a particular example is that thrift allows for union types but the codegen will encode such a type (say 2 fields) as class with two fields and a bunch of methods. you are supposed to figure out what part of the union was sent by checking what field was set
<joelr> i would rather have a converter that does this and then gives me back a variant with a constructor for each part of the union
smerz has joined #ocaml
<joelr> thus my insistence on variant type and convert function in the message module
robinnn has quit [Quit: Leaving]
<mfp> joelr: are you sure about the union types? there were not there the last time I looked at thrift, and they're not here http://wiki.apache.org/thrift/ThriftTypes
<joelr> does the gist i posted make it clear what i'm doing? i'm trying to improve on that working code
<joelr> mfp: trust me, they are there now
<mfp> but with no support from the ocaml generator?
<joelr> mfp: with support. let me paste it
* mfp checking out thrift
Snark has quit [Quit: Ex-Chat]
<joelr> mfp: ^
<joelr> thelema: ^
<joelr> hmm... i should remember to add files to the gist in the opposite order
<joelr> do look from the bottom up
<f[x]> but it is not mapped to proper ocaml types
<thelema> joelr: seems like a horrible solution to the problem of extensible protocols
<f[x]> extprot rules btw
<mfp> hmm maybe that much was already there last time I looked (when I was playing with cassandra), but I wouldn't call it proper support :-)
<mfp> I mean, you have to iterate over all the fields and see which one isn't None
<mfp> so you have to write a huge val wrap : fooBar -> myvariant function
<thelema> mfp: which I guess is what he's trying to automate with even more code. But this new code has to know everything about the structure of the types involved
<mfp> that looks like match o#get_foo with Some x -> Foo x | None -> match o#get_bar with Some x -> Bar x | None -> ....
<joelr> thelema: my code does know about the types involved. see stats.ml
<joelr> that code uses a combination type for request and reply, both bundled into one module
<mfp> joelr: so you're tring to (auto- ?)generate a function like the above wrap? does that sound right?
<joelr> no auto-generating
<joelr> i will write it
<joelr> i just want the dispatch function in MyReply to know about the variant type of MyRequest
<joelr> that's all i want, really
<thelema> and you want the wrapping and unwrapping to happen automatically?
<joelr> thelema: the wrapping and unwrapping happens in the server
<joelr> https://gist.github.com/886971 <- original gist that you sent
<mfp> f[x]: I've realized I didn't document things like Pretty_print and some other modules properly, must add some .mlis someday; also the compatibility checker tool
<joelr> thelema: look at the loop in the Server module
<thelema> joelr: use one module to hold both - I don't think you can split request and response and maintain the variant type between
<joelr> thelema: i'd rather keep two separate modules.
<joelr> what about this comment?
<joelr> Well, you have to make it transparent in the Request signature then. Then you should be able to say Req.A -> 1. /Andreas
<thelema> meaning that Message.variant has to have type variant = A of ... | B of ... or ...
<thelema> and the whole thing won't be usable on any other variant type
<f[x]> mfp, btw, http://paste.in.ua/1991/
<thelema> well, maybe not message variant, maybe only request.variant
<thelema> but the type in the module type has to expose all the variants
<joelr> thelema: which doesn't work because it's ... abstract
<joelr> right
<thelema> joelr: exactly
<mfp> f[x]: ah sorry, forgot to apply
<joelr> argh
<joelr> thelema: what about a slightly different tack... dispatch is only used in the server module
<thelema> which is why they should be one module - if you have an interface between them, you have to specify exactly that interface
<mfp> argh, I always forget if it's git am, git fetch or what
<joelr> hmm
<f[x]> hmm
<joelr> thelema: my concern against making request/reply one type is that they are both messages. so i'll have 2 print functions, two make functions, two convert functions, etc. it just looks neater when they are split.
<joelr> of course dispatch needs to be solved then
<_habnabit> ns5, you just summarzed it
<thelema> well, you could drop out of module land and use records, then you get 'a for variant, and the typechecker can verify that reply's 'a on dispatch matches request's 'a on convert
<_habnabit> ...
* _habnabit kicks irssi.
<thelema> type ('a, 'b) message = {make : unit -> 'a; convert : 'a -> 'b; print : 'a -> unit}
<joelr> thelema: interesting...
<thelema> type ('a, 'b) reply = {make: unit -> 'a; convert: 'a -> 'b; print : 'a -> unit; dispatch : 'b -> 'a}
<hcarty> Or nest both modules in a parent functor
<rien> with 0 being "easy peasy" and 10 being "nigh impossible", how easy would it be to rewrite that "Write a Scheme in 48 hours" in ocaml? (it uses haskell)
<thelema> err, fix the field names in reply to be distinct -- rp_make, etc.
<joelr> thelema: i think with modules the typechecker doesn't care what else i have in there as long as i have the needed fields and funs. i have a hunch that it doesn't work the same with records
<joelr> e.g. reply will not be considered a message anymore
<f[x]> mfp, sorry, here is ready for git am - http://paste.in.ua/1992/
<thelema> well, you could have just reply, and for requests, put assert false in their dispatch slot
<mfp> f[x]: thanks, was scratching head trying to massage the patch into something git am liked
<joelr> thelema: hacking the type system sounds ... more elegant
<thelema> if you really needed the type system to differentiate the two, a phantom type would ensure you couldn't confuse requests with replies
* f[x] writes down "git format-patch --stdout" into persistent memory
<joelr> thelema: i wonder if i can put dispatch into the server instead, since the server knows about both request and reply, it's specialized on them
<thelema> let server req rep = while true do let r = req.make () in req.convert r |> rep.dispatch |> rep.print; req.print r; done
<thelema> joelr: you'd still have to expose the variant type in your functor parameter type, which makes the code not general
<joelr> thelema: pass the dispatch function into the server then?
<hcarty> rien: I don't know Haskell well enough to say, but on a somewhat related note I think there is a scheme or two written in OCaml already out there.
<hcarty> rien: So that may help
<rien> hcarty: understood. I'll look for those. do you know if there's a parser combinator library for OCaml? (in Haskell there's a good one called Parsec)
<joelr> thelema: i understand the contraint, i suppose. i think i should either pass a dispatch module or a dispatch function to server and things will magically work
<hcarty> rien: There may be something in Batteries, but this is an area of OCaml I haven't worked with
<hcarty> rien: There is some more information here, though I don't know how useful it is - http://stackoverflow.com/questions/307499/a-good-ocaml-parser
<joelr> darn, so much for good intentions
<joelr> thelema: thanks a lot for your help!
<rien> hcarty: I appreciate the help!
<hcarty> rien: You're welcome, and good luck :-)
<rien> :)
<hcarty> thelema: Thanks, I thought Batteries had something
<rien> yep, that looks a lot like Parsec
<thelema> hey, batteries has a valid _oasis
<thelema> and why 1.2.2?
<thelema> anyway, that's just nitpick.
<gildor> thelema: I just reinjected the previously uploaded data
<gildor> thelema: some are lacking valid data
<gildor> (because there were bugs before ;-)
<thelema> yes, cryptokit has "deps=\n", which doesn't parse at the moment
<thelema> anyway, looks good, I've pushed the new webroot
<gildor> thelema: BTW, the parser for listing package is very dependent on lighttpd output
<thelema> yes it is.
<gildor> thelema: could you make it less sensitive so that oasis-db/odb output can be parsed as well
<thelema> I'd love to
<gildor> thelema: ask me if you need changes in the output, I will try to do them as far as possible
<gildor> and for now, there is no deps on tools (only findlib deps)
<gildor> I am working on extending the deps= to be as complete as the already present package in ODB
<thelema> so oasis doesn't depend on ocamlify?
<gildor> thelema: another very nice feature would be to use publink/backup
<gildor> thelema: indeed, ocamlify is a tool and I don't yet take into account BuildTools
<thelema> ok
<gildor> thelema: but this is not an issue, just a matter of programming it
<thelema> publink/backup?
<gildor> in oasis-db you can use either the publink, which will download the tarball directly on the original website
<gildor> or the backup which will download the tarball from oasis-db
<gildor> this is just a matter of redirection
<thelema> ah, more fields in the info file?
<gildor> what would be nice is to try download a first link foo.tar.gz and if it doesn't work try to download backup/foo.tar.gz
<thelema> ok, simple logic
<gildor> thelema: no need of an additional field, just if you have a download error, try the backup
<gildor> and if it doesn't work, fail
<thelema> got it
<gildor> I can hack that quite quickly if you want
<gildor> BTW, when you'll be happy with oasis-db/odb, I will make an official announcement about the availability of oasis-db 0.1.0~alpha2
<gildor> if you agree
<thelema> it's on my todo list right after the html "parsing" for a list of modules
<gildor> anyway, it will almost be time for kids, I'll try to be back in 4 hours
<gildor> thelema: send me an email if you need something on the output or have ideas
<thelema> ok
lopex has quit [Ping timeout: 250 seconds]
lopex has joined #ocaml
<thelema> <td class="n"><a href="../pkg">..</a>
<thelema> ocsigen is wierd about directory listings.
joewilliams_away is now known as joewilliams
avsm has quit [Quit: Leaving.]
joewilliams is now known as joewilliams_away
Associat0r has joined #ocaml
tauntaun has quit [Quit: Ex-Chat]
ymasory has joined #ocaml
ymasory has quit [Client Quit]
joewilliams_away is now known as joewilliams
larhat has quit [Quit: Leaving.]
joewilliams is now known as joewilliams_away
<joelr> any suggestions on how to functorize this?
joewilliams_away is now known as joewilliams
<thelema> no way to join types other than another level of tag: type rep_or_req = Rep of rep | Req of req
<thelema> unless you want to wander into polymorphic variants
<joelr> thelema: i just want to stick dispatch and convert into a module and have them work -just- for my types req, rep, MyRequest and MyReply
<joelr> obviously, it has to be a functor since it needs to be specialized on MyRequest.t and MyReply.t. req and rep could be defined internally, i suppose
<joelr> right?
<thelema> module type CD (Req:Message) (Rep: Message) = sig type var val convert : Req.t -> var val dispatch : var -> Rep.t end
<joelr> right, working on that
joewilliams is now known as joewilliams_away
<joelr> thelema: why can't i type it the way you have above and need to use the word functor? argh...
<joelr> meaning it needs to be module type CD = functor (Req:Message) -> functor (Rep:Message) -> sig ... end
<joelr> of course that only needs to be done in type signatures
<joelr> but why not be consistent
<thelema> the shortcut to omit the functor keyword only exists in definitions
<joelr> thelema: that's what i'm saying
<thelema> you can put it in definitions for consistency if you like
<joelr> i want it in signatures as well
joewilliams_away is now known as joewilliams
<thelema> if you have to have a module type that's a functor, you're already way into academic programming, and practical considerations don't apply
<joelr> thelema: dunno if i agree, i find these things awfully handy
<thelema> Golden hammer syndrome?
<joelr> hahaha
<adrien> been using functors to avoid depending on another library (avoid depending on react in lablgtk)
enthymeme has joined #ocaml
<thelema> joelr: they are kind of the ultimate parameterization that's possible
<joelr> ok
<thelema> If you can't make code more generic with a functor, you almost can't make it more generic. almost.
<thelema> They're a bit heavy, as you're finding.
<joelr> right
<hcarty> thelema: Functors work beautifully in the Map.Make case, particularly if you want to be different maps can't be mistakenly interchanged.
joewilliams is now known as joewilliams_away
<thelema> hcarty: there's definitely uses for them, but they're not the right solution for everything.
<hcarty> thelema: Agreed
vivanov has quit [Quit: leaving]
<gildor> thelema: no ocsigen don't do directory listing, this is probably an error from me
<thelema> gildor: ah, that's why if I requested pkg/info/, I'd get an error, but I could get a listing from pkg/info
<thelema> this and the really wierd paths were the two difficulties in parsing the directory listing. everything else was identical
<gildor> thelema: I can fix that too
<thelema> if you want. The important fix now is to actually have packages that install
<thelema> (and maybe a sandbox to pre-test installation before a new package is accepted)
<gildor> pick a simple library/exec and tell me what is missing, if you have time
<gildor> for the sandbox, I can create a tag that you can apply to a package version
<gildor> and only the version with the right tag will be in odb/pkg
<gildor> e.g. tag batteries 1.2.2 with "odb-ready"
<thelema> odd, I'm getting this error when installing with oasis: ocamlfind: /usr/lib/ocaml/ld.conf: Permission denied
<gildor> OCAML_LDCONF=ignore
<gildor> OCAMLFIND_LDCONF=ignore
<gildor> export OCAMLFIND_LDCONF=ignore
<thelema> this needs to be set for non-root oasis installs?
<gildor> yes
ymasory has joined #ocaml
<gildor> this and a LD_LIBRARY_PATH that contains the place where the stub are installed
<gildor> thelema: summary TODO: fix ../pkg, fix pkg/info/ vs pkg/info and implement tag odb-ready
<gildor> for odb-ready, the rule is: if there is no version with odb-ready, pick the latest, otherwise pick the one that has the tag
<gildor> + display the list of package where latest <> odb-ready ?
<gildor> and allow to edit _oasis online
<gildor> (or create a very simple one online)
<gildor> is this ok for you ?
<gildor> thelema: ^^^
* gildor still with kids so will leave again soon
<thelema> ok
<thelema> yes, ok for me
<thelema> ocaml-fastrandom is marked as a program, not a library, while it installs a library.
tauntaun has joined #ocaml
<thelema> gildor: similar for ocaml-expect (maybe logic backwards?)
<thelema> gildor: and ounit package name needs to have capital letter to match findlib package name
<gildor> thelema: you choose to name pkg/info following the name of the findlib package they contain ?
<gildor> ocaml-fastrandom/ocaml-expect, ok will have a look
<gildor> what if a package contains several findlib package ?
<thelema> the package name is used to identify if it's installed
<thelema> if a package installs multiple findlib packages, it suffices that one of them matches the package name, as long as they're all installed together
<gildor> so if a tarball foo.tar.gz provides bar and baz, I create pkg/info/bar and pkg/info/baz pointing to the same foo.tar.gz ?
<thelema> very simple detection of installed packages - if it's a library, there must be a findlib package with the right name.
<thelema> if a tarball foo.tar.gz provides bar and baz, pick one and have that be the package name. And have anything that depends on either bar or baz depend on that package name.
<thelema> if possible, a single package shouldn't provide multiple findlib packages (excepting subpackages)
<gildor> thelema: wouldn't it be more simple to have both bar and baz ?
<thelema> that should work too.
<gildor> thelema: so I'll pick this solution (both bar and baz)
<thelema> what packages provide multiple findlib packages?
thieusoai has joined #ocaml
<gildor> thelema: e.g. batteries provides estring and batteries ;-)
<thelema> heh. true. We should fix that.
groovy2shoes has joined #ocaml
<gildor> thelema: I don't see the need for it, you can live with both
<thelema> anyone wanting estring will have to install batteries... :(
<thelema> anyway, not critical at the moment.
<thelema> duplicating packages seems fine to me.
<joelr> i think i may need to embrace objects instead of modules in my quest for an elegant architecture
* gildor gtg
<thelema> gildor: cheers
_andre has quit [Quit: leaving]
<hcarty> thelema: It may be worth grabbing or at least studying a few of the updated Core functions, particularly the sped up tail recursive list functions.
tauntaun has quit [Ping timeout: 255 seconds]
<thelema> hcarty: agreed - I helped develop those functions, but thought them too risky to use in production code. If Jane street has vetted them well, maybe it's okay to put them in batteries
yezariaely has joined #ocaml
ulfdoz has joined #ocaml
joewilliams_away is now known as joewilliams
groovy2shoes has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
tauntaun has joined #ocaml
joewilliams is now known as joewilliams_away
robinn has quit [Remote host closed the connection]
Fullma has quit [Ping timeout: 255 seconds]
joewilliams_away is now known as joewilliams
jonafan_ has joined #ocaml
Derander has quit [Read error: Operation timed out]
yezariaely has quit [Ping timeout: 252 seconds]
Derander has joined #ocaml
yezariaely has joined #ocaml
jonafan__ has quit [Ping timeout: 252 seconds]
philtor has quit [Ping timeout: 260 seconds]
Anarchos has joined #ocaml
tauntaun has quit [Quit: Ex-Chat]
joelr has quit [Quit: joelr]
joewilliams is now known as joewilliams_away
yezariaely has left #ocaml []
ftrvxmtrx has quit [Quit: Leaving]
ftrvxmtrx has joined #ocaml
smerz has quit [Quit: Ex-Chat]
edwin has quit [Remote host closed the connection]
Anarchos has quit [Quit: Vision[0.9.7-H-090423]: i've been blurred!]
tauntaun has joined #ocaml
mal`` has quit [Quit: ERC Version 5.3 (IRC client for Emacs)]
mal`` has joined #ocaml
Yoric has quit [Quit: Yoric]
Cyanure has joined #ocaml
<adrien> just found out that pre-3.12's myocamlbuild.ml and 3.12.0 do not go together
<adrien> won't be able to create a native library: complains that .cmxa files aren't interface description files iirc
<adrien> and now I'm stuck between 3.12.0's missing support for threads with ocamlbuild+ocamlfind and the fact that it can't use the myocamlbuild.ml for 3.11 and 3.10 ='(
Cyanure has quit [Client Quit]
Cyanure has joined #ocaml
<hcarty> adrien: That's odd - I've used the same (generic) myocamlbuild.ml between 3.11.x and 3.12.0
<hcarty> adrien: Using the myocamlbuild.ml from Batteries
dnolen has joined #ocaml
<adrien> been able to reproduce it with trivial code: make foo.native, make foo.byte, make foo.cma all work, only foor.cmxa doesn't
sepp2k1 has joined #ocaml
sepp2k has quit [Ping timeout: 255 seconds]