introom has quit [Remote host closed the connection]
Drup has quit [Quit: Leaving.]
avsm has quit [Ping timeout: 246 seconds]
Neros has quit [Ping timeout: 276 seconds]
travisbrady has quit [Quit: travisbrady]
avsm has joined #ocaml
introom has joined #ocaml
avsm has quit [Ping timeout: 240 seconds]
introom has quit [Ping timeout: 276 seconds]
ygrek has joined #ocaml
hellome has joined #ocaml
ggole has joined #ocaml
introom has joined #ocaml
avsm has joined #ocaml
avsm has quit [Ping timeout: 240 seconds]
leroux has joined #ocaml
avsm has joined #ocaml
shinnya has quit [Ping timeout: 246 seconds]
avsm has quit [Ping timeout: 276 seconds]
weie_ has joined #ocaml
introom has quit [Remote host closed the connection]
weie has quit [Ping timeout: 264 seconds]
avsm has joined #ocaml
gereedy has quit [Ping timeout: 245 seconds]
yacks has quit [Quit: Leaving]
avsm has quit [Ping timeout: 264 seconds]
introom has joined #ocaml
ollehar has joined #ocaml
avsm has joined #ocaml
avsm has quit [Ping timeout: 264 seconds]
csakatok_ has joined #ocaml
csakatoku has quit [Ping timeout: 246 seconds]
avsm has joined #ocaml
avsm has quit [Ping timeout: 240 seconds]
ygrek has quit [Ping timeout: 276 seconds]
avsm has joined #ocaml
avsm has quit [Ping timeout: 240 seconds]
manud has quit [Quit: manud]
Xom has quit [Ping timeout: 264 seconds]
avsm has joined #ocaml
Xom has joined #ocaml
avsm has quit [Ping timeout: 240 seconds]
ttamttam has joined #ocaml
yezariaely has joined #ocaml
ygrek has joined #ocaml
avsm has joined #ocaml
zpe has joined #ocaml
avsm has quit [Ping timeout: 264 seconds]
ben_zen has joined #ocaml
joostvb has joined #ocaml
zpe has quit [Remote host closed the connection]
ollehar has quit [Ping timeout: 248 seconds]
cago has joined #ocaml
mika1 has joined #ocaml
avsm has joined #ocaml
ggherdov has quit [Ping timeout: 264 seconds]
avsm has quit [Ping timeout: 276 seconds]
djcoin has joined #ocaml
levi has quit [Ping timeout: 276 seconds]
thomasga has joined #ocaml
avsm has joined #ocaml
levi has joined #ocaml
ben_zen has quit [Ping timeout: 264 seconds]
avsm has quit [Ping timeout: 245 seconds]
Neros has joined #ocaml
Xom has quit [Quit: ChatZilla 0.9.90.1 [Firefox 22.0/20130618035212]]
zpe has joined #ocaml
avsm has joined #ocaml
ggherdov has joined #ocaml
zpe has quit [Remote host closed the connection]
<yezariaely>
anyone knows an implementation of tree zippers in ocaml?
mort___ has joined #ocaml
<gasche>
yezariaely: google "tree zipper" will return you lots of results
<gasche>
but the zipper structure depends on the structure of the tree (binary of not, where the values are, etc.)
<gasche>
so you'll probably have to roll your own if your structure is not a boring binary tree
<yezariaely>
gasche: I know that there are many results. I am looking for an abstract tested library implementation which I can use ;-)
<yezariaely>
yeah, looks like I have to do my own.
<levi>
It looks like Oleg did his in haskell rather than ocaml.
<levi>
He has one in scheme, too.
<gasche>
it's rather easy to write and hard to make generic
<yezariaely>
True, implementing it is not the problem. Just wanted to safe some time writing it.
<gasche>
what's your tree structure?
<yezariaely>
more or less this: type term = App of t * t list | Var of string | Ctor of string
<gasche>
you'll have to make your own
<yezariaely>
thank you
<yezariaely>
thought so ;-)
ocp has joined #ocaml
<levi>
Apparently a generic one can be built in Haskell via the Traversable typeclass and the Cont monad, following Oleg's generic continuation-based zipper in Scheme. You could probably follow a similar approach in Ocaml if you really wanted a generic one.
avsm has quit [Ping timeout: 276 seconds]
zpe has joined #ocaml
beckerb_ has joined #ocaml
q66 has joined #ocaml
<yezariaely>
levi: I don't need a generic one right now, just wondered if there is one available. Maybe I should do it generic so people would benefit...
cago has quit [Quit: Leaving.]
cago1 has joined #ocaml
mcclurmc has quit [Quit: Leaving.]
ocp has quit [Quit: Leaving.]
ocp has joined #ocaml
avsm has joined #ocaml
<gasche>
levi: using continuations kind of kills the benefits of having zipper, imho
<gasche>
zippers are reified data-structure that allow to move arbitrarily in a structure
<gasche>
continuation capture can be used instead to allow backtracking (but I'm not sure for arbitrary traversal)
<gasche>
so you have the continuation machinery to pay, instead of a nice specialized structure
<gasche>
you're probably just as well using Delimcc directly instead of hiding it under a zipperish interface
mcclurmc has joined #ocaml
dsheets has quit [Ping timeout: 268 seconds]
dsheets has joined #ocaml
yacks has joined #ocaml
hellome has quit [Ping timeout: 264 seconds]
dezzy has quit [Remote host closed the connection]
ttamttam has quit [Quit: ttamttam]
ttamttam has joined #ocaml
gautamc has quit [Read error: Connection reset by peer]
mort___ has quit [Quit: Leaving.]
dezzy has joined #ocaml
mort___ has joined #ocaml
dezzy has quit [Client Quit]
dezzy has joined #ocaml
gautamc has joined #ocaml
fmardini has joined #ocaml
fmardini has left #ocaml []
fmardini has joined #ocaml
fmardini has left #ocaml []
fmardini has joined #ocaml
<ggole>
Pattern matching on named constants is so annoying. :/
zpe has quit [Remote host closed the connection]
<ggole>
Inefficient, too (though that doesn't matter here)
csakatok_ has quit [Ping timeout: 240 seconds]
csakatoku has joined #ocaml
_andre has joined #ocaml
<ousado>
ggole: how does that look like?
introom has quit [Remote host closed the connection]
introom has joined #ocaml
Drup has joined #ocaml
ygrek has quit [Ping timeout: 240 seconds]
csakatoku has quit [Remote host closed the connection]
<ousado>
ggole: is there a special construct for that or do you have to use guards?
<ggole>
ousado: guards
csakatoku has joined #ocaml
<yezariaely>
ggole: how do named constants look like in ocaml?
<ggole>
let pi = 3
<yezariaely>
is it type whatever = A | B | C and a function value : type -> int ?
<ggole>
When you match it will have to be x when x = pi
<ousado>
I just found a post from 2001 mentioning some camlp4 thing replacing them with a literal
<ggole>
No, variants like that are compiled very effectively
<ggole>
Yes, a beneficial transformation wouldn't be hard
<ggole>
Although scoping things across modules might not work?
<yezariaely>
ggole: so you write functions and the compiler inlines them?
<ggole>
I don't see what inlining has to do with it?
<ggole>
ousado: hmm, I'll have a look
<yezariaely>
was just a guess, because you said they are compiled efficiently.
<ggole>
I have a workable (ugly) solution for my problem, but it's always nice to know about better approaches
<ggole>
Oh, right. That refers to the match code: variants will be compiled into nice jump tables or reasonable decision trees
<ggole>
x when x = foo will be compiled into a naive test every time
csakatoku has quit [Remote host closed the connection]
wmeyer has joined #ocaml
<wmeyer>
hi
<ousado>
o//
<pippijn>
hi
<wmeyer>
\\o
<wmeyer>
hi pippijn
watermind has joined #ocaml
introom has quit [Ping timeout: 240 seconds]
introom has joined #ocaml
yezariaely has quit [Quit: Leaving.]
wmeyer has quit [Ping timeout: 245 seconds]
cago has joined #ocaml
cago1 has quit [Ping timeout: 240 seconds]
cago has quit [Client Quit]
zpe has joined #ocaml
malo has joined #ocaml
<introom>
let x = 1 and x = 2 in x;;
<introom>
Error: Variable x is bound several times in this matching
<introom>
why should it complain? I think it's just a re-binding
<whitequark>
one let, one scope
<introom>
so the and shares the scope, then why let x =1 and y =x in x;; doesn't compile?
<ggole>
let rec will
<introom>
Error: This kind of expression is not allowed as right-hand side of `let rec'
<ggole>
Oh, right
<introom>
and with this: let x x = x + 1 in x 2;;
<ggole>
Just use two lets then
<ggole>
let x = 1 in let y = x in ...
<introom>
it's an exercise
<introom>
to tell which is right and which is wrong.
<ggole>
let rec x x = x + 1 in x 2;; should be fine
<introom>
even without rec is fine
<introom>
my question is how ocaml discern the function let X from the name let x X /
<ggole>
Well, let x arg = ... is just sugar for let x = (fun arg -> ...)
<rks`>
the point is: when you have "let x = fun arg -> body" x isn't bound in body
<rks`>
so it's ok if arg = x
<introom>
ggole: yeah. let x y = x + in y_will_not_show_up_here
<introom>
let x y = y in bla
<ggole>
Yep
<rks`>
ok forget what I said
<rks`>
it's not the point...
<ggole>
And that's true of non-functions too
<ggole>
(Although ocaml will prevent some cases to rule out nonsense like let x = x in ...)
<ousado>
huh, why does this work? let x x = x + 1 in x 2;;
<ggole>
Er, let rec x = x in ...
<introom>
rks`: x is bound in body while the arg is not.
<ggole>
ousado: read it as let x = (fun x -> x + 1) in x 2
<ggole>
It does jar a bit though
<rks`>
(listen to ggole)
<rks`>
(and ignore what I said earlier)
<rks`>
(:))
<ousado>
oh sure..
<ousado>
in the "in" part there must be access to x as function, ofc
ohama has quit [Remote host closed the connection]
Nahra has quit [Ping timeout: 264 seconds]
<introom>
and what about let rec x x = x + x in x 2
<introom>
what does the rec do ?
<ggole>
The rec makes the x available in the expression part: but it is immediately shadowed by the argument, so there is no visible effect
<introom>
gotcha
<ggole>
rec is usually used for recursive (or mutually recursive) functions
<ggole>
let rec forever () = forever () in forever ()
<ggole>
let rec forever1 () = forever2 () and forever2 () = forever1 () in forever1 ()
<ggole>
(Not the most useful example there.)
cago has joined #ocaml
Nahra has joined #ocaml
Nahra has quit [Changing host]
Nahra has joined #ocaml
<introom>
ggole: the () of rec forever () is to make it function conveniently?
<introom>
make it a function
<ggole>
Yeah
<ggole>
Every function takes one arg in ocaml: if you aren't going to use it, it's conventional to indicate that with ()
<nicoo>
introom: Note that "let f () =" isn't special syntax : () is the unique value of type unit, and we are just pattern-matching in the function definition
<introom>
nicoo: yeah.
compnaion_cbue is now known as companion_cube
<introom>
let (+) x y z = x + y + z in + 5 6 7 ;; doesn't compile
<rixed>
in (+) 5 6 7 ;; should
<Drup>
introom: the ( x ) notation is for infix *binary* operators
<Drup>
in your case, "3 + 4" will return a function from int to int, so you should write it like this : "(3 + 4) 4
<introom>
Drup: so, it would be x + y z
skchrko has joined #ocaml
<Drup>
unfornutly, no
<Drup>
unfortunately*
<ggole>
Wrong precedence there
<ggole>
Well, "wrong"
<introom>
yeah. seems function application is pretty high.
<ggole>
The parser is hardwired to see that as Apply (+, x, Apply (y, z))
<ggole>
Yes
<introom>
ps, it's a special case that I should write () in (+),
<Drup>
(it's the same for merlin and ocamlyacc, from this point of view)
<chris2>
hm
<chris2>
interesting
<ggole>
In your action you have try SomeCtor args with Parse_error info -> ... or whatever
<Drup>
you can do better with merlin, but it's painful and i don't have any ressources on this
<chris2>
yeah
<ggole>
Instead of just SomeCtor args
<ggole>
At least, I'm not aware of a better way
<chris2>
my syntax is fairly simple, but i'm most familiar with menhir
<rks`>
Drup: you mean menhir, not merlin, right?
<Drup>
rks`: yes I do, today is a great day, I keeping doing silly spelling mistakes.
<chris2>
:)
<rks`>
Drup: keep* :>
<chris2>
so i need | error alternatives for all productions?
<Drup>
chris2: not with the method I linked
<chris2>
just at the top level?
<chris2>
ah ok
gautamc has quit [Ping timeout: 240 seconds]
ollehar has joined #ocaml
avsm has joined #ocaml
travisbrady has joined #ocaml
gautamc has joined #ocaml
smondet has joined #ocaml
ygrek has joined #ocaml
yacks has quit [Quit: Leaving]
<introom>
Does Jason Hickey's Ocaml book have answers publicly?
travisbrady has quit [Quit: travisbrady]
introom has quit [Remote host closed the connection]
cago has quit [Quit: Leaving.]
cago has joined #ocaml
ben_zen has joined #ocaml
cago has left #ocaml []
mika1 has quit [Quit: Leaving.]
fmardini has quit [Ping timeout: 245 seconds]
travisbrady has joined #ocaml
introom has joined #ocaml
ben_zen has quit [Ping timeout: 240 seconds]
tlockney has quit [Excess Flood]
tlockney has joined #ocaml
ygrek has quit [Remote host closed the connection]
ygrek has joined #ocaml
introom has quit [Remote host closed the connection]
zpe has quit [Remote host closed the connection]
logicgeezer has quit [Quit: Leaving]
hellome has joined #ocaml
travisbrady has quit [Quit: travisbrady]
csakatoku has joined #ocaml
travisbrady has joined #ocaml
introom has joined #ocaml
hellome has quit [Remote host closed the connection]
hellome has joined #ocaml
wwilly has joined #ocaml
zpe has joined #ocaml
zpe has quit [Ping timeout: 276 seconds]
ttamttam has quit [Quit: ttamttam]
jdoles has joined #ocaml
<jdoles>
If I use a state monad, how much of that remains at run-time? Let's say the alternative is to introduce a global variable.
<companion_cube>
I think it would create lots of intermediate closures
<ggole>
You could peek at the assembly
<jdoles>
And this is different in Haskell?
<companion_cube>
you can peek at intermediate languages
<jdoles>
As an abstraction they are sort of nice, but if they make all programs slower, it seems a rather bad abstraction.
<companion_cube>
ocamlopt -dcmm or -dlambda
<ggole>
That's abstractions for you
<ggole>
Never seen one that didn't hurt performance without being paper thin
<jdoles>
C++ people seem to be able to do just that.
<ggole>
See "paper thin".
<Drup>
ggole: my (G)ADTs disagree.
<Drup>
except if you consider them as paper thin, but .. meh.
<ggole>
It isn't hard to find examples where ADTs produce inferior code
<ggole>
Compare small sets of nullary constructors to bitsets built on small integers, say
<companion_cube>
C++ abstractions rely heavily on inlining
<ggole>
(OCaml could support that, actually, if sets were built-in... but they are not.)
thomasga has quit [Quit: Leaving.]
<ggole>
ADTs are a very good abstraction though. I am not complaining.
<companion_cube>
I think ghc does a lot of complicated optimizations to make state monads (and other purely functional thingies) relatively efficient
<mrvn>
ggole: too bad one can't write a type for a generic Variant of nullary constructors
mort___ has quit [Ping timeout: 276 seconds]
tianon has quit [Quit: "I'm a very important man. I've got a tower!"]
<ggole>
Actually even variants containing non-nullary constructors could probably benefit from specialised set representations
<companion_cube>
I'm not sure of that
<mrvn>
ggole: how would you save them?
<companion_cube>
even in C, a disjunction in which some cases have arguments require a structure
<companion_cube>
I mean a block, to store tag + possible arguments
<mrvn>
That is what the variant type is
<ggole>
You have a bitset for the nullary constructors, and then a vector of sets for the others
<ggole>
Hmm, might be expensive to copy :/
<ggole>
mrvn: not sure what you mean
<mrvn>
The bitset would be tiny, the rest probably magnitudes larger. Makes the bitset irelevant in most cases
shinnya has joined #ocaml
<companion_cube>
the bitset only works for smallish enumerations anyway
<companion_cube>
if you're using integer
<companion_cube>
+s
<mrvn>
You can write a module that checks if the argument is a block or integer. Integers you put into a bitset (string) and blocks into a set.
<ggole>
With vector instructions, you can work on 128 at a time (more with recent machines)
<ggole>
Since you are in complete control of representation, there aren't any alignment issues (you'd have to work with the runtime to achieve that, I guess).
<mrvn>
ggole: all set operations work on single elements basically
<mrvn>
union of sets might be the only exception
<ggole>
Actually, you could even nest specialisations
<ggole>
type foo = One | Two of bar | Three and bar = Zot | Bam
<ggole>
Totally enumerable
<companion_cube>
anyway this looks pretty complicated for a very specific case ;)
<ggole>
Yeah
<mrvn>
ggole: For that you use IntSet with int_of_foo and foo_of_int functions.
<ggole>
Why not just an int with the bits encoding each of the possibilities?
<mrvn>
for nullary constructors you can simply use Obj.magic there
<ggole>
Answer: you'd have to write it all yourself
<mrvn>
ggole: IntSet would use a bit field or similar.
<ggole>
Oh, I thought you meant Set applied to an Int module
<mrvn>
no
<ggole>
Yeah, you'd do that
<mrvn>
I am. :)
<ggole>
Hmm... maps would not be as efficient
<mrvn>
depends. foo -> int would be an int array
<ggole>
You could have an array, giving fast access, but growing one would be an expensive copy
<ggole>
Mutable maps could be efficient though
<ggole>
:/
<mrvn>
you would probably use a rope
<ggole>
Yeah
<ggole>
Or some more compact/cache-friendly tree than Map
<mrvn>
or hashtbl
<ggole>
(Although persistency conflicts with contiguity in some sense, since it tends to cause you to copy more.)
<companion_cube>
maybe a HAMT
<companion_cube>
(for persistent structures)
<mrvn>
a mutable map doesn't make much sense
<companion_cube>
int hashtables are faaast
<levi>
jdoles: Haskell has a very different evaluation model due to laziness. It's hard to compare its implementation to a strict evaluator.
csakatoku has quit [Remote host closed the connection]
<ggole>
If it was a mutable table, you could just use an array/two arrays
zpe has joined #ocaml
<ggole>
Before you'd do any such thing I suspect it would be sensible to inspect a large codebase and see how many types would benefit from such a scheme.
<ggole>
That would probably put the kibosh on it.
<levi>
If you are interested in interesting optimizations of functional programs that take advantage of vectorization, look at the recently published 'generalized stream fusion' paper. It's in Haskell, but would likely be straightforward to port to OCaml.
<ggole>
Fast sets for all-nullary types would be nice though... didn't Pascal have small ordinal sets along those lines?
<ggole>
The intel paper? I have that sitting around
<mrvn>
Aren't variant types limited to 256 cases or something?
<orbitz>
Yes there is a limit
<ggole>
Is there? O_o
<mrvn>
or was that only for the ones with arguments?
<orbitz>
Hrmmm
<mrvn>
ggole: Obviously there is a limit. a value only have 32/64 bit after all. 31/63 for tagged int.
<companion_cube>
makes me wonder whether merged patter-matching branches are reduced to bitwise tests
<orbitz>
I don't remember, i know htere is some limit on the number of elements in a variant. I'm pretty sure it's high enough to only be aproblem if you are autogenerating prgorams
<ggole>
Oh, for the set thing
<mrvn>
The constructors with arguments are stored as blocks with tag and the tag only has a few bits. That is one limit. Can't remember of the nullary constructors had a limit thoug.
ohama has joined #ocaml
<ggole>
mrvn: that's only due to the limitations of OCaml, a good impl would use xmm/ymm registers (or equivalent)
<mrvn>
ggole: how would that increase the number of bits in a tag?
<ggole>
It wouldn't: but you could use the same unboxing tricks that are done for floats.
<ggole>
And of course for small sets you could just use ints and keep the tag.
<ggole>
It would totally work: just a SMOP
* ggole
coughs
jpdeplaix has quit [Ping timeout: 264 seconds]
zpe has quit [Ping timeout: 248 seconds]
<mrvn>
ggole: And how many files do you have with variants with more than 2147483648 nullary constructors?
<ggole>
companion_cube: from what I can see, pattern-matching turns into either a jump table or ternary integer tests
<ggole>
mrvn: you need separate bit positions for each possibility if the scheme is going to work
<ggole>
And you need to be able to calculate a bit position (mask, really) fairly fast given the variant tag
<ggole>
(Actually, that might cause trouble for an SIMD approach... hmm.)
<ggole>
companion_cube: ternary because you can use the results of one compare to make two decisions
<ggole>
At least, on x86
ocp has quit [Ping timeout: 245 seconds]
<mrvn>
lets not design the language for something as broken as x86
<companion_cube>
ggole: depending on the 2 bits of information of < , = or > ?
<ggole>
They didn't: pattern matching is nice and abstract
<ggole>
companion_cube: yeah. You basically do cmp x, K/jg greater_case/jl lesser_case and then fallthrough to the equal case
<mrvn>
companion_cube: a swith with 3 cases only needs 1 compare
<companion_cube>
ok, that's nice
<mrvn>
switch
<ggole>
Or whichever way you want to arrange it
<ggole>
companion_cube: and of course you pick a value in the middle of the range, so you get as much info as possible for each comparison
<companion_cube>
but say, if we have type foo = A | B | C, if A=1, B=2 and C=4, match my_foo with | A | B -> .... should check whether (my_foo | 3) is zero
<ggole>
In theory you could make choices based on profiling, too
<companion_cube>
(ideally)
<mrvn>
ggole: no, you pick a value that, from profiling, gives you the least number of compares and false branch predictions
<mrvn>
too bad it breaks down with | Foo (x, y) when x = 23 ->
<ggole>
companion_cube: hmm, that could work for small numbers of legs
<companion_cube>
indeed
<companion_cube>
but that's a nice optimization ^^
<ggole>
For larger ones I think ocaml would like to keep contiguous values for tags, since that allows you to use jump tables fairly cheaply
<ggole>
I think you could get arbitrarily clever though
<companion_cube>
as with most optimizations
<ggole>
The entirely abstract notion of pattern matching gives you free reign there
<mrvn>
would be a pain for C code. How would you get the right integer for a variant?
<ggole>
Of course, the fly in the ointment.
<mrvn>
The compiler would have to generate header files for variant types
<mrvn>
.oO(which I would realy love even now)
jpdeplaix has joined #ocaml
<levi>
ggole: I have recently been looking into how one might be able to separate the specification of a type's algebraic representation from its in-memory implementation, and there have been a couple of interesting research projects in that direction.
<adrien>
ocaml-ty for instanec :P
<ggole>
levi: that's an interesting idea. There's a
<ggole>
Wadler paper on the topic iirc.
<ggole>
It'd be mainly useful for performance hacks, I think.