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
Associat0r has quit [Quit: Associat0r]
oriba has quit [Remote host closed the connection]
lopexx has quit []
alexgord- has joined #ocaml
pheredhel has joined #ocaml
ttblrs_ has joined #ocaml
alexgordon has quit [Disconnected by services]
alexgord- is now known as alexgordon
avysk has quit [Ping timeout: 248 seconds]
ttblrs has quit [Ping timeout: 246 seconds]
pheredhel` has quit [Ping timeout: 246 seconds]
thieusoai has quit [Ping timeout: 246 seconds]
tvn2009_1 has joined #ocaml
avysk has joined #ocaml
enthymeme has quit [Quit: rcirc on GNU Emacs 23.1.1]
dnolen has quit [Quit: dnolen]
boscop__ has joined #ocaml
boscop_ has quit [Ping timeout: 248 seconds]
ymasory has quit [Quit: Leaving]
ymasory has joined #ocaml
ulfdoz has joined #ocaml
ymasory has quit [Quit: Leaving]
DOUK has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
ikaros has joined #ocaml
ulfdoz has quit [Ping timeout: 252 seconds]
jderque has joined #ocaml
groovy2shoes has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
groovy2shoes has quit [Read error: Connection reset by peer]
Yoric has joined #ocaml
groovy2shoes has joined #ocaml
groovy2shoes has quit [Quit: Computer has gone to sleep]
valross has quit [Quit: Ex-Chat]
Cyanure has joined #ocaml
eye-scuzzy has joined #ocaml
ocp has joined #ocaml
Derander has quit [Ping timeout: 248 seconds]
Derander has joined #ocaml
jamii has joined #ocaml
jonafan has quit [Ping timeout: 276 seconds]
jonafan has joined #ocaml
ankit9 has joined #ocaml
ftrvxmtrx has joined #ocaml
impy has quit [Read error: Connection reset by peer]
Yoric has quit [Quit: Yoric]
larhat has joined #ocaml
eikke has joined #ocaml
ikaros has quit [Quit: Leave the magic to Houdini]
jamii has quit [Ping timeout: 240 seconds]
Associat0r has joined #ocaml
jderque has quit [Quit: leaving]
joelr has joined #ocaml
<joelr> Good morning
<rproust> joelr: morning
<joelr> How do I make this function polymorphic?
<joelr> let rec collate ?(transform = fun x -> x) l acc : =
<joelr> match l with
<joelr> | [] -> Some (List.rev acc)
<joelr> | None :: t -> collate t (None :: acc)
<joelr> | (Some h1) :: (Some h2) :: t -> collate t ((Some (h1, transform h2)) :: acc)
<joelr> | _ -> failwith "Did not provide a pair of field-values"
<joelr> Duh
<joelr> This one
<joelr> rproust: help!
<ocp> it is polymorphic
<ocp> val collate :
<ocp> ?transform:('a -> 'a) ->
<ocp> 'a option list -> ('a * 'a) option list -> ('a * 'a) option list option
<flux> joelr, the problem is with out default value
<flux> joelr, you must not provide one. unfortunately.
<joelr> flux: how so?
<flux> there are good reasons, too.. I think ;)
<flux> well, it uses that function for inferring the function type.
<joelr> flux: just use f then? always?
<flux> and a function cannot have multiple types.
<flux> joelr, do it like: let rec collate ~transform l acc = ..
<joelr> flux: fair enough, thanks!
<flux> or even without the label
<joelr> right
<joelr> I thought there's some fancy way to type the default argument
<flux> just give in and have collate_default l acc = collate (fun x -> x) l acc ;)
<joelr> :D
<joelr> that's what I did
<joelr> thanks
<joelr> ok, i'm dumb this morning.
<joelr> What am I doing wrong? http://pastie.org/1870870
<joelr> help!
Yoric has joined #ocaml
<ocp> now that transform is not optional anymore, you need to specify [f] everytime you call collate
<ocp> let rec collate f l acc =
<ocp> match l with
<ocp> | [] -> Some (List.rev acc)
<ocp> | None :: t -> collate f t (None :: acc) (* <--------------- this one *)
<ocp> | (Some h1) :: (Some h2) :: t -> collate f t ((Some (h1, f h2)) :: acc)
<ocp> | _ -> failwith "Did not provide a pair of field-values"
<joelr> I thought I was dumb :(
<joelr> sorry about that
<flux> btw, funny how your original function had that bug as well :)
<flux> so it only used the provided transform for the head of the list
<flux> dangers of default parameters :)
<joelr> :D
<flux> I sometimes just use the default parametes in the external interface, and provide the actual loop internally
<flux> that avoid repeating the function name
cromartie-x182 has joined #ocaml
cromartie-x182 has left #ocaml []
<joelr> true
Associat0r has quit [Quit: Associat0r]
joelr has quit [Quit: joelr]
Cyanure has quit [Remote host closed the connection]
Associat0r has joined #ocaml
jderque has joined #ocaml
jamii has joined #ocaml
jamii has quit [Ping timeout: 240 seconds]
avsm has joined #ocaml
jld has quit [Ping timeout: 248 seconds]
munga has joined #ocaml
eye-scuzzy has quit [Quit: leaving]
odekopoon has joined #ocaml
odekopoon has quit [Client Quit]
odekopoon has joined #ocaml
odekopoon has quit [Client Quit]
Yoric has quit [Quit: Yoric]
odekopoon has joined #ocaml
odekopoon has quit [Client Quit]
Modius has joined #ocaml
vivanov has joined #ocaml
avsm has quit [Quit: Leaving.]
oriba has joined #ocaml
oriba has left #ocaml []
_andre has joined #ocaml
Yoric has joined #ocaml
Snark has joined #ocaml
Yoric has quit [Quit: Yoric]
odekopoon has joined #ocaml
odekopoon has quit [Client Quit]
Snark has quit [Ping timeout: 264 seconds]
vivanov has quit [Ping timeout: 276 seconds]
Yoric has joined #ocaml
vivanov has joined #ocaml
astertronistic has quit [Quit: Leaving]
vivanov has quit [Ping timeout: 276 seconds]
lopex has joined #ocaml
vivanov_ has joined #ocaml
ftrvxmtrx has quit [Read error: Operation timed out]
odekopoon has joined #ocaml
odekopoon has left #ocaml []
jderque has quit [Quit: leaving]
Smerdyakov has joined #ocaml
ftrvxmtrx has joined #ocaml
ankit9 has quit [Ping timeout: 258 seconds]
edwin has joined #ocaml
Smerdyakov has quit [Quit: Leaving]
pdhborges has joined #ocaml
ikaros has joined #ocaml
pdhborges has quit [Quit: Leaving.]
munga has quit [Ping timeout: 248 seconds]
impy has joined #ocaml
tvn2009_1 has quit [Remote host closed the connection]
sku has joined #ocaml
vivanov_ has quit [Quit: leaving]
vivanov has joined #ocaml
hyperboreean has quit [Ping timeout: 276 seconds]
sku has quit [Quit: Leaving]
groovy2shoes has joined #ocaml
hyperboreean has joined #ocaml
dnolen has joined #ocaml
pdhborges has joined #ocaml
_andre has quit [Ping timeout: 258 seconds]
pdhborges has quit [Quit: Leaving.]
avsm has joined #ocaml
dnolen has quit [Quit: dnolen]
elehack has joined #ocaml
boscop__ is now known as boscop
munga has joined #ocaml
munga has quit [Read error: Operation timed out]
joelr has joined #ocaml
<joelr> let collate (f : a' b' c. a' -> 'b -> 'c) =
<joelr> What's the right syntax for this?
<joelr> Then again, how do you do this with multiple type variables?
<flux> hmm, I don't think you really want to use that
<flux> joelr, isn't the type given by toplevel good enough for you?
<joelr> flux: I'm trying to use two different f-s
<flux> f-s?
<flux> functions?
<joelr> one that returns a ('a * 'b) option and another that returns 'a * 'b
<joelr> use collate in two different places with two different functions f
<flux> so, let foo (f : unit -> 'a * 'b) (f2 : unit -> ('a * 'b) option) = .. ?
<flux> but, off ->
<joelr> no
<joelr> i want a polymorphic f
<flux> f is polymorphic, no?
<joelr> :-(
<flux> it has a type variable in itys type
<flux> that's polymorphic in my books :)
<flux> I seriously doubt 'a. 'a is what a collate function would ned
<joelr> let me paste
<flux> because typically you run the function for certain types, not for 'all' types
<flux> any instance of a type is different from all types
<joelr> let score_transformer = collate (fun a b -> Some (a, float_of_string b))
<joelr> This fixes f to a certain type so I cannot use it like this anymore
<joelr> match collate (fun a b -> (a, b)) result with
<joelr> because f is of a different type
<flux> oh, so you want to enforce that 'a and 'b must be different
<flux> perhaps
<flux> but I need to fly, back in two to three hours ->
<joelr> :D
<joelr> cheers
_andre has joined #ocaml
<thelema> joelr: what's the purpose of this collate function?
_andre has quit [Client Quit]
_andre has joined #ocaml
<joelr> It processes string option list option and builds tuples from adjacent elements
<joelr> Is there a function that converts 'a option to 'a and throws an exception on None?
<thelema> string option list option? why the last option?
<thelema> joelr: in batteries, Option.get. It's trivial to write yourself
<joelr> a list of pairs, sorry
<joelr> yes, i know and i have written it. just curious.
<joelr> thelema: the last option is due to the way redis multibulk works
<thelema> I rarely find myself needing list option because the empty list is usually good for 'none'
<joelr> it returns a list or nil to indicate an error
<thelema> ok.
<joelr> and the list can have nil values itself
waern_ has quit [Quit: Page closed]
<thelema> sure, that's string option list, can the whole list be nil? (different from empty)?
<joelr> yes, the whole list can be nil on error
<thelema> okay then. input: string option list option. output: string pair option list option?
<joelr> Except in cases where it's different, like this one
<joelr> where it actually returns an empty list
<joelr> output for hgetall is actually (string * string) list
<joelr> go figure
<joelr> because there's no error and it's just a list with stuff or an empty list
<joelr> thelema: thus convoluted processing like this http://pastie.org/1871899
<joelr> thelema: or marvel at this type: string option list option list :D
ymasory has joined #ocaml
<joelr> that's to handle http://redis.io/commands/sort
<joelr> because it can return multiple lists
<joelr> one per GET pattern
<thelema> joelr: That's not so bad. For command line processing, I have a (switch * spec list * (spec * (unit -> unit)) list * string) list
<joelr> :D
<thelema> joelr: well, it might help you to modularize a bit more
<thelema> type item = string option
<joelr> right
<thelema> type reply = item list option
<thelema> and then your final type is reply list
<joelr> I was thinking that it may be a good idea to shield the users of the redis api from the redis internal types
<joelr> thus no aliasing
<thelema> back to the original question, collate takes a list with 2*n elements and turns it into a list of pairs?
<joelr> i could easily do type bulk = string option and type multibulk = bulk list option
<thelema> (maybe with some mapping along the way?)
<joelr> correct
<joelr> i solved the original collate issue in my 2nd paste
<thelema> 1871865?
<joelr> 1871899
<thelema> okay then. Time for me to transport myself.
<joelr> thelema: thanks!
ankit9 has joined #ocaml
avsm has quit [Ping timeout: 240 seconds]
avsm has joined #ocaml
larhat has quit [Quit: Leaving.]
ikaros has quit [Quit: Leave the magic to Houdini]
ocp has left #ocaml []
lopex has quit []
jonafan has quit [Quit: leaving]
jonafan has joined #ocaml
ymasory has quit [Quit: Leaving]
Yoric has quit [Quit: Yoric]
jld has joined #ocaml
avsm has quit [Ping timeout: 240 seconds]
avsm has joined #ocaml
eikke has quit [Ping timeout: 252 seconds]
ankit9 has quit [Quit: Leaving]
ftrvxmtrx has quit [Quit: Leaving]
boscop_ has joined #ocaml
<hnrgrgr> whois thelema
<hnrgrgr> whois flux
<hnrgrgr> oups
boscop has quit [Ping timeout: 248 seconds]
boscop__ has joined #ocaml
<thelema> hnrgrgr: hi
boscop_ has quit [Ping timeout: 240 seconds]
boscop__ has quit [Ping timeout: 240 seconds]
Associat0r has quit [Quit: Associat0r]
jderque has joined #ocaml
jamii has joined #ocaml
ulfdoz has joined #ocaml
avsm has quit [Quit: Leaving.]
Yoric has joined #ocaml
ftrvxmtrx has joined #ocaml
eikke has joined #ocaml
Associat0r has joined #ocaml
groovy2shoes has quit [Quit: It is now safe to turn off your groovebot.]
groovy2shoes has joined #ocaml
groovy2shoes has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
sgnb` is now known as sgnb
joelr has quit [Quit: joelr]
Yoric has quit [Quit: Yoric]
groovy2shoes has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
ankit9 has joined #ocaml
lopex has joined #ocaml
bzzbzz has quit [Quit: leaving]
Associat0r has quit [Quit: Associat0r]
lopex has quit [Ping timeout: 276 seconds]
lopex has joined #ocaml
groovy2shoes has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
lpereira has joined #ocaml
_habnabit has joined #ocaml
<_habnabit> If I'm writing a .mli for a module, and I want to make my own module-instance of Set.Make, how can I specify "I want this module signature to be the same as this other module signature"
<_habnabit> i.e. I won't have to write out `module ColorSet: sig val empty; ... end`
<sheets> _habnabit: include Set.Make?
<_habnabit> sheets, so, `module ColorSet: sig include Set.Make end` ?
<sheets> i believe Set.Make is a functor so you will probably have to apply it
<thelema> _habnabit: module ColorSet : Set.S with elt = color
<_habnabit> thelema, aha
<_habnabit> thelema, out of cuiosity, where is this documented?
<thelema> the return type of Set is already given as a module type
<thelema> the with part or the "module ColoSet : Set.S"?
<_habnabit> thelema, the with part
<_habnabit> oh, ah, that's giving me a syntax error on 2.10. Is this a 2.12 thing?
<thelema> no, it should work in 2.10
<thelema> maybe I mess something up...
<thelema> module ColorSet : Set.S with *type* elt = color
<thelema> I always forget that bit
<_habnabit> ah, that did it. Great!
<thelema> "To overcome this difficulty, Objective Caml provides a with type construct over signatures that allows to enrich a signature with extra type equalities:"
<_habnabit> Oh, heh. I was reading that page, but skimmed over that bit
<_habnabit> thanks, though
<thelema> the manual is information-dense
<_habnabit> hm, so, what's the difference between Set.Make and Set.S
<sheets> Set.S is the signature of the set modules that Set.Make produces when applied
groovy2shoes has quit [Remote host closed the connection]
<thelema> _habnabit: one is a type, the other is a functor
<_habnabit> okay
groovy2shoes has joined #ocaml
<thelema> a module type, even
<_habnabit> so, this is in one of the files of the codebase I'm maintaining: http://paste.pound-python.org/show/QdAYUMYPFIGzhMtKghfC/
<_habnabit> there's no .mli file for it, or a 'sig' for the module
<_habnabit> This is a functor, right?
<thelema> yes, it's a functor.
<thelema> if that's not the whole file, it doesn't get a .mli file
<_habnabit> And is there any easy way to get the returned module type out of the functor?
<thelema> in 3.12 is, but not in 3.10
tildedave has quit [Quit: Leaving]
<_habnabit> I'm trying to make a ColorSetFuns module
<_habnabit> ah, okay.
<thelema> s/is/there is/
jamii has quit [Ping timeout: 240 seconds]
<_habnabit> so, since it's a functor without a module type, there's no way in 3.10?
<thelema> it looks like the returned type is just "sig include Set.S val of_list : ... val map : ... val ppr : ... end
<thelema> "
<thelema> there's no way to automatically derive the returned type - you can still specify it by hand, even including Set.S so you don't have to repeat what comes out of Set.Make
<_habnabit> hmm, okay
<thelema> and if you're really lazy, ocamlc -i will generate the whole module type for you
<_habnabit> and so is there a way to say 'this functor produces a module of this type', so I don't have to define the module type twice?
<_habnabit> It looks like I can use -> for that as well
<thelema> only the way that Set does, by explicitly declaring a module type for the output of the functor and using that type where you need it.
<_habnabit> right, okay
<_habnabit> functors are something I've basically never had to deal with before.
<thelema> they're a bit intimidating at times
<thelema> you'll become immune with repeated exposure. :)
<_habnabit> hmm, okay, I think I'm getting it now.
vivanov has quit [Ping timeout: 252 seconds]
<_habnabit> http://paste.pound-python.org/show/mrxTFIvm6oaOXDG9lA7i/ <- this is saying 'elt is required but not provided'. Am I doing the 'elt' thing wrong, or do I just need to stick another line in the SetFuns struct?
<thelema> there's no declaration of a type elt in SetFuns
<_habnabit> Well. I should reword my question.
<thelema> just remove line 2
<_habnabit> Oh, I see.
Yoric has joined #ocaml
<_habnabit> Well, now it's saying "Unbound type constructor elt"
<thelema> yes, L3 doesn't have an elt type. just drop the "with ..."
<_habnabit> ahh
<_habnabit> Okay neat that did it.
<thelema> *after* applying the functor, you can use 'with' to specify the type of elt
<thelema> which is what you have on line 9 (except there's no type elt, you'll have to "with type S.elt = OT.elt" (I think that should work)
<_habnabit> Okay double sweet now that I have `module type SF` my .mli file can do `module ColorSetFuns: MapsSets.SF`
<thelema> you'll want a "with" there.
<_habnabit> I'll try that with.
<thelema> If it causes you trouble, you can put the 'type elt' back in and link everything in the signature back through it, although you'll have to put a 'type elt = OT.t' in your SetFuns body.
<_habnabit> It was fine when I did `with type S.elt = O.t`
<_habnabit> er, OT.T
<_habnabit> t
<thelema> great.
<_habnabit> (since OT is the ordered type, not the set type.)
<_habnabit> And I understand why it works! that's the most important part.
<_habnabit> Anyway, lunchtime.
ymasory has joined #ocaml
sheets has quit [Ping timeout: 252 seconds]
groovy2shoes has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
fraggle_ has quit [Ping timeout: 276 seconds]
groovy2shoes has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
ankit9 has quit [Ping timeout: 252 seconds]
jderque has quit [Quit: leaving]
fraggle_ has joined #ocaml
eikke has quit [Read error: Operation timed out]
joelr has joined #ocaml
joelr has quit [Client Quit]
lpereira has quit [Quit: Leaving.]
groovy2shoes has quit [Quit: It is now safe to turn off your groovebot.]
ikaros has joined #ocaml
_andre has quit [Ping timeout: 258 seconds]
pdhborges has joined #ocaml
avsm has joined #ocaml
bzzbzz has joined #ocaml
avsm has quit [Client Quit]
tautologico has joined #ocaml
ymasory has quit [Read error: Operation timed out]
pdhborges has quit [Quit: Leaving.]
edwin has quit [Quit: Leaving.]
elehack has quit [Quit: Headed out, possibly to home]
ikaros has quit [Quit: Leave the magic to Houdini]
pdhborges has joined #ocaml
pdhborges has quit [Client Quit]
Yoric has quit [Quit: Yoric]
ymasory has joined #ocaml
lamawithonel has quit [Remote host closed the connection]
Modius has quit [Ping timeout: 248 seconds]
Modius_ has joined #ocaml
Amorphous has quit [Ping timeout: 240 seconds]
dnolen has joined #ocaml
Modius has joined #ocaml
Modius_ has quit [Ping timeout: 240 seconds]
Amorphous has joined #ocaml
fraggle_ has quit [Read error: Connection reset by peer]
fraggle_ has joined #ocaml
<_habnabit> 'when' has to apply to everything that's being matched?
<_habnabit> I was trying to do `| None, None | Some x, Some y when x = y -> foo`
<_habnabit> Too clever for my own good, I guess. ;<