rwmjones 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!)
ofaurax has joined #ocaml
seafood_ has quit []
Tetsuo has quit ["Leaving"]
ofaurax has quit [Client Quit]
evn_ has joined #ocaml
evn_ has quit [Remote closed the connection]
<mbishop> I know I did this before, but how do I read a line from a file one after the other? I tried a while loop to check for a delimiter, print the string and then call input_line again, but it complains and just prints the first string over and over
<mbishop> pretty sure I did this with refs once...can't seem to remember
hkBst has quit ["Konversation terminated!"]
mfp_ has joined #ocaml
<jlouis_> mbishop: code?
mfp has quit [Read error: 110 (Connection timed out)]
thermoplyae has quit ["daddy's in space"]
catch22 has joined #ocaml
|Catch22| has quit [Read error: 104 (Connection reset by peer)]
<jlouis_> mbishop: fortunes is not a function but a value
<jlouis_> so it gets bound to the single line
<jlouis_> you must make it into a function from unit so you can keep on invoking it
<jlouis_> hope that helps
<mbishop> Yeah, I tried adding (), and then it just reads the entire file, and the while loop never breaks
<jlouis_> So you read 2 lines in each loop iteration. Is that what you want?
<jlouis_> ehm, 3
<jlouis_> can't read
<mbishop> Hmm, no heh
<jlouis_> every time you call fortunes (), you read another line
<jlouis_> so you better call fortunes () and bind it to something via let l = fortune () in ... and then use l
<jlouis_> alternatively define let loop l = .... with a recursive call to loop (fortunes ()) to handle the next line. You start it up with loop (fortunes ()) as well
<mbishop> Yeah, I added a let cur_fortune = fortunes () in ... but now it just prints the first line over and over and then gets an EOF
<jlouis_> You don't code for a living, do you?
<jlouis_> or are you just forgetting the semantics of OCaml completely?
<jlouis_> (Mind you, I haven't coded in OCaml for ages, so I tend to forget them as well)
postalchris has quit [Connection timed out]
<mbishop> I don't code much ocaml, but yes I don't know the semantics very well, most likely
<mbishop> although I am feeling totally off today :/
<mbishop> Like I said earlier, pretty sure I've done this before
<mbishop> I think I better stop and do this tomorrow, heh
AxleLonghorn has joined #ocaml
seafood_ has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
thermoplyae has joined #ocaml
jlouis_ has quit [Remote closed the connection]
jlouis has joined #ocaml
ben__ has joined #ocaml
jlouis_ has joined #ocaml
jlouis_ has quit [Client Quit]
thermoplyae is now known as Slave
Slave is now known as thermoplyae
jlouis has quit [Read error: 110 (Connection timed out)]
yminsky has quit [Read error: 104 (Connection reset by peer)]
yminsky has joined #ocaml
pango has quit [Excess Flood]
pango has joined #ocaml
middayc_ has quit []
thermoplyae has quit ["daddy's in space"]
goalieca has joined #ocaml
postalchris has joined #ocaml
postalchris has quit [Client Quit]
catch22 has quit [Read error: 104 (Connection reset by peer)]
AxleLonghorn has left #ocaml []
stugy has quit [Remote closed the connection]
pizaa has joined #ocaml
<pizaa> how do i raise an exception inside of a function and then use a try/with in my main module to catch the function?
musically_ut has joined #ocaml
ttamttam has joined #ocaml
<thelema> pizaa: have your main module call that function within the try/with block.
<pizaa> thelema: i'm not sure how to catch the right exception?
<pizaa> so inside my function, i have a raise (Invalid_argument "invalid"), how would my main module catch that raise?
<thelema> try foo () with Exception_name (exception, parameters) -> fix things
<thelema> try foo with Invalid_argument str -> print_string str
<thelema> btw, invalid_arg "invalid" will do that raise slightly easier.
<thelema> if you don't want to catch *any* Invalid_argument, you could do:
<thelema> try foo () with Invalid_argument "invalid" -> handler
<pizaa> i don't think i'm doing it right... http://rafb.net/p/1Gz5i185.html
<thelema> try foo () with Invalid_argument "invalid" -> handler | Stack.Empty -> print_stackempty ()
<thelema> and your [Invalid_argument "d"] will only catch if you raise Invalid_argument "d", and no other strings.
<thelema> Maybe you want [with Invalid_argument _ -> print_stackempty ()]
<pizaa> i see
<pizaa> got it working now.. thanks
pizaa has quit ["Leaving."]
stugy has joined #ocaml
pizaa has joined #ocaml
<pizaa> how do i check if a stack is empty or not?
musicallyut has joined #ocaml
musically_ut has quit [Remote closed the connection]
ecc has quit [Remote closed the connection]
ecc has joined #ocaml
musically_ut has joined #ocaml
musically has joined #ocaml
musicallyut has quit [Remote closed the connection]
pango_ has joined #ocaml
musically_ut has quit [Remote closed the connection]
filp has joined #ocaml
musically has quit [Remote closed the connection]
Tetsuo has joined #ocaml
pizaa has quit [Read error: 110 (Connection timed out)]
prince has quit [Read error: 110 (Connection timed out)]
goalieca has quit [Remote closed the connection]
OChameau has joined #ocaml
goalieca has joined #ocaml
prince has joined #ocaml
seafood_ has quit []
goalieca has quit [Remote closed the connection]
goalieca has joined #ocaml
musically_ut has joined #ocaml
johnnowak has joined #ocaml
Linktim has joined #ocaml
goalieca has quit [Remote closed the connection]
middayc has joined #ocaml
prince has quit [SendQ exceeded]
prince has joined #ocaml
hkBst has joined #ocaml
musically_ut has quit [Remote closed the connection]
johnnowak has quit []
Yoric[DT] has joined #ocaml
m3ga has joined #ocaml
seafood_ has joined #ocaml
Mr_Awesome has quit [Read error: 110 (Connection timed out)]
Mr_Awesome has joined #ocaml
m3ga has quit [Client Quit]
musically_ut has joined #ocaml
filp has quit ["Bye"]
filp has joined #ocaml
Yoric[DT] has quit [Read error: 110 (Connection timed out)]
StoneNote has quit []
seafood_ has quit []
delamarche has joined #ocaml
WatersOfMemory has joined #ocaml
LordMetroid has joined #ocaml
love-pingoo has joined #ocaml
WatersOfMemory has quit [Read error: 104 (Connection reset by peer)]
gaja has quit ["Lost terminal"]
<fremo> 'lo, is there somthing like setjmp in OCaml ? do I have to do it by myself in C ?
<flux> what do you want to do?
<fremo> save a context
<flux> there is a module that provides callcc, I suppose it should do it
* fremo looks
<flux> but it works only for byte code
<fremo> too bad
AxleLonghorn has joined #ocaml
<flux> and then another that provides callcc with monads, which will obviously be reflected in types
<flux> otherwise I don't think it's possible
<flux> but if you want to do it in C, perhaps it's better to take a look at the byte code version and check if it could somehow be ported to native code
<fremo> yes
<flux> I think it will be complicated.
<fremo> is callcc in the manual ?
<flux> no
<flux> one alternative, which might not suit you, is to code in continuation passing style
<fremo> there is no module called callcc
<flux> it's not an official module; infact it's not of production quality either
<fremo> yes, I do it in a part of my code but...
<fremo> not an official module <- callcc ?
<flux> yes
<fremo> ok
<fremo> it seems it wont be trivial to do it using C's setjmp
<flux> so setjmp/longjmp is all you need to do?
<fremo> yes
<fremo> suspend the execution and continue it later
<flux> I have a feeling it will still be simpler than the full callcc implementations
<fremo> can be done with threads but I try to stay away of this...
<flux> who knows, maybe setjmp would work, except GC would need to be taken into consideration
<fremo> yes, I was thinking about that
<fremo> and I never wrote anything combining C and OCaml...
<fremo> juste read about it in the manual...
<flux> how would you use setjmp in the corresponding C program? without special trickery it's only suitable for exception handling -type operation..
<flux> so you can't longjmp to a "sister stack"
<flux> hm, s/stack/branch/
<fremo> "-type operation" ?
Linktim_ has joined #ocaml
|Catch22| has joined #ocaml
<flux> operatinons that are similar to exception handling
<flux> jumping up in the stack
<fremo> I want to be able tu write somthing like "throw (Suspend (get_context())"
<flux> why can't you use cps there?
TheLittlePrince has joined #ocaml
<flux> throw (Suspend (fun () -> carry_on ()))
<fremo> I could, but I have a lot of code to write that would use this. It is worth for me to find an easier solution...
<fremo> "It worths" ? hum, "$ exec man english"
<flux> sponsor inria to write solid call/cc support :-)
<fremo> heh, I can only sponsor them by singing encouraging things, I can ask an awesome friend to do it, singing and dancing under their windows :)
<fremo> (my bank disabled my credit card last week and I work by myself...)
<flux> songs about how great call/cc would be.. finally it'll end up in their dreams, and they can't help themselves not writing it
<flux> (hm, that last part of the sentence doesn't quite sound right: "but write it" perhaps? not much better..)
<fremo> I may have guessed what you mean ;)
<fremo> "Your real duty is to save your dream" -- Modigliani
<fremo> "Your real duty is to save your dream" -- Modigliani
<fremo> oups
Linktim has quit [Read error: 110 (Connection timed out)]
bongy has joined #ocaml
dwmw2_gone is now known as dwmw2_AVF
Linktim- has joined #ocaml
<ben__> Is there a shortcut for getting operators as functions? I.e. shorthand for "fun a, b -> a && b" similar to the shorthand Haskell has?
<ben__> Hmm, I should've just tried the Haskell way in Ocmal. ;)
Linktim_ has quit [Read error: 110 (Connection timed out)]
musicallyut has joined #ocaml
<munga> ben__ : let (>>=) f l = List.map f l;; (fun a -> a + 1) >>= [1;2;3];;
<ben__> munga, I meant the "(&&)" in (for instance) "List.map2 (&&) [true, false] [true, true]"
filp has quit ["Bye"]
ben__ is now known as ziph
<munga> like : let (oo) = fun (a,b) (c,d) -> a && b || c && d;; List.map2 (oo) [true, false] [true, true] ;; otherwise I don't get you ...
Linktim_ has joined #ocaml
musically has joined #ocaml
musically_ut has quit [Remote closed the connection]
ttamttam has left #ocaml []
<neale> ooh I just had a neat idea
<letrec> Wow, do tell us :)
Linktim- has quit [Read error: 110 (Connection timed out)]
Linktim- has joined #ocaml
<letrec> Btw, the relational operators works for all (?) types except functions. But assume I'm implementing a type like Int32, but unsigned. I'll have the < I guess, but what will be the behaviour?
Linktim_ has quit [Read error: 110 (Connection timed out)]
<flux> you would need to write the type's guts in C to define custom comparison
<flux> otherwise it works, well, as expected
<flux> there isn't an unsigned type in ocaml
musicallyut has quit [Remote closed the connection]
<flux> so all comparisons would be signed..
<flux> hm, apparently otags is not yet upgraded to 3.10.x?
<petchema> if you implement it in C, you'll have to extend this code. If you implement it in pure OCaml, you'll get "some total order" over your type (that may not match what you expected, but that's another story), depending on the structural representation of your type
jlouis has joined #ocaml
delamarche has quit []
mfp_ has quit [Read error: 104 (Connection reset by peer)]
Linktim_ has joined #ocaml
mfp_ has joined #ocaml
mfp_ is now known as mfp
jlouis_ has joined #ocaml
gim has quit [Read error: 104 (Connection reset by peer)]
<letrec> petchema: but can redefine the < for my new type in pure ocaml?
<petchema> no
<petchema> it's a C hack
<petchema> OCaml doesn't feature ad-hoc polymorphism
Linktim- has quit [Read error: 110 (Connection timed out)]
<letrec> Ok, thx. Then I'll define new operators and not use < anymore.
<thelema> you can write a comparison function for your new type in pure ocaml. you can't use the name <
<petchema> if you want to write really generic code, you need to use functors (see Map and Set implementations for example)
<ziph> Is there a preferred unit test framework for Ocaml? (Or does everyone just use Coq? ;)
Linktim_ has quit [Read error: 110 (Connection timed out)]
delamarche has joined #ocaml
<neale> I use OUnit.
<neale> it gets the job done.
<flux> thelema, you can use the name again, but it could be confusing :-). let ( < ) a b = Random.bool ()..
<neale> I use strace a lot too.
<neale> oh and this:
<neale> let debug msg a = prerr_endline msg; a
<delamarche> yeah OUnit isn't too bad. Sometimes I wish it was more verbose, but it works well.
gim has joined #ocaml
jlouis has quit [Read error: 110 (Connection timed out)]
<ziph> OUnit it is, ta.
RobertFischer has joined #ocaml
<hcarty> ziph: TestSimple is, as its name suggests, very simple to use
<neale> OUnit isn't what I'd call complex.
<ziph> I shouldn't be put off by the word "Perl" in the TestSimple documentation? ;) ;) ;)
<RobertFischer> I've been a bit annoyed with the bookkeeping with OUnit.
<RobertFischer> So I'm looking for a good alternative.
* RobertFischer has no patience for bookkeeping, wiring, or other configuration mojo.
pango_ has quit [Remote closed the connection]
<neale> let mytest = "My test" >::: [ "test 1" >:: (fun () -> do_stuff); "test 2" >:: (fun () -> do_more_stuff)]; let _ = run_test_tt_main (TestList [mytest])
<neale> tada, unit test.
<neale> RobertFischer: what bookkeeping?
<ziph> The book-keeping that prevents it from being: "let test1 = do_stuff"? :)
<hcarty> TestSimple has the horrendously complicated syntax of # is 1 1 "Check if 1 = 1";;
<hcarty> Or # ok (true) "Is true really true?"
bongy has quit ["Leaving"]
mfp_ has joined #ocaml
<hcarty> Not as flexible as OUnit, but it works well for its limited domain
<letrec> petchema: At the moment, my virual machine takes all the different numeric operators (except equality) and objects (<, add, sub, and, land, ..., zero) from a different module a module so I can change it (like go from 32bits to 64bits number). Would I get more than that with a functor?
mfp has quit [Read error: 110 (Connection timed out)]
<letrec> s/(a different module) a module/$1/
<RobertFischer> neale: Exactly like ziph said -- why do I have to write a test, write a method name for the test in a string, and then put it all of that into a suite later?
ulfdoz has quit [Read error: 110 (Connection timed out)]
pango_ has joined #ocaml
<RobertFischer> neale: I should be able to write functions or scripts that are simply each a test.
evn_ has joined #ocaml
<ziph> RobertFischer: fire up campl4? ;)
<RobertFischer> neale: Although, the best way I can come up with to do that involves a p4 hack.
<RobertFischer> ziph: GMTA.
evn_ has left #ocaml []
<neale> RobertFischer: you don't have to name them
<neale> if you don't want to
<neale> I find it handy for figuring out where the problem occurred
<neale> I guess 3.10 has tracebacks though
<RobertFischer> Yeah, if I want useful error messages, I have to name them.
<RobertFischer> Which means I'm repeating the name three seperate times in the file.
<RobertFischer> (Or some close variation on the name)
<ziph> Being able to feed sets of arguments to a test fixture and have it print the arguments on failure is nice, too.
Morphous_ has joined #ocaml
ramkrsna has joined #ocaml
<RobertFischer> What we need is an OTestNG.
<RobertFischer> :)
<RobertFischer> neale: Are you the maintainer of OUnit?
|Catch22| has quit [Read error: 113 (No route to host)]
|Catch22| has joined #ocaml
coucou747 has joined #ocaml
<delamarche> I mean, the problem that ocaml has with unit testing is the same problem that any language that lacks introspection will have... it's hard to write programs that build your test suites for you
<delamarche> but it's no big deal
<delamarche> like, look at cppunit in boost
<delamarche> i've had projects where my suite construction took up more room than the tests :)
<delamarche> exaggerating slightly, of course
<RobertFischer> That's why God and Inria invented P4.
<ziph> The work-arounds are macros and parsers. CppTest is zero book-keeping for C++ for instance.
<RobertFischer> Which is the route I would expect something that's not-quite-application code to go.
<delamarche> RobertFischer: That's a very valid point. I haven't touched p4 yet though :)
<RobertFischer> But we don't have that for Ocaml yet.
mfp_ is now known as mfp
<RobertFischer> I'll add it to my todo list.
<RobertFischer> :)
<delamarche> you know now that you mention it
<delamarche> "add auto suite construction to OUnit" is in my tickler
<delamarche> i just looked
<delamarche> it put it there 2 years ago
<delamarche> hahaha
<RobertFischer> delamarche: Well, I'm taking some time off work coming up to work on open source.
<delamarche> Good man. I took time off work to start my own web startup thingie :)
Morphous has quit [Read error: 110 (Connection timed out)]
<delamarche> your motives are much more pure.
<delamarche> heh
<neale> RobertFischer: no I'm not associated with OUnit other than using it.
<RobertFischer> I don't think a p4 processor which let you do "test this_should_do_something = " wouldn't be too hard to write.
* RobertFischer counts his negatives in that sentence, and comes up with a bad answer.
<delamarche> hahahaha
<RobertFischer> Although it might be a more correct answer....
<RobertFischer> Anyway.
ulfdoz has joined #ocaml
<RobertFischer> I also plan on starting a couple of little web apps, but I'll probably just chuck them out on my server and see what's up.
<RobertFischer> If they take off, I might think about "monetizing" them.
<RobertFischer> What's your web app going to do?
<RobertFischer> Or is it super-de-dooper-top-seekrit?
<RobertFischer> And are you using Ocaml, or some other web framework?
authentic has joined #ocaml
<thelema> RobertFischer: what about a test/end block, where all functions within either return true/false (indicating pass/fail) or return 'a (and have syntax saying what was expected)/ throw an exception (another pass/fail)
<neale> I think JUnit is a really good model guys
ttamttam has joined #ocaml
<neale> Why don't you just focus on using p4caml to make OUnit suck less
<neale> everybody knows how to use JUnit.
<RobertFischer> neale: The only thing valuable about JUnit which is preserved into OUnit is the names of the assertions.
<thelema> neale: actually, I'm more comfortable with the perl testing environment, which got mirrored into TestSimple, not Ounit
<RobertFischer> thelema: I'd have to experiment with that approach to see how hard it would be to build something like that in p4.
* neale shrugs
ttamttam has left #ocaml []
Illocution has quit ["ow stop kicking my head sheesh"]
Illocution has joined #ocaml
kotarak has joined #ocaml
postalchris has joined #ocaml
|Catch22| has quit []
ttamttam has joined #ocaml
ygrek has joined #ocaml
stugy has quit [Remote closed the connection]
marmottine has joined #ocaml
postalchris has quit [Read error: 110 (Connection timed out)]
<rwmjones> ouch
* rwmjones hates these types of bugs:
<rwmjones> val form_add_component :
<rwmjones> [> `Form ] component -> [> `Component ] component -> unit
<rwmjones> val form_add_components :
<rwmjones> [> `Form ] component -> [> `Component ] component list -> unit
<rwmjones> let form_add_component form co =
<rwmjones> if co.in_form then failwith "component can only be added to a single form";
<rwmjones> newtFormAddComponent form.co co.co;
<rwmjones> co.in_form <- true
<rwmjones> let form_add_components form components =
<rwmjones> List.iter (form_add_component form) components
<rwmjones> that all works, but ...
<rwmjones> if I try to add a mixture of types of components, I get:
<rwmjones> File "examples/04_form.ml", line 17, characters 33-35:
<rwmjones> This expression has type [ `Button | `Component ] Newt.component
<rwmjones> but is here used with type [ `Component | `Textbox ] Newt.component
<rwmjones> The second variant type does not allow tag(s) `Button
<rwmjones> it seems like the polymorphism of form_add_components collapses to the type of the first element of the list
<thelema> rwmjones: eta-expand your List.iter
<rwmjones> hmmm .... how?
<thelema> List.iter (fun c -> form_add_component form c) components
<rwmjones> ah
<rwmjones> so why did it work before I added the explicit signature?
<thelema> I can't guarantee that'll fix the problem - that's just my intuition about these things
<rwmjones> thelema, actually that didn't work
<thelema> :(
<rwmjones> if I remove the signature it does work
<rwmjones> yet the signature comes from ocamlc -i ...
<thelema> if you remove the signature on just form_add_components
OChameau has quit ["Leaving"]
<thelema> List.iter (fun (c: [> `Component] component) -> form_add_component form c) components
<thelema> or maybe a more explicit coercion is necessary...
<thelema> List.iter (fun c -> form_add_component form (c :> [> `Component] component)) components
<thelema> the problem is the type of (form_add_component form), and what I've been proposing tries to fix that type to what it should have.
<thelema> It seems that somehow a weak type is getting inferred (thus the insufficient polymorphism)
<thelema> usually eta expansion helps with the weak type problem.
dwmw2_AVF is now known as dwmw2_gone
ziph has quit []
Demitar has quit [Read error: 104 (Connection reset by peer)]
<thelema> rwmjones: found any solution?
<rwmjones> thelema, no ...
<rwmjones> ah
* rwmjones reads your response first
bluestorm has joined #ocaml
<rwmjones> hmm, no no idea
<rwmjones> I think I'm going to ask on caml-list
* thelema looks forward to a brilliant response
<mfp> rwmjones: is Newt.component abstract?
<rwmjones> mfp yes
<rwmjones> type 'a component
<rwmjones> in the public signature
<rwmjones> but the implementation is:
<rwmjones> type 'a component = {
<rwmjones> co : newtComponent;(* The component. *)
<rwmjones> mutable in_form : bool; (* If added to a form, this is set. *)
<rwmjones> }
<mfp> just a phantom type?
<mfp> try +'a then to make it covariant
<mfp> and then subtype the elems when you call form_add_component
<rwmjones> mfp where do I put the +?
<rwmjones> and how do I "subtype the elems"?
<mfp> in the signature where you have type 'a component, turning that into type +'a component
<mfp> (actually I'm not sure that's needed, but it won't hurt :P)
<rwmjones> ok, that change on its own doesn't fix it .. do I need to do the same in the impl?
<mfp> then for the components (c :> [`Button | `Box | `Whatever])
<mfp> that change allows you to do (x : [`Foo] component :> [`Foo | `Bar] component)
* thelema wonders if there's problems leaving the types open ([> `Component])
<rwmjones> I'm not really sure I understand
<mfp> since I don't have the code in front of me I don't know which side needs to be fixed, the component or the component list
<mfp> hmm
<mfp> can you reduce it to a minimal case?
* mfp doesn't really know what is being added to what and what for :P
<thelema> mfp: can you look a little back in your IRC history?
<mfp> thx, examples/04_form.ml should be useful
<rwmjones> I'll paste the relevant functions somewhere, just a sec
<thelema> rwmjones: could you try changing [>`Component] to [`Component] in form_add_component, and do (fun c -> form_add_component form (c :> [`Component] component))
<thelema> rwmjones: wait, why do you even have `Component component? don't you mean 'a component?
<thelema> do you have any components that aren't `Component?
<rwmjones> [>`Component] component ... the actual components have types like [`Button|`Component] component or [`Textbox|`Component] component
<thelema> rwmjones: why have the `Component tag? do any components lack that?
<rwmjones> no, that tag isn't strictly necessary I don't think
<rwmjones> every component is at least [> `Component]
<thelema> maybe the type of form_add_component should be [`Form] component -> 'a component -> unit
<rwmjones> I tried that one ...
postalchris has joined #ocaml
* mfp getting camlidl and stuff
<thelema> n/m, the types should stay open...
<thelema> maybe the type of form_add_component should be [> `Form] component -> 'a component -> unit
<rwmjones> yup, tried :-(
<thelema> tried with +'a?
<rwmjones> that's a syntax error
<thelema> in your type definition.
<thelema> type +'a component
<thelema> type +'a component = ...
<rwmjones> doesn't work :-(
<mfp> have you tried form_add_components form [(text :> [`Whatever | `Button | `Component] component); ...; (b2 :> [ ... ] component)] ?
<mfp> (of course, the proper way is let comp x = (x :> all_components component) with type all_components = [ `Button | `Thing | ... ])
<mfp> (form_add_components form [comp text; comp b1; comp b2])
* thelema looks at gobject in lablgtk2, and is surprised it's contravariant... -'a obj
<thelema> mfp: [all_components component]? don't you mean 'a component?
<mfp> well, actually "any_component" would be better
Demitar has joined #ocaml
<rwmjones> This expression cannot be coerced to type [ `Component ] Newt.component;
<mfp> type any_component = [ `Box | .... ]
<rwmjones> (text :> [`Component] component)
<rwmjones> fails with the error ^^
<mfp> nope, (text :> [`Box | `Text | `Component] component)
<thelema> rwmjones: could you get rid of the `Component tag and use 'a for [>`Component]?
<mfp> with all the possible constructors
<rwmjones> hmmm ... so I have to change all the calling code?
<rwmjones> this worked before when there was no explicit .mli file, but I just had a .ml file with all the functions having explicit types
<mfp> => if text is [ `Text | `Component ] component and b1, b2 [`Button | `Component] component, then :> [`Text | `Button | `Component] component
|Catch22| has joined #ocaml
<rwmjones> I've gotta go now, thanks everyone
middayc_ has joined #ocaml
<thelema> rwmjones: good luck
<mfp> we have something like http://rafb.net/p/3utvOX73.html
<thelema> mfp: are you sure about +'a? from the manual: a covariant parameter may only appear on the right side of a functional arrow (more precisely, follow the left branch of an even number of arrows), and a contravariant parameter only the left side (left branch of an odd number of arrows).
<mfp> ah well, it depends on what he does with the component
<mfp> the 'a is just used for the phantom type so it probably needs not be invariant
<thelema> yes, that line seems to only apply to functional types...
<thelema> I wonder if he wants contravariance, after all gobject uses contravariance for its major type
<mfp> but it is needed in the above example, in order to get (a :> [`A | `B] t) to work, where a is : [`A] t
<thelema> The variance indicated by the + and - annotations on parameters are required only for abstract types. For abbreviations, variant types or record types, the variance properties of the type constructor are inferred from its definition, and the variance annotations are only checked for conformance with the definition.
<thelema> this explains why things failed when he added an abstract type...
<mfp> if he only reads from the object it's covariant; if he writes to it, it's contravariant; if he does both, it has to be invariant
<thelema> and what he wants is to go [`A | `B] :> [`A], no?
<mfp> the other way around
<mfp> he's building a list of [`A | `B] t given [`A] t and [`B] t elements
<thelema> he has objects that have type [`Button | `Component], and he wants to apply a function that takes [> `Component] as argument.
<mfp> the problem is not with the function though, it's with the list
<RobertFischer> Then he needs to first filter out the items with the wrong type, doesn't i?
<RobertFischer> (he)?
<mfp> I think he just has to subtype them
<mfp> hmm
bongy has joined #ocaml
<mfp> I guess it depends on what the phantom type is meant to represent
middayc has quit [Read error: 110 (Connection timed out)]
<mfp> whether [`Foo | `Bar] component means "accepts `Foo & `Bar components" or "can be passed to things accepting `Foo & `Bar"
<mfp> the former needs +'a, the latter -'a, unless I'm too tired to think
<thelema> I think it means the latter.
<thelema> but I don't understand co/contra-variance at the moment. It's always seemed too simple when it gets explained to me.
Linktim- has joined #ocaml
lordmetroid_ has joined #ocaml
<thelema> RobertFischer: yes - he. no, he doesn't need to filter out items, he needs to make all the items in the list have the correct type.
<thelema> and in this case, the correct type is [> `Component] component
<RobertFischer> Well, sure.
<RobertFischer> But the problem was the typing of the list.
<RobertFischer> That's what I was getting at.
<ygrek> Can anybody confirm the fingerprint of forge.ocamlcore.org certificate?
LordMetroid has quit [Connection timed out]
<thelema> ygrek: SHA1 or MD5?
Linktim- has quit [Remote closed the connection]
delamarche_ has joined #ocaml
<thelema> ygrek: sha1 begins with 21:5a:10:a0:01:f6, md5 begins with 05:10:3a:a8:54:35
<ygrek> thelema, I guess it is md5 (for ssh)
<thelema> oh, sorry -- that's their https certificate.
<thelema> ygrek: 45:a9:59:2e:03:...
jlouis has joined #ocaml
<ygrek> thelema, thanks
<thelema> I admit, someone *could* be MITM-ing both our connections.
<RobertFischer> Uh.
<RobertFischer> How much do you care?
<RobertFischer> Unless you're using the same password for Forge as you use everywhere else.
<RobertFischer> In which case this is the least of your concerns.
<ygrek> sure :)
jmdc has joined #ocaml
love-pingoo has quit [brown.freenode.net irc.freenode.net]
ppsmimou has quit [brown.freenode.net irc.freenode.net]
l_a_m has quit [brown.freenode.net irc.freenode.net]
l_a_m has joined #ocaml
ttamttam has left #ocaml []
ppsmimou has joined #ocaml
Yoric[DT] has joined #ocaml
* thelema thinks rwmjones's problem gets solved by not introducing lists of components.
<thelema> and was created by making 'a component abstract.
love-pingoo has joined #ocaml
RobertFischer has quit ["I'm out of here. Check out my blog at http://enfranchisedmind.com/blog or my company website at http://smokejumperit.com"]
jmdc has left #ocaml []
netx has quit [Remote closed the connection]
jlouis_ has quit [Read error: 110 (Connection timed out)]
ramkrsna has quit [Remote closed the connection]
delamarche has quit [Success]
thermoplyae has joined #ocaml
<rwmjones> yes, quite probably by making the component abstract
<thelema> when you did that, the values couldn't be put in the list together.
<thelema> because their types differed.
<thelema> maybe you could do type component_impl;; type 'a component = component_impl;;
<thelema> hiding the implementation, but maybe allowing a list because they're all component_impl.
<thelema> that seems hackish, though...
<thelema> you could provide a coerce function, like lablgtk...
<thelema> rwmjones: do you have a git tree for ocaml-newt?
sgnb` has joined #ocaml
sgnb` is now known as sgnb
bongy has quit ["Leaving"]
StoneNote has joined #ocaml
oracle1 has joined #ocaml
<oracle1> hi
<oracle1> just discovered this in the syntax.. first time I needed it:
seafood_ has joined #ocaml
<oracle1> # (fun ((a,b) as p) -> p) (1,2);;
<oracle1>
<oracle1> how cool is that :)
<oracle1> it's obvious when you look at it from a pattern matching perspective, still unexpected to me
<thelema> oracle1: ocaml does give you really good pattern matching.
<thelema> it's very easy to deconstruct and bind nearly anything.
<oracle1> yep. i was just not expecting it there. but it's cool.
<thelema> of course if you're not planning on using a and b, (fun ((_,_) as p) -> p) (1,2)
<oracle1> no im using it for some tests, but then got to return i as a whole
<oracle1> well, its bit more complex
<thelema> sure.
<oracle1> (fun ((name,(lb,ub)) as p) -> ... tests on lb/ub, returning p)
<thelema> programming-style-wise, why have a function that returns its input?
<thelema> exceptions?
<oracle1> I'm mapping a list to another list, changing some of the entries depending on the lower and upper bounds on the elements
<thelema> ah, so sometimes you don't return the input. gotcha.
<oracle1> so sotimes i return p and sometimes (name,(f lb, f ub)) which is a new element
<oracle1> yep
<Illocution> n
marmottine has quit [Remote closed the connection]
<Illocution> whoops pardon me, interesting discussion
<oracle1> well here the as-clause is not really needed actually, it's just sweeter.
<oracle1> i think sometimes it's actually preventing some.. addtional pattern matchings or if's
<thelema> oracle1: what about (function (n,(lb,ub)) when test lb ub -> (n,(f lb, f ub)) | p -> p)?
<oracle1> to be honest, up until now I never looked at parameter pattern matching like that. except sometimes a fun (_,b) but that was it. So thelema yes that's an idea.
<oracle1> actually that's quite cool.
delamarche_ has quit []
<oracle1> not very readable though
<thelema> I wouldn't put it all on one line - I'd space it out so each case had its own line
<oracle1> I think I never came across that use in a library code or so I read.
<oracle1> in an argument of a e.g. a List. function
<thelema> List.* don't use when, they used an if statement inside the match case.
seafood_ has quit []
<thelema> the Arg module uses 'when' - look there for some more examples
<oracle1> yes. but not inside an anonymous function
<oracle1> i mean ..it's slightly different to match a variable and matching a function parameter .. at least from a naive C programmer view :)
jlouis_ has joined #ocaml
<oracle1> but yes, after all it's the same thing
<thelema> how big are your tests? Names are good for readability.
<oracle1> they are ugly. contain fold_left itself etc.
<thelema> So why do you need this function to be anonymous?
<oracle1> i dont. Its just that i commonly do it like that with library function arguments
<oracle1> to just creat it anonymously nicely indented
<thelema> my personal rule: if it doesn't fit on one line (or *maybe* two), it gets a name.
<oracle1> hm
<oracle1> ok it's not my rule. but maybe i can give it a try
<oracle1> could be more readable
<thelema> I made this rule after I ended up with 20-line List.fold_left invocations, with the List.fold_left 20 lines separated form the data it'll work on.
<oracle1> yes. that's true.
<oracle1> from a compiler/performance point of view it's exactly the same, isn't it ?
<thelema> yes.
<oracle1> k
jlouis has quit [Read error: 110 (Connection timed out)]
love-pingoo has quit ["Connection reset by pear"]
ita has joined #ocaml
<oracle1> ok, laters
<oracle1> thx for the discussion
oracle1 has quit ["leaving"]
bluestorm has quit ["Konversation terminated!"]
kotarak has quit [":qa!"]
ygrek has quit [Remote closed the connection]
ita has quit ["Hasta luego!"]