adrien changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 4.00.1 http://bit.ly/UHeZyT | http://www.ocaml-lang.org | Public logs at http://tunes.org/~nef/logs/ocaml/
<wmeyer```> good habit for Haskell, but in ML I prefer to use signatures for the same purpose
lolcathost has joined #ocaml
<wmeyer```> dskippy: how do you find OCaml?
<wmeyer```> (out of curiosity; from the perspective of Haskell programmer)
<benmachine> dskippy: I actually started on OCaml from Haskell today as well
<benmachine> in the process of writing this http://www.haskell.org/haskellwiki/OCaml#Syntactic_dictionary
<dskippy> It's good and bad. There are some things I really get annoyed with. The syntax is ugly but it's not important. I dislike the lack of an integrated build manager, and the order-dependent definitions is annoying.
<dskippy> Missing Haskell's type classes for the ability to have actual polymorphism.
<benmachine> type class polymorphism is overrated imo :P
<wmeyer```> dskippy: for the package management I strongly advise to use OPAM or odb
<dskippy> But Ocaml's ability to have mutable state and objects is a big plus and it has all the manin things I need.
<dskippy> Type classes are amazing, imo
<benmachine> (mutable state is also overrated)
<dskippy> benmachine: I agree with you there.
<wmeyer```> dskippy: for lack of polymorphism, or rather generic programming, currently there is no cure, but you gain modules :-)
<dskippy> Right.
<benmachine> dskippy: type classes are kind of amazing but sometimes they allow people to forget how amazing ordinary data and functions are
<wmeyer```> as for the syntax, I actually prefer OCaml and I don't think it's uggly
<benmachine> and parametric polymorphism, which is the most amazing
<dskippy> benmachine: I find quite the contrary, actually. Type classes allow parametric polymorphism to actually do something.
<wmeyer```> the problem with type classes is that they are slightly lower level building blocks than modules (that's my personal impression though)
<wmeyer```> but I agree in many ways there are wonderful!
<wmeyer```> they*
<benmachine> dskippy: the difference between type classes and just having records of functions is kind of subtle
<wmeyer```> I've heard that we might have type classes someday :-)
<dskippy> benmachine: I disagree.
<benmachine> dskippy: what's so different between type classes and explicit dictionary passing?
<wmeyer```> benmachine: the same subtle difference as, objects ~ records ~ first class modules
<dskippy> benmachine: Are you confusing classes in an object oriented sense with type classes in Haskell?
<wmeyer```> benmachine: the biggest difference is that type classes are type classes so the dictionary is passed implicitly
<thizanne> that's again a syntactic problem
<wmeyer```> so it's not how it's implemented but rather how the type system works
<benmachine> dskippy: nope! but I'm saying that class Eq a where (==) :: a -> a -> Bool is a bit like data EqD a = EqD { eq :: a -> a -> Bool }
<thizanne> and for the order of definitions, actually the ability to write mutable programs needs it to be meaningful
<benmachine> wmeyer```: right. with implicit parameters you can even get that, sort of
<benmachine> thizanne: in Python the order of definitions is not relevant, but admittedly this is because Python has deeper things wrong with it :P
<benmachine> wmeyer```: I think the real differences are more along the lines of guaranteeing that the dictionary is globally unique for each type
<dskippy> benmachine: There's a non subtle difference there though.
<wmeyer```> dskippy: there will be always a discussion about type classes, and I like it :-)
<thizanne> benmachine: yes, in Python the construction of the language is rather fundamentally different than in ocaml
<thizanne> wow, i'm tired
<thizanne> and my english is too :D
<wmeyer```> I did some Haskell while ago and can't say I didn't enjoy them.
<dskippy> If I want to make some function that accepts something of class Eq and compares it then you want to have it accept your type, you need not change your type or make a new one.
<dskippy> You just need to implement Eq on your class.
<dskippy> Or I as a third party user of both your type and that function can implement the class on your type and pass it to the function.
<benmachine> dskippy: sure, but you could also just pass the function the Eq dictionary you want, converting Eq a => ... to EqD a -> ...
<dskippy> Rather than creating a new type and a wrapper function.
<wmeyer```> dskippy: in Haskell type classes are very important, Haskell lacks polymorphic equality operators (which is good) but it's nice to have it generic. Also with laziness the physical equality does not make any sense
<dskippy> Without type classes, I need to make a new type and a new function that converts to the new type, passes to the the function, and converts the new type back.
<benmachine> dskippy: think of sortBy and groupBy, and maybe you'll see what I mean
<benmachine> dskippy: you can use sortBy without implementing anything more than you'd have to implement to use sort, only the way you give it to the sorting algorithm changes
<dskippy> I see it but the author of the other function might not provide such a version that takes a compare function.
<wmeyer```> benmachine: Use functor application!
<benmachine> dskippy: right, but they /could/ do, and you could imagine a version of Haskell where everyone did that all the time, and hence there was "no need" for type classes
<wmeyer```> that's server the same purpose as type classes
<wmeyer```> even the usage is quite similar
<benmachine> I say no need in quotation marks because type classes aren't /quite/ like that, but they're actually pretty close
<benmachine> wmeyer```: functor application is modules parameterised over modules, right? I haven't learnt that far yet :P
<dskippy> benmachine: Sure I could. It's possible to do it using type classes or not. We're not arguing the same program is not possible to write in either of these languages.
<benmachine> dskippy: I'm arguing not only it's possible but it's not /that/ inconvenient, in particular it doesn't involve defining new types or using wrapper types or anything
<wmeyer```> thizanne: I'm tired too, somewhat today I saw a lot of OCamlers, some Clojurists, and Haskellers in the same table drinking beer :-)
<dskippy> benmachine: It does if the author of sort only provided sort.
<wmeyer```> actually I saw the biggest number of Camlrs since the OUD.
<benmachine> dskippy: but if you're trying to say "type classes are great" it doesn't seem convincing to just argue "type classes are useful if you want to use an API that uses type classes"
<dskippy> Sure I understand. But let's imagine something more complicated than sort.
<dskippy> minimax.
<wmeyer```> benmachine: Yes, so you implement your module with the values and types you need and pass it to the functor, which then can use these values and types and create another module.
<dskippy> Now I have to pass in a function to compare the game states as well as a function to get the next game states.
<dskippy> Instead of just passing in a game state.
<dskippy> Without type classes, you are passing in one function to perform every operation needed on your type.
<dskippy> With type classes you are passing in just the argument of that type.
<benmachine> dskippy: yeah, but the translation is really pretty direct. in fact, if you use the (little-known) ImplicitParams extension in conjuction with ConstraintKinds, you could make the functions look *extremely* similar
<benmachine> with the benefit that you can use different instances for the same type if you want, and the drawback that you don't get guaranteed uniqueness of instances
<dskippy> Yeah, again, I can't disagree it's possible. I just think it's a lot clearer.
<dskippy> minimax gamestate vs minmax gamestate getNextStates compareStates
<dskippy> And if the type has four important operations... meh, that's really annoying.
<dskippy> In Ocaml you'd resort to OOP in that case.
<wmeyer```> dskippy: no, I wouldn't do it.
<wmeyer```> :-)
<dskippy> You'd pass all four functions?
<wmeyer```> there are two patterns I use OOP in OCaml
<wmeyer```> use module with the four functions
<wmeyer```> and pass it to functor
<wmeyer```> almost the same as type classes!
<benmachine> dskippy: you can wrap the four functions in a single value, and then make a global variable which is that value with your "standard" implementations
<benmachine> dskippy: that effectively becomes your class instance, and you have only one extra parameter to pass around
<dskippy> Alright.
<wmeyer```> for OOP - pattern 1) Set of mutually recursive functions, like traversing AST, pretty printing, parsing as set of methods with the name of the recursive types.
<wmeyer```> pattern 2) GUI.
<dskippy> You'd pass around a value and then a structure of functions that operate on that value.
<wmeyer```> for 1) you then can customise each rule, by inhertiting
<wmeyer```> dskippy: It's a question, how dynamic you want it to be
<wmeyer```> if you know at the toplevel the four functions, and also don't need to change them then use functor
<wmeyer```> if you plan to change them but they don't call each other, use first class module or record or labeled function
<wmeyer```> if you want to change the behavior and they call each other mutually, use object
<wmeyer```> (or again record)
<wmeyer```> for most cases functors are more than enough!
<wmeyer```> in my experience first class modules are not very often useful, but they allow to do more funky stuff with the type system
<wmeyer```> with GADTs however this is lifted
emmanuelux has quit [Remote host closed the connection]
<benmachine> dskippy: I unrelatedly have a headache so I'm going to go to bed soon, however you may find the following interesting: http://lukepalmer.wordpress.com/2010/01/24/haskell-antipattern-existential-typeclass/
<benmachine> dskippy: that link is largely what I had in mind when I said that type classes can be a distraction from normal data
<wmeyer```> so in your case: http://paste.xinu.at/rNH/
mattrepl has quit [Quit: mattrepl]
<hongboz> dskippy: opam is worth a try
<wmeyer```> hongboz: I saw your message, let me know how it goes :-)
<wmeyer```> (the one about Camlp4)
hongboz` has joined #ocaml
ulfdoz has quit [Read error: Operation timed out]
ulfdoz has joined #ocaml
justdit has joined #ocaml
dskippy has quit [Ping timeout: 248 seconds]
eikke has quit [Ping timeout: 252 seconds]
destrius has joined #ocaml
destrius has quit [Quit: Leaving.]
mye has joined #ocaml
madroach has quit [Ping timeout: 244 seconds]
madroach has joined #ocaml
dskippy has joined #ocaml
lolcathost has quit [Ping timeout: 244 seconds]
dskippy has quit [Ping timeout: 264 seconds]
justdit has quit [Ping timeout: 252 seconds]
mattrepl has joined #ocaml
ousado has quit [Remote host closed the connection]
gnuvince has joined #ocaml
dwmw2_gone has quit [Ping timeout: 245 seconds]
gustav__ has quit [Remote host closed the connection]
gustav__ has joined #ocaml
justdit has joined #ocaml
mattrepl has quit [Quit: mattrepl]
<hongboz> wmeyer```: I just got a prototype working
paolooo has joined #ocaml
flux has quit [Ping timeout: 260 seconds]
paolooo has quit [Quit: Page closed]
flux has joined #ocaml
benmachine has left #ocaml []
mye_ has joined #ocaml
mye has quit [Ping timeout: 240 seconds]
mye_ is now known as mye
hongboz` has quit [Ping timeout: 248 seconds]
hongboz has quit [Ping timeout: 276 seconds]
Cyanure has joined #ocaml
jewel has joined #ocaml
ccasin has quit [Read error: Operation timed out]
ccasin has joined #ocaml
gustav__ has quit [Excess Flood]
gustav__ has joined #ocaml
jewel has quit [Ping timeout: 276 seconds]
justdit has quit [Ping timeout: 260 seconds]
pkrnj has quit [Quit: Textual IRC Client: www.textualapp.com]
answer_42 has joined #ocaml
Yoric1 has joined #ocaml
justdit has joined #ocaml
Cyanure has quit [Remote host closed the connection]
BiDOrD has joined #ocaml
BiDOrD_ has quit [Ping timeout: 250 seconds]
paolooo has joined #ocaml
Snark_ has joined #ocaml
Cyanure has joined #ocaml
cdidd has joined #ocaml
chambart has joined #ocaml
Kakadu has joined #ocaml
larhat has quit [Quit: Leaving.]
hkBst has joined #ocaml
ocp has joined #ocaml
ontologiae has joined #ocaml
paolooo has quit [Ping timeout: 245 seconds]
rixed has joined #ocaml
ontologiae has quit [Ping timeout: 260 seconds]
myx has quit [Ping timeout: 276 seconds]
djcoin has joined #ocaml
thomasga has joined #ocaml
mika1 has joined #ocaml
fusillia has joined #ocaml
sivoais has quit [Remote host closed the connection]
cago has joined #ocaml
cdidd has quit [Ping timeout: 244 seconds]
chambart has quit [Ping timeout: 246 seconds]
bru` has joined #ocaml
cdidd has joined #ocaml
<matthewt> hello, i'm trying to get my environment working correctly, i'm running ocaml 3.12.1 in windows and i get a syntax error on every piece of code i try to execute. this one is from the wiki page http://pastie.org/5515005 any idea what's happening?
<matthewt> disregard that, forgot to put ;;
mika1 has quit [Quit: Leaving.]
mika1 has joined #ocaml
bru` has quit [Ping timeout: 240 seconds]
ontologiae has joined #ocaml
dwmw2_gone has joined #ocaml
Yoric1 has quit [Remote host closed the connection]
<orbitz> matthewt: try simpler: let x = 5;;
<matthewt> that was it, thanks
<matthewt> could someone explain how this is meant to be read [u: 'a -> ('a -> 'a) -> int -> 'a]
<thizanne> it's a list of one element named u whose type is 'a -> ('a -> 'a) -> int -> 'a
<matthewt> i see
<yezariaely> If I have open A;; open B;; and both define a function "foo" then B.foo should be in scope, shouldn't it?
<yezariaely> I have a counterexample to that right now :/
<orbitz> matthewt: and let rec f = function 0 -> 0 | x -> f (x - 1);;
<thizanne> yezariaely: what is your example ?
<yezariaely> thizanne: hmm a bit large for simply posting … lets try to minimize it. Maybe the error disappears. Give me some minutes…
<yezariaely> just wanted to make sure that the expected behavior is, that B.foo is in scope
sivoais has joined #ocaml
Neros has joined #ocaml
eikke has joined #ocaml
TaXules_ has quit [Ping timeout: 265 seconds]
<yezariaely> damnit… thizanne sorry for bothering.
<yezariaely> Is there any plans to implement slicing for nicer type errors into ocaml?
<yezariaely> to see where types flow into an expression?
<yezariaely> This would be really helpful
sivoais has quit [Ping timeout: 264 seconds]
<matthewt> sorry for the newbie question but i'm trying to write a function that returns a if n == a and 1 otherwise, but what i wrote always returns n; let u n a = match n with | a -> a | _ -> 1 ;;
ftrvxmtrx has joined #ocaml
ikaros has joined #ocaml
<matthewt> the interpreter is telling me that n will always match a but i don't see why
<matthewt> apparently using match with integers is a mistake
TaXules has joined #ocaml
<thizanne> matthewt: you can use match to match patterns, not values
<thizanne> `a` is a pattern which can match with every integer
<matthewt> ah, right
TaXules has quit [Ping timeout: 256 seconds]
Neros has quit [Remote host closed the connection]
mika1 has quit [Quit: Leaving.]
cdidd has quit [Remote host closed the connection]
TaXules has joined #ocaml
larhat has joined #ocaml
Kakadu has quit []
<testcocoon> did anybody had a try with ocamldebug (v4.00) on windows: it is really unstable.
sivoais has joined #ocaml
<fasta> Is there a build tool which figures out that I want to link in unix when I refer to Unix?
<fasta> That is, a tool which doesn't bother me with details?
<orbitz> fasta: I'm not aware of one
<orbitz> you can find innerproject deps with ocamldep but other than that you have to specify libraries
<fasta> How 'native' is native?
<fasta> Is it just arch specific?
<fasta> (That is, OS+arch)
<fasta> Or is it so specific that a version compiled on an Intel platform wouldn't run on an AMD platform?
bru` has joined #ocaml
<pippijn> has anybody used the Ohm web framework?
justdit has quit [Ping timeout: 255 seconds]
<matthewt> why do i get the error This expression is not a function; it cannot be applied? let rec u n a f = if n = a then a else f(u ((n-1) a f)) ;;
<thizanne> because u ((n - 1) a f) tries to compute (n - 1) a f
<thizanne> you don't need parenthesis around the parameters of a function
<thizanne> you just need them around u (n - 1) a f, so that f is applied to u (n - 1) a f and not u, (n - 1), a and f
mika1 has joined #ocaml
<matthewt> i see. thank you again
chambart has joined #ocaml
mye has quit [Quit: mye]
justdit has joined #ocaml
csag8264 has joined #ocaml
mye has joined #ocaml
justdit has quit [Ping timeout: 264 seconds]
benmachine has joined #ocaml
<benmachine> http://ocaml.org/tutorials/if_statements_loops_and_recursion.html this page has "<dfn>Fold</dfn>" appearing on it at one point
<benmachine> it looks like some kind of weird pseudo-markup, my guess is it's a mistake
<benmachine> but I can't work out what it's meant to be saying
csag8264 has quit [Remote host closed the connection]
larhat1 has joined #ocaml
larhat has quit [Read error: Connection reset by peer]
xavierm02 has joined #ocaml
<xavierm02> Hey
<xavierm02> I have a type to represent boolean expressions
<xavierm02> type booleanExpressionTree =
<xavierm02> And of booleanExpressionTree list |
<xavierm02> Not of booleanExpressionTree |
<xavierm02> Or of booleanExpressionTree list |
<xavierm02> Variable of int
<xavierm02> ;;
<xavierm02> but I'm not exactly sure how I should let it be used
<xavierm02> I'd like to make sure if I have n variables
<xavierm02> they range from 0 to (n-1)
<xavierm02> So I thought of making a class to wrap this type and the class would enforce that
<xavierm02> is this the good solution?
<benmachine> xavierm02: why would you like to make sure of that? actually, why are your variables ints anyway?
<benmachine> (full disclosure: I am new to ocaml, my questions are genuine)
everyonemines has joined #ocaml
<xavierm02> well
<xavierm02> i'D CALL VARIABLES
<xavierm02> sry capslock >_<
<xavierm02> so
<xavierm02> I'd call variables b1, b2, b3 etc.
<xavierm02> but to represent them in memory, using strings kinda sucks
<Qrntz> why not use a variant type?
<xavierm02> so I use ints
<xavierm02> What do you mean?
<benmachine> xavierm02: I think instead of enforcing that, I'd just supply (or invent) a function to "canonicalise" the variable names, rename them all to the appropriate ints
<Qrntz> or, now that I think about it, polymorphic variant types
<Qrntz> actually, show me an example of what you want to achieve.
<everyonemines> what are you doing here?
<benmachine> Qrntz: at a guess because the user might want to specify arbitrarily many variables in their expressions
<Qrntz> (an example statement or so)
<everyonemines> oh is this a compiler?
<everyonemines> this problem has been solved already
<Qrntz> benmachine, I see it now, this is why I suggested polymorphic ones (you don't need to define a type to use them)
<xavierm02> benmachine: but then, other functions could be called on instances of the type that do not have this invarient
<benmachine> xavierm02: hmm. would this invariant even really be that useful?
<xavierm02> benmachine: so like. To count the number of variables, I'd need to set up a list of all variables. Whereas if I have the invariant, I can just return the largest int + 1
<xavierm02> And
<benmachine> xavierm02: how would you find the largest int?
<xavierm02> well
<benmachine> oh, well, I guess I see what you mean
<xavierm02> let rec numberOfVariables tree =
<xavierm02> match tree with
<xavierm02> | And( l ) -> List.fold_left (fun m t -> max m (numberOfVariables t)) 0 l
<xavierm02> | Not( t ) -> numberOfVariables t
<xavierm02> | Or( l ) -> List.fold_left (fun m t -> max m (numberOfVariables t)) 0 l
<xavierm02> | Variable( i ) -> i
<xavierm02> ;;
<benmachine> you'd have to traverse either way but in one case you have to store a list, the other case you only have to store a single thing
<xavierm02> yeah
<xavierm02> and
<xavierm02> I have to keep the list sorted
<xavierm02> etc.
<benmachine> eh, that's not too big a deal :P
<xavierm02> Yeah
<xavierm02> and then
everyonemines has quit [Quit: Leaving.]
<xavierm02> I'll try to find solutions
<xavierm02> so I have have an array
<xavierm02> and index variable values by their names
<xavierm02> and if I don't have the invariant, I'll have a sparse array
<xavierm02> which sucks
<benmachine> can't you just use a dictionaryish type instead?
<xavierm02> well
<xavierm02> I'm not doing this for anything other than learning
<xavierm02> so the more things I do myself
<xavierm02> the better it is
<benmachine> implement a dictionaryish type yourself then :P
<benmachine> well, ok, so
<xavierm02> that's not part of the things I have to learn :)
<xavierm02> and I already did one in Java
<benmachine> I can tell you what I would do in Haskell and I don't know if OCaml can do it but I suspect it probably can
<xavierm02> I'd like that
<benmachine> you'd make a new type, of expressions-with-this-invariant
<benmachine> say canonicalTree
<benmachine> you have a module which defines this type but doesn't export the constructor, and instead exports functions
<benmachine> isCanonicalTree : booleanExpressionTree -> canonicalTree option
<benmachine> that's a bad name but come up with a better one
<benmachine> and canonicaliseTree : booleanExpressionTree -> canonicalTree
<benmachine> the latter is optional but I think it would be useful
<xavierm02> aww
<xavierm02> nice
<benmachine> the idea is that users of the module can't create canonical trees except via isCanonicalTree, which only returns Some tree if the tree is in the form you want
<Qrntz> this is done via phantom types in OCaml
<benmachine> so then any function accepting a canonicalTree knows it must have come through that function
<benmachine> Qrntz: oh, I guess you can do it with phantom types too
<benmachine> Qrntz: so you'd parametrise the original data type over an extra type variable that reflects whether or not it's canonical?
<benmachine> Qrntz: yeah, that's even nicer, actually
<Qrntz> benmachine, exactly
<xavierm02> thank you very much
Cyanure has quit [Remote host closed the connection]
<xavierm02> that helps a lot :)
<benmachine> xavierm02: let me know if you want more detail on the phantom-type bit
<benmachine> it's pretty clever and avoids you having to define the same type twice
<benmachine> oh wait no
<benmachine> mine avoids that too
<benmachine> canonicalTree isn't a whole new tree, it's just a wrapper around the original tree
<benmachine> silly me
<xavierm02> yeah
Cyanure has joined #ocaml
<xavierm02> but you still need to define functions that can be applied to both twice
<xavierm02> don't you?
<Qrntz> you do.
<Qrntz> unless you do type magic and this doesn't call for type magic at all
<Qrntz> just use polymorphic variant phantom types
<Qrntz> if I understood your aim correctly, of course
<benmachine> okay Qrntz can explain that bit :P
<Qrntz> luckily, a lot of people have explained it for me previously
<benmachine> oh, neat
<xavierm02> Ok
<xavierm02> Here's what I understood
<xavierm02> I define my type like this
<xavierm02> type 'a booleanExpressionTree =
<xavierm02> And of 'a booleanExpressionTree list |
<xavierm02> Not of 'a booleanExpressionTree |
<xavierm02> Or of 'a booleanExpressionTree list |
<xavierm02> Variable of int
<xavierm02> ;;
<xavierm02> and type 'a booleanExpressionTree in the .mli
<xavierm02> and then I decide that one type (e.g. int) for 'a means it respects the invariant
<xavierm02> and other types means it doesn't
<Qrntz> no
<xavierm02> >_<
<Qrntz> you probably haven't read the article fully
<Qrntz> the core idea is correct, but you don't use primitive types for this
<Qrntz> you use the types polymorphic variants have (since those are human-readable and make sense in errors)
<Qrntz> you don't use polymorphic variants per se, but bind their types to the free type variable 'a in your booleanExpressionTree type
<Qrntz> and type-annotate your functions so that they accept 'a booleanExpressionTree where 'a can be restricted to `Canonical, `NonCanonical or both (for example)
<xavierm02> ok
<xavierm02> ty :)
<Qrntz> and I still can't quite understand why you use lists as type parameters
<Qrntz> shouldn't that be 2-tuples?
<Qrntz> actually wait, I have trouble thinking clearly now
<xavierm02> well it could be 2-tuples
<xavierm02> but (a&(b&c)) = ((a&b)&c)
<xavierm02> so I can keep a&n&c
<xavierm02> a&b&c
<xavierm02> with only one & node
<benmachine> xavierm02: but with lots of :: nodes to make up for it :P
<xavierm02> yeah
<xavierm02> by my brain find :: nodes easier to understand than & nodes ^.^
<xavierm02> plus when I'll get in DNF, it'll be easier
<xavierm02> to iterate
<xavierm02> because I'll have a list of list, not a bunch of 2-tuples containing 2-tuples....
<benmachine> arguably you should store your DNF in a different type
<benmachine> (int, bool) list list ought to do the trick
<xavierm02> why?
<xavierm02> It's not that much more efficient than with my general type
<xavierm02> is it?
<xavierm02> I have another question
<xavierm02> I often have to write the same thing
<xavierm02> for Or and And
<xavierm02> is there some trick to avoid duplicating the code?
gnuvince has quit [Ping timeout: 264 seconds]
<Qrntz> xavierm02, could you explain?
<benmachine> xavierm02: I wasn't worried about efficiency, it's more to do with the fact that with the type I gave, every DNF has one and exactly one representation
<xavierm02> well
<xavierm02> like
<xavierm02> let rec numberOfVariables tree =
<xavierm02> match tree with
<xavierm02> | And( l ) -> List.fold_left (fun m t -> max m (numberOfVariables t)) 0 l
<xavierm02> | Not( t ) -> numberOfVariables t
<xavierm02> | Or( l ) -> List.fold_left (fun m t -> max m (numberOfVariables t)) 0 l
<xavierm02> | Variable( i ) -> i
<xavierm02> ;;
<benmachine> xavierm02: with your type, expressions which are nominally the same expression - even syntactically - can have different tree representations
<xavierm02> the code for And and Or is exactly the same
<xavierm02> this one is short
<xavierm02> but others might be a bit longer..
<benmachine> you can do match And l | Or l -> List.fold_left, can't you?
<xavierm02> O_O
<Qrntz> of course
<benmachine> (even if you couldn't, I'd just abstract the rhs into a function, put the function in the let rec, and call it in both branches)
<Qrntz> this is called an or-pattern
<xavierm02> ty
gnuvince has joined #ocaml
mattrepl has joined #ocaml
<xavierm02> I'd have thought I would need to replace
<xavierm02> type 'a boolean_expression =
<xavierm02> Variable of int |
<xavierm02> Not of 'a boolean_expression |
<xavierm02> And of 'a boolean_expression list |
<xavierm02> Or of 'a boolean_expression list
<xavierm02> ;;
<xavierm02> by
<xavierm02> type 'a boolean_expressio;;
<xavierm02> in the .mli
<xavierm02> to make the phnatom type thing work
<xavierm02> but then I can't have access to Or Variable Not etc.
<xavierm02> so I can't even build "non canonical" expressions
<xavierm02> >_<
smondet has joined #ocaml
<xavierm02> never mind
<xavierm02> I think I found
<xavierm02> type test = [`V] boolean_expression;;
ocp has quit [Quit: Leaving.]
<xavierm02> I have this in the .ml
<xavierm02> type 'canonical generic_boolean_expression =
<xavierm02> Variable of int |
<xavierm02> Not of 'canonical generic_boolean_expression |
<xavierm02> And of 'canonical generic_boolean_expression list |
<xavierm02> Or of 'canonical generic_boolean_expression list
<xavierm02> ;;
<xavierm02> type boolean_expression = [`Not_Canonical] generic_boolean_expression;;
<xavierm02> but how do I export constructors
<xavierm02> while exporting boolean_expression and not generic_boolean_expression?
<xavierm02> type boolean_expression =
<xavierm02> Variable of int |
<xavierm02> Not of boolean_expression |
<xavierm02> And of boolean_expression list |
<xavierm02> Or of boolean_expression list
<xavierm02> ;;
<xavierm02> tells me
<xavierm02> Error: The implementation booleanExpression.ml
<xavierm02> does not match the interface booleanExpression.cmi:
<xavierm02> Type declarations do not match:
<xavierm02> type boolean_expression =
<xavierm02> [ `Not_Canonical ] generic_boolean_expression
<xavierm02> is not included in
<xavierm02> type boolean_expression =
<xavierm02> Variable of int
<xavierm02> | Not of boolean_expression
<xavierm02> | And of boolean_expression list
<xavierm02> | Or of boolean_expression list
<xavierm02> --------
<xavierm02> Qrntz benmachine
<Qrntz> you could use polymorphic variants as constructors, they don't have scope
mika1 has quit [Quit: Leaving.]
<xavierm02> Qrntz: could you be a bit more precis please?
<xavierm02> Do I replace my type definition and use polymorphic variants
<xavierm02> or is it just for the /lmi
<xavierm02> .mli*
<xavierm02> ?
jamii has joined #ocaml
fusillia has quit [Ping timeout: 240 seconds]
<Qrntz> xavierm02, you replace your plain variant type definition with one defining polymorphic variant constructors and expose the abstracted type as usual
<Qrntz> you'll be able to use constructors without opening the module or exposing the type
<xavierm02> ok
<xavierm02> I did this
<xavierm02> ---- file.ml----
<xavierm02> type 'canonical generic_boolean_expression = [
<xavierm02> `Variable of int |
<xavierm02> `Not of 'canonical generic_boolean_expression |
<xavierm02> `And of 'canonical generic_boolean_expression list |
<xavierm02> `Or of 'canonical generic_boolean_expression list
<xavierm02> ];;
<xavierm02> type boolean_expression = [`Not_Canonical] generic_boolean_expression;;
<xavierm02> -----
<xavierm02> ----file.mli----
<xavierm02> type boolean_expression = [
<xavierm02> `Variable of int |
<xavierm02> `Not of boolean_expression |
<xavierm02> `And of boolean_expression list |
<xavierm02> `Or of boolean_expression list
<xavierm02> ];;
<xavierm02> ---
<xavierm02> and it works
<xavierm02> but when you said "expose the abstracted type as usual"
<xavierm02> I tried
<xavierm02> --- file.mli ---
<xavierm02> type boolean_expression;;
<xavierm02> And I got
<Qrntz> please use a pastebin
<xavierm02> Error: This expression has type
<xavierm02> [> `And of
<xavierm02> [> `Or of [> `Variable of int ] list | `Variable of int ] list ]
<xavierm02> but an expression was expected of type
<xavierm02> BooleanExpression.boolean_expression
<xavierm02> yeah sorry
<xavierm02> will use pastebin next time
<xavierm02> when you said
<xavierm02> "expose the abstracted type as usual"
<xavierm02> did you mean "type boolean_expression;;" ?
<Qrntz> ok, you lost me here
<Qrntz> why does one of your type definitions have a type parameter and the other doesn't
<xavierm02> the one with a parameter
<xavierm02> is generic_boolean_expression
<xavierm02> and the one I expose is
<xavierm02> boolean_expression = [`Not_Canonical] generic_boolean_expression
<xavierm02> because I can't do this http://pastebin.com/XtKCQttu
<xavierm02> apparently
<xavierm02> so I had to put [`Not_Canonical] generic_boolean_expression in a type variable
<xavierm02> to be able to use it in the .mli
eikke has quit [Ping timeout: 250 seconds]
<xavierm02> here, I put all the code on pastebin http://pastebin.com/sPZ5VuC2
Cyanure has quit [Remote host closed the connection]
ftrvxmtrx has quit [Quit: Leaving]
dwmw2_gone has quit [Ping timeout: 260 seconds]
mika1 has joined #ocaml
cago has left #ocaml []
<Qrntz> that's a bit not how you do that
mika1 has quit [Client Quit]
dwmw2_gone has joined #ocaml
<xavierm02> well how then >_<
benmachine has left #ocaml []
<Qrntz> hold on
<thelema> xavierm02: you're declaring `type 'a foo = ...` in your .ml, but want to say `type foo` in your .mli
<xavierm02> yeah
<thelema> does this simplification make things clear?
<thelema> imagine if you could do this for... lists.
<xavierm02> I want to use phantom types
<thelema> `type 'a list = ...` -> `type list`
<xavierm02> to enforce an invariant
<xavierm02> and that's how you do it
<xavierm02> apparently
<thelema> xavierm02: that's fine, then your .mli file should have `type 'a boolean_expression;;`
<xavierm02> so
<xavierm02> I don't need the things after the =?
<thelema> no.
<thelema> you do need the type parameter, though
<xavierm02> hm
<thelema> oh, wait...
<thelema> I misread
<xavierm02> I did type boolean_expression = [`Not_Canonical] generic_boolean_expression;;
<xavierm02> so I shouldn't need it >_<
<thelema> I thought that you were trying to expose generic_boolean_expression
<thelema> hmm, what's the error?
<thelema> `type boolean_expression;;` should be fine in the .mli
<xavierm02> Error: This expression has type
<xavierm02> [> `And of
<xavierm02> [> `Or of [> `Variable of int ] list | `Variable of int ] list ]
<xavierm02> but an expression was expected of type
<xavierm02> 'a BooleanExpression.generic_boolean_expression
<xavierm02> wait
hkBst has quit [Quit: Konversation terminated!]
<xavierm02> I'll put what I have atm on a pastebin
<xavierm02> because I've been playing with it a bit so it changed
<thelema> what I see on pastebin compiles fine for me.
<xavierm02> Ok
<xavierm02> thelema: I've got this now http://pastebin.com/VgHCF5km
<xavierm02> and it works
<xavierm02> but
<xavierm02> I won't be able to use string_of_boolean_expression
<xavierm02> on canonical_boolean_expression
<xavierm02> whereas the point of this whole thing
<thelema> true; 1) get rid of the type aliases, and have users interact directly with `[`Canonical] boolean_expression` and `[`Not_canonical] boolean expression`
<xavierm02> is that the "user" can't create canonical_boolean_expression - only not_canonical_boolean_expression - but when he canonicalize it with a function I will provide, I still want it to be able to use the other functions
<thelema> 2) change the type of `string_of_boolean_expression` to `[`Canonical | `Not_canonical] boolean_expression -> string`
<thelema> or even `_ boolean_expression -> string`
<xavierm02> ok
<xavierm02> but how do you do 1) ?
<xavierm02> thelema: the reason for the type alias in the first place is that I tried to do this http://pastebin.com/XtKCQttu
<xavierm02> and it failed :/
<thelema> yes, you can't put [`Not_Canonical] as a type parameter
djcoin has quit [Quit: WeeChat 0.3.9.2]
<thelema> type 'a be = Var of int | Not of 'a be | And of 'a be list | Or of 'a be list constraint 'a = [ < `Canonical | `Not_canonical ]
<thelema> and then in your .mli:
fraggle_laptop has quit [Remote host closed the connection]
<thelema> type 'a be constraint 'a = [< `Canonical | Not_canonical ]
<thelema> val string_of_be : _ be -> string
<thelema> val canonize : _ be -> [`Canonical] be
<thelema> val from_user : string -> [`Not_canonical] be
<thelema> etc.
tac has joined #ocaml
dwmw2_gone has quit [Ping timeout: 244 seconds]
fraggle_laptop has joined #ocaml
<thelema> maybe even: val of_not_canonical : not_canonical_boolean_expression -> [`Not_canonical] be
<thelema> with your existing not_canonical_boolean_expression type
<companion_cube> is there a simple way to use Sexplib with ocamlbuild? Without writing a ocaml customization file?
<thelema> companion_cube: ocamlbuild -use-findlib -tag package(sexplib)foo.native
<thelema> err, missed space before foo
<thelema> and wrong findlib
<thelema> -use-ocamlfind
<companion_cube> can I add the package(sexplib) to my _tag file ?
<thelema> yes
<thelema> _tags
<thelema> but the -use-ocamlfind needs to be on the command line, afaik
<companion_cube> hmm, can I also use the camlp4 extension this way?
<companion_cube> the 'with sexp' syntax
<thelema> package(sexplib.syntax)?
<thelema> possibly also a syntax(camlp4o) tag
<xavierm02> thelema: I still get the error: http://pastebin.com/JV23Y8Xf :/
<thelema> xavierm02: yes, you'll have to use a construction function to actually create values of the correct phantom type
<xavierm02> oh
<thelema> that's what the of_not_canonical was showing
<xavierm02> so there is no way to have a phantom type and export constructors?
<thelema> your construction function could be %identity
<companion_cube> Parse error: [semi] expected after [sig_item] (in [interf]) <-- already looks better, but not done yet
<companion_cube> thank you thelemea
<companion_cube> -e
<thelema> by "export constructors", you mean "expose the internals of the phanton type"? if so, then that will circumvent the phantom typing, if the client module knows `type 'a foo = bar`, then it can unify `['Canonical] foo` with `['Not_canonical] foo` because they're both `bar`.
<thelema> companion_cube: you're welcome.
dwmw2_gone has joined #ocaml
<xavierm02> I can see how I would do the be_of_string function
<xavierm02> but not how I would do the be_of_tree one
<xavierm02> I need to define a new type
<xavierm02> exactly like be
<thelema> xavierm02: correct.
<xavierm02> just so that be trees can be expressed?
<xavierm02> ok
<thelema> just so that users can use that type, yes.
<thelema> You could expose a bunch of constructor functions instead:
<xavierm02> and for this type
<xavierm02> I have to put type name = ...
<thelema> val var : int -> `Canonical be
<xavierm02> I can't stop befor ethe =
<xavierm02> right?
<xavierm02> in the .mloi
<xavierm02> .mli
<thelema> val not : _ be -> [`Not_canonical] be
<xavierm02> oh
<xavierm02> that's nice too
<thelema> val and : _ be list -> [`Not_canonical] be
<xavierm02> didn't think of it
<thelema> although you can't use the name 'and'
<thelema> be_var, be_not, be_and, be_or
<xavierm02> thank you very much :)
<xavierm02> yeah
<xavierm02> anyway
<thelema> you're welcome.
<xavierm02> those are just for testing
<xavierm02> then I'll use strings
<companion_cube> thelema: sorry for disturbing again, but does this error ([semi] expected after [sig_item]...) ring a bell?
<xavierm02> thelema: how do I get "val var_ : int -> [`Not_canonical] boolean_expression" ?
<xavierm02> Because I have "val var_ : int -> `canonical boolean_expression"
<xavierm02> but I can't let that kind of value out of the module can I?
<xavierm02> shouldn't*
<thelema> companion_cube: missing a semicolon after a ... not sure. paste the line of code.
<thelema> xavierm02: correct, you shouldn't let that value out; just put the restricted version in your .mli
<companion_cube> oh, that was a type foo = ... with sexp and bar = ... with sexp
<companion_cube> by splitting them, it works
<companion_cube> thanks
<thelema> if your .ml has a `int -> 'a be`, you can put `val foo : int -> [`Canonical] be`
<thelema> into the mli
<thelema> companion_cube: you're welcome
<xavierm02> thelema: I get a syntax error qith the code you gave me O_O. I'm quite sure it worked for some time and now I get a syntax error even with everythign else commented
<xavierm02> type 'canonical boolean_expression =
<xavierm02> | Var of int
<xavierm02> | Not of 'canonical boolean_expression
<xavierm02> | And of 'canonical boolean_expression list
<xavierm02> | Or of 'canonical boolean_expression list
<xavierm02> constraint 'canonical = [ < `Canonical | `Not_canonical ]
<xavierm02> ;;
<xavierm02> or did I change something I shouldnt have changed?
<xavierm02> File "booleanExpression.ml", line 6, characters 30-31:
<xavierm02> Error: Syntax error
<thelema> remove leading |
<thelema> err... maybe
<xavierm02> didn't change anything :(
<thelema> ah, [< has to be one token
<xavierm02> yay!
<xavierm02> ty :)
<thelema> n/p
<xavierm02> back to the error about restricting the "image" of the function
<xavierm02> File "booleanExpression.ml", line 1, characters 0-1:
<xavierm02> Error: The implementation booleanExpression.ml
<xavierm02> does not match the interface booleanExpression.cmi:
<xavierm02> Values do not match:
<xavierm02> val and_ :
<xavierm02> ([< `Canonical | `Not_canonical ] as 'a) boolean_expression list ->
<xavierm02> 'a boolean_expression
<xavierm02> is not included in
<xavierm02> val and_ :
<xavierm02> [< `Canonical | `Not_canonical ] boolean_expression list ->
<xavierm02> [ `Not_canonical ] boolean_expression
<xavierm02> let and_ (l:_ boolean_expression list) = And l;;
<xavierm02> val and_ : _ boolean_expression list -> [`Not_canonical] boolean_expression
<xavierm02> first line is .ml and second line is .mli
<thelema> ah, this is because of the type of And...
<thelema> just drop the 'canonical from your boolean_expression type
<thelema> and re-introduce it in a wrapper
sepp2k has joined #ocaml
<thelema> i.e. type be = Var | Not | And | Or
<thelema> type 'a bec = be constraint 'a =[< `Canonical | `Not_canonical]
<companion_cube> yay, I can serialize data structures \o/
<xavierm02> wait
<xavierm02> so I remove the cosntraint on the type
<thelema> your type declaration says says that an 'And' `Canonical boolean expression is made of `Canonical boolean expressions
<xavierm02> and get a second type with that constraint added
<thelema> yes, put the phantom type on a second type, not your base type
<thelema> the type declaration connection affects the type of your and_ function so that it's not compatible with what you want.
<thelema> as is, it's not a phantom type, as it appears on the right side of the =
<xavierm02> it works!
<xavierm02> thank you once again :)
Submarine_ has joined #ocaml
Submarine_ has quit [Changing host]
Submarine_ has joined #ocaml
ontologiae has quit [Read error: Connection reset by peer]
milosn_ has joined #ocaml
milosn has quit [Ping timeout: 276 seconds]
ontologiae has joined #ocaml
bru` has quit [Ping timeout: 265 seconds]
ontologiae has quit [Ping timeout: 252 seconds]
myx has joined #ocaml
hongboz has joined #ocaml
dskippy has joined #ocaml
Xizor has joined #ocaml
tane has joined #ocaml
emmanuelux has joined #ocaml
<wmeyer```> hi
<thelema> hi
chambart has quit [Ping timeout: 244 seconds]
<adrien> wmeyer```: sorry but you have unbalanced quotes, it's disturbing ='(
larhat1 has quit [Quit: Leaving.]
wmeyer``` is now known as wmeyer
<wmeyer> yes
<wmeyer> sorry
<adrien> :D
<wmeyer> fixed! :D
wmeyer is now known as camlp4
camlp4 is now known as wmeyer
<wmeyer> ooops
tane has quit [Quit: Verlassend]
Cyanure has joined #ocaml
mye has quit [Quit: mye]
<wmeyer> hongboz: can you send me a snippet?
ikaros has quit [Quit: Ex-Chat]
ikaros has joined #ocaml
dskippy has quit [Quit: Leaving.]
dskippy1 has joined #ocaml
<thelema> Infrastructure for instrumenting arbitrary lines of source code without recompilation
<ben_zen> wow
pango has quit [Ping timeout: 255 seconds]
* thelema just wants to apply 'perf stat' to part of a process' execution
* wmeyer wants to just write some code today
gnuvince has quit [Ping timeout: 248 seconds]
* ben_zen should get back to using OCaml ... although next semester's fun is SML.
eni has joined #ocaml
Submarine_ has quit [Ping timeout: 260 seconds]
pango has joined #ocaml
gnuvince has joined #ocaml
iZsh has quit [Ping timeout: 252 seconds]
iZsh has joined #ocaml
tane has joined #ocaml
weie has quit [Quit: Leaving...]
sepp2k1 has joined #ocaml
sepp2k has quit [Ping timeout: 248 seconds]
beckerb has quit [Quit: Konversation terminated!]
<smondet> Hi has anyone managed to install opam since yesterday? It keeps failing while trying "curl -OL http://gforge.info.ucl.ac.be/frs/download.php/190/cudf-0.6.3.tar.gz"
<smondet> is there a mirror for that lib?
everyonemines has joined #ocaml
Snark_ has quit [Quit: Quitte]
answer_42 has quit [Quit: WeeChat 0.3.9.2]
hongboz has quit [Ping timeout: 244 seconds]
<smondet> thelema: Thanks!
<thelema> smondet: you're welcome
everyonemines has quit [Quit: Leaving.]
mattrepl_ has joined #ocaml
mattrepl has quit [Ping timeout: 260 seconds]
mattrepl_ is now known as mattrepl
<orbitz> Can I mmap a file in ocaml?
mattrepl_ has joined #ocaml
mattrepl has quit [Ping timeout: 248 seconds]
mattrepl_ is now known as mattrepl
<adrien> orbitz: Bigarray
X1z0r has joined #ocaml
Xizor has quit [Ping timeout: 260 seconds]
<orbitz> can I actually just say "make this file a big array" or do I have to load it in?
<orbitz> My other option is to track where in the file I see the info I'm intereste and store teh file position in a table
<thelema> orbitz: you can give BigArray a Unix.file_descr and an offset and it'll give you a bigarray
<orbitz> interesting
<thelema> map_file
<orbitz> clever bastards
<thelema> yup.
<orbitz> I dont' think I'm going to use this but good to know it exists
milosn_ has quit [Read error: No route to host]
milosn has joined #ocaml
<avsm> its very handy, especially since ocaml4 when it doesnt call lseek unless it needs to
<avsm> so you can map shared memory through it as well
eikke has joined #ocaml
gnuvince has quit [Ping timeout: 260 seconds]
thomasga has quit [Quit: Leaving.]
xavierm02 has quit [Quit: Leaving]
eni has quit [Ping timeout: 260 seconds]
TDJACR has quit [Remote host closed the connection]
sepp2k1 has quit [Remote host closed the connection]
tane has quit [Quit: Verlassend]
gnuvince has joined #ocaml
ikaros has quit [Quit: Ex-Chat]
smondet has quit [Ping timeout: 248 seconds]
xavierm02 has joined #ocaml
xavierm02 has quit [Client Quit]
Cyanure has quit [Remote host closed the connection]
X1z0r has quit [Remote host closed the connection]
tac has quit [Ping timeout: 245 seconds]
jamii has quit [Quit: Leaving]
sivoais has quit [Ping timeout: 240 seconds]
sivoais has joined #ocaml
mattrepl has quit [Quit: mattrepl]
lolcathost has joined #ocaml
lolcathost has quit [Client Quit]
<dskippy1> I am trying to create a program that is going to run indefinitely, respond to other processes (probably through DBus), and add timeouts to be called in the future. I have used GObject for this in C and Python programs. Is GObject the best way to go in OCaml as well?
dskippy1 is now known as dskippy