mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab OCaml 3.10.2 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
<hcarty> "didn't seem to go anywhere" is wrong
<orbitz> wrong in what way?
<hcarty> The thread did not clear up the reason for this feature for me. But that could be an allergy-induced haze speaking
<hcarty> s/speaking/acting/
mbishop has quit [Remote closed the connection]
mbishop has joined #ocaml
mfp has quit [Read error: 104 (Connection reset by peer)]
mbishop_ has joined #ocaml
<Ramzi> I'm getting an error that says This function is applied to too many arguments,
<Ramzi> but i'm pretty sure i've got the right number...
<orbitz> lay it on us
<orbitz> sure eTrans(trans) is right?
<Ramzi> val eTrans : ('a * 'b option * 'c) list -> ('a * 'c) list = <fun>
<orbitz> what is (trans)?
<Ramzi> transition list
<orbitz> why do you have parens around it?
<Ramzi> oh man
<Ramzi> thanks
mfp has joined #ocaml
mbishop has quit [Read error: 110 (Connection timed out)]
Kopophex has joined #ocaml
mbishop_ is now known as mbishop
<palomer> hmm
<palomer> is there something similar to haskell guards for ocaml?
<orbitz> 'when'?
<palomer> righto!
Kopophex has quit [Remote closed the connection]
RobertFischer has joined #ocaml
alexyk has joined #ocaml
coucou747 has quit ["bye ca veut dire tchao en anglais"]
Kopophex has joined #ocaml
<alexyk> at the top level of a compiled file, when I place a statement of type unit like printf, ocamlopt complains that the previous one is wrong as it tries to glue them together; how should I wrap lot-level statements like List.iter <some action on a list>?
<orbitz> example?
<Ramzi> Am I to understand correctly that you can define your own types in OCaml, some of which can be like, "This type can hold 1 of many types," and the other, "This type holds many types."
<Ramzi> That is, you can make types similiar to unions in C. A type that can hold only one value, but of many possibilities.
<Ramzi> And you can make types similiar to structs in C. A type that can hold many values.
<orbitz> you can have variants, which can be one of several possiblites
<orbitz> however tha ti snot lik ea union
<orbitz> yes
<orbitz> see variants for the former and records for the latter
<Ramzi> Could you illustrate to me a new type, say, ID which holds a string to represent a name and an int to represent an age.
<orbitz> use a record for that
<Ramzi> Could you show me that form please?
<orbitz> no
<Ramzi> Oh, it's type ID = {name : string; age : int}
<orbitz> yup
<Ramzi> If I had done type ID = Name of String | Age of int, that would be a variant?
<orbitz> yes
<Ramzi> And it could only hold one thing, a string or an int, but not both
<Ramzi> Alright. Thank you.
<orbitz> Ramzi: it's really not a good idea to think of these things in terms of C equivalents
<orbitz> C doe snot have equivalents
<Ramzi> if I have a new type, let's say, type new = {a : int; b : int; c : int}
<Ramzi> how can i pattern match on it
<orbitz> same way you would anything ese...
<Ramzi> suppose i had a parameter called n, and i knew it was of type new
<Ramzi> i just do, match n with c -> ...
<Ramzi> or do i have to explicitly write, match n with {a;b;c} ...
<Ramzi> to use the c
<orbitz> you can just do n.c if you want teh c
<Ramzi> oh really?! dot notation!
<orbitz> did you read the section on records?
<Ramzi> yes, i don't see mention of the dot notation
thelema has joined #ocaml
<Ramzi> Yay!
<Ramzi> How've you been thelema?
<thelema> hi ramzi. I've been busy.
<thelema> nothing ocaml related, which is too bad. I've got lots that needs doing on this community ocaml / "batteries included" project.
<Ramzi> well keep up the good work mr. super cool
<thelema> How's the automata theory coming? Got it all figured out?
<orbitz> 2 The Rock movies on tonight, it mus tbe my lucky day
<Ramzi> i spose.
<Ramzi> Nice error message: This expression has type nfa but is here used with type nfa
<orbitz> is that the entire message?>
<Ramzi> yep
<orbitz> cool
<Ramzi> I think it's just the program I use.
<Ramzi> Sometimes it's buggy, but I just cp the same thing again and it works.
<thelema> Good night all.
RobertFischer has left #ocaml []
<Ramzi> goodnight
<Ramzi> This expression has type in_channel -> string -> int -> int -> int but is here used with type string
<Ramzi> if index = (String.length input) then states
<Ramzi> Is there anything wrong with the way I'm using String.length? That's what gets underlined
<orbitz> sure you don't want ==?
<Ramzi> i don't see why i need it. i'm just comparing two ints
<Ramzi> index is an int, and input is a string. String.length input should return an int.
<orbitz> the = is fine you are right, however you haven't provided enough contextual code to diagnose your error
<orbitz> you should pastebin the code + errors
<Ramzi> i think i got it
<orbitz> k
Ramzi has quit [Read error: 104 (Connection reset by peer)]
Ramzi has joined #ocaml
TheLittlePrince has joined #ocaml
alexyk has quit []
evn_ has joined #ocaml
alexyk has joined #ocaml
alexyk has quit [Client Quit]
alexyk has joined #ocaml
evn_ has quit []
alexyk has quit []
alexyk has joined #ocaml
<palomer> is it possible to bypass the ocaml type system?
<palomer> I'm compiling into ocaml and this is necessary
l_a_m has joined #ocaml
RobertFischer has joined #ocaml
RobertFischer has left #ocaml []
robozni_ has joined #ocaml
robozni has quit [Read error: 113 (No route to host)]
<mattam> palomer: Obj.magic is here for this purpose.
bluestorm has joined #ocaml
coucou747 has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
alexyk_ has joined #ocaml
hkBst has joined #ocaml
alexyk__ has joined #ocaml
hkBst has quit [Client Quit]
hkBst has joined #ocaml
hkBst has quit [Read error: 104 (Connection reset by peer)]
TheLittlePrince has quit [Client Quit]
hkBst has joined #ocaml
alexyk___ has joined #ocaml
schme has joined #ocaml
alexyk____ has joined #ocaml
alexyk_____ has joined #ocaml
alexyk has quit [Read error: 110 (Connection timed out)]
alexyk_ has quit [Read error: 110 (Connection timed out)]
alexyk__ has quit [Read error: 110 (Connection timed out)]
coucou747 has quit [Read error: 113 (No route to host)]
alexyk___ has quit [Read error: 110 (Connection timed out)]
Linktim has joined #ocaml
alexyk____ has quit [Read error: 110 (Connection timed out)]
Kopophex has quit [Read error: 110 (Connection timed out)]
Kopophex has joined #ocaml
alexyk has joined #ocaml
Kopophex has quit [Read error: 110 (Connection timed out)]
alexyk_____ has quit [Read error: 110 (Connection timed out)]
alexyk has quit []
alexyk has joined #ocaml
alexyk has quit [Read error: 110 (Connection timed out)]
<pango_> palomer: the point of "case sensitivity" is to allow to visually distinguish values from variables in patterns
<pango_> <Ramzi> Nice error message: This expression has type nfa but is here used with type nfa <= http://caml.inria.fr/pub/old_caml_site/ocaml/problems.html
<pango_> Ramzi: most of it happens in the REPL, when you (re)define types with the same name
<bluestorm> REPL ?
<pango_> aka toplevel (Read-Eval-Print Loop)
LordMetroid has joined #ocaml
ikaros has joined #ocaml
Linktim has quit [Remote closed the connection]
Linktim has joined #ocaml
vfdfdfvd has joined #ocaml
lordmetroid_ has joined #ocaml
lordmetroid_ has quit [Read error: 104 (Connection reset by peer)]
LordMetroid has quit [Connection timed out]
Snark_ has joined #ocaml
Morphous_ has joined #ocaml
coucou747 has joined #ocaml
Morphous has quit [Read error: 110 (Connection timed out)]
jlouis has quit [Read error: 110 (Connection timed out)]
coucou747 has quit [Read error: 113 (No route to host)]
hsuh has joined #ocaml
hsuh has left #ocaml []
vfdfdfvd has quit [Remote closed the connection]
hkBst has quit ["Konversation terminated!"]
coucou747 has joined #ocaml
vbmithr has joined #ocaml
<bluestorm> !summon Yoric
coucou747 has quit ["bye ca veut dire tchao en anglais"]
joat has joined #ocaml
Linktim has quit [Read error: 104 (Connection reset by peer)]
Linktim has joined #ocaml
mikeX_ has joined #ocaml
mikeX has quit [Read error: 101 (Network is unreachable)]
ikaros has quit [Read error: 104 (Connection reset by peer)]
ikaros has joined #ocaml
schme has quit [Read error: 104 (Connection reset by peer)]
schme has joined #ocaml
RobertFischer has joined #ocaml
pango__ has joined #ocaml
pango__ is now known as pango
pango_ has quit [Remote closed the connection]
dlomsak has joined #ocaml
Kopophex has joined #ocaml
robozni_ is now known as robozni
ktne has joined #ocaml
<ktne> hello
<ktne> anyone here familiar with garbage collection?
<bluestorm> dont ask to ask
<ktne> i mean with GC implementations
<ktne> because i've come with what i think is a great idea
<ktne> but i might just reinvent the wheel :)
<orbitz> just lay it out there
<ktne> my idea is how to randomly walk the objects without having to proceed from the root
<ktne> which might be very useful for parallel GC
<orbitz> and freeing used objects
<ktne> well not necesarly freeing them
<ktne> i was thinking about marking them
<ktne> or do whatever you want next
<ktne> the idea is to make sure that all objects on a page are of same size
<ktne> then you can just walk into the page by iterating
<ktne> if you allocate using a sort of stack
<ktne> you just have to keep several page heads
<ktne> for each size range
<ktne> of course there are many possible sizes, so you could allocate multplies of 4bytes for example, which would reduce the number of simultaenously open pages
<ktne> so was this used before?
* orbitz dunno
mfp has quit [Remote closed the connection]
<ktne> you can have several threads that walk the graph object, each one starting at random positions except one that starts at the top
<Smerdyakov> ktne, and what makes you think this would be useful?
LordMetroid has joined #ocaml
<ktne> Smerdyakov it allows you to scale linearly the walking part of GC using threads
<Smerdyakov> ktne, but doesn't it also not collect garbage?
<ktne> for example if you walk only from the root and you have one very long linked list, you can only walk it one at a time
<ktne> but with this method you can jump anywhere in the object graph
<Smerdyakov> Yeah, and you might jump to an unreachable object.
<ktne> yes
<ktne> you mark the objects with a thread ID
<ktne> when two threads meet they join
<Smerdyakov> Common patterns of functional programming have most objects unreachable at any given point.
<ktne> hmm
<ktne> well but you still have one thread doing the regular way
<ktne> so you don't lose except cache faults and swapping
<Smerdyakov> You lose by wasting threads on useless work, for the most part.
<ktne> yes but the world is stopped anyway
<Smerdyakov> Most random choices of starting points will be of unreachable objects.
mfp has joined #ocaml
<Smerdyakov> Most parallel collectors don't stop the world.
<ktne> hmm
<ktne> how do they walk the graph?
<Smerdyakov> It's very, very complicated.
<ktne> is a linked list a pathological case of parallel collectors?
<Smerdyakov> Read a few PhD dissertations to find the answer. :)
<ktne> because this method doesn't have a such pathological case
<Smerdyakov> Maybe so, but I imagine it's no problem if you add in generational collection.
<ktne> i assume you have to copy the reachable objects, right?
<Smerdyakov> No.
<Smerdyakov> Generational GC avoids copying long-lived objects on most scans.
schme has quit [Connection timed out]
<ktne> i see
<ktne> well this was very specific for the walking part :)
<ktne> not a whole GC
<ktne> i mean, it removes a limitation
<Smerdyakov> You should study existing parallel GC algorithms before asserting that you've come up with an improvement.
<orbitz> especially such a trivial one
schme has joined #ocaml
<ktne> hmm
dlomsak has quit [Remote closed the connection]
<kig> how do i remove every fourth character from a string?
<kig> s/(...)./\1/g
<Smerdyakov> kig, either you are very new to programming period, or you should instead be asking more basic questions about strings in OCaml.
<Smerdyakov> Or your question is about library functions.
<kig> or i want to know how to remove every fourth character from a string
<Smerdyakov> If you don't know how to implement this without library functions, though, then you're in trouble.
<Smerdyakov> Do you know how to implement this without using library functions besides string length?
<thelema> kig: step 1: make an empty string 3/4 the length of the original...
<thelema> kig: then put the characters you want from the original into the new string.
<Smerdyakov> thelema, I think it's counterproductive for you to be saying this.
<Smerdyakov> thelema, he either already knows it, in which case it's just noise; or he doesn't, and he needs an introductory programming book, not an impromptu IRC lecture.
<thelema> I expect the actuality fits between your two extremes - he knows how to do it, but has become too used to library functions that he doesn't know how to get started doing it on his own.
<kig> ok, i'll implement it in a c extension
<thelema> I just try to put him in the right frame of mind.
<thelema> kig: implement it in ocaml.
<orbitz> haha
<kig> no
<orbitz> is he joking?
<kig> faster in c
<thelema> kig: implement it in ocaml.
<orbitz> i think he is joking
<orbitz> or very ignorant
<orbitz> i hope the former
<thelema> orbitz: s/very ignorant/still learning/
<Smerdyakov> thelema, his approach to asking and accepting answers shows ignorance, independently of how far he is with learning OCaml.
<orbitz> thelema: i dunno, to reply "I'll do it in a C extension" is beyond still learning
<RobertFischer> Smerdyakov: Where do you come off being so judgmental on all this stuff? If someone asks a question, and someone answers it, what's the skin off your back?
<RobertFischer> Smerdyakov: Are you just really down on anyone without a Ph.D. being anywhere near Ocaml or something?
yziquel has quit [Read error: 110 (Connection timed out)]
<thelema> orbitz: it shows me an imbalance of familiarity - he knows how to manipulate raw strings in C, so wants to do it the way he knows.
<thelema> Smerdyakov: learning follows well from public displays of ignorance.
<orbitz> kig: a C extension will most likely not give you any usful speed improvement
<kig> it gets me a coding speed improvement, already done
<orbitz> kig: and will be much more trouble than it' worth
<orbitz> why are you even writing somehign in ocaml then if you are simply going to implement every non-hard function in c?
<thelema> kig: I still recommend you implement it in ocaml, so that you become more familiar with programming in ocaml - you should be able to do a pretty straightforward translation of your C code.
<Smerdyakov> RobertFischer, folks need to learn to ask questions well.
<Smerdyakov> RobertFischer, it's just polite.
<orbitz> kig doesn't seem very interested in learning ocaml
schme has quit [Remote closed the connection]
schme has joined #ocaml
<RobertFischer> Obviously not.
lordmetroid_ has joined #ocaml
|Catch22| has joined #ocaml
LordMetroid has quit [Connection timed out]
<bluestorm> did you know about #use "topfind" in the toplevel ? i discovered it recently and i'm still smiling
<bluestorm> (it provides findlib integration in the toplevel)
<mfp> echo '#use "topfind";;' >> ~/.ocamlinit did it so long ago that I began to think of #require "foo" and #camlp4o as native to ocaml
l_a_m has quit [Remote closed the connection]
<bluestorm> mfp: :p
coucou747 has joined #ocaml
<kig> Pcre.replace ~rex:(Pcre.regexp "(...).") ~templ:"$1" "123456789";; - : string = "1235679"
<kig> which is very simple and easy to find out, all you need to do is find pcre-ocaml and read its sources
<Smerdyakov> kig, I asked if you were asking about libraries, and you didn't respond.
joat has left #ocaml []
<Smerdyakov> kig, if someone is trying to help you in good faith by asking questions, it's just polite to explain why you think the questions are unreasonable, if that's why you're not responding.
<Smerdyakov> kig, and I knew about that Pcre business and could have pointed you right to it, if you weren't being so rude as to ignore me.
<pango> kig: since you were about to code it in C, does performance really matter in this case? I wonder how using a regexp library compares (speed wise) with a more "hand made" solution...
<kig> it didn't really matter, i just needed it to turn rgba images into rgb images to test libjpeg
<pango> yes, I figured out it's for rgb data
<pango> but sometimes speed matter for those things, it depends on use
* kig benchmarks the different versions for the heck of it
r0bby has quit [Connection timed out]
Snark_ has quit ["Ex-Chat"]
^authentic has joined #ocaml
RobertFischer has quit ["Taking off -- check out http://smokejumperit.com and http://enfranchisedmind.com/blog/"]
<palomer> hello world!
<thelema> hi palomer
<orbitz> print_endline "Hello palomer"
<palomer> how would you fudge inheritance with records?
<palomer> actually, scratch that
<bluestorm> palomer: objects ? :-'
<thelema> palomer: delegation
<orbitz> i'd probably just use an object:)
<kig> pango: [threeoffour] 10 times needed 71.581 ms, [pcre] 10 times needed 2774.437 ms, [c] 10 times needed 27.184 ms
<kig> (1MB)
<thelema> kig: String.unsafe_get?
<pango> not that bad, for a first try ;)
<orbitz> wha tis te implemetn of threeofour?
<pango> orbitz: see my above, http://codepad.org/t0vgF0D9
authentic has quit [Read error: 110 (Connection timed out)]
<pango> s/my/my message/
^authentic is now known as authentic
coucou747 has quit ["bye ca veut dire tchao en anglais"]
<thelema> you might get some gain by using String.unsafe_blit
<orbitz> one might ask how important the performance of said function really is in the long run
<pango> orbitz: it was already answered
<orbitz> ok
r0bby has joined #ocaml
<bluestorm> i'm trying to create a bundle of camlp4 extensions that would be part of the OSR distribution effort
<bluestorm> the idea is to get as much extensions as possible first, and then to create a sublist of "default extensions" that would get more attention
<bluestorm> for now i only have five : pa_memo, pa_oo, pa_openin, pa_tryfinally and pa_for
<bluestorm> do you have any other suggestions ?
<orbitz> what is the openin everyone talks about?
<bluestorm> yes it is
<orbitz> autoamtically close?
<bluestorm> (there a lot more camlp4 extensions out there but the difficulty is to find the camlp4>=3.10 ones, or to port the others)
<bluestorm> what do you mean by "automatically close" ?
<flux> orbitz, it opens modules to a scope
<orbitz> waht does the openin extension do?
<orbitz> oh ok
<bluestorm> open <module> in <expression>
<orbitz> what is the for extension?
<flux> it's a shame that tuareg doesn't support it :)
<bluestorm> orbitz: an extension for moderately-python-like iteration on data structures
<bluestorm> for each i in List ['a'; 'b'; 'c'] do print_char i done
<bluestorm> i found it in Yoric's comprehension package, and it's an adaptation of the camlp4 foreach tutorial ( http://www.ocaml-tutorial.org/camlp4_3.10/foreach_tutorial )
<hcarty> bluestorm: Your pa_holes.ml extension may be worth including
<bluestorm> hm, concerning the pa_holes extensions
<bluestorm> it's been a subject of concern lately
<orbitz> what does it do?
<bluestorm> as i'm still not sure what (\ foo _ _ ) should do
<bluestorm> (fun x -> foo x x) or (fun x y -> foo x y) ?
<bluestorm> orbitz: simple lambda abstraction, using (\ ... _ ... )
<flux> if the scheme CUT was to be modeled, it would be the latter
<hcarty> bluestorm: I would think the second
<flux> one option is to outright refuse to compile it
<flux> if you have two anonymous bindings (hmm?), maybe you can write a function too
<bluestorm> ?
<bluestorm> when writing it i choosed the first because it is harder to emulate with point-free style, and the second raise positional issues
<bluestorm> but i actually i too tend to see the second as more natural
<orbitz> is ther ean ocaml operator for haskells .?
<bluestorm> there isn't, but you can declare one
<bluestorm> my personal choice is |<
<flux> btw, wouldn't this be the same: \(\(foo _)_)? I have hard time thinking that through :)
<flux> I've used @.
<bluestorm> (then i can have >| in the other direction)
<bluestorm> flux: i've tried to currify holes, but it seems it doesn't work
<bluestorm> hm
<bluestorm> this one is correct actually
<flux> bluestorm, so what does come out of that expr?
<bluestorm> i must have failed to currify (+)
<bluestorm> hm
<bluestorm> let me ask camlp4o :]
<flux> (\ _ + 4) didn't work?-o
<hcarty> Regarding pa_private - this list post seems to suggest a good syntax mapping, but I don't know how easy or difficult it would be to implement
<bluestorm> Camlp4: Uncaught exception: DynLoader.Error ("./pa_holes.cmo", "interface mismatch on Camlp4")
<bluestorm> heh :p
<flux> hcarty, cool, finally ocaml's error messages can compete with c++ (and maybe haskell when certain extensions have been used?)
<bluestorm> flux:
<bluestorm> fun _hole_ -> (fun hole -> foo hole) _hole_
<bluestorm> seems ok
<bluestorm> hmm
<bluestorm> isn't actually
<flux> yeah, it reverses the arguments
<bluestorm> worse
<flux> and it only "works" for that case
<bluestorm> _hole_ get binded on hole when applying the inner lamba abstraction
<flux> if you have anything more complicated, it becomes difficult to write
<flux> ah, right
<bluestorm> so it looks like (foo) :p
<flux> in any case: tricky
<bluestorm> convolutive holes :-'
<flux> actually obvious once you think about it ;) (..after you know it..)
<bluestorm> anyway, as holes are not exactly intended for brain-scratching and complex applications, this is not really a problem
<bluestorm> but i still am not sure about the multi-_ choice
<flux> hcarty, ah, my msg must've appeared strange, as I was actually looking at this: http://nleyten.com/2008/04/24/oh-the-humanity.aspx
<bluestorm> i even thought of enabling both behaviors through different keywords, but this is a bad idea imho
<hcarty> flux: Yes, I was just about to ask :-)
<hcarty> If Ciml (http://friggeri.net/blog/2008/02/26/ciml-c-in-ocaml) developed to handle more advanced types then it may be worth including
<bluestorm> another thing i've been looking at are the libraries including syntax extensions, such as Yoric's comprehension package, deriving, bitmatch, json_static..
<bluestorm> but most of them would be more pertinent in the "library" side of the OSR as their syntax sugar is library-specific
<bluestorm> and i prefer to wait for Extlib improvement before including demanding extensions such as comprehension
<bluestorm> hcarty: interesting
<bluestorm> ah
<bluestorm> another question : from the http://martin.jambon.free.fr/p4ck.list.html list, wich one would you like to see ported to camlp4>=3.10 first ?
<bluestorm> (pa_bounds is ruled out as this feature is not necessary anymore since 3.10)
<hcarty> pa_infix maybe
<hcarty> Particularly if associativity could be set per-operator. I don't know how reasonable that would be.
vbmithr has quit ["leaving"]
<thelema> bluestorm: as to (\ foo _ _), I'd lean (fun x y -> foo x y), but it might be nice to allow (\ foo _x _x) to name the argument, and allow its use in multiple places.
<bluestorm> hmm
<bluestorm> the problem with _x is that it's a legal ocaml identifier
<bluestorm> (_1 is as well)
<thelema> and if someone uses _x inside (\ ... ), they get what they deserve.
<bluestorm> :D
<thelema> maybe _1, _2 would be nicer.
<thelema> although claiming all two-character identifiers starting with _ wouldn't pose too much a restriction on users.
<flux> _1 would be something that would refer to the first argument etc?
<flux> I think it would be much more clear than _x etc, for which the order would be somewhat arbitrary
<bluestorm> _1 or _0 ?
<flux> _1 imo
<thelema> _1
<bluestorm> i'm a little dissatisfied with the idea of disabling legal identifiers, but on the other hand the machinery to enable _ is quite heavy too, and with _1 i could get rid of it
<thelema> bluestorm: discriminate between legal and useful. _1 falls in only one category.
<bluestorm> other camlp4 extensions could generate such identifiers
<flux> however, such identifiers would only be used inside (\ .. )
<flux> which should be very short anyway
<flux> I suppose it could be annoying
<flux> but in general identifiers beginning with _ would be only used in generated code anyway, no? (well, not always)
<flux> and if they are generated, they should be more difficult to clash ;)
<bluestorm> let's try _1 for a while
ktne has quit []
vbmithr has joined #ocaml
vbmithr has quit [Read error: 131 (Connection reset by peer)]
<thelema> hmmm, map all the _ to _1, _2, _3 (skipping any that are already listed)
<bluestorm> thelema: you think i should still enable _ inside (\ ... ) ?
<thelema> yes, as an alias for the next unused _n
<thelema> (\ fun _ _) ==> (\ fun _1 _2)
<flux> who wants to read (\f _1 _ (_3 + _) _4)?-)
<bluestorm> hmm
<bluestorm> i could process exclusively : _n or else _
<thelema> flux: who wants to read (fun a b c d e -> f a b (c + e) d)?
<flux> thelema, well, I didn't think it would even mean that
<bluestorm> that would allow people using _1 .. as identifiers to use a weakened version with _ only, without risk of conflict
<thelema> it means either that or (fun a b c d -> f a b (c + d) d)
<flux> what would _ _2 mean, and _ _1 ?
<bluestorm> i suggest (fun hole -> hole _2)
<flux> I think it should be either a single _ or multiple ones with _1 _2 etc.
<thelema> _ _2 -> pretty clearly _1 _2
<thelema> _ _1 could be either _1 _1 or _2 _1
<thelema> we could judge it either way. Or we could forbid it.
<bluestorm> i'm thinking of considering _1 and _2 as legal identifier when a _ is present
<bluestorm> so that (\ let _1 = ... in _ _1) would translate to (fun hole -> let _1 = ... in hole _1)
<thelema> and there would be problems with (\ foo _9) - who wants a function that ignores its first 8 arguments?
<thelema> bluestorm: what about (\ foo _ _1)?
<thelema> I think we decide what's the 1) easiest semantics to explain and 2) least likely to surprise people.
<bluestorm> thelema: (\ foo _ _1) would be (fun hole -> foo hole _1)
<bluestorm> we could say : there are two possible syntax : one with only one _ allowed, and one without _ at all, using _1, ..., _9
<thelema> (fun hole -> (\foo hole _1))?
<bluestorm> ?
<bluestorm> (and (\ foo _9) seems ok, it's unlikely to do that but not impossible and certainly not meaningless)
<thelema> how about each _ gets mapped in order to _1 .. _9, ignoring any _n's
<thelema> i.e. the first _ = _1, second _ = _2, etc.
<thelema> then (\ foo _ _1) == (\ foo _1 _1)
<bluestorm> i'm not very happy with that
<thelema> can you explain why?
<bluestorm> looks like a beginner's failure in a lambda-calculus and variable substitution tutorials
<bluestorm> more explicitely, i think that identifiers we do not change should not be given a new meaning during the syntaxic transformation
<bluestorm> (\ foo _ _1) -> let __1 = _1 in (\ foo _1 __1) would be ok
<thelema> I don't follow you. Which identifier doesn't change but gets a new meaning? _ gets the new meaning?
<bluestorm> _1
<thelema> (\ foo _ _1) ==> (\ foo _1 _1) ==> (fun x -> foo x x)
<bluestorm> that's the idea
<thelema> that's ok, or not ok?
<bluestorm> i would like to get (fun x -> foo x _1)
<thelema> because _ != _1?
<bluestorm> yes
<thelema> It makes sense to me to define the base system in terms of _1 .. _9 as holes - positionally specified.
<bluestorm> this is ok
<thelema> and to have a syntactic shortcut where _ gets replaced by the _n where n is the next hole.
<thelema> _ shortcuts for _n for the next n.
<bluestorm> this rule is strange and unnatural
<bluestorm> i'm not sure what the "next" is : from left to right ?
<thelema> yes.
<bluestorm> is that useful ?
<thelema> if we have _n defined, and we want to define _ as something useful, what definition would you like? I like mine because it captures the original idea of (\ foo _ _) well, while giving an easy-to-compute meaning for (\ foo _ _1)
<kig> ocamlbrowser is great, btw
<bluestorm> thelema: actually i'd be happy to disable _ completely
<bluestorm> with _n it is not necessary anymore, and i could get rid of the AstFilter hack
<thelema> _n only? hmmm... a bit more heavyweight...
<bluestorm> (\ foo _1 ) is not so terrible
<bluestorm> (\ foo _ ) is nice but hackish
<bluestorm> hm
<thelema> if it makes the implementation much nicer...
<bluestorm> actually i excpect the _n handling to be longer than the _-related hack
<bluestorm> well, i'll try and see
RobertFischer has joined #ocaml
Kopophex has quit [Connection timed out]
Kopophex has joined #ocaml
gyziquel has joined #ocaml
gyziquel has quit [SendQ exceeded]
gyziquel has joined #ocaml
gyziquel has quit [Client Quit]
yziquel has joined #ocaml
<Ramzi> how can i see the value of a member of a record to use before the record is finished?
<Ramzi> for example, if I have type foo = {a : int ; b : int}
<thelema> Ramzi: use a let before you construct the record.
<Ramzi> I want to say, let bar = {a = 5; b = if a = 5 then 10 else 20} ;;
<Ramzi> but it'd say that a is unbound
<flux> let bar = let a = 5 in { a = a; if a = 5 then 10 else 20 }
<thelema> let a = 5 in let bar = { a = a; b = if a = 5 then 10 else 20}
jlouis has joined #ocaml
<Ramzi> i see
<Ramzi> thanks
Kopophex has quit [Read error: 110 (Connection timed out)]
Kopophex has joined #ocaml
<thelema> maybe you want something like this:
<thelema> let make_bar a = { a = a; b = if a = 5 then 10 else 20}
Linktim has quit [Remote closed the connection]
<Ramzi> what if I wanted to lets in, do I use and?
<Ramzi> let a = 5 and let b = 10 in let bar = ....
<thelema> you could.
<Ramzi> i like the way that reads now
<thelema> but you can't do let a = 5 and let b = if a = 5 then 10 else 20
<Ramzi> okay
<Ramzi> does it evaluate the lets in order?
<thelema> maybe.
<Ramzi> I have a function called next () which always returns 1 number higher than it did before.
<thelema> it evaluates the bit before the [in] before the bit after it.
alexyk has joined #ocaml
<Ramzi> So if I say, let a = next () and b = next () in bar..., I want a = 1 and b = 2, not the other way around
<thelema> then do let a = next () in let b = next () in bar...
<bluestorm> you can't guarantee the evaluation order with "and"
<thelema> (It might work with [and], but it's not guaranteed)
<olegfink> no, 'and' lets are performed 'simultaneously', which means undefined behaviour in your case
<bluestorm> imho you should not use "and" unless you want mutually recursive function definitions
<olegfink> <-- slow
<Ramzi> wow. let me compliment myself on the question, and you on the answers.
<bluestorm> Ramzi: if you want a nice syntax, use
<bluestorm> let a, b = foo, bar in
<bluestorm> (but evaluation order is still unspecified)
<thelema> bluestorm: I use 'and' for when I'm happy to let initialization take any order.
<bluestorm> thelema: i would be confused if i see a code using "and" for no apparent reason
<thelema> I guess that's just not your style.
<bluestorm> maybe :p
bluestorm has quit ["Konversation terminated!"]
<Ramzi> if i make a new type, say foo... how can i make other functions infer when something is a foo.
<Ramzi> type foo = int * char ;;
<Ramzi> let bar = (5, 'z') ;;
<Ramzi> that will say, val bar : int * char = (5, 7)
<Ramzi> How can I make it say, val bar: foo = (5,7)
<flux> let bar : foo = (5, 'z') would do it.
<Ramzi> if I have a function that takes a foo, could I call it simply like, someFunc (5,'z') or would that say...
<Ramzi> someFunc is expecting type foo but is here used with type int*char
<flux> those values would be of identical type
<qwr> Ramzi: what you try to do?
<flux> like: type a = int let v : a = 42 print_int v works
<Ramzi> qwr: i have a function that takes a new type, and i'm wondering if i can just call it with the "components" of the type, or if that will be a type error
<qwr> Ramzi: the type foo = int * char;; is just an alias, not a new type really
<flux> however, if have a signature for the function (modules have a signature), you can hide the structure of the type
<flux> then it becomes an abstract data type and it will not be compatible with int * char
<flux> I suppose it's slightly more advanced what you're doing now, though
<Ramzi> the same "type definition/specification" is used in both the signature and the structure of the module
<flux> module M : sig type t val create : unit -> t end = struct type t = (int * int) let create () = (4, 3) end
<flux> for external users it's just type t, and no further information can be extracted
<qwr> Ramzi: and components mean what? let f (a, b) = a + int_of_char b;; ?
<flux> but if you said .. sig type t = (int * int) .. the type would be just an alias
<flux> but, I'm off to bed, happy hacking ->
<Ramzi> yep, thanks guys
<Ramzi> qwr, don't worry about it. think i got it
<qwr> Ramzi: you can mostly think about ml typing as of duck typing
<qwr> Ramzi: that is checked at compile time ;)
<qwr> (though there are some exceptions with modules...)
ulfdoz is now known as mosterevilulf
<pango> thelema: "and" can introduce unexpected monomorphisation (because type inference is the done in "less steps"), so I don't think it's a good idea to use "and" needlessly... it could (will?) bite you someday
<Ramzi> so what's wrong with this code? http://codepad.org/nvodo4EA
<Ramzi> it seems i used my types correctly...
mosterevilulf is now known as ulfdoz
<pango> you're using let ... in ... at top level line 13, it can only be used to local bindings
<pango> will you use start and final only in atom ?
<Ramzi> yeah
<pango> then you could reverse the order of lines 11 and 12
RobertFischer has left #ocaml []
<Ramzi> oh man. thanks
<pango> other than that, some extra parenthesis (not much concern); you can write count := (!count) + 1 as incr count
<Ramzi> <Ramzi> let a = 5 and let b = 10 in let bar = ....
<Ramzi> why was i told that's okay?
<Ramzi> should it be, let bar = let a = 5 and let b = 10 in ...
<pango> and shorten atom definition with {start = start ; finals = [final]; transitions = [(start, if c= 'E' then None else Some c, final)]}
<pango> Ramzi: by definition what's after let ... in is local, so let a = 5 and let b = 10 in let bar = .... makes bar definition local to this expression
<Ramzi> I understand now. Thank you.
<pango> like 8 and 9 are strangely indented... I suppose it's copy and paste problem
<pango> it doesn't prevent the code from working, but it's nice to have a correctly indented source, it helps readability tremendously
<Ramzi> If I know that a function will always be passed a list with at least 2 elements.
<Ramzi> is there a way I can supress the "this pattern-matching is not exhaustive." warning?
<pango> pass the first two elements as separate arguments ;)
<Ramzi> that is, i want to match on (h1::(h2::t)) but I don't need to match on [] since I know it'll never happen
<hcarty> bluestorm wrote a camlp4 extension
alexyk has quit []
<pango> by the way :: is right associative, so you don't need those parents
<Ramzi> ok
alexyk has joined #ocaml
<pango> s/parents/parens/g
lordmetroid_ has quit [Client Quit]
LordMetroid has joined #ocaml
Kopophex has quit [Read error: 110 (Connection timed out)]
Kopophex has joined #ocaml
thelema has quit ["biab"]
thelema has joined #ocaml
alexyk has quit []
ikaros has quit ["segfault"]
LordMetroid has quit [Read error: 110 (Connection timed out)]
alexyk has joined #ocaml