mjonsson has quit [Read error: Operation timed out]
justdit has joined #ocaml
lolcathost has joined #ocaml
deu5 has quit [Quit: Leaving]
larhat has quit [Quit: Leaving.]
testcocoon has quit [Quit: Coyote finally caught me]
testcocoon has joined #ocaml
answer_42 has joined #ocaml
Yoric has joined #ocaml
Snark has joined #ocaml
lolcathost has quit [Ping timeout: 256 seconds]
pango is now known as pangoafk
oiz has joined #ocaml
<flux>
gustav__, just declare all variables as 'const' :)
lolcathost has joined #ocaml
ftrvxmtrx has quit [Quit: Leaving]
lolcathost has quit [Ping timeout: 260 seconds]
gustav__ has quit [Read error: Connection reset by peer]
gustav__ has joined #ocaml
Cyanure has joined #ocaml
djcoin has joined #ocaml
gustav__ has quit [Read error: Connection reset by peer]
hkBst has joined #ocaml
hkBst has quit [Changing host]
hkBst has joined #ocaml
Cyanure has quit [Remote host closed the connection]
ftrvxmtrx has joined #ocaml
ontologiae has joined #ocaml
<oiz>
hello, i have a type T = I of int | S of string, a map m of type (string,int) Hashtbl, and i want to write a function that takes as argument x of type T, matches x, and treats the case here x = I n and x = S s where n = Hashtbl.find m s when Hashtbl.mem m s in the same way; how can i do that without duplicating the code?
ontologiae has quit [Ping timeout: 255 seconds]
jbrown__ has joined #ocaml
|jbrown| has quit [Ping timeout: 260 seconds]
Cyanure has joined #ocaml
cago has joined #ocaml
<flux>
hmm, I'm not sure I understand, as you cannot search both strings and integers from the same map. perhaps you can show actual code doing it, with code duplication, and we can suggest how to simplify it?
<flux>
oiz, you mean duplication in guard patterns and the expression it chooses?
<oiz>
_habnabit: ye that's what i'm doing now, but isn't there some syntax trick with the match? for instance with the keyword "as" or something like that?
<flux>
although your example isn't the best perhaps, because .mem returns a boolean which you know is true..
<oiz>
flux: why is it true?
<flux>
oiz, if you really, really want to get rid of the duplication, you can use lazy evaluation
<flux>
oiz, well, you can only enter the clause when Hashtbl.mem h s is true
<flux>
therefore your code is equivalent to let n = true in ..
<flux>
it's as if you had written: if Hashtbl.mem h s then let n = Hashtbl.mem h s in .. (* n must be true here *)
<oiz>
flux: i'm sorry that's a typo
<oiz>
n is an integer (Hashtbl.find h s)
astertronistic has quit [Ping timeout: 245 seconds]
<flux>
ah, and it's not the 'duplication' of Hashtbl.mem/Hashtbl.find you want to get rid of, but the part you didn't write :-)
<flux>
oiz, just define a local function
<flux>
as _habnabit suggested
<_habnabit>
oiz, there is, but you can't use it here because you need to call a function with the value
<oiz>
_habnabit: "there is" what?
<flux>
let do_it_with_n n = (* do something with n *) in match .. -> do_it_with_n n ... | -> do_it_with_n n -> ..
<_habnabit>
oiz, there's a way to have alternate matches like you were thinking
<_habnabit>
oiz, but the types need to be the same _before_ calling functions
<oiz>
they're both integers
<_habnabit>
oiz, it's not an integer before you call Hashtbl.find
<oiz>
so i cannot put Hashtbl.find somehow in the match clause?
<_habnabit>
oiz, if you had, say, type t of A of (int, string) | B of (string, int) and you did `function A (i, _) | B (_, i) -> succ i`
<flux>
(but it's missing code for do_something_with_n)
<flux>
oiz, I can't think of how to write that otherwise in that particular case
<oiz>
ok i get it
<oiz>
oh what about
mfp has joined #ocaml
<oiz>
match (x, k) with (I n,_) | (S s, n) when Hashtbl.mem h s && n = Hashtbl.find h s -> (* do something *)
<oiz>
but k isn't defined, it should be havoced i guess :)
<flux>
oiz, you could use something like this in with batteries, but it's a bit convoluted: let get_s = function S s -> s | _ -> assert false let f h x = let v = lazy (Hashtbl.find_option h (get_s t x) in match x, v with | I n -> do_something_with_n n | S s, lazy (Some n) -> do_something_with_n n | ..
<_habnabit>
oiz, i suppose so, but that's rather complicated
<_habnabit>
oiz, what's the point, if you have to write code like that?
<oiz>
ye i agree i prefer the local function method
<flux>
nice, this compiles: match assert false, assert false with | `Int n, _ | `Str _, lazy (Some n) -> n
<flux>
but still pretty convoluted..
<oiz>
match assert false, that's weird :o
<flux>
well, it's just for checking the syntax
<flux>
assert false returns a polymorphic value that is compatible with everything
<flux>
of course, it never really does that, because of the exception
<oiz>
right
Kakadu has joined #ocaml
chambart has joined #ocaml
oiz has quit [Ping timeout: 245 seconds]
Neros has joined #ocaml
ontologiae has joined #ocaml
thomasga has joined #ocaml
sepp2k has quit [Remote host closed the connection]
eikke has joined #ocaml
_andre has joined #ocaml
Yoric has quit [Ping timeout: 246 seconds]
larhat has quit [Read error: Connection reset by peer]
larhat has joined #ocaml
<pippijn>
"A channel is a high-level object for performing IOs. It allow to read/write things from/to the outside worlds in an efficient way, by minimising the number of system calls."
csag8264 has quit [Remote host closed the connection]
Kakadu has quit [Quit: Konversation terminated!]
andreypopp has quit [Quit: sleep]
justdit has joined #ocaml
justdit has quit [Read error: Connection reset by peer]
travisbrady has joined #ocaml
justdit has joined #ocaml
justdit has quit [Read error: Connection reset by peer]
justdit has joined #ocaml
justdit has quit [Ping timeout: 240 seconds]
mye has joined #ocaml
travisbrady has quit [Quit: travisbrady]
Kakadu has joined #ocaml
travisbrady has joined #ocaml
deu5 has joined #ocaml
jamii has joined #ocaml
ftrvxmtrx has quit [Quit: Leaving]
tac has joined #ocaml
hkBst has quit [Quit: Konversation terminated!]
<makrz>
if i have a list of Variables, and two maps "min" and "max" from Variables to int, how can i generate all the possible valuations of these variables?
<djcoin>
pippijn: did you give birth to iter() and new DataIteration.Processor() {}, or does it come from another lib ?
<pippijn>
I made that
<djcoin>
:)
<pippijn>
it works for any number of arguments
<pippijn>
it iterates over maps
<pippijn>
"Products" is just a description for exceptions thrown and caught in iter
<pippijn>
so it can say "While processing Products"
<djcoin>
I would have liked to find back this awesome link of a coworker paste the first thing a guy coming from FP background switched to C# : 3000 lines long of FP iodioms (like currying etc.)
<pippijn>
I'm not like that
<pippijn>
but when I can make things simpler, I do
<pippijn>
the implementation of iter is not simple at all ;)
<djcoin>
Sorry for my poorly phrased sentence !
<djcoin>
:)
<pippijn>
it's not compile-time type-safe
<pippijn>
it iterates over lists of maps
<pippijn>
over a list of maps
<pippijn>
and each map is expected to contain the keys "Blattname" and "gid"
<pippijn>
if java had dependent types, it could be compile-time type-safe
<xavierm02>
I mean I understand that two lists may share a common end.
<xavierm02>
but the programmer is probably aware of that when he tries to modify the list
<_habnabit>
xavierm02, what do you mean by 'set' it?
<xavierm02>
well
<_habnabit>
xavierm02, you can do let l' = match l with h :: t -> h :: t' | _ -> invalid_arg "..."
<xavierm02>
yes
<xavierm02>
but that copies most of the list
<_habnabit>
xavierm02, no it doesn't
<xavierm02>
are you sure?
<_habnabit>
xavierm02, why would you think it copies?
<xavierm02>
let a = [ 2, 3, 4 ] in let b = 1 :: a and c = 0 :: 1;;
<xavierm02>
if it doesn't copy
<xavierm02>
it might break other lists
<xavierm02>
that use the same tail
<xavierm02>
c = 0 :: a
<_habnabit>
xavierm02, how is that possible? afaik using :: will always create a new list _node_ but it copies neither the head nor the tail
lolcathost has joined #ocaml
<xavierm02>
ok
<xavierm02>
I'll give you a real example in a few minutes
<_habnabit>
# let l = [1; 2; 3] in let a = 4 :: l and b = 5 :: l in List.tl a == List.tl b;;
<_habnabit>
- : bool = true
<_habnabit>
looks like it doesn't copy to me
<_habnabit>
also,
<_habnabit>
# let l = [1; 2; 3] in let a = 4 :: l and b = 5 :: l in List.tl (List.tl a) == List.tl (List.tl b);;
<_habnabit>
- : bool = true
<flux>
xavierm02, you can never modify a list, that's why it's safe to not copy, but just reference.. but, you may be able to mutate stuff pointer by lists, so that's when you need to manually do a deep copy
thomasga has joined #ocaml
Yoric has quit [Ping timeout: 252 seconds]
lolcathost has quit [Remote host closed the connection]
larhat has quit [Quit: Leaving.]
cdidd has joined #ocaml
lolcathost has joined #ocaml
makrz has joined #ocaml
deu5 has quit [Remote host closed the connection]
<beginner42>
adrien: do i need to clone the webkit repo or is there a debian package, so i can use your binding?
<xavierm02>
_habnabit: I know if I don't keep it in a variable, the list will be dropped by the garbage collector. But I want to reuse it for my "sublist"
<flux>
makrz, maybe you could use Map instead of Hashtbl for valuation, to avoid copying
<xavierm02>
_habnabit: And I can't. I have to copy all those items when I could just "skip" the one I don't one by setting the tail of the previous element to the next
<makrz>
flux: yes ok
<_habnabit>
xavierm02, so... why can't you do the code I suggested on line 26?
<flux>
xavierm02, I don't think you can really write that more efficiently than: List.filter (fun x -> x >= 0) l
<_habnabit>
xavierm02, let prev' = match prev with h :: t when head < 0 -> h :: t' | _ -> prev in loop prev' tail
<xavierm02>
_habnabit: It will copy the list from what I understand
djcoin has quit [Quit: WeeChat 0.3.9]
<_habnabit>
xavierm02, as I _just_ said, it won't
Xizor has joined #ocaml
<flux>
xavierm02, you cannot express that prev.tail <- tail part in your code.. or is that your question, how to do it?
<flux>
xavierm02, if you really really want to do it, it's actually possible. iirc ExtLib does it with List.map, possibly batteries as well
<flux>
but, it should be well verified that it does the right thing..
<_habnabit>
flux, it's possible, but in this case not necessary
sepp2k1 has joined #ocaml
sepp2k has quit [Ping timeout: 240 seconds]
<xavierm02>
type 'a mut_list = {
<xavierm02>
hd: 'a;
<xavierm02>
mutable tl: 'a list
avsm has quit [Ping timeout: 260 seconds]
<xavierm02>
}
<xavierm02>
that's how they implement the list
<xavierm02>
so I get why it works
<xavierm02>
but don't you loose more perf by switching to a non-native list than you win by not copying the list?
<xavierm02>
anyway
<xavierm02>
ty :)
<_habnabit>
xavierm02, for the Nth time, there is no copying
<xavierm02>
there must be some copying
<xavierm02>
otherwise
<xavierm02>
if I keep the list in a variable
<xavierm02>
it's get modified
<xavierm02>
it'll*
<xavierm02>
and
<xavierm02>
I tried to understand your code
<_habnabit>
xavierm02, as I said, it creates a new list node, because the previous one is immutable. the tail is not copied.
<xavierm02>
ok
<xavierm02>
the tail is not copied
<xavierm02>
but if you have
<xavierm02>
[ a, b, c, d, e ]
<xavierm02>
and you want to remove c
pkrnj has joined #ocaml
<xavierm02>
you copy [ a, b ] and then append [ d, e ] to it
<xavierm02>
so if you want to remove the very last item
<_habnabit>
incorrect
<xavierm02>
you're screwed
<_habnabit>
oh, wait, yes
<_habnabit>
but it's not copying because it's not the same thing
<xavierm02>
yeah
<xavierm02>
it doesnt really copy
notdan has quit [Remote host closed the connection]
<xavierm02>
it just creates a new "beginning of list" that is similar
<adrien>
beginner42: there is no debian package for lablwebkit
<xavierm02>
but if the "beginning of the list" is the whole list minux 1 item
<xavierm02>
it sucks :/
<adrien>
you should use the tarball
<beginner42>
adrien: i downloaded your tarball
tane has joined #ocaml
<beginner42>
and cloned the git repo of the webkit project
csag8264 has joined #ocaml
gustav__ has quit [Remote host closed the connection]
pangoafk is now known as pango
gustav__ has joined #ocaml
csag8264 has quit [Remote host closed the connection]
notdan has joined #ocaml
<adrien>
beginner42: you mean the 3GB webkit repo?
<beginner42>
adrien: yes that one :)
<adrien>
that was not necessary :p
<adrien>
you probably should use tarballs
<adrien>
but the git repo can be handy for debugging
<beginner42>
now that i have them i wont delete it, but what tarballs do you refer to?