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
ikaros has quit [Quit: Leave the magic to Houdini]
vpalle has quit [Ping timeout: 246 seconds]
drunK has quit [Remote host closed the connection]
rien_ has quit [Ping timeout: 240 seconds]
accel has joined #ocaml
<accel> what's the best way to bind C++ classes to ocaml?
<thelema> accel: same as C
<accel> so basically, ocaml only respects the C api
<accel> and you have to wrap your C++ crap in C ?
<thelema> you can directly access C functions from ocaml. I don't think you can directly access c++ method calls
<thelema> c functions with the right interface
accel has quit [Quit: leaving]
joewilliams_away is now known as joewilliams
joewilliams is now known as joewilliams_away
oriba has quit [Quit: Verlassend]
oriba has joined #ocaml
Amorphous has quit [Ping timeout: 272 seconds]
alexyk has joined #ocaml
Amorphous has joined #ocaml
oriba has quit [Remote host closed the connection]
groovy2shoes has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
groovy2shoes has quit [Changing host]
groovy2shoes has joined #ocaml
groovy2shoes has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
groovy2shoes has quit [Changing host]
groovy2shoes has joined #ocaml
groovy2shoes has quit [Client Quit]
alexyk has quit [Quit: alexyk]
alexyk has joined #ocaml
alexyk has quit [Read error: Connection reset by peer]
alexyk has joined #ocaml
alexyk has quit [Read error: Connection reset by peer]
alexyk has joined #ocaml
alexyk has quit [Read error: Connection reset by peer]
ikaros has joined #ocaml
bzzbzz has quit [Quit: leaving]
ymasory has joined #ocaml
Snark has joined #ocaml
almaisan-away is now known as al-maisan
ikaros has quit [Quit: Leave the magic to Houdini]
ymasory has quit [Ping timeout: 255 seconds]
edwin has joined #ocaml
ttamttam has joined #ocaml
edwin has quit [Remote host closed the connection]
Yoric has joined #ocaml
oriba has joined #ocaml
LeNsTR has joined #ocaml
sgnb has quit [Read error: Operation timed out]
sgnb has joined #ocaml
al-maisan is now known as almaisan-away
Vinnipeg has joined #ocaml
_andre has joined #ocaml
rudi_s has quit [Ping timeout: 272 seconds]
sgnb has quit [Read error: Operation timed out]
sgnb has joined #ocaml
eye-scuzzy has quit [Ping timeout: 260 seconds]
Yoric has quit [Quit: Yoric]
eye-scuzzy has joined #ocaml
avsm has joined #ocaml
edwin has joined #ocaml
boscop has joined #ocaml
Vinnipeg has quit [Remote host closed the connection]
mehdid has quit [Ping timeout: 264 seconds]
<oriba> hi
<oriba> when implementing an interpreter or compiler....
<oriba> ...where would you do things like hashes for variables and functions?
<oriba> or in general: identifiers
<oriba> in lexer would make sense, so to identify as early as possible...
<oriba> or would you create a parse tree without such early decisions and do all that in the module that gets a quite raw parse tree?
<mrvn> well, anything that isn't a keyword or literal is an identifier
<oriba> at the moment that decision is done in my lexer
<mrvn> are you asking when to check if the identifier is a valid one?
<oriba> hmhh
<oriba> what am I asking...
<oriba> let me explain what I did, so it may become more clear
<mrvn> 1+foo I would tokenize into (Lit 1); Plus; (Ident "foo")
<oriba> I started with lexer (ocamllex) and parser 8ocamlyacc) for a simple interpreter
<oriba> the language was SQL-like and had not even if-then-else
<oriba> later to have that, I had changed my parser
<oriba> I changed some return values by using funj () -> former_retval
<oriba> then I could later evaluate by new_retval()
<oriba> now I think on better creating a complete tree
<oriba> and evaluate outside of the parser
<oriba> from the calling module
<oriba> but the decision if it's a keyword or not is nevertheless inside the lexer
<oriba> what about assignments
<oriba> if I say var_a = "hjjk";
<mrvn> So you want to do this in multiple passes: First you tokenize and do syntax checking and output an AST. then you evaluate the AST
<oriba> that stuf then would be in the parser-calling m odule
<oriba> AFAIK it's easier than what I did before
<mrvn> The lexer still returns var_a as ident
<oriba> before I had not an explicit AST, but an implicit one
<oriba> yes
jado has joined #ocaml
<oriba> that's what I think makes sense
<mrvn> It has to be something and nothing else makes sense
<oriba> would you always build up an explicit tree?
<mrvn> in anything non trivial sure.
<oriba> and: what about computing obvious things directly in the parser (e.g.: Const_A + Const_B)?
<oriba> ok
<oriba> at the moiment it's n interpreter, and later I also want to implement a compiler
<jado> hello, how can i use extlib with ocamlbuild after installing the packages libextlib-ocaml*?
<mrvn> oriba: thats called partial evaluation
<oriba> so... an *explicit* AST seems to be necessary...?!
<mrvn> call it an optimizer step
<oriba> but would you do such optimizations directlöy in the parser (I mean: here: yacc), or outside of it?
<oriba> it seems, for both are good reasons
<mrvn> It isn't neccessary but I sure think it is a good idea.
ikaros has joined #ocaml
<mrvn> (the ast)
<oriba> hmhh
<mrvn> I would keep the parser simple. That part is complex enough already.
<oriba> so I think about which type definition I should crearte
<oriba> it can be rather weak accepting a lot, and relying on yacc to ensure some things
<oriba> or I can make rigid type and restrict for example int and string values not beng mixed up
<mrvn> 90% of errors in programming are type errors.
<oriba> the latter seems to become somehow bloating up the type
LeNsTR is now known as iLeNsTR
<mrvn> I prefer my compiler to find them rather than the user
<oriba> me too
<oriba> but where is it easiest to check the types?
<oriba> I could say: the yacc grammar diallows it
<oriba> or: I check when I have a rather raw AST
<jado> i'm trying ocamlbuild -lib extlib main.native but i still can't "open ExtLib" nor "open Extlib"
<mrvn> oriba: I wouldn't do it in the grammar.
<oriba> both makes sense to me
<oriba> qaha
<oriba> why not?
<mrvn> Because then the grammar needs to know the type of literals and idents
<oriba> mrvn, somehow I should decide, if it's string or int value?!
<mrvn> oriba: what is "a"? int or string?
<oriba> you would create (Lit "1") and (Lit "mystring")?
<oriba> hmhh
<oriba> if " is used, it's a string
<mrvn> oriba: probably more IntLit 1 and StringLit "mystring"
<oriba> if a is there without " then it's varname
<mrvn> Literals are simple. the lexer types those.
<oriba> but then the yacc grammar already did the decision
<oriba> you would use the lexer and implement the grammar without yacc?
<oriba> hand coded?
<mrvn> no.
<oriba> aha
<mrvn> But the lexer parses literals
<oriba> ok
ftrvxmtrx has quit [Quit: Leaving]
Yoric has joined #ocaml
<oriba> the parser (yacc) then would decide if it's int or varname or string
<mrvn> If you return 1 as Lit "1" then how do you return "1"?
<oriba> and build the tree
<mrvn> The lexer has to say if it was a number or a string enclosed in ""
<oriba> yes
<oriba> ok
<oriba> yes I just looked in my lexer... ok that's how I did it
<oriba> I have VARNAME and STRING and INT_NUM
<mrvn> In the grammar you have Number = IntLit | Ident, String = StrLit | Ident, Addition = Expression Plus Number, ...
eye-scuzzy has quit [Ping timeout: 260 seconds]
<oriba> hmhh
<mrvn> Then yacc would already reject 1 + "hallo" as syntax error
<oriba> why Number = IntLit | Ident ?
<mrvn> Or you keep the grammar more loose and report it later as type error.
<jado> no one?
<oriba> how can ident be a number?
<mrvn> oriba: Because a number can be either a literal number or a variable.
<mrvn> 1+a
<oriba> hmhh
<mrvn> The other way is to say Expression = Ident | IntLit | StringLit | '(' Expression ')' | Multiplication or something
<oriba> aha
<mrvn> Then yacc would accept 1+"a"
<oriba> that's more to what I had used
<oriba> ??
<oriba> in my lexer I have read_string read_int read_varname
<jado> hm actually i may have to combine ocamlfind and ocamlbuild
<mrvn> An addition would be Expression Plus Expression. '1' is an expression and '"a"' is. So that is valid for yacc.
<oriba> the yacc-grammar then gets already split up stuff
<oriba> but 'a' can be string or int
<oriba> a = 23; b = 1 + a;
<mrvn> oriba: "a", not a.
<oriba> a = "ihihi"; b = a ^ a;
<oriba> ok
<oriba> 1 + "a" would be parse error
<mrvn> I would prefer 1+"a" to give a type error instead of a syntax error in yacc.
<oriba> aha
<mrvn> # 1+"a";;
<mrvn> Error: This expression has type string but an expression was expected of type int
<oriba> and type error would be detected from the complete AST?
<mrvn> ocaml doesn
<mrvn> 't check the literals in the grammar
<mrvn> oriba: yep.
<oriba> aha
<oriba> hmhh
<mrvn> Unless you have a really simple type system I would keep that completly out of the grammar. As said, keep the grammar simple. Split the things up into seperate steps so each one is managable. That is how I would do it.
<oriba> this would mean to have a rather weak type for the AST
<mrvn> oriba: at least for the first one
<jado> i found that i can use: ocamlfind opt -package extlib -linkpkg -o main.native main.ml but that doesn't use the power of ocamlbuild
<oriba> the first one?
<oriba> first what?
<mrvn> first AST.
<mrvn> your type checking can take an AST as input and output a revised AST with stricter types.
<oriba> do you mean my first trials, or do you mean: first AST from parsing, and create a second, more abstratc one on that?
<oriba> aha
<oriba> ok
<oriba> so this is common practise?
<oriba> I also thought about such things
<mrvn> it isn't unheard of
<oriba> hehe
<oriba> has this technique a name?
<mrvn> doubtfull. if I would call that multipass as oppsosed to doing everything in a single pass.
<oriba> hmhh
<oriba> but it also is something like a transformation of an AST
<mrvn> absolutly.
<oriba> I would rather call it multi-level parsing
<oriba> but not sure that name exists already
<mrvn> And nothing says a transformation of an AST must have the same type for input and output.
<oriba> yes that's clear
mfp has quit [Ping timeout: 240 seconds]
<oriba> at the moment I'm thinking about your example of grammar you mentioned above
<oriba> you wrote: Number = IntLit | Ident, String = StrLit | Ident, Addition = Expression Plus Number, ...
<oriba> at least with Sum types this would not work
<oriba> Becasue of twice ident
<oriba> or is it meant to be grammar or yacc?
<mrvn> oriba: that was for yacc
<oriba> otherwise polymorphic variants must be used
<oriba> aha ok
<oriba> with Number = IntLit | Ident would you then return Intlit 1 and Ident "a"
<oriba> ?
<oriba> and in case of string: Stringlit "something" and StringIdent "b" ?
<mrvn> probably `LitInt 1 and `Ident "a"
<oriba> if so: isn#t then the decision already done on the type?
<mrvn> oriba: yes, that was the example.
<oriba> hmhh
<mrvn> If you have a language with only number and strings and no complex types you can do all the checks in yacc.
<mrvn> Or rather you can write the grammar so that a type error is already a parse error
<oriba> that was my approach so far, but I wanted to add more features now and so it seems to become more and more complicated
<mrvn> oriba: if you want to do type inference then checking types in yacc will never suffice.
<oriba> hmhh
<mrvn> and then one might as well not try at all in yacc
<oriba> type inference maybe is much ahead of what I need 8and would be able of so far)
<oriba> it seems my type (at least as an input type) is too strong
<oriba> maybe what I tried to do must be done in transformation oif the AST later
<mrvn> if variables need to be declared before use, like in C, then you have the option of type checking in yacc.
<oriba> starting with a weak type, working on the weak-types AST and create a more strong St from it
<oriba> no I want directly use
<oriba> (at least for that stuff, I'm working on right now)
<oriba> in that case... of type checking in yacc, then you would save the types in a hash inside the *.mly?
<oriba> like ident-detection in the lexer?
<oriba> ...btw what I also had as a problem..... was to have the possibility of using my own function or subroutine definitions
<mrvn> oriba: if you have limited livetimes for variables then you can't use a global hash
<oriba> using blocks would need recursive parser then... I guess
<jado> ok now i'm trying: "ocamlbuild -use-ocamlfind main.native" but i'm told 'Error: /usr/lib/ocaml/extlib/std.cmi is not a compiled interface' (if i try to use Std.dump)
mfp has joined #ocaml
<mrvn> oriba: yacc is one
<oriba> but how to call yacc from within yacc#s grammar?
<oriba> AFAIk that doe snot work
<mrvn> oriba: aeh, no. you write the grammar recursively.
<oriba> ah
<oriba> you mean that the grammar includes something like block = assignment | expression | func_def
<jado> plus, this calls "ocamlfind ocamlc -c -package extlib -o main.cmo main.ml" instead of ocamlopt :(
<oriba> and func_def includes bloxk?
<oriba> block
<oriba> e.g. func_def = IDENT LPAR block RPAR ?
<oriba> but how to save the ast then for the IDENT name?
<oriba> ?
<oriba> I mean when func_call is used, the func_def must be substitued for it
<mrvn> oriba: yes
<oriba> block = assignment | expression | func_def | func_call
<oriba> hmhh func_call is expression...
<mrvn> oriba: you already need a recursion for +, -, *, / and ()
<oriba> but the parser normally eavlkuates that
<oriba> moment
<oriba> my pizza is arriving :)
<mrvn> hmm, good idea. *hungry*
<oriba> ok, hope to see you later
* oriba going to eat :)
<mrvn> I recommend writing down a few examples in your language. A hello world, a factorial, a mandelbrot prog. Then write the grammar and see how it fits. Only then start coding.
ftrvxmtrx has joined #ocaml
<oriba> back
<oriba> mrvn, you mean some examples that show me what the language have to look like?
<mrvn> yes
<oriba> mrvn, btw: so far I had the distinction of command_void and command_ret in my simple language.... so the type-distinction was made inside the yacc-grammar
<oriba> with the approach you recommend, this would be done on the AST later
<oriba> for my language I had many examples, but could not really decide for an ideal language desing
<oriba> it#s still a work in progress
<oriba> what I now want to do is: making the AST stuff for that language as well as writing me a kind of compiler template, that I can reuse later for different languages
<oriba> so there are two projects in parallel
<oriba> ...when the typechecks are done on the AST, I think assign,ments also will be done there? For variables as well as for functions?
<oriba> so far I not really had managed the eval of a func-def....
<oriba> that's one of the remaining problems in my interpreter
<oriba> but maybe just playing around with that recursive solution can show me some insights
<oriba> but somehow the to-be-evaluated stuff from a subroutine/function must be feed into the parser again.... is this then also recursive...?!
<oriba> mrvn, does it make sense to say an assignment is a binary operation? (operand_varname) (operator EQUALS) (operand var_value) ?
_andre has quit [Quit: leaving]
<mrvn> sure
_andre has joined #ocaml
<oriba> ok
Yoric has quit [Read error: Connection reset by peer]
Yoric has joined #ocaml
eye-scuzzy has joined #ocaml
<oriba> hmhh, mrvn the yacc-file becomes smaller and smaller :)
<oriba> not sure it will need to exist some hours later .... ;)
avsm has quit [Quit: Leaving.]
kaustuv has left #ocaml []
* oriba needs a nap and thanks mrvn for the help so far...
Yoric has quit [Read error: Connection reset by peer]
Yoric has joined #ocaml
Yoric has quit [Read error: Connection reset by peer]
Yoric has joined #ocaml
almaisan-away is now known as al-maisan
rien_ has joined #ocaml
unkanon2 has joined #ocaml
rien_ has quit [Ping timeout: 240 seconds]
Vinnipeg has joined #ocaml
Yoric has quit [Read error: Connection reset by peer]
Vinnipeg has quit [Remote host closed the connection]
Yoric has joined #ocaml
unkanon2 has quit [Read error: Connection reset by peer]
rien_ has joined #ocaml
Yoric has quit [Read error: Connection reset by peer]
ftrvxmtrx has quit [Remote host closed the connection]
kaustuv has joined #ocaml
<kaustuv> Around this time last year when I looked at Haskell's unboxed arrays, I was less than impressed with their speed w.r.t. roughly the same code written in OCaml. Since then the situation has exactly reversed: http://haskell.pastebin.com/iMJfge4q vs. http://ocaml.pastebin.com/DuxLHNUC -- both running on a single core amd64 processor. Can anyone explain how Haskell is able to be nearly four times as fast as OCaml?
jado has quit [Remote host closed the connection]
ftrvxmtrx has joined #ocaml
alexyk has joined #ocaml
<npouillard> gildor: ping?
alexyk has quit [Read error: Connection reset by peer]
Yoric has joined #ocaml
<gildor> npouillard: pong
<npouillard> gildor: Hi
<gildor> hi
<thelema> kaustuv: bounds checking?
<npouillard> what's the simplest way to give a different destdir when installing a oasis enabled project?
<gildor> ocaml setup.ml -configure -destdir fn
<kaustuv> thelema: Both versions do bounds checking, actually. Using unsafe_get/unsafe_set barely affects the runtime for the OCaml version.
<npouillard> ok, this "mostly" fine
<npouillard> but it makes little sense to specify this at configure time
<gildor> npouillard: you can also override the current value using the env variable "destdir"
<gildor> (after configure)
<kaustuv> For reference, here's the version with ordinary arrays instead of bigarrays: http://ocaml.pastebin.com/JzbynHya
<kaustuv> Apparently, bigarray has a hefty overhead.
<npouillard> gildor: oh, the second way would be exactly what I wanted but it does not seems to work here
<gildor> npouillard: could you give me the command you are running ?
<npouillard> actually I'm using the Makefile wrapper
<gildor> npouillard: do you have the matching export destdir
<gildor> (N.B. this is destdir in lowercase)
<npouillard> and the sequence is this:
<npouillard> make
<npouillard> destdir="$pkgdir$(ocamlfind printconf destdir)" make install
<gildor> npouillard: which project ?
<npouillard> bin-prot
<npouillard> using the -configure way does not seems to help
<gildor> npouillard: can you run ocaml setup.ml -version
<kaustuv> is $destdir set inside the makefile, overriding the env variable (in which case use make -e)?
<gildor> npouillard: yes, this is a bug, you have to remove the setup.data to make it take into account
<npouillard> gildor: Actually the pkg builder I use does clean everything, but the issue is more specific actually
<npouillard> It is about the ocamlfind destdir
<gildor> destdir is not used in ocamlfind destdir !!!
<gildor> use the OCAMLFIND_DESTDIR environment variable
<thelema> kaustuv: 31 vs. 32-bit values in array?
<gildor> (OCAMLFIND_DESTDIR is managed directly by ocamlfind, not by oasis)
<npouillard> gildor: Yes I just tried that
<gildor> npouillard: and it doesn't work ?
<kaustuv> thelema: using Array instead of Bigarray.Array1 is not a fair comparison because of the 63/64 bits issue, since the Haskell version is 64 bits. If I use a nativeint bigarray, the runtime drops by another factor of 2.
<npouillard> gildor: getting better
<gildor> npouillard: what fails ?
<npouillard> about ld.conf
<gildor> OCAMLFIND_LDCONF=ignore
<npouillard> aha thanks
<gildor> (Debian packager trick)
<npouillard> the old one was using some OCAMLFIND_INSTFLAGS but it maybe was something specific to the makefile
<gildor> what packager are you using ?
<thelema> kaustuv: so bigarray of nativeints is still about 2x speed of haskell equivalent
<npouillard> gildor: thanks. Ok, so I didn't need the other destdir flag since everything is installed by ocamlfind in this package
<npouillard> gildor: ArchLinux (makepkg)
as has joined #ocaml
<npouillard> I'm responsible for a bunch of OCaml package there
<mrvn> kaustuv: because they are boxed
<gildor> npouillard: I have talked a little bit about aur with Magnus Therning, do you know him ?
<thelema> kaustuv: probably all the overhead of doing a full get and put, without possibility of optimizing the pair... maybe an Array1.update function would help performance
<npouillard> virtually only
as has quit [Client Quit]
<kaustuv> thelema: a nativeint bigarray takes 1 minute where the haskell array of unboxed native ints takes 11 seconds. Where did you get the 2x speed?
<mrvn> kaustuv: also int bigarrays don't use the optimized functions for ints but fall back to the generic ones which are a lot slower.
<mrvn> kaustuv: some bug in the compiler
thelema_ has joined #ocaml
<thelema_> kaustuv: also, it seems that bigarray has to do runtime dispatch on the type of the elements in the array
<mrvn> thelema_: only for int and bigger
<mrvn> thelema_: or when the type is polymorphic
<thelema_> really? I'm looking at caml_ba_get_N, and it's got a giant switch statement for all kinds of big arrays
<mrvn> thelema_: the compiler optimized on the type during code generation. For known types it injects a Cmm statement. It has one for ints but it fails there.
<mrvn> optimizes even
thelema has quit [Ping timeout: 250 seconds]
thelema_ is now known as thelema
<thelema> mrvn: ah, that's... cheating
avsm has joined #ocaml
<kaustuv> caml_ba_get_N and caml_ba_set_aux take up 31% of the runtime based on the profiler. 23% is taken up by caml_ba_offset, which doesn't do any typecase at runtime.
<mrvn> kaustuv: try it with int8 or int16
<thelema> kaustuv: looks like you're failing to trigger mrvn's optimization
<kaustuv> I am not interested in trying int8 or int16. I want to compare unboxed int64 arrays between two different language implementations.
<thelema> kaustuv: try inlining all your functions, so you're not forcing ocaml to build a polymorphic incr_array
<mrvn> kaustuv: then you are comparing apples and oranges because you are still boxing int64 outside the array
<kaustuv> thelema: hmm, let me try with a monomorphic incr_array then.
<kaustuv> ps, int8 and int16 both take upwards of 35 seconds, i.e., same ballpark as nativeint
<npouillard> gildor: virtually only
<mrvn> kaustuv: what is your code?
<kaustuv> thelema: monomorphizing incr_array was the right answer:
<kaustuv> ./bigarr.ocaml 6.66s user 0.00s system 100% cpu 6.667 total
<kaustuv> good deduction
unkanon2 has joined #ocaml
<mrvn> kaustuv: told you
unkanon2 has quit [Read error: Connection reset by peer]
<mrvn> kaustuv: now compare that with int8/16 vs. int/int32/int64.
rien_ has quit [Ping timeout: 240 seconds]
rien_ has joined #ocaml
ftrvxmtrx_ has joined #ocaml
<mrvn> kaustuv: is that on a 32bit cpu?
<kaustuv> No.
<thelema> bigarray is 2x speed of regular array because regular array is boxed, and bigarray not
ftrvxmtrx has quit [Ping timeout: 276 seconds]
<thelema> (for nativeint)
joewilliams_away is now known as joewilliams
roconnor has quit [Remote host closed the connection]
roconnor has joined #ocaml
avsm has quit [Quit: Leaving.]
zerny has joined #ocaml
zerny has left #ocaml []
lamawithonel has quit [Remote host closed the connection]
lamawithonel has joined #ocaml
ccasin has joined #ocaml
alexyk has joined #ocaml
alexyk has quit [Read error: Connection reset by peer]
alexyk has joined #ocaml
mehdid has joined #ocaml
alexyk has quit [Read error: Connection reset by peer]
rien_ has quit [Read error: Connection reset by peer]
rien_ has joined #ocaml
alexyk has joined #ocaml
alexyk has quit [Read error: Connection reset by peer]
alexyk has joined #ocaml
alexyk has quit [Client Quit]
oriba has quit [Quit: Verlassend]
jamii_ has joined #ocaml
<jamii_> i have a program which gprof reports is spending ~25% of its time in caml_create_string
<jamii_> now the interesting thing is that i dont use any strings
<jamii_> anywhere
<jamii_> apart from one printf at the end
<mrvn> Buffer?
<thelema> jamii_: what are your major data structures?
<jamii_> maybe. i use scanf at the beginning but that completes practically instantly. the rest of the computation takes about 3 mins
<jamii_> bool array, int array, (bool array * int) hashbl
<jamii_> *hashtbl
<jamii_> maybe bool array is being packed into a string?
<adrien> nah
<adrien> can you show the code? and which functions lead to caml_create_string?
<jamii_> i also have caml_make_vect, caml_string_get, caml_string_greaterequal with high usage
<thelema> jamii_: ocaml is very literal about how it compiles programs
<mrvn> You use a bool array as key for a hashtbl?
<jamii_> ssshh...
<jamii_> its a prototype
<adrien> jamii_: not what you're after but stumbled on it: you might want to factorize your calls to 'snd' and 'fst' (right in 'fun cell ->' : 'fun (cell_fst, cell_snd) ->')
<jamii_> yep
<jamii_> will do
<mrvn> is width/height <=31 (<= 63 on 64bit cpus)?
<jamii_> width/height is 7/8
<jamii_> for the largest problem
<jamii_> which still takes a long time
<adrien> "Fatal error: exception Out_of_memory" =P
<jamii_> on what input?
<adrien> http://www.quora.com/about/challenges <- the 7x8 input (I had the tab opened in seamonkey :P )
<adrien> (but don't worry, I only had it for fun ;-) )
<jamii_> stack overflow? it works fine for me on a 32 bit netbook with ocamlopt. just takes a long time
<adrien> jamii_: also, use exhaustive patterns otherwise ocamlopt will add code to manage the Match_failure (which should take more time)
<mrvn> you are doing this way to complex.
<adrien> failed in Arg but that might be something else, let me see (I removed the call to Arg.parse and directly used 'main Sys.argv.(1)' and the exception is still there)
<jamii_> sssshhhh .....
<jamii_> no helping
<jamii_> adrien: i didn't know about the exhaustive patterns. thanks
<jamii_> huh. caml_create_string is not called by anything
<jamii_> its alone in the call graph
<adrien> let cache = Cache.create (int_of_float (2.0 ** (float_of_int (puzzle.width * puzzle.height))))
<jamii_> wtf?
<adrien> 2**(7*8) ...
<jamii_> adrien: oops, i didnt mean to commit that
<thelema> 2^56, that's a big number...
<thelema> yay virtual memory
<mrvn> 1) Make the puzzle 2 units bigger and set the border to false (not empty). That way you can skip the test for >= 0 and < width/height.
<jamii_> it should be puzzle.width * puzzle.height
<thelema> or yay overflow on a 32-bit platform, and no overflow on 64-bit platforms.
<mrvn> 2) don't keep a list of empty neighbours, just recurse into the field and abort if it isn't empty.
<jamii_> mrvn: 1) breaks the flood fill
<jamii_> mrvn: 2) yeah, i guess so
<mrvn> jamii_: no. It will recurse onto a border, the border is marked already used, it will go back and try another direction
<jamii_> mrvn: no wait, 1) is fine. :|
<mrvn> 3) kick the cache
<jamii_> mrvn: just did. 30s -> 0.6s
<jamii_> yeah, the caching came before the pruning
<mrvn> did it have any hits at all? Can it even have hits?
<jamii_> it was an improvement at that point
<jamii_> yeah, you can take different paths and still end up with the same pattern of filled squares
<jamii_> oh, now the caml_create_string is gone
<mrvn> jamii_: but you have to count both paths
<jamii_> yeah, you count the answer each time you hit a path with the same pattern
<jamii_> but whatever, its much faster without
<jamii_> that was poorly thought out
avsm has joined #ocaml
<adrien> not like programs were magically fast on the first try ;-)
<mrvn> If you want to cache you might want to represent your puzzle as Int64.t
ymasory has joined #ocaml
<jamii_> good idea
<mrvn> But the memory overhead of the cache probably far outways the benefits I think.
<adrien> jamii_: what's the complexity of your algorithm?
<mrvn> adrien: O(4^n)?
<adrien> because if it takes 10 minutes for 7*8 without profiling on my machine, I better not try to profile it :P
<adrien> ah
<mrvn> adrien: you've got to beat 5 seconds. :)
<adrien> anyway, boring work to do, good luck
<mrvn> actually only O(3^n)
<adrien> maybe this week-end
<mrvn> jamii_: How long does it take for the 7*8?
<adrien> might be hard to do less than O(3^n) without changing a lot of stuff, but again, not before this week-end
<mrvn> adrien: I'm not sure you can unless you can prove some form of caching works. Each point in the graph has 4 connections. You enter through one and have to test a 3 others for each step of your depth first search.
<jamii_> takes 1m30 on my netbook at the moment. will upload the speedy version in a minute
unkanon2 has joined #ocaml
<mrvn> jamii_: There are some tests you can do to prune some choices. e.g. a cell with only one other free neighbour must be visited next. every free cell must have >=2 free neighbours except the next one.
<adrien> mrvn: I was thinking that maybe a different data structure could help, I've put very little thought into that obviously but I'd probably start by trying to get a "better" representation for the data
<jamii_> mrvn: look at the choices function
<mrvn> adrien: if you represent the board as int64 you can probably do some clever shifts, and, or operations to check for unreachable cells and such.
<ymasory> hi all. i'm using the ocaml toploop in the ubuntu repositories. is there a wrapper that will allow me to use the arrow keys, emacs keybindings, etc?
rien_ has quit [Ping timeout: 272 seconds]
<hcarty> ymasory: rlwrap or ledit
<mrvn> jamii_: hehe, great minds think alike. :)
<mrvn> ymasory: emacs will
<ymasory> hcarty: worked like a charm, thanks
<mrvn> jamii_: Instead of bools I would maybe use an int giving the number of free neighbours.
<adrien> mrvn: int64 will only work up to 8*8, it should work for bigger values too (but I guess you can make several algorithms and use a different one depending on the size of the input)
<mrvn> jamii_: when you visit a cell you substract 1 from all neighbours and 4 from the cell itself. You can't go to cells with <=0 and you must go to a cell of 1 next.
<jamii_> mrvn: nice
joewilliams is now known as joewilliams_away
joewilliams_away is now known as joewilliams
<mrvn> jamii_: just an idea though. not sure if that would work out well. But it should simplify your neigbours, num_neighbours and choices greatly.
<mrvn> jamii_: In connected you test if your last move split the empty region into 2 chunks?
<jamii_> yep
<jamii_> might be a faster way to do it, knowing that the move before didnt split it
<mrvn> yeah. If you moved down and the cell down one more is taken then you might have split. Same for up/left/right. I think otherwise you can't have split it.
<mrvn> The choices function prevents crossroads where you otherwise split it.
npouillard has quit [Ping timeout: 272 seconds]
<mrvn> jamii_: nice little problem
ftrvxmtrx_ has quit [Quit: Leaving]
unkanon2 is now known as rien_
eye-scuzzy has quit [Quit: leaving]
npouillard has joined #ocaml
WonTu has joined #ocaml
WonTu has left #ocaml []
Yoric has quit [Quit: Yoric]
thieusoai has joined #ocaml
decaf has joined #ocaml
decaf is now known as Guest41664
Guest41664 is now known as decaf
julien_t has joined #ocaml
<jamii_> screw it, i'll finish it in the morning
ulfdoz has joined #ocaml
avsm has quit [Quit: Leaving.]
ttamttam has quit [Remote host closed the connection]
<hcarty> adrien: I lost it in the backlog - what terminal are you using that has trouble with lwt-toplevel?
vpalle has joined #ocaml
<adrien> hcarty: xterm
<adrien> for backspace
ygrek has joined #ocaml
ftrvxmtrx has joined #ocaml
<hcarty> adrien: What OS? It works here in an xterm on Ubuntu and CentOS/RHEL 5
ymasory_ has joined #ocaml
<adrien> linux, slackware
<adrien> might be in the .Xdefaults
<hcarty> Could be
<adrien> I don't have the absolute last version of lwt I think, but not a very old one either
<hcarty> Terminal incompatibilities like this are terrible, evil things.
<adrien> I'd push for the bsd-licensed mini readline library in ocaml actually
<bitbckt> linenoise
Yoric has joined #ocaml
<hcarty> The lwt completion goes beyond readline support - it has some knowledge of what values/modules/etc are visible
<hcarty> With the latest verion (2.2.0). "open Batteries;;" then "Enum." brings up an appropriate list of functions for completion
<adrien> nice
<adrien> what I'd like in a "bare" ocaml toplevel is that at least ^H and ^W worked
<adrien> really, minimal support
<hcarty> Yes, that would be ideal
<adrien> lwt 2.1 here, the completion doesn't seem to work
<adrien> will see this week-end or next week, too much work currently
<hcarty> adrien: With 2.1 and earlier, the completion only works for fully-pathed names
<hcarty> Which is a bummer
vpalle has quit [Ping timeout: 265 seconds]
<adrien> ok, that'd explain it
_andre has quit [Quit: leaving]
al-maisan is now known as almaisan-away
alexyk has joined #ocaml
jamii_ has quit [Ping timeout: 255 seconds]
vpalle has joined #ocaml
hto has quit [Read error: Connection reset by peer]
avsm has joined #ocaml
hto has joined #ocaml
fraggle_ has quit [Ping timeout: 276 seconds]
yezariaely has joined #ocaml
yezariaely has left #ocaml []
jcaose has joined #ocaml
jcaose has quit [Remote host closed the connection]
ygrek has quit [Ping timeout: 240 seconds]
fraggle_ has joined #ocaml
ygrek has joined #ocaml
lamawithonel has quit [Remote host closed the connection]
decaf has quit [Read error: Operation timed out]
lamawithonel has joined #ocaml
decaf has joined #ocaml
alexyk has quit [Ping timeout: 240 seconds]
smerz has joined #ocaml
alexyk has joined #ocaml
rwmjones is now known as rwmjones_afk
noisymouse has joined #ocaml
<noisymouse> hi, why does this code that I posted at http://pastebin.com/t6NXKBPp result in a syntax error?
<ezyang> you need an in after a let
<ezyang> let foo = bar in ...
<flux> noisymouse, there are two kinds of 'let's
<ezyang> no semicolon necessary either.
lamawithonel has quit [Remote host closed the connection]
<flux> noisymouse, top-level lets and lets that are expressions
<noisymouse> ok
<flux> noisymouse, within a top-level let you would use an expression variety of let and its syntax is like: let a = b in expr
<noisymouse> so what should the in part be?
lamawithonel has joined #ocaml
<noisymouse> I guess I don't know exactly what you mean by expression
<flux> expression like: 1 + 2 is an expression. it has a value
<noisymouse> also it says the syntax error is on line 64, but I realize the parser might be reading the code differently than I am
<ezyang> noisymouse: not too surprising
<flux> "let foo a = a + 4" is not an expression, it doesn't have a value. it says, that in future, when you find 'foo x', do this.
<ezyang> syntax errors usually happen a few lines after the real error.
<noisymouse> ok
<flux> "let a = 42 in 44" is an expression, it has value 44
<noisymouse> so if I said print_int a;; would I get 42?
<flux> nope. "let a = 42 in 44" doesn't say that a is 42 after that
<flux> a is 42 only within the expr part of that: let a = 42 in (here a is 42)
<flux> it sort of reads out loud like "let variable be 42 within this expression" :)
<noisymouse> I'm really confused... maybe you can refer me to a reference?
<flux> you can play with these things interactively
<flux> you will find, for instance, that let a = 42 in 44;; doesn't create variable a
<flux> (a in 'unbound' after evaluating that expression)
<adrien> it's only bound in the expression following the 'in'
lamawithonel has quit [Remote host closed the connection]
<noisymouse> ok so I just put in at the end and don't need anything else?
lamawithonel has joined #ocaml
<flux> well, not anything else to get around this particular issue perhaps :)
<noisymouse> ok, so of course there are some programming errors I have now, but the syntax seems to be ok
<noisymouse> thanks!
<noisymouse> I'm going stay on here as I expect I'll have some more questions... and I don't want to barrage my teacher with questions
<noisymouse> but you guys are putting yourselves directly in the line of fire
<bitbckt> That's what this channel is for.
ikaros has quit [Quit: Leave the magic to Houdini]
lamawithonel has quit [Remote host closed the connection]
lamawithonel has joined #ocaml
<ezyang> Does OCaml have an array syntax, like its list syntax [1;2;3]?
<ftrvxmtrx> [|1;2;3|]
<ezyang> cool.
<ezyang> I wasn't sure if that was quasiquoting notation or not.
<thelema> nope, just funny brackets around arrays. Supposedly, at one time caml had a syntax rule of not overloading any tokens
Snark has quit [Quit: Ex-Chat]
almaisan-away is now known as al-maisan
oriba has joined #ocaml
lamawithonel has quit [Remote host closed the connection]
lamawithonel has joined #ocaml
ccasin has quit [Remote host closed the connection]
ikaros has joined #ocaml
alexyk has quit [Quit: alexyk]
noisymouse has quit [Remote host closed the connection]
ulfdoz has quit [Ping timeout: 246 seconds]
drunK has joined #ocaml
fraggle_ has quit [Read error: Connection reset by peer]
groovy2shoes has joined #ocaml
<decaf> http://caml.inria.fr/pub/docs/manual-ocaml/manual038.html isn't something wrong with this explanation?
<decaf> "It will not take advantage of multi-processor machines. "
<decaf> "System threads. This implementation builds on the OS-provided threads facilities"
<adrien> there's a lock
<ezyang> Oh, OCaml has a GIL? That's disappointing.
<avsm> garbage collector lock, not interpreter
<avsm> stay out of the GC, and you're good.
<ezyang> Oh, ok. That's much less bad :-)
fraggle_ has joined #ocaml
<adrien> you can run some things really in parallel, that's done for some C calls
<decaf> so if I can implement mailbox threads like erlang, will scale on all cpus
<adrien> I can't remember: does jocaml allow to take advantage of multiple processors?
* decaf starts reading jocaml
<Yoric> adrien: it does
<adrien> ah, thanks, got unsure at some point
<ygrek> via multiprocessing
<adrien> ah, that explains it
<decaf> jocaml forks processes?
<decaf> or uses threads?
<hcarty> decaf: It provides communication between processes
<decaf> not bad, forking is cheap on linux
<adrien> that might be of interest to some people here: mingw-w64 might provide a fork() too soon, using native windws APIs, so much faster than cygwin's
<hcarty> It may not use fork internally. I'm not sure if it has external tools to setup the processes (think MPI) or forks on its own.
<hcarty> decaf: preludeml provides some parallel list and array processing functions which use fork internally
<decaf> thank you all
mascotte has joined #ocaml
ygrek has quit [Ping timeout: 240 seconds]
avsm has quit [Quit: Leaving.]
ymasory_ has quit [Read error: Connection reset by peer]
vpalle has quit [Ping timeout: 272 seconds]
alexyk has joined #ocaml
joewilliams is now known as joewilliams_away
joewilliams_away is now known as joewilliams
vpalle has joined #ocaml
lamawithonel has quit [Remote host closed the connection]
lamawithonel has joined #ocaml
unkanon2 has joined #ocaml
iLeNsTR has quit [Quit: iLeNsTR]
rien_ has quit [Disconnected by services]
unkanon2 is now known as rien_
rwmjones_afk is now known as rwmjones
<thelema> My program runs and grows in memory usage, I Gc.compact(), and it drops in memory usage, but it immediately jumps right back to where it was before - does the real major_heap_increment... go away?
<thelema> s/go away/increase so that it can easily return to its original vmsize?/
<thelema> I'm trying to measure memory usage of a mixed ocaml/C program, so I think I have to use /proc/$pid/status.VmSize
vpalle has quit [Ping timeout: 260 seconds]
<julien_t> I don't know much about this but there was recently a discussion about memory usage Gc, etc. in the ocaml mailing list
vpalle has joined #ocaml
Yoric has quit [Quit: Yoric]
<thelema> julien_t: the one about sizeof? I'm looking for more of a "how much memory does this program need to run in its loop forever"
mnabil_ has joined #ocaml
<julien_t> Yes I was thinking to this one
<thelema> It's like I have a warm GC, which behaves differently from the cool GC I start with
al-maisan is now known as almaisan-away
<thelema> maybe that is the difference, as the data is already cached in memory (linux disk buffers), it returns to full size quickly
<julien_t> I think you can print all the Gc parameter during execution, maybe you can look at the major_heap_increment value ?
<hcarty> IIRC, there is a project like PLEAC which has implementations of multiple simple tasks in several programming languages. Does anyone here know the/a name?
<hcarty> name of that site/project
<ezyang> Rosetta Stone?
<ezyang> or something.
<hcarty> ezyang: Thanks! I think it is Rosetta Code
vpalle has quit [Ping timeout: 240 seconds]
<julien_t> \quit fermeture du labo
<adrien> forward slashes :P
<julien_t> lol
julien_t has quit [Quit: fermeture du labo]
vk0 has quit [Ping timeout: 250 seconds]
vk0 has joined #ocaml
edwin has quit [Remote host closed the connection]
joewilliams is now known as joewilliams_away
joewilliams_away is now known as joewilliams
rks has quit [Ping timeout: 250 seconds]
noisymouse has joined #ocaml
<noisymouse> hi again, is there a way when in interactive mode to reenter a command without having to type it out?
rks has joined #ocaml
<noisymouse> also when I use #use, sometimes old functions are still in the memory of the interpreter. Is there a way to clear the memory without quitting and running ocaml again?
<hcarty> noisymouse: Use rlwrap or ledit to get history and line editing
kerneis has quit [Read error: Operation timed out]
<mfp> noisymouse: as for the 2nd question, AFAIK not
<hcarty> noisymouse: Emacs can apparently do some nifty tricks with the interactive toplevel as well
<noisymouse> ok Ill look into rlwrap and ledit
boscop has quit [Ping timeout: 240 seconds]
mascotte has quit [Quit: Quitte]
vpalle has joined #ocaml
<ezyang> Will people look at me funny if I use Unicode variable names? :-)
vpalle has quit [Client Quit]
<hcarty> ezyang: OCaml might
<hcarty> I don't think the compiler supports it
<ezyang> I have all these deltas and epsilons and I really want to just write δ and ε
<ezyang> Oh. Bummer. :-/
Edward__ has joined #ocaml
<ezyang> Aw, I can't put named arguments in tuples :-(
ikaros has quit [Quit: Leave the magic to Houdini]
<ezyang> Going to have to think a little carefully about how I'm going to do this.
lamawithonel has quit [Remote host closed the connection]
<ezyang> Ok, who will stab me if I make a tuple (float, float, float)?
<thelema> ezyang: yes, ocaml source must be latin-1 encoded
<thelema> df
<ezyang> thelema: Oh, latin1, not ASCII? Curious.
<thelema> ezyang: france
<ezyang> Haha, that's right. :-)
<ezyang> So, her'es my problem
<ezyang> I'm trying to reuse some code, where the pattern is "takes some common arguments, and then takes some uncommong arguments"
<ezyang> where teh uncommon arguments are not necessarily preserved from function to function.
<ezyang> However, to reuse the code, I need a signature that contains all of these functions.
<ezyang> One way to do this is common_args -> 'a -> result
<ezyang> but if I use anonymous tuples then anything 'a is unlabeled
<ezyang> and if I define individual structs for each set of args, I run into the subtypting problem
<ezyang> *subtyping
<ezyang> in that I have fields that are semantically equivalent from record to record, but I can't overload the names.
<ezyang> I'd like to avoid using OCaml objects.
<hcarty> ezyang: Why not normal arguments, or labeled/optional arguments as appropriate?
<ezyang> hcarty: Normal arguments are poor because it leads to float -> (float, float, float)
<ezyang> Or maybe I'm misunderstanding you.
<hcarty> thelema: For what it's worth - the pa_string toplevel printing problem seems to be introduced by the pa_estring extension
<hcarty> thelema: As opposed to (or perhaps in addition to?) pa_string itself
<thelema> hcarty: really? interesting
lamawithonel has joined #ocaml
<ezyang> How much protection do I get from defining type synonyms?
<ezyang> it seems OCaml implicitly casts things as necessary. Is there a way to get a stronger guarantee?
<ezyang> I guess this is... ok
<hcarty> thelema: Starting a fresh topleve + findlib, "#camlp4o;;" then "#require "estring";;" -> the printed types are in revised syntax
<hcarty> toplevel. I need to check my typing fingers for proper function.
<thelema> ezyang: type synonyms are interchangeable
<ezyang> ok.
<thelema> ezyang: option 1: tag the types -- type norm = Norm of float
<ezyang> thelema: Does that compiled away, like in Haskell?
<thelema> option 2: use the module system -- module Norm : sig type t val of_float : float -> t val to_float : t -> float end = struct type t = float let of_float x = x let to_float x = x end
<thelema> ezyang: no, ocaml does what you tell it to
<thelema> option 2 has no runtime cost
<thelema> as the functions all get inlined
<ezyang> hmm, ok. I should learn how to use the module system anyway :-)