Banana changed the topic of #ocaml to: OCaml 3.08.1 available! | Archive of Caml Weekly News: http://sardes.inrialpes.fr/~aschmitt/cwn/ | A tutorial: http://merjis.com/richj/computers/ocaml/tutorial/ | A free book: http://cristal.inria.fr/~remy/cours/appsem/ | Mailing List: http://caml.inria.fr/bin/wilma/caml-list/ | Cookbook: http://pleac.sourceforge.net/
ianxek has quit [Remote closed the connection]
async_ has joined #ocaml
vezenchio has joined #ocaml
<async_> is there a way to put characters back into the lexing buffer?
<Nutssh> AFAIK, no, do you need it?
<async_> yeah.. maybe im not doing this lexer correctly
<async_> hehe
<Nutssh> Sometimes things can work nicely with doing a two-pass lexer. Lex once, copy into temporary buf, then lex that.
<async_> Nutssh: thats exactly what i need
<async_> how does that work? ;)
<async_> do you just use differnt lexer rules for each pass?
<Nutssh> Buffer.add buf (Lexing.lexeme lexbuf) // and when you want to do the rule lexerFunc (Lexing.from_string (Buffer.as_string buf)) or something vaguely like that.
<Nutssh> Lexers get compiled into functions and can accept extra arguments. (and an implicit argument containing the lexer state in 'lexbuf')
<async_> Nutssh: is this all done in the lexer? or is the second pass called from the parser?
kinners has joined #ocaml
<async_> but yeah, i'd like to pass a generic token into the lexer to extract a more precise token
<async_> er, extract the data from a generic token, and get a more precise token
<async_> if that makes sense
vezenchio has quit ["None of you understand. I'm not locked up in here with you. YOU are locked up in here with ME!"]
<Nutssh> I've done what I described in the lexer. I've yet to use the ocaml parser generator.
vezenchio has joined #ocaml
gim has quit [Read error: 110 (Connection timed out)]
<async_> ok
<Nutssh> A lexer rule is just some code. It can do anything --- up to and including calling the lexer to continue lexing, or calling another lexer to lex. As long as it returns something of the right type.
<Nutssh> For a relex, I'd have it allocate a buffer, then call a different lexer to, eg, fill the buffer, pull it out as a string, then pass the string to either a function F, and return what F returns. F could be another lexer pass, or even a full-featured parser&lexer pass.
CosmicRay has joined #ocaml
async_ has quit [Read error: 110 (Connection timed out)]
async_ has joined #ocaml
<vincenz> Hmm
<vincenz> Is jocaml still being continued?
<vincenz> it looks quite magnificent
<vincenz> especially the part of relocating code
<vincenz> (and it does remind me of erlang)
* vincenz quickly reboots
vincenz has quit ["leaving"]
vincenz has joined #ocaml
mrsolo_ has quit [Success]
<vincenz> re
<vincenz> Smerdyakov: ?
<drz> how does backstep work in the debugger? does it rerun the program until just before where you're at now?
<drz> if so, that would nicely explain why it's not giving me any sensible data
<vincenz> it runs a program backwards
<drz> but how? you can't run a program backwards just by looking at the code and the current state
<drz> it sure is acting as if it's rerunning the entire program until where you backstepped to
<vincenz> no idea, never used it
CosmicRay has quit ["Client exiting"]
<vincenz> Anyone know why jocaml is no longer maintained? It seems very interesting
CosmicRay has joined #ocaml
mrsolo_ has joined #ocaml
<async_> vincenz: probably because no one was using it
<Nutssh> drz, it runs the program forward to the point just before.
<async_> oh, i thought it saved the state of the program
<async_> incrememtally
<Nutssh> As an optimization, it saves occasional 'snapshots' the program by fork() so it doesn't have to run from the beginning. See the docs for ocamldebug.
<drz> nutssh: IC. Thanks.
CosmicRay has quit ["Leaving"]
grirgz_ has joined #ocaml
grirgz has quit [Read error: 110 (Connection timed out)]
kinners has quit ["leaving"]
vezenchio has quit ["None of you understand. I'm not locked up in here with you. YOU are locked up in here with ME!"]
async_ has quit ["leaving"]
mrsolo has joined #ocaml
mrsolo_ has quit [Read error: 113 (No route to host)]
mlh has quit [Client Quit]
async_ has joined #ocaml
async has quit [Read error: 104 (Connection reset by peer)]
pango has quit ["Client exiting"]
Submarine has joined #ocaml
mlh has joined #ocaml
mrsolo has quit [Read error: 104 (Connection reset by peer)]
mrsolo has joined #ocaml
kinners has joined #ocaml
grirgz_ has quit [Read error: 110 (Connection timed out)]
ianxek has joined #ocaml
Tachyon76 has joined #ocaml
mrvn_ has joined #ocaml
pango has joined #ocaml
mrvn has quit [Read error: 110 (Connection timed out)]
pango has quit [Remote closed the connection]
Tachyon76 has quit [Client Quit]
Tachyon76 has joined #ocaml
Tachyon76 has quit ["Leaving"]
det_ is now known as det
kinners has quit ["leaving"]
pango has joined #ocaml
mlh has quit [Client Quit]
Submarine has quit ["ChatZilla 0.8.31 [Mozilla rv:1.4.1/20031114]"]
Submarine has joined #ocaml
<vincenz> async_: too bad
<Submarine> I'm plotting the time it takes to do some computation wrt the size of the minor heap and it's really intriguing.
<vincenz> really?
<vincenz> what sort of gains can one expect?
<Submarine> on this example, the default settings yield 2660 seconds of computation
<Submarine> (default settings= 32 kwords)
<Submarine> but settings near 700 kwords yield 2146 seconds
<vincenz> is there any method of determining the #kwordS?
<Submarine> so it's a 19.5% speed improvement
<Submarine> you mean optimal?
<Submarine> it's a decreasing function
<vincenz> well doesn't have to be optimal
<vincenz> near-optimal
<Submarine> the thing is, it seems to be a decreasing function
<vincenz> decreasing?
<Submarine> well minor_heap_size -> computation time is decreasing
<Submarine> décroissante, quoi
<Submarine> on this example at least
<Submarine> I'm going to test bigger examples when I have CPU time on hand.
<vincenz> well it should rise again
<vincenz> it can't decrease forever
* vincenz just figured out a flaw with his classes
<vincenz> I'm constantly passing too many params
<vincenz> like 6-8
<vincenz> should I put them into tuples?
<vincenz> that way I don't have to push em on the stack
<Submarine> depends whether you keep them between several calls
<vincenz> well I have the mixins...
<vincenz> so yes
<vincenz> on the other hand it means the cost of a tuple creation
<vincenz> (and then when I use it, a tuple matching)
<Submarine> mixins?
<vincenz> nm that
* Submarine remembers some paper Mixin Modules
<vincenz> or what I could od is have the bottom class store the values
<vincenz> Submarine: mixins is something that's often heard of (lately) in OO-langs
<vincenz> in template syntax (C++)
<vincenz> template <class Super> class MyClass: public Super {};
<vincenz> allows you to stack functionality
<vincenz> in layer s
<vincenz> a very simplistic example (and not quite representative of it's power
<vincenz> template <class Super> class Double: public Super { int f(int x) {return 2 * Super::f(x);};
<Submarine> so it just means enrichment of features?
<vincenz> template <class Super> class Double: public Square { int f(int x) {int y = Super::f(x); return y*y;};
<vincenz> yes
<vincenz> We use it for our DMMlibrary
<Submarine> yeah I now remember the Mixin' Modules paper
<vincenz> to easily build custom DMMs
<vincenz> we have many basic building blocks
<Submarine> it was basically late binding of some module features and mixing of feature sets
<vincenz> yup
<vincenz> well I use it now in ocaml
<vincenz> but for classes
<vincenz> let me show you
<vincenz> module Mixin = functor(Super : StateMachine.Mixin) -> struct
<vincenz> class machine f_map = object
<vincenz> inherit Super.machine f_map as super
<vincenz> the I override the methods I want
<vincenz> make them call super#themselves
<vincenz> and then do the extra functionality
<vincenz> but most of my methods have 5-8 params
<vincenz> so lots of stack
<vincenz> and apparently each mixin gets it's crap from the stack and pushes them on the stack again (just checked the assembleur)
<vincenz> maybe the bottom class (that does the dispatching) should store all the values in the class?
<vincenz> and the methods can then access them as needed?
<vincenz> oh well
<vincenz> hmm
<vincenz> would you mind giving me a hand with something?
<vincenz> I have this new datastructure I made
<vincenz> but it's not very efficient
<vincenz> and I'm going to make a new mixin which will call it quite often
<Submarine> and apparently each mixin gets it's crap from the stack and pushes them on the stack again <-- sounds normal
<Submarine> if it's the same vector of parameters, just pass it around as a tuple
<Submarine> however, don't do:
<Submarine> let f (a, b, c) = g (a, b, c)
<Submarine> I suspect this builds another tuple
<vincenz> well I'd do
<vincenz> f (a,b,c) as t =
<vincenz> g t
<vincenz> ...
<Submarine> do let f ((a, b, c) as v1) = g v1
<vincenz> yup
<vincenz> though I might do it later
<vincenz> I'm not the only one building mixins
<vincenz> I have this Master's student working for me
<vincenz> and he already has enough trouble grasping ocaml
<vincenz> but if I paste my trie code could you give me some pointerS?
<Submarine> uuuh
<Submarine> why not
* vincenz uses his own paste-site as he added ocaml syntax coloring
<mrvn_> vincenz: Why f (a,b,c) as t and not just f t?
<vincenz> mrvn_: good point :)
<vincenz> before you comment, let me comment
<vincenz> the trie is meant to keep structure apparent
<vincenz> basically it makes
<vincenz> key list to value
<vincenz> so I can have (for int's as keys)
<mrvn_> or f ((_, _, _) as t)
<vincenz> nm, basically so map and iter when they iterate
<mrvn_> of (t : ('a, 'b, 'c) trie)
<vincenz> iterate over children
<vincenz> 1
<vincenz> 12
<vincenz> 1 2 3
<vincenz> 1 3
<vincenz> 2
<Submarine> vincenz, ok, I see you wish to build a trie where instead of association lists, you have maps, correct?
<vincenz> assocation lists?
<vincenz> you mean hashtbl?
<Submarine> well, the simplest tries are with assoc lists :-)
<vincenz> what's an assoc list?
<Submarine> it's a list of pairs
<vincenz> oh
<vincenz> well I could work with assoclists
<Submarine> you know, the most stupid way to implement a map
<vincenz> but that doesn't show sturcutres
<vincenz> structure
<Submarine> and it's very inefficienyt
<vincenz> yes
<vincenz> my trie is too
<Submarine> so what's the issue?
<vincenz> it's most likely very innefficient
<vincenz> I mean for keylength = l
<vincenz> I have l Map-lookups
<mrvn_> vincenz: Why do you use "key list" instead of "key"?
<vincenz> mrvn_: cause I want structure
<vincenz> aka
<vincenz> 1 -> a
<vincenz> 1 2 -> b
<vincenz> 1 3 -> c
<vincenz> 2 -> d
<vincenz> then when I map/iter over it
<vincenz> I want the order a b c d
<vincenz> cause 1 2 and 1 2 are inside 1
<vincenz> (1 2)
<vincenz> ack ..3
<Submarine> sounds easy
<vincenz> a simple hashtbl key list -> value won't do that as you lose the structure in herent
* Submarine still does not see the problem
<vincenz> Submarine: if I use a hashtbl I lose ordering
<vincenz> let's say:
<mrvn_> vincenz: So you have to specify the full path to include a value in the tree?
<Submarine> so? don't use it
<vincenz> mrvn_: yes
<Submarine> mrvn_, that's the point of a Trie!
<vincenz> Submarine: no I know but with what I have right now it's most likely very slow
<mrvn_> Submarine: not at all
<Submarine> have you tested it
<vincenz> I have one mixin that uses it
<vincenz> it takes about 60% of the total runtime
<vincenz> maybe even more
<vincenz> we're talking 2k seconds
<Submarine> do you need to instantiate on many orders?
<vincenz> orders?
<vincenz> you mean depth?
<Submarine> ordered sets
<vincenz> oh
<vincenz> right now only on one type Id.t (which is basically an int)
<Submarine> mrvn_, we're discussing TRIES not just maps implemented by balanced trees
<vincenz> but I'm planning to add a second
<Submarine> vincenz, try specializing the darn thing
<vincenz> (Memory.Type.t, Memory.Address.t)
<Submarine> where's that defunctorizer when one needs it?
<vincenz> where Type.t = Read | Write
<vincenz> and Address.t = int64
<mrvn_> They key list should be inherent in the value to be saved.
<Submarine> write your own compare
<vincenz> I do
<mrvn_> And the actual values should be stored only in the leafes of the tree.
<mrvn_> Thats what a Trie (by Fredkin) is.
<vincenz> mrvn_: yes thats a normal trie
<vincenz> but you lose the ordering
<vincenz> aka structure
<Submarine> to me, a trie is a map from A* to B
<mrvn_> The odering of the values orders the trie.
<vincenz> if you map or iter over it you will not do depthfirst
Cyber_Syrnyk has joined #ocaml
<vincenz> Submarine: well I have the extra requirement that I want depthfirst traersal
<mrvn_> vincenz: Depends if you do left to right or right to left order.
Cyber_Syrnyk has left #ocaml []
<mrvn_> Depth or width order
<vincenz> I want depth, most tries map the keylist directly to a value
<Submarine> vincenz, have you profiled the darn thing?
<vincenz> Submarine: on it's own, no
<vincenz> or wait, yes
<Submarine> in your program
<mrvn_> vincenz: What you have looks more like a B-Tree than a trie.
<vincenz> hmm
<vincenz> it might also be slow cause the mixin using the trie is quite complex
<vincenz> I think that's it
<mrvn_> Hmm, what is a "Trie of (None, Empty)" supposed to be?
<vincenz> mrvn_: one that's fully empty
<vincenz> aka no binding for []
<vincenz> and no binding for anything longer than []
<mrvn_> That would be "Trie of TrieMap.empty"
<vincenz> oh
<vincenz> nem
<vincenz> nm
<vincenz> my trie-lib won't let it
<vincenz> Trie of (None. Empty) will alway be made into an Empty
<Submarine> mrvn_, how do you mark the trie = singleton empty word?
<mrvn_> the what?
<Submarine> err
* vincenz goes about making his new trie-mixin
<Submarine> vincenz, there's something weird
<mrvn_> vincenz: The 'a option in the nodes is to store a value if the key list ends on this node, right?
<vincenz> mrvn_: yes
<Submarine> vincenz, you have to means to have the map containing { empty_word -> A }
<vincenz> Submarine: no
<vincenz> I do not allow empty_words
<Submarine> vincenz, I mean, your system cannot store the map containing only the association from an empty word
<Submarine> aaah
<vincenz> there's no point to it
<vincenz> at least not for what I'm using it
<vincenz> one instantiation I use it to track many different things by function-call-depth
<mrvn_> Submarine: (Some foo, TrieMap.empty)
<Submarine> mrvn_, right, but that's not how vincenz implements it
<vincenz> (I actually have a set of maps at each Some)
<vincenz> let me show
<Submarine> mrvn_, his implementation prohibits associating to the empty list
<Submarine> vincenz, in any case, you should profile before speculating
<mrvn_> let rec add l v t=
<mrvn_> match l, t with
<mrvn_> | [], _ -> t
<vincenz> this is the REALLY slow mixin
<Submarine> often, programs spend an awful lot of time in polymorphic compare
<mrvn_> That last line is wrong.
<Submarine> do you use poly compare yes or no?
<vincenz> Submarine: no
<vincenz> what's quite nasty is where I add and substract maps
<Submarine> you mean add and remove objects from maps?
<vincenz> nope
* Submarine is confused
<vincenz> for instanc
<vincenz> I map varid -> #accesses
<vincenz> now I have a previously stored map
<vincenz> and I want to subtract the #accesses from previously storedmap
<vincenz> so
<vincenz> current_map : (1, 10), (2, 20)
<vincenz> previous_map: (1,5) (3,10)
<vincenz> subtract
<mrvn_> vincenz: You should use a simpler tree tructure.
<vincenz> (1,5) (2,20)
<mrvn_> +s
<vincenz> what's killing me is the process_scope_final
<mrvn_> vincenz: You should replace "Empty" with "Leafe of 'a"
<Submarine> vincenz, you mean you have two maps representing functions f and g
<vincenz> mrvn_: why?
<vincenz> Submarine: let's denote a map as
<Submarine> and you want a map representing a function x -> H(f(x),g(x)) correct?
<vincenz> Submarine: yes
<vincenz> for all keys in D(f)
<Submarine> where H can be addition, subtraction
<Submarine> OK
<Submarine> what you want is Map2
<mrvn_> vincenz: Because you are wasting a ('a, Empty) TrieMap for it as it is.
<vincenz> Submarine: thnx
<mrvn_> vincenz: Or get rid of Empty altogether and use ('a, TrieMap.empty)
<vincenz> mrvn_: no
<vincenz> how do I represent
<vincenz> [1] -> 1
<vincenz> [1,2,3] -> 1
<vincenz> without [1,2] having a value
<mrvn_> The polymorphic variant is wasted and you have to check for it on evry key level.
<vincenz> Submarine: where do I find Map2?
<mrvn_> vincenz: [1, 2] -> None
<vincenz> o I donee 'a option
<vincenz> ack
<Submarine> vincenz, I'll have to ask my colleagues whether we can release it and under what license
<vincenz> so I do need 'a option
<mrvn_> vincenz: you have one. You don't need the Empty.
<vincenz> mrvn_: Empty is an optimization
<vincenz> I don't need to go further down
<mrvn_> vincenz: To get rid of the 'a option you would need a Key.NULL special key to map.
<vincenz> no I'll keep 'a option
<Submarine> vincenz, we have functions to apply H on the images
<mrvn_> vincenz: It adds a level of indirection to every node that you don't need.
<Submarine> vincenz, and if H(x,x)=x we have "short circuit" functions
<vincenz> Submarine: yes, I think the issue is that because I don't know the internals of Map
<mrvn_> vincenz: The Empty could cost you as much as half the time seraching the tree.
<vincenz> I have to find at each leaf of f
<vincenz> (find in g)
<vincenz> mrvn_: but if I don't have Empty I'll have to check whether the tree is empty anyways
<mrvn_> vincenz: it creates an indirection and another switch case.
<mrvn_> vincenz: reading and following a pointer can be quite expensive.
<vincenz> look at the add function
<vincenz> how would you combine [x], Empty and [x], Trie tr
<mrvn_> Empty == Trie TrieMap.empty
<vincenz> you think it's killing me?
<mrvn_> It is needless.
<vincenz> hmm
<mrvn_> Wastefull of ram 8and cache) too.
* vincenz tries it out
<mrvn_> The "Trie" variant dissapears if you remove the Empty.
<vincenz> I do have to keep it labeled
<mrvn_> type 'a t = ('a option * 'a t) TrieMap.t
<vincenz> nope
<vincenz> that's a recursive type
<mrvn_> hmm, you are right.
<mrvn_> You need "ocaml -rectypes" for it: # type 'a t = ('a option * 'a t) list;;
<mrvn_> type 'a t = ('a option * 'a t) list
<vincenz> I'll stick to
<vincenz> Trie ('a option * 'a t) list
<vincenz> that's allowable
kencausey has joined #ocaml
<mrvn_> Does it compile that into a variant type or does it optimize it out?
<vincenz> no idea
<vincenz> either way...
<vincenz> the remove function becomes more complex
<mrvn_> If it builds a variant you have gained nothing.
<vincenz> how can you tell?
<mrvn_> read the code or Obj.magic
<vincenz> the assembler shows you?
<mrvn_> If you can read it well enough.
<mrvn_> Building a simple tree and looking at it in gdb is probably easier.
<vincenz> and how would you able to tell then?
<vincenz> in c syntax
<vincenz> what's the difference?
<mrvn_> A variant is an int or an int + data.
<mrvn_> Empty would be 0, Trie would be 1 + TrieMap
<Submarine> vincenz, the difference is one block in the heap :-)
<Submarine> naaah
<Submarine> Empty would be coded as 1 in memory
<Submarine> rather, as the immediate integer 1
<mrvn_> Submarine: int(0). That would be tagged
<vincenz> fug it
<Submarine> Trie would be coded as an (even) pointer to a block beginning with a 1
<Submarine> and ending with a pointer to the root of a TrieMap or something like that
<mrvn_> Submarine: Does ocaml optimize the enum out for Empty | Trei of ...?
<Submarine> still, I think that your problems are not with such little "linear" optimizations
kencausey has left #ocaml []
<Submarine> mrvn: sorry?
<Submarine> I think you have an *algorithmic* problem, probably resulting from your implementation of + and - over map images
<mrvn_> Submarine: Would think the Trie wneds up as "Trie enum, pointer to TrieMap"
<Submarine> sorry
<mrvn_> s/wneds/ends/
<Submarine> you have type t = Empty | Trie of foobar
<Submarine> what's the question there?
<vincenz> Submarine: I think so too
<mrvn_> How is Trie represented in memory.
<vincenz> But now I have to use the trie differently
<vincenz> and I think I have a second algorithmic problem
<Submarine> mrvn: it will be one block with a tag and a foobar afterwards, afaik
<mrvn_> Submarine: Thats what I said
<Submarine> mrvn: I see you coming, you're resurrecting the question of the implementation of the option type!
<mrvn_> You said it would just be foobar
* vincenz expands his trie interface
<Submarine> Trie would be coded as an (even) pointer to a block beginning with a 1 and ending with a pointer to the root of a TrieMap or something like that
<vincenz> step one: apply f k map
<vincenz> I mean apply f kl trie
<vincenz> (basically update a single element with a func
<Submarine> Caml does not optimize the option type because it would be impossible to distinguish None and Option None
<Submarine> sorry, None and Some None
<Smerdyakov> In most SML compilers, that type t would be either 0 (or some other constant) to stand for Empty, or otherwise a pointer directly to a foobar to stand for Trie.
<Submarine> and here we have the same problem
<mrvn_> Submarine: If the compiler were superb it could optimize the 1 out. It can check if a Trie.t is an int or a pointer to differentiate the two cases. The 1 isn't needed.
<Smerdyakov> mrvn_, it doesn't need to be superb. It's pretty trivial. Perhaps an earlier OCaml design decision makes it hard, though.
<Submarine> but you still have to allocate a block, right?
<Submarine> your TreeMap is not necessarily a pointer, it can be a constant
<Smerdyakov> Submarine, are you talking to me?
<mrvn_> Submarine: sure, just a smaller one.
<Submarine> Smerdyakov, no
<Submarine> mrvn_, essentially, you're asking to allocate a block containing one word instead of a tagged block?
<mrvn_> Submarine: yeah, if it is not a pointer (like in Some None) it can't.
<Submarine> mrvn_, but a TreeMap.t is *not* a pointer in general
<Smerdyakov> mrvn_, that works fine in SML.
<Submarine> a TreeMap.t can itself be "empty" or "node"
<mrvn_> Submarine: too bad.
<Submarine> you cannot distinguish in your scheme Empty and Trie (Treemap.empty)
<mrvn_> Submarine: How about "type 'a t = Trie of foobar"; Does that end up as block with 0 and foobar pointer?
<Submarine> I suspect so, and I agree that in that case, the compiler could do a special-case optimization.
<Submarine> I suspect that Xavier hasn't done it.
<mrvn_> Any idea why the Trie variant is needed there?
<Submarine> there's very little gain in omitting the tag, mrvn_
<Submarine> essentially, all blocks in the heap are tagged
<Submarine> so the tag takes nil extra space
<mrvn_> # type t = t;;
<mrvn_> The type abbreviation t is cyclic
<mrvn_> # type t = T of t;;
<mrvn_> type t = T of t
<Submarine> Smerdyakov, I doubt there's any sensible way to solve the "option optimization issue" if you must distinguish None from Some (None)
<mrvn_> Why is the second any less cyclic?
<Submarine> mrvn_, use the rectypes options :-)
<vincenz> ok is this clear:
<vincenz> val apply: key list -> ('a option -> 'a option) -> 'a t -> 'a t
<vincenz> (** [apply x f m] applies a [f] to the associated value of [x]. If there
<vincenz> is no binding for [x] then it will add a binding in case [f] returns
<vincenz> Some 'a. If there is a binding for [x] and [f] returns None, then the
<vincenz> binding will be removed. *)
<vincenz> damn
* vincenz joins his lines into one
<vincenz> val apply: key list -> ('a option -> 'a option) -> 'a t -> 'a t
<vincenz> (** [apply x f m] applies a [f] to the associated value of [x]. If there is no binding for [x] then it will add a binding in case [f] returns Some 'a. If there is a binding for [x] and [f] returns None, then the binding will be removed. *)
<Submarine> mrvn_, this prohibition has no semantic or implementation basis, it's just that, in general, immediately recursive types are a programming error, afaik
<vincenz> val apply_all: key list -> ('a option -> 'a option) -> 'a t -> 'a t
<vincenz> (** Same as {!Trie.S.apply}, but the function is applied to the associated value of [x] as well as all parents (traversing up from [x] *)
<Submarine> and they complicate typing, also, afaik
<mrvn_> Submarine: type t = t list;; looks fine to me.
<mrvn_> Submarine: Is the T of ... needed so the type checker sees a constructor and can interfere the right type?
<Smerdyakov> Recursive types without explicit coercions lead to undecidable type inference, or something like that, if I recall.
<Submarine> of course, the obvious solution is that a datatype with a single unary constructor should be considered isomorphic to the argument of that constructor
<Submarine> I dont think this is what's done today.
Submarine has quit ["ChatZilla 0.8.31 [Mozilla rv:1.4.1/20031114]"]
<vincenz> hmm
<vincenz> blink blink
Submarine has joined #ocaml
vezenchio has joined #ocaml
* vincenz mutters
<vincenz> why doesn't Queue have a to_list?
kencausey has joined #ocaml
<kencausey> Newbie Q: let is_digit = function x -> (x >= 0) && (x <= 9);; is_digit - 1;; Get an error 'This expression has type int -> bool but is here used with type int'. Translation?
<pango> is_digit (-1)
<kencausey> Ah, so a precedence problem?
<pango> yes
<kencausey> Thanks
kencausey has left #ocaml []
<mrvn_> I hate that -<int literal> doesn't get recognised by the parser.
<mrvn_> It could enforce 1 - 1 and f -1.
CosmicRay has joined #ocaml
<vincenz> mrvn_: I think it's unavoidable
<vincenz> consider
<vincenz> f 2 - 2
<vincenz> should it be f (2) (-2)
<vincenz> or f (2-2)
<vincenz> or even
<vincenz> (f 2) - 2
<mrvn_> vincenz: A lonely - is the infix - operator. That is (f 2) - (2)
<vincenz> heh...
<vincenz> so you'd have to do
<vincenz> 2 - 2
<vincenz> instead of 2-2
<mrvn_> A - compined with a numerical char is a negativ int literal 'f 2 -2' -> f (2) (-2)
<mrvn_> vincenz: yes.
<vincenz> sounds like a hassle to me, more than doing (-2)
<mrvn_> Unless the parser recognises <something>- from <something> -
<vincenz> /me is about to see his memory blowup
* vincenz is about to see his memory blowup
<mrvn_> I find "2 - 2" good style.
<vincenz> that's subjective
<vincenz> I find spacing good style too, unless it's something painfulyl simple, in which case I like to keep it condensed
<vincenz> | Some y -> Some (y+1)
<vincenz> Too bad jocaml is discontinued :/
<vincenz> I think they should add it to the ocaml distro
<Nutssh> Be a maintainer of it.
<vincenz> I'm considering it
pango has quit ["Leaving"]
malte has joined #ocaml
<malte> howdy! i can't find what's wrong with my bubble sort (http://www.pastebin.com/116835), could anyone take a look?
pango has joined #ocaml
<mflux> malte, not thinking about the implementation itself, but let's say you call bubble [42] -> ([42] :: []) -> .. List.hd [] -> error
<malte> mflux, hm, that's obviously a problem... but why do i get "Exception: Failure "hd"." even on a list with several elements?
<mflux> xs is [] in that case
<mflux> and you're writing List.hd xs
<malte> yes, but shouldn't it work with, say, [1; 4; 2; 87; 6; 4; 1; 9]?
<malte> oh
<malte> it will get to [9] eventually i suppose :)
<mflux> I don't think it crashes right away, but after a bit of recursion
<mrvn_> malte: you do know that you can "match l with x::y::l -> ?
<mflux> he might actually want to use something like x::(x'::l as xs)
<mrvn_> malte: reload your paste.
<mrvn_> # let rec loop f l = let l2 = f l in if l = l2 then l else loop f l2;;
<mrvn_> # loop bubble [1; 4; 2; 87; 6; 4; 1; 9];;
<mrvn_> - : int list = [87; 9; 6; 4; 4; 2; 1; 1]
<mrvn_> malte: I hope you know that bubble sort is one of the worse sorting algorithms only beaten by bogo sort?
<async_> mrvn_: bogo sort is linear in quantum computers!
<mrvn_> async_: place the element ion ramdon order and test if the sorting criteria is fullfilled?
<mrvn_> random I mean
<mrvn_> I guess on quantum computers it says: Consider all possible permutations of the list and pick the one that is sorted?
<mrvn_> Sorting is O(1) on analog computers. Take spagetties each the length of one number and loosly hold them upright on a flat surface. :)
<async_> mrvn_: something like that... i was just reading up on bogosort right now
<mflux> it's O(1) in digital computers too.. if you have big enough precalc tables
<mrvn_> You still need to look at every element at least ones.
<mrvn_> once.
<Submarine> Holy cow!
<Submarine> I gained 23% of running time just by setting the minor heap size to 1 M words.
<Submarine> I'm not discussing GC time, but running time.
<Submarine> It's *enormous*.
<mrvn_> DOesn't that grow on its own over time?
<mrvn_> You might have avoided GC altogether with the large minor heap.
* mrvn_ likes merge-sort: http://www.pastebin.com/116849
<mrvn_> Converting to tail recursive form is left to the reader.
<Submarine> mrvn_, we're discussing programs taking 400 Mbytes of RAM and running for 2 hours
<Submarine> I suspect something like cache locality.
<Nutssh> Strange. I found a 20% speedup staying with 32kb minor heap compared to 256k.
<Nutssh> Err, 5%, there was 15% by altering the major GC slice rate. (But that is an artifact.)
<Nutssh> Pales to the 40% I got by rewriting a single function.. I *heart* profiler.
<Submarine> Nutssh, what's the size of your cache?
<Submarine> Does your program compute a *lot* but uses little long-term data?
<Nutssh> Athlon XP 256kb.
<Nutssh> No. Lot of long term data,
<Submarine> this is intriguing
<Nutssh> Err, Athlon XP 512kb.. I tried 64kb minor heap size for no gain compared to 32kb.
<Nutssh> I think I'm hitting misprediction by the GC --- Its slicing through oldspace too aggressively.
<Submarine> maybe the moral of this is that one should benchmark one's code with respect to various GC sizes
<Nutssh> Eh.. I found that usually its best off to run a profiler oprofile, which doesn't impact the program running much, and ocamlopt -p to get a calltree and runcount.
<Submarine> Nutssh, I use oprofile too.
<Nutssh> Its great, but I've found that gprof's calltree helps to understand oprofile's output.
<Nutssh> I also reported another bug. ocaml treats int array's contents as potentially containing pointers. So it scans the array for any relocations during a sweep and for pointers during a mark. That was about 8% when I had about 900mb worth in RAM. Finally got aroudn to sending in a remark.
<Nutssh> What do you do with ocaml?
<Submarine> Nutssh, this is not really a bug, OCaml's VM does not distinguish arrays of pointers and arrays of ints
<Submarine> Nutssh, www.astree.ens.fr
<malte> mrvn_, yeah, i was just trying to translate the lisp version found at http://dev.unix.se/Bubblesort :)
<Nutssh> I know its not a bug, but we know that all of the elements in an array are the same type, so an 'int array' can be tagged as an unscanned object. It wouldn't affect anything other than the GC.
<Submarine> Nutssh, it could be done indeed of the system knew the type of elements when creating the array
<Submarine> you'd need one function make_vect and one make_vect_unscanned
<malte> would this (http://www.pastebin.com/116859) be a good way to implement bubble sort btw? shouldn't that be tail recursive as well?
<Submarine> optimizing bubble sort, what an idea
<malte> i was just wondering :)
<Nutssh> Or have make_vect look at whether the initial object is an integer and set the tag.
<Nutssh> Submarine, interesting project.
<mellum> Nutssh: But not all entries might be integer
<Nutssh> How can that be true with an array?
<mellum> Nutssh: if you have type t = Foo | Bar of int, then Foo is an int and Bar not.
<mellum> But you can have t arrays.
<Nutssh> Then the array would be of pointers to t's.
<mellum> No, it isn't.
<TheDracle> ..
<Nutssh> Can you explain?
<mellum> If you put Foo at cell 0, then simply a 0 is written there. No need to put a pointer there.
<Nutssh> And if you put a Bar at cell 0, what is written there?
<mellum> A pointer to a two-word tagged box allocated on the heap.
<TheDracle> Nutssh: Does the compiler just produce a pointer to Null in that case?
<Nutssh> What if 'type t = Foo | Bar of int | Baz of int'?
<mellum> Then the same happens. One can distinguish Bar and Baz by the first word of the box.
<TheDracle> mellum: The compiler has to uniformly represent both of them. If one is a pointer, the other simply can't be a vlaue.
<mellum> TheDracle: Why not?
<mellum> All you can do with a "t" is pass it around and do pattern matching. And that works just fine.
<Nutssh> I can see how that optimization is possible, I'm a bit surprised if ocaml actually does that. I'd like confirmation.
<mellum> Just disassemble some test code.
<TheDracle> So, every access checks to tell if the element is a pointer or a value?
<TheDracle> Doesn't seem very 'optimal' to me.
<TheDracle> I understand doing so in garbage collection, but that is rarer than access.
<mellum> TheDracle: Some kind of checking has to be done in any case.
<TheDracle> Well, bounds checking, yes.
<Nutssh> If you're going to patternmatch on it, you have to check the tag. If you're just copying it, no check needed.
<mellum> TheDracle: Maybe I'm misunderstanding. What kind of code do you think produces spurious checks?
<TheDracle> Well if you iterate that array of t's, and match against a NULL value, and a value that is essentially a pointer to something.
<TheDracle> It has to discern between the two if it represents one as a value, and the other as a pointer.
<mellum> So? Otherwise, it still would have to discern between the two.
<mellum> It's even more efficient this way.
<TheDracle> Yes, but that's a single statement. Is it NULL? Is it this kind of value? is it that kind of value?
<Nutssh> mellum, thanks. I see how ocaml could work that way. ARRGGHH. This sucks. How often does one put a 0-argument sum-type constructor into an array?
<mellum> Nutssh: well, an array of lists doesn't seem that far-fetched
<Nutssh> Its also consistent with how sum types are designed into the rest of the system.
<TheDracle> mellum: Does it actually work that way?
<Nutssh> This applies if you had an array of []'s no box in your design, but a box in mine design, If its [...], you pay the box in both designs.
<TheDracle> If you have an array of type t, is it an array of some things being values, and some being pointers to values?
<mellum> TheDracle: I'm pretty sure it is.
kencausey has joined #ocaml
kencausey has left #ocaml []
budjet has joined #ocaml
<TheDracle> mellum: I definitely see your point in the fact that a comparison is required on matching and separating the data out anyways. I'm just wondering if such a check is made on array access. Like, let myVal = myAr.(0);;. If that element was null, when myVal was accessed it would have to check if its a pointer or a value every access. Maybe that is the case.
<TheDracle> Hm, I wonder if Xavier Leroy's collegues call him Dr. X.
<Nutssh> The idea is that a value of a type of a sum type 'type t = A | B | C | D of int | E of foo' is represented as the integers 0,1,2 for A,B,C, and pointers to boxed values with tags of 4, 5 for D,E.
<Nutssh> If you drop them into an array, that format is preserved. That means if I do a 'make_vect 23 A' or 'make_vect 23 0' there's no way for make_vect to distinguish between its output being a 't array' or a 'int array'.
<TheDracle> Nutssh: Yeah, I think I found a document in French about how this works.
<TheDracle> Too bad I don't know French :)
<Nutssh> Still doable, just a bit harder.
Godeke has quit ["Leaving"]
<TheDracle> Nutssh: THe compiler can distinguish right? Maybe not the runtime.
<Submarine> Nutssh, not exactly.
Godeke has joined #ocaml
<Submarine> TheDracle, a good document is "interfacing C with objective caml" in the manual
<TheDracle> Submarine: Yeah, I've interfaced C with Ocaml :)
<Submarine> if I remember well, zeroary constructors are represented by Int_val(0), Int_val(1),...
<TheDracle> Submarine: As far as I can tell I just pump the types through a conversion function.
<Submarine> and n-ary constructors are represented by blocks tagged with 0, 1, 2...
<TheDracle> Maybe I missed some things :P
<Submarine> so n-ary constructors are zeroaries are numbered completely independently
<Submarine> and, to answer your question, my impression is that everyone calls Xavier "Xavier"
<TheDracle> Hm.. No sense of humor ;)
<Submarine> when you set the size of the minor heap in caml, in "words", what does it mean on 64-bit archs?
<Submarine> 8-byte words?
<pango> probably
* Submarine sees unbelievable minor_heap -> CPU time curves
budjet has quit [Remote closed the connection]
<pango> is most objects are short lived, the more you wait before doing in minor collection, the lower the percentage of objects that will survive. So minor collection efficiency must increase
<pango> s/is/if/
Kevin_ has joined #ocaml
Heimdall has joined #ocaml
<Heimdall> Bonsoir
<Kevin_> hi
vezenchio has quit ["None of you understand. I'm not locked up in here with you. YOU are locked up in here with ME!"]
vezenchio has joined #ocaml
Godeke has quit ["Leaving"]
Godeke has joined #ocaml
Godeke has quit [Client Quit]
Godeke has joined #ocaml
Godeke has quit [Client Quit]
Godeke has joined #ocaml
pango has quit [Remote closed the connection]
Submarine has quit ["ChatZilla 0.8.31 [Mozilla rv:1.4.1/20031114]"]
async_ has quit [Read error: 110 (Connection timed out)]
CosmicRay has quit ["Client exiting"]
Heimdall has quit ["Leaving"]
mlh has joined #ocaml
<vincenz> re
<vincenz> any new findings on cache/minor heap?
<Nutssh> No, but I don't obsess over it. Larger wins are usually elsewhere, and few programs that I run have a runtime high enough to be worth the experimentation.
* vincenz nods
<vincenz> what do you do for research?
<Nutssh> Security. Last program was analyzing about 130 million network RTT times. This one is doing a probabilistic model on social graphs.
pango has joined #ocaml
<vincenz> rtt
<vincenz> ?
<Nutssh> round trip time.
<Nutssh> TTYL.
<vincenz> bye
Kevin_ has quit ["Quit"]
segphault has joined #ocaml
<segphault> I've been trying (unsuccessfully) to generate anonymous functions with camlp4 quotations... something along the lines of: <:expr< fun $e1$ -> $e1$ * 2 >> but I havent been able to get it to compile. I'm assuming I have to specify some particular type for the anti-quotation that I use to fill in the arguments, but I dont know which one or how it should look.... anybody have any hints for me?
<vincenz> segphault: could you paste your code on http://rafb.net/paste ?
<segphault> sure. its really a very trivial experiment: http://rafb.net/paste/results/qBLxhG40.html
<segphault> anybody have any suggestions?
ianxek has quit [Remote closed the connection]
<vincenz> no idea, never used campl4 :/
<segphault> its hard to learn. Its documented extensively, but not clearly
<segphault> its extremely powerful and the potential is enormous, but there are a really aggravating details that I just cant figure out.
<segphault> *are a few
<vincenz> segphault: I think maybe I know what it is
<vincenz> you want {expr} to become
<vincenz> what do you want to do actually?
<segphault> that particular experiment, if it had worked, would have created an ocaml extension that made the compiler convert: { x } into: fun x -> x * 2
<vincenz> I think the problem is fun
<vincenz> besides...you're passing an expression
<vincenz> you can't have
<vincenz> fun expr -> ...
<vincenz> what if you do {x*4}
<vincenz> it should be LIDENT
<segphault> I figured it was a type issue of some sort
<vincenz> the compiler output is really awful
<segphault> hm. I'm getting a different compiler error now