<lecuyer>
and whenever I try to use snd element, I get a compile error
sebz has quit []
<lecuyer>
Error: This expression has type foo list but an expression was expected of type (string * string) list
sebz has joined #ocaml
<surikator>
you have something like [("foo1","bar1"); ("foo2","bar2");("foo3","bar3");...], right? and then what do you want your function to do with it?
<surikator>
you're missing the constructor
<surikator>
you always have to write Bar("foo","bar") and not simply ("foo","bar").
<surikator>
Bar("foo","bar") is of type foo list, while ("foo","bar") is of type (string * string) list
<surikator>
got it?
<lecuyer>
no, that's not what I have. I have a while loop that calls a function that returns a list of Bar("dsa","fdsaa"), etc
<surikator>
just paste the code
<surikator>
it's easier
<surikator>
only the part which is relevant, of course.
Kevin_ has quit [Remote host closed the connection]
<lecuyer>
type foo = Bar of string * string
<lecuyer>
# Bar( "foo", "bar");;
<lecuyer>
- : foo = Bar ("foo", "bar")
<lecuyer>
# snd (Bar( "foo", "bar"));;
<lecuyer>
Error: This expression has type foo but an expression was expected of type 'a * 'b
lopex has quit []
<surikator>
yes... snd can only be applied to a pair of strings
<surikator>
you're applying to something of type foo
<surikator>
you have to redefine your fst and snd functions to your particular foo type
<lecuyer>
how do I do that? how do I get the individual parts?
<lecuyer>
19:57 < surikator> you have to redefine your fst and snd functions to your particular foo type
<lecuyer>
19:58 < lecuyer> how do I do that? how do I get the individual parts?
<lecuyer>
sorry, my terminal copy/pasted when I was moving it
<surikator>
you can define for example
<surikator>
let new_fst x = match x with Bar(a,b) -> a
<surikator>
let new_snd x = match x with Bar(a,b) -> b
<lecuyer>
ah, okay
<lecuyer>
thanks
<surikator>
these are the corresponding fst/snd functions for your particular type
<surikator>
you can't use fst/snd directly
<surikator>
because they don't apply to your foo type
<surikator>
no prob
<_habnabit>
hmmm. the *** operator only works on unary functions. should the binary function version be ****, *****, or ***++
<surikator>
what's the *** operator?
<_habnabit>
('a -> 'b) -> ('c -> 'd) -> 'a * 'c -> 'b * 'd
<_habnabit>
this would be ('a -> 'b -> 'c) -> ('d -> 'e -> 'f) -> 'a * 'd -> 'b * 'e -> 'c * 'f
<dsheets>
_habnabit: why not ('a -> 'b) * ('c -> 'd) -> 'a * 'c -> 'b * 'd ? then you are arity-free
<_habnabit>
well, my use case specifically is `List.reduce (IntSet.union ***** IntSet.union)`
<_habnabit>
and previously I did finagle a combination of *** and &&& into doing that, but it was pretty ugly.
lecuyer has quit [Quit: Lost terminal]
mdelaney has joined #ocaml
mdelaney has quit [Read error: Connection reset by peer]
mdelaney has joined #ocaml
mdelaney has quit [Read error: Connection reset by peer]
mdelaney has joined #ocaml
sebz has quit []
sebz has joined #ocaml
dnolen has quit [Quit: dnolen]
dnolen has joined #ocaml
dnolen has quit [Quit: dnolen]
jimmyrcom has quit [Ping timeout: 264 seconds]
surikator has quit [Quit: surikator]
rgrinberg has quit [Remote host closed the connection]
rgrinberg has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]
arubin has quit [Quit: arubin]
sebz has joined #ocaml
<rgrinberg>
wtf, the current date i get in ocaml is a month off. The one from Unix.localtime (Unix.time())
<rgrinberg>
yet `date` is correct
<flux>
rgrinberg, it works the same as the normal unix localtime
<flux>
rgrinberg, that is, months begin from 0
<rgrinberg>
ya i just remembered
<rgrinberg>
embarassing..
rgrinberg has quit [Remote host closed the connection]
ulfdoz has quit [Ping timeout: 258 seconds]
rgrinberg has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]
dnolen has joined #ocaml
sebz has joined #ocaml
rgrinberg has quit [Remote host closed the connection]
rgrinberg has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]
junsuijin has quit [Quit: Leaving.]
quackv2 has joined #ocaml
dnolen has quit [Quit: dnolen]
Associat0r has joined #ocaml
Associat0r has quit [Quit: Associat0r]
Yoric has joined #ocaml
sebz has joined #ocaml
jonafan has quit [Ping timeout: 252 seconds]
jonafan has joined #ocaml
bobry has joined #ocaml
ag4ve has quit [Ping timeout: 258 seconds]
ag4ve has joined #ocaml
rgrinberg has quit [Remote host closed the connection]
<adrien>
ah, new issue on windows: when compiling with -mwindows (or "-subsystem windows" to flexlink), printf will raise an exception
<adrien>
which is annoying for left-over debugging printfs
Yoric has quit [Ping timeout: 260 seconds]
Yoric has joined #ocaml
<adrien>
and one day we'll really need something to check the actual meaning of if/then/else against the indentation and pop up a warning
sebz has quit []
<Yoric>
adrien: take a look at what we do in Opa for this kind of things
<Yoric>
Not perfect but quite helpful.
bobry1 has quit [Read error: Operation timed out]
ikaros has joined #ocaml
Yoric has quit [Quit: Leaving.]
Yoric has joined #ocaml
<adrien>
Yoric: you have some kind of "lint"?
Yoric has quit [Client Quit]
jaar has joined #ocaml
Yoric has joined #ocaml
Yoric has quit [Client Quit]
sebz has joined #ocaml
bobry1 has joined #ocaml
larhat has joined #ocaml
ftrvxmtrx has joined #ocaml
lopex has joined #ocaml
jimmyrcom has joined #ocaml
jimmyrcom has quit [Ping timeout: 260 seconds]
jimmyrcom has joined #ocaml
<adrien>
whys does (fun i -> let s = "_" in s.[0] <- Char.chr i) lead to s being shared? I expected that a fresh 's' would be allocated for each call
ftrvxmtrx has quit [Quit: Leaving]
ftrvxmtrx has joined #ocaml
<raphael-p>
adrien: what is the prupose of the function? (considering it returns () and does nothing to the outside world)
<adrien>
right, I forgot to return 's' at the end of it
sebz has quit []
<adrien>
I had a template: let s = "_:\\", and '_' was being replaced by a drive letter (on windows)
<raphael-p>
adrien: idk why it's shared, I'd have expected an allocation too
_andre has joined #ocaml
<raphael-p>
you can replace "_" by (String.create 1) and it works
sebz has joined #ocaml
sebz has quit [Client Quit]
surikator has joined #ocaml
<f[x]>
string constants are shared
<flux>
hm, windows cannot have two-letter drive names?
fracek has joined #ocaml
lopex_ has joined #ocaml
lopex has quit [Ping timeout: 252 seconds]
<adrien>
flux: nope, and when you reach Z:\\ and add another (network?) drive, it disconnects another one at random to make room for the new one from what I've heard
<adrien>
f[x]: ok, thanks
lopex_ is now known as lopex
<adrien>
Map.Make.merge takes a function of type (key -> 'a option -> 'b option -> 'c option), is it possible that "a" and "b" will both be None? (the function is used to decide what to do when both arguments map the same key)
<adrien>
also, would there be something faster (and available) when I know that the two trees I want to merge are disjoint?
<thelema>
adrien: no, at least one of the arguments will be some.
<adrien>
thelema: ok, thanks
<thelema>
and there's not really anything faster for balanced tree maps -- if you really want faster concat, you can use association lists.
<adrien>
lookups are way more important than concat
<thelema>
the two trees will have to be merged. If you can guarantee all the keys of one tree are less than those of the other, you can get a fast tree concat.
<adrien>
and it's true that with the balancing, I won't probably won't be able to take advantage of the fact my maps are disjoint
<adrien>
oh? because I can guarantee it
<thelema>
are your keys ints?
<adrien>
yes
<thelema>
IMap?
<flux>
maybe there could be an order of inserting keys that would result in the fewest number of rebalancing operations
<adrien>
Map.Make with compare (a, b) (c, d) = if b < c then -1 else if d < a then 1 else 0
<adrien>
which is a shortcut because when I add, everything is disjoint and already packed in ranges
<thelema>
adrien: ah, n/m, you're using those semi-range trees
<adrien>
but I see 'join' inside Map, it's not exported however
<thelema>
well, I'd not worry much about the cost of merging two trees with tree1 < tree2
<adrien>
so I might try with that if really needed
<adrien>
I have to say I haven't bench'ed yet, it's mostly that when wondering about which function I should use, it stroke me as potentially being very expensive (I'll reach 100M elements? or more)
<thelema>
adrien: merge will do a single split on the top tree, realize there's nothing to split and do a concat_or_join
<adrien>
(it's going to require a safety check to refuse loading files that would make the program reach 2GB of memory when on 32bit platforms)
<adrien>
thelema: ok, that would be perfect, thanks =)
<thelema>
yes, merge is as efficient as possible already.
<adrien>
I have to admit I'm quite scared to try loading and going through so much data on commodity hardware and get everying real-time and fluid (actually, even on _old_ hardware sometimes)
<zorun>
adrien: what's your project?
<adrien>
plotting of big amounts of data from sensors
<zorun>
*that* big an amount of data?
<adrien>
after putting it on paper, maybe less points, but I can have 15 or more sets so it's 15*30M points or more
zorun has quit [Quit: leaving]
surikator has quit [Quit: surikator]
Kakadu has joined #ocaml
zorun has joined #ocaml
BiDOrD_ has joined #ocaml
BiDOrD has quit [Ping timeout: 240 seconds]
slecuyer has joined #ocaml
Yoric has joined #ocaml
Associat0r has joined #ocaml
Associat0r has quit [Changing host]
Associat0r has joined #ocaml
slecuyer has quit [Quit: leaving]
Kevin_ has joined #ocaml
<Kevin_>
hopefully a quick question when ocaml programmers use the term: (xhd::xtl).. is the term 'xhd' a built in function or do people just use xhd as a variable to indicate the head
<thelema>
just a variable name
<Kevin_>
ok thanks
<Kevin_>
clears up some stuff then heh
<thelema>
I usually use (h::t) or (hd::tl)
<raphael-p>
Kevin_: a variable name bound by the pattern <pattern> :: <pattern>
<Kevin_>
thanks both
<raphael-p>
I do as thelema with sometime a Haskellish x::xs
dnolen has joined #ocaml
<thelema>
raphael-p: yup, some of my code has picked up that haskellism, but luckily it didn't stick
<Kevin_>
would it equate to the same values as entered by the user
<Kevin_>
so if a user entered sum [1;2], [3;4]
<Kevin_>
would xtl = [1;2]
<thelema>
I assume you're doing this for learning purposes, as List.map2 (+) x y |> Result.to_option
<thelema>
no, xtl would be [2]
<Kevin_>
ok
<Kevin_>
yeah for learning purposes :)
<thelema>
err, Result.catch (List.map2 (+) x) y |> Result.to_option
<Kevin_>
so the (xhd::xtl) from earlier
<Kevin_>
does not make xtl a single int
<thelema>
so when a list is "deconstructed" by the pattern h::t, the "head" of the list (its first element) gets bound to [h] and the "
<thelema>
tail" of the list (the whole list without the first element) gets bound to t
<Kevin_>
ahh
<Kevin_>
so in that instance
<Kevin_>
xtl is still an int list
<Kevin_>
while xhd
<Kevin_>
is just an int
<thelema>
[1;2] -> 1 :: [2], [2] -> 2:: []
<thelema>
yes
<Kevin_>
AHHHH
dnolen has quit [Quit: dnolen]
<Kevin_>
thank you
<Kevin_>
that clarifies a lot then
iratsu has quit [Ping timeout: 245 seconds]
Kevin_ has quit [Remote host closed the connection]
Associat0r has quit [Quit: Associat0r]
yroeht has quit [Ping timeout: 260 seconds]
zsparks_ has joined #ocaml
zsparks_ is now known as zsporks
iratsu has joined #ocaml
iratsu has quit [Ping timeout: 245 seconds]
lopex has quit []
bobry has quit [Ping timeout: 276 seconds]
surikator has joined #ocaml
sumanah has joined #ocaml
fracek has left #ocaml []
ulfdoz has joined #ocaml
yroeht has joined #ocaml
sumanah has left #ocaml []
Kakadu has quit [Quit: Page closed]
iratsu has joined #ocaml
Yoric has quit [Quit: Leaving.]
zsparks has quit [Quit: scheduled downtime in RIGHT NOW FIGHT THE POWAH]
Yoric has joined #ocaml
Yoric has quit [Quit: Leaving.]
larhat has quit [Quit: Leaving.]
Yoric has joined #ocaml
mdelaney has quit [Quit: mdelaney]
Yoric has quit [Quit: Leaving.]
surikator has quit [Quit: Scientific discovery is just maximal compression of strings. Nothing more, nothing less.]
jaar has quit [Quit: Quitte]
Yoric has joined #ocaml
zsparks has joined #ocaml
<adrien>
bug fixed \o/
zsporks has quit [Quit: still fightin' the powah]
ftrvxmtrx has quit [Quit: Leaving]
<adrien>
and rather than marging maps, I was simply able to reuse the same map from one datafile to another: my already existing code pretty gave that for free, going to handle 40M events, and up to 90M events for my 16 datasets =)
<thelema>
yay
Yoric has quit [Quit: Leaving.]
<adrien>
the "worst" thing is that I'm getting pretty good performance, better than many other tools/libraries, even though I have to tell Archimedes to render its files to disk and then load them from disk in lablgtk2
<thelema>
sounds terrible.
<adrien>
I'll improve it but that is going to require work in archimedes and I didn't have the time to do that, it still gives a solid 100ms if the filesystem is fast at file creation and the cpu isn't a P3 desktop
<adrien>
100ms for each step I mean, which is 10 frames per second, which is roughly the key repeat delay of most computer/interfaces and that gives enough time to do the rendering
<ousado>
adrien: how about /dev/shm?
<zorun>
you're doing everything on disk? :o
mdelaney has joined #ocaml
<adrien>
ousado: mostly running on windows
<ousado>
oh
<adrien>
archimedes renders to the disk but through cairo, which means that it can be used directly from lablgtk2 but the code isn't there yet
_andre has quit [Quit: leaving]
zorun has quit [Quit: leaving]
iratsu has quit [Ping timeout: 245 seconds]
caligula has quit [Ping timeout: 252 seconds]
ftrvxmtrx has joined #ocaml
rgrinberg has joined #ocaml
<rgrinberg>
is there a function composition function/operator in ocaml?
<thelema>
rgrinberg: not built in, but easy to define: let compose f g = fun x -> g (f x)
<thelema>
The reverse of this seems more useful in OCaml, and is spelled `|-` in batteries
<thelema>
also useful is the point-ful version of this: `|>`, which is used like this: let point_count = List.map Set.cardinal sets |> List.map ((+) 1) |> List.fold_left ( * ) 1 in
zorun has joined #ocaml
<rgrinberg>
thelema: thanks
mdelaney has quit [Quit: mdelaney]
mdelaney has joined #ocaml
ftrvxmtrx has quit [Quit: Leaving]
iratsu has joined #ocaml
malouin has joined #ocaml
<malouin>
Can ocamlbuild produce statically linked binaries?
<thelema>
malouin: yes, but you have to tell it to add the right command-line flag using myocamlbuild.ml
<malouin>
ok. I'll see what I can do.
Yoric has joined #ocaml
sebz has joined #ocaml
lopex has joined #ocaml
Anarchos has joined #ocaml
caligula has joined #ocaml
srcerer has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]
ftrvxmtrx has joined #ocaml
metasyntax|work has quit [Quit: WeeChat [quit]]
Yoric has quit [Quit: Leaving.]
Anarchos has quit [Quit: Vision[0.9.7-H-090423]: i've been blurred!]
as has joined #ocaml
as has quit [Ping timeout: 264 seconds]
bzzbzz has joined #ocaml
Morphous has quit [Ping timeout: 264 seconds]
quackv2 has quit [Quit: leaving]
lopex has quit [Ping timeout: 276 seconds]
lopex has joined #ocaml
zorun has quit [Quit: leaving]
zorun has joined #ocaml
Morphous has joined #ocaml
iratsu has quit [Ping timeout: 245 seconds]
ftrvxmtrx has quit [Quit: Leaving]
arubin has joined #ocaml
iratsu has joined #ocaml
mjonsson has joined #ocaml
joewilliams is now known as joewilliams_away
surikator has joined #ocaml
ikaros has quit [Quit: Ex-Chat]
<ousado>
Kakadu.. is that the guy who writes that JS editor?
mjonsson has quit [Remote host closed the connection]
<ousado>
wow.. how ambitious is that..
<ousado>
hm.. that kind of stuff might benefit from additional type safety.. as in ATS
<olasd>
diml: I've got an ocamldoc syntax error when trying to build the api docs for zed (I think there is a "helpful" interaction with the camomile syntax extension) : http://paste.debian.net/128234/
<ousado>
very very interesteing..
<olasd>
diml: fyi, the minimal failing ocamldoc snippet is (** "U+<code>" *)
<olasd>
I can't seem to escape it
dnolen has joined #ocaml
<ousado>
dsheets: alright.. now I know why I should have know that name :)
<ousado>
*known
<ousado>
dsheets: is he here sometimes?
<dsheets>
ousado: yeah, he shows up sometimes. he's based in the UK
<ousado>
ya I know now :)
<ousado>
his projects are awesome
<ousado>
exactly what I'm interested in.. glad you mentioned it
<dsheets>
agreed
<ousado>
.. high performance network programming that is..
<ousado>
not so much exokernels, though I thought about it :)
<dsheets>
the interesting thing about mirage is that it isn't really an exokernel. it's more of a run-time library that lets you compile ocaml to an image runnable on the xen hypervisor
<dsheets>
so this ties directly into the high performance networking — you can get zero copy loading
<dsheets>
which is why we picked ocaml to run in the browser and on the game sim servers
<ousado>
yeah
<ousado>
wow
<ousado>
heavy metal, given that ocaml isn't even in the top 50 on the tiobe index
<ousado>
haha
<dsheets>
ousado: we're writing a compiler for an ml dialect to glsl, as well
<ousado>
but is all that networking code written using 31 bit ints?
<dsheets>
ousado: dunno… ask avsm? or read the mirage code?
<ousado>
yeah, I will
<ousado>
and port it to ATS, if the answer is yes :)
<ousado>
you know it?
<dsheets>
ousado: i've read some docs but never written any code in it
<dsheets>
ousado: have a favorite ATS project?
<ousado>
nope.. I'm not even sure there is a sinlge major one
<ousado>
but the author is writing a kernel or something
<ousado>
he's crazy, too
<dsheets>
hrm… sorta like my excursion into Coq code generation — not a lot of open source exemplars
<ousado>
Coq is written in ocaml, right?
<ousado>
the first versions of ATS, too
<ousado>
seems that ocaml is the language of the monster brains
<dsheets>
yes, written in ocaml
<dsheets>
ousado: haskell's popularity is skyrocketing
<ousado>
yep
<ousado>
but I dunno..
<ousado>
do you know it well?
<dsheets>
ousado: i'm a dabbler. i'm interested in Oleg's DSL type system adventures mostly
<dsheets>
he writes ocaml as well but Haskell typically wins out in elegance and implicit structure
<ousado>
ah nice..
mjonsson has joined #ocaml
<ousado>
implicit structure?
<ousado>
as in less type annotations?
<ousado>
(are they even possible in haskell?)
<dsheets>
ousado: as in type inference with type classes reduces the amount of functor boilerplate you have to write
<ousado>
mm k
<ousado>
yeah
mdelaney_ has joined #ocaml
<ousado>
that's indeed a goal..
* dsheets
is excited for GADTs on top of the new module system
lopex has quit []
<ousado>
any reason why you're not in #haskell?
surikator has quit [Quit: surikator]
dcolish has quit [Ping timeout: 264 seconds]
<dsheets>
ousado: no current haskell projects, not enough time to lurk :-P
ulfdoz_ has joined #ocaml
<ousado>
mm I see
<ousado>
I hope I don't steal your time
habnabit has joined #ocaml
<dsheets>
ousado: it is valuable to me to bring interest to js_of_ocaml and ocamljs
habnabit has quit [Changing host]
habnabit has joined #ocaml
mdelaney has quit [Ping timeout: 264 seconds]
mdelaney_ is now known as mdelaney
_habnabit has quit [Ping timeout: 264 seconds]
<ousado>
dsheets: good
<ousado>
dsheets: I'm a good candidate for that
habnabit is now known as _habnabit
<ousado>
dsheets: I'll most likely use it
<dsheets>
ousado: excellent! I should dust off my port and see if any recent js_of_ocaml updates have resolved my issues
<ousado>
that is unless a bus hits me
<ousado>
there were a few in recent months
ulfdoz has quit [Ping timeout: 240 seconds]
ulfdoz_ is now known as ulfdoz
<dsheets>
ousado: be careful! we need your contributions :-)
<ousado>
I came to ocaml because of haxe, the compiler is written in ocaml
<ousado>
and it's among the most beautiful pieces of code I've ever seen
<ousado>
so I started to hack it
dcolish has joined #ocaml
<ousado>
now I came here
<ousado>
iprobably a place to stay
<dsheets>
ousado: nice! i'd like to send you an email when we release our WebGL shader compiler. would that be ok with you? you can direct message your address to me if yes