Alpounet changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.1 out now! Get yours from http://caml.inria.fr/ocaml/release.html - Answer OCaml Meeting 2010 poll https://forge.ocamlcore.org/survey/survey.php?group_id=77&survey_id=1
<monestri> wait, I can't?
<monestri> but I can match against types?
<Camarade_Tux> depending on your type, you can pattern-match:
<Camarade_Tux> type t = Square | NotSquare
<Camarade_Tux> match some_variable with
<Camarade_Tux> | Square -> ...
<Camarade_Tux> | NotSquare -> ...
<monestri> well that's boring
<Camarade_Tux> it's the shortest you can do (no matter the language I guess)
thrasibule has joined #ocaml
<monestri> no functional language?
<mrvn> monestri: "how do I check something's type?" makes no sense as parameters only ever have one type.
<monestri> in this context i think it makes sense
<monestri> unless Square, Name, Bopolean, etc aren't types
<monestri> I was calling them types
<monestri> but it seems that thing may be the only type
<monestri> in which case what is a Square?
<monestri> i.e. the original intent of Square? is to confirm if it was a square without using match
verte has joined #ocaml
<monestri> in which case what is Name?* (less name confliction)
<mfp> monestri: those are constructors belonging to a single sum (variant) type
<mrvn> monestri: They are constructors
seanmcl has joined #ocaml
Xteven has quit [Read error: 131 (Connection reset by peer)]
seanmcl has quit [Client Quit]
munga_ has quit [Read error: 113 (No route to host)]
onigiri has quit [Read error: 54 (Connection reset by peer)]
onigiri has joined #ocaml
tmaeda is now known as tmaedaZ
tmaedaZ is now known as tmaeda
tmaeda is now known as tmaedaZ
seanmcl has joined #ocaml
<monestri> can I raise an exception of type list?
<mrvn> # exception L of int list;;
<mrvn> exception L of int list
<mrvn> # raise (L [1;2]);;
<mrvn> Exception: L [1; 2].
<monestri> oh.. needs to have a type
<monestri> thanks
<mrvn> exception L of 'a list somehow isn't possible
valross has quit [Read error: 110 (Connection timed out)]
valross has joined #ocaml
<thelema> mrvn: yup, no way to catch that.
<mrvn> thelema: why? try foo () with x -> List.hd x
<mrvn> thelema: Why does that need to know the type of the list?
<mrvn> with L x even
tmaedaZ is now known as tmaeda
tvn2009 has quit ["Leaving"]
tmaeda is now known as tmaedaZ
<thelema> and what are you going to do with [List.hd x]?
<thelema> if it has a specific type, the exception should have that type
<thelema> if it doesn't have a specific type, you can't do anything with it.
<thelema> other than maybe marshal it, or dump it, both of which cheat the type system
<mrvn> thelema: The 'a could be known to the calling function and I just return it.
<thelema> you can't even compare it, because you'd need another value of guaranteed same type
<mrvn> let find_first list f = try List.iter (fun x -> if f x then raise Res x) list with Res x -> x
<thelema> so you want [foo] to have type [unit -> 'a] and for it to raise an exception [L of 'a list]
<thelema> and you want to say the two have to be the same type?
<mrvn> thelema: More 'a list -> 'a
<thelema> well, first problem is that your find_first doesn't type, as List.iter returns unit
<thelema> of course you could fix that with a [raise Not_found]
<mrvn> thelema: ok, you need a raise Not_found
<thelema> now the problem is inferring the type of the function.
<thelema> the type of [Res x] is 'a
<thelema> so find_first returns 'a
tvn2009 has joined #ocaml
<mrvn> List.iter gives you list == 'a list => Res x == Res of 'a
<thelema> but there's no way to connect this with the 'a of the argument list
<thelema> there's no way to unify the argument type with the Res type
<mrvn> But you are right, there could be a "raise (Res 1)" hidden in there, possibly in a function that gets called.
<thelema> hmm, maybe you could in this case.
<thelema> yes, that's the problem...
<mrvn> Without knowing all exceptions every called function can possibly raise you can't infere the type.
<thelema> yes, you'd have to have the raised exceptions encoded in the type of the function
<mrvn> (which I want anyway :)
<thelema> and it's not a bad idea in terms of safety
<thelema> it's just ugly as sin
<mrvn> I used this (using an exception to abort) in a game. I recursively try all possible moves to find the best one. But when I find a winning move I throw an exception because you always take that.
<mrvn> Only way to abstract this find_best_move is with a functor. You can't throw a 'a exception.
<thelema> yup, use a functor to set the type of 'a
<mrvn> Alternatively you can have a 'a reference (option) and set that before "raise Won"
<mrvn> Somehow both isn't pretty.
<thelema> true. But in either case, the 'a gets fixed - you only have '_a
valross has quit [Read error: 145 (Connection timed out)]
verte has quit ["Lost terminal"]
verte has joined #ocaml
tvn2009 has quit ["Leaving"]
tvn2009 has joined #ocaml
tvn2009 has quit [Client Quit]
tvn2009 has joined #ocaml
razel has joined #ocaml
seanmcl has quit []
<razel> let a = Null | Node of real_node and real_node = { x : int ; nod : node } ;;
<razel> how do i match for nod ? for example
<thelema> match x with {nod=Null} -> print "empty"
<razel> let example n = match n with Null -> 0 | real_node ->
<razel> yes
<razel> i got that part
<razel> now how do i get to x
<mrvn> real_node.x
<razel> ah cool
<thelema> match x with {x=x; nod=Null} -> print "empty, x=%d" x
<thelema> *printf
<mrvn> thelema: too many x'es. don't confuse him
<razel> hmm
<thelema> yes, sorry. The new syntax will help, no?
<razel> could i have replaced real_node with antything i wanted or no ?
<mrvn> razel: not anything but a lot of things
<razel> like any name
<razel> for example rn
<razel> and then rn.x
<mrvn> let example n = match n with Null -> 0 | {x=x} -> 1 ?
<thelema> type real_node = {x : int; nod : real_node option}
<razel> oh
<razel> nvm
<mrvn> razel: yes, any name. You are binding a new variable there
<razel> oh
<razel> ok
<razel> cool
<thelema> match n with Null -> 0 | Node {x=x} -> 1
<thelema> match n with Null -> 0 | Node {x=x} -> x
seanmcl has joined #ocaml
<mrvn> | Node {x=y} -> y , just to make clear which x is which.
<razel> oh cool
<mrvn> razel: But also look at the option type.
<mrvn> 03:23 < thelema> type real_node = {x : int; nod : real_node option}
<razel> the one i know of is ref
<razel> lol
<razel> but thx will look into it
<mrvn> or type node = Null | Node of int * node
<mrvn> or type node = Leaf of int | Node of int * node
<mrvn> Each has its own advantages.
<razel> i had type node = Null | Node of int * node but node has to be mutable
<razel> k now i have another question
<mrvn> both the int and the node part?
<razel> no just the node
<razel> int is just the value it holds
<razel> let example n = match n with Null -> n <- Node { x = 1 ; nod = Null };;
<razel> will that work ?
<razel> n <- ..
<mrvn> if n is a reference
<mrvn> Do you need a Null node?
<mrvn> # type node = { x : int; mutable next : node option; };;
<mrvn> type node = { x : int; mutable next : node option; }
<razel> yes i need a null node
<razel> im simulating a list, null node is the last node
<mrvn> and you need the empty list?
<razel> yes
<mrvn> then you have to use a node ref
<razel> so Node of real_node and real_node = { x : int ; nod : node ref } ?
<razel> or just type node = Null | Node of int * node ref ;;
<mrvn> type node = Null | Node of int * node ref;;
<mrvn> let rec append x n = match !n with
<mrvn> Null -> n := Node (x, ref Null)
<mrvn> | Node (x, n) -> append x n;;
_unK has quit [Remote closed the connection]
<mrvn> let n = ref Null;;
<mrvn> append 1 n;;
<mrvn> n;;
<mrvn> - : node ref = {contents = Node (1, {contents = Null})}
<mrvn> Or type node = real_node ref
<mrvn> and real_node = Null | Node of int * node;;
<mrvn> To hide the reference.
<razel> 1 sec
<razel> the link i gave you, when i insert a node, it loops around itself
<razel> why ?
<mrvn> #
<mrvn> else c := Node(v,c)
<mrvn> That creates a loop
<razel> but doesnt c = Null
<razel> oh
<razel> wrong one sorry
<mrvn> razel: No. c is a reference
<razel> or sorry !c = Null
<mrvn> I think what you want here is a doubly linked list
<razel> nope
<razel> the layout is correct, its just my coding thats wrong
<mrvn> You want a list of vectors sorted by magnitude, right?
<razel> yes
<razel> i still dont understand whats wrong with c := Node(v,c)
<razel> doesnt it execute the second c before the first ?
<mrvn> To insert a new vector before this one you need to create a new Node pointing to this node and then replace that node.
<mrvn> razel: It is a reference. No execution invoved.
<razel> isnt that what i am doing
<razel> Node(v,c) creates a new node pointing to c which = Null
<mrvn> No, you just create circular nodes.
<razel> let x = ref Node(v,c) in c = x ??
<razel> err
jeddhaberstro has quit [Client Quit]
<razel> so then id have to make the node ref mutable
<razel> correct ?
<mrvn> You need to create a new reference.
<mrvn> Are you sure you don't want to use a set or map instead of this mutable list?
<razel> i got specific instructions
<mrvn> homework?
<razel> yes, aaah
<razel> ref Node worked i think i get it.. i need to create a NEW reference
<razel> correct
<razel> ?
<mrvn> yep. Otherwise you point the node at itself.
<mrvn> Try to avoid unneccessary matches and ifs.
<razel> oooh cool man now it works i just replaced node with ref !node
<mrvn> Your remove can be done with a simple match and 3 cases.
<mrvn> Or 2 cases and if i = 1
<razel> yeah im still learning pattern matching
<mrvn> razel: You main "bug" is the "i = 2" test. The recursion already takes care of that case.
<razel> hmm
<razel> no because if i remove a from a -> Null i replace it with Null, if i remove a from Null it raises exception
<mrvn> razel: which is wrong.
onigiri has quit [Read error: 104 (Connection reset by peer)]
<mrvn> If you have a list containing 1 vector and you remove the seond one you want an exception.
onigiri has joined #ocaml
onigiri has quit [Read error: 54 (Connection reset by peer)]
<razel> no
<razel> that will be checked with a new function
<razel> that will mask this one
<razel> the new function will check that i is in boundaries
onigiri has joined #ocaml
onigiri has quit [Connection reset by peer]
<mrvn> That just means it will never raise the exception. Not that it shouldn't.
<razel> yeah pretty much
<razel> it should never end up there
onigiri has joined #ocaml
<mrvn> which makes the code completly useless
<razel> yeah i tough u sorta needed the | Null .. kind of like an if else
<razel> i guess you dont
onigiri has quit [Read error: 131 (Connection reset by peer)]
<razel> its more for developing purposes
<mrvn> You do. But you don't need the "if i = 2" case at all as the "remove nod (i-1)" already perfectly handles that case.
onigiri has joined #ocaml
onigiri has quit [Connection reset by peer]
<razel> yeah
<razel> hmm
<razel> i wonder why i added that lol
<mrvn> me too. In get you didn't.
<razel> ah i think i know
<razel> because of insert
onigiri has joined #ocaml
<mrvn> In insert the same thing. you don't need the extra check. Just recurse.
<razel> hmm
<razel> im gona re-analyze it...thx for the help
<mrvn> One thing you should probably also start to look out for is to pull out function calls that don't change out of a recrusive function. Here your "vec_mag v". That never changes so you want to only compute it once.
<mrvn> Purely an optimizing thing but worth it.
<razel> ah yes
<razel> i like doing that in c :)
<mrvn> I often also do it just so the line length stays < 75 chars.
<mrvn> let x = foo_bar_baz blubber bing in
<mrvn> let y = foo_bar_baz blubber bang in
<mrvn> if x < y then ...
<mrvn> Often easier to read than having it all in one long line.
<mrvn> But that is a matter of taste.
<mrvn> I like my version more than yours: http://pastebin.org/53235 :)
<mrvn> "when" is great sometimes.
<razel> i will show you mine when i finish it :)
<razel> never herd of of "when" lol
<mrvn> razel: you need it when you want to match against a variable:
<mrvn> let redc elem c list = match list with [] -> false | x::xs when x = c -> true | x::xs -> elem c xs
<mrvn> -d
<mrvn> But any conditional will do.
<razel> hmm
<razel> theres mine
<razel> im more used to if-else
<mrvn> razel: I would put the "then" in the next line so "if" "then" and "else" are under each other.
<razel> ln # ?
<mrvn> 14 and 32
<razel> ah i get it
<mrvn> I always use 1 or 3 lines for an if. Never 2.
<razel> looks nicer
<razel> thx alot for the help man
shazam has joined #ocaml
<shazam> what's that list function for removing duplicates?
tmaedaZ is now known as tmaeda
<mattam> shazam: unique IIRC
<shazam> can't find it anywhere in the standard lib
<razel> hmm
<razel> i have a file that declares a module
<razel> how do i use it now
<razel> oh nvm
<razel> Open Modulename;
valross has joined #ocaml
<razel> wtf
<razel> whats wrong here: try (get_vec store1 0) with Out_of_bouns -> print_line "error\n";;
<mrvn> your vector store starts at index 1
<mrvn> but should still work.
<razel> nvm
<mrvn> what does ocaml say?
<razel> i forgot to put a ;;
<razel> lol
seanmcl has quit []
ulfdoz has joined #ocaml
shazam has quit [Remote closed the connection]
razel has quit [Read error: 104 (Connection reset by peer)]
thrasibule has quit [Read error: 110 (Connection timed out)]
verte has quit ["~~~ Crash in JIT!"]
<monestri> is there a map that works with nested lists?
<mrvn> "works"?
<mrvn> let nested_map f = List.map (List.map f)
ua has quit [Read error: 60 (Operation timed out)]
ski_ has quit ["Lost terminal"]
ulfdoz has quit [Read error: 110 (Connection timed out)]
ski_ has joined #ocaml
ttamttam has joined #ocaml
ygrek has joined #ocaml
mishok13 has joined #ocaml
Yoric has joined #ocaml
ttamttam has quit ["Leaving."]
verte has joined #ocaml
julm has quit ["Lost terminal"]
ikaros has joined #ocaml
julm has joined #ocaml
ua has joined #ocaml
zhijie1 has joined #ocaml
ttamttam has joined #ocaml
zhijie has quit [Read error: 110 (Connection timed out)]
ua has quit [Read error: 110 (Connection timed out)]
jcaose has joined #ocaml
jcaose has quit [Client Quit]
jcaose has joined #ocaml
Associat0r has joined #ocaml
rwmjones has joined #ocaml
ikaros has quit ["Leave the magic to Houdini"]
onigiri has quit []
ygrek has quit [Remote closed the connection]
_zack has joined #ocaml
munga_ has joined #ocaml
kaustuv has joined #ocaml
tvn has joined #ocaml
valross has quit [Read error: 60 (Operation timed out)]
tvn has quit [Client Quit]
jcaose_ has joined #ocaml
ua has joined #ocaml
jcaose has quit [Read error: 110 (Connection timed out)]
deavid has quit [SendQ exceeded]
deavid has joined #ocaml
deavid has quit [SendQ exceeded]
tmaeda is now known as tmaedaZ
deavid has joined #ocaml
deavid has quit [SendQ exceeded]
deavid has joined #ocaml
deavid has quit [SendQ exceeded]
deavid has joined #ocaml
gim has quit []
gim has joined #ocaml
deavid has quit [Read error: 60 (Operation timed out)]
deavid has joined #ocaml
_andre has joined #ocaml
thelema has quit [Remote closed the connection]
thelema has joined #ocaml
ttamttam has quit ["Leaving."]
thelema_ has joined #ocaml
thelema has quit [Read error: 54 (Connection reset by peer)]
thelema has joined #ocaml
thelema_ has quit [Read error: 54 (Connection reset by peer)]
ztfw has joined #ocaml
zhijie1 has quit ["Leaving."]
zhijie has joined #ocaml
ua has quit [Read error: 113 (No route to host)]
rwmjones_ has joined #ocaml
ttamttam has joined #ocaml
Yoric has quit []
Yoric has joined #ocaml
Yoric has quit []
verte has quit ["~~~ Crash in JIT!"]
rwmjones_ has quit [Remote closed the connection]
hjpark has joined #ocaml
<hjpark> if do "open SomeModule" from one source code, There's no name collision between the source code and SomeModule?
<hjpark> If i define some type nice = int | string in SomeModule and also define type nice = float | int in the source, There's no error.
<flux> the latter definition will be in use
<flux> and there indeed is no error (or other indication) of this
<flux> it doesn't affect previous dependant definitions
<hjpark> umm...
<hjpark> There's no way to access nice type at SomeModule?
<hjpark> SomeModule.nice ?
<flux> nope
<flux> instead of opening a module you can do module S = SomeModule to avoid spelling SomeModule out all the time
<hjpark> ah
seanmcl has joined #ocaml
hjpark has quit [Remote closed the connection]
Snark has joined #ocaml
Yoric has joined #ocaml
ua has joined #ocaml
jcaose_ is now known as jcaose
ttamttam has quit ["Leaving."]
seanmcl has quit []
Yoric has quit []
Yoric has joined #ocaml
ttamttam has joined #ocaml
_unK has joined #ocaml
munga_ has quit [Read error: 60 (Operation timed out)]
ua has quit [Read error: 113 (No route to host)]
julm has quit [Read error: 104 (Connection reset by peer)]
julm has joined #ocaml
Yoric has quit []
_zack has quit ["Leaving."]
Yoric has joined #ocaml
ikaros has joined #ocaml
_zack has joined #ocaml
tmaedaZ is now known as tmaeda
_zack has quit ["Leaving."]
ski_ has quit ["Lost terminal"]
ikaros has quit ["Leave the magic to Houdini"]
ikaros has joined #ocaml
jcaose has quit [Success]
ski_ has joined #ocaml
_zack has joined #ocaml
kaustuv has quit ["ERC Version 5.3 (IRC client for Emacs)"]
_andre has quit ["reboot"]
_andre has joined #ocaml
_zack has quit ["Leaving."]
ksson has joined #ocaml
jcaose has joined #ocaml
<Alpounet> hcarty, ping ?
tmaeda is now known as tmaedaZ
mishok13 has quit [Connection timed out]
_andre has quit ["leaving"]
ksson has quit ["leaving"]
bombshelter13__ has quit [Connection timed out]
onigiri has joined #ocaml
onigiri has quit [Client Quit]
onigiri has joined #ocaml
<hcarty> Alpounet: pong
onigiri has quit [Read error: 104 (Connection reset by peer)]
onigiri has joined #ocaml
onigiri has quit [Read error: 104 (Connection reset by peer)]
_andre has joined #ocaml
Amorphous has quit [Read error: 113 (No route to host)]
onigiri has joined #ocaml
Amorphous has joined #ocaml
ulfdoz has joined #ocaml
mishok13 has joined #ocaml
onigiri has quit []
ikaros has quit ["Leave the magic to Houdini"]
ikaros has joined #ocaml
Asmadeus has quit [Read error: 60 (Operation timed out)]
animist_ has joined #ocaml
Asmadeus has joined #ocaml
tmaedaZ is now known as tmaeda
animist has quit [Read error: 111 (Connection refused)]
jcaose has quit [Read error: 110 (Connection timed out)]
ygrek has joined #ocaml
jcaose has joined #ocaml
jcaose has quit ["Leaving"]
jcaose has joined #ocaml
Yoric has quit []
<safire> This expression has type x but is here used with type x
<safire> i get these errors every so often
<safire> and I can't understand why
<safire> happens when I'm calling the function, not when I'm defining it
<Camarade_Tux> safire: in the toplevel, right?
<safire> yes
<flux> less-than-nice feature of my myocamlbuid.ml-file: if a package doesn't exist, the effect of pkg_xxx disappears fully, ie. it doesn't produce an error (..directly..)
<Camarade_Tux> you most probably defined your types twice (even with the same definition, the types will be incompatible), when that happens, try to close the toplevel and start it again
<safire> yeah, just rememered that
<hcarty> flux: Yes, that is a major downside to the general findlib support in myocamlbuild.ml
<hcarty> s/general/common/
<flux> safire, easy way to reproduce: type x = X let a b = b = X;; type x = X;; a X;;
Snark has quit ["Ex-Chat"]
ulfdoz has quit [Success]
jcaose has quit [Read error: 104 (Connection reset by peer)]
onigiri has joined #ocaml
ygrek has quit [Remote closed the connection]
mishok13 has quit [Connection timed out]
ttamttam has quit ["Leaving."]
ulfdoz has joined #ocaml
slash_ has joined #ocaml
Submarine has joined #ocaml
bohanlon has joined #ocaml
bohanlon is now known as bohanlon_
Yoric has joined #ocaml
bohanlon_ is now known as bohanlon
Yoric has quit []
thrasibule has joined #ocaml
ulfdoz has quit [Read error: 60 (Operation timed out)]
ikaros_ has joined #ocaml
ikaros has quit [Read error: 110 (Connection timed out)]
BigJ2 has joined #ocaml
<BigJ2> are linked lists and binary trees similar?
<mrvn> in that they link things together? sure.
<BigJ2> i haven't been able to find any info on ocaml linked lists
<mrvn> BigJ2: 'a list is a single linked list
<mrvn> There is no double linked list by default. Can't be functional.
<BigJ2> ohh i see
<BigJ2> lists i know
<mrvn> A list in ocaml is type 'a list = Nil | Cons of 'a * 'a list
<mrvn> Nil being [] and Cons usualy created through ::
clog has joined #ocaml
M| has quit [Remote closed the connection]
<mrvn> equivalent but not identical. 'a list is built-in with some special quirks in the compiler.
<mrvn> namely the [] and ::
<BigJ2> how do u add elements if those are not available?
<mrvn> with Null and Regular (node, vec)
<mrvn> And you can not "add" elements. You can only create a new list that is bigger.
<BigJ2> right lists are functional so only copying is allowed not modifying of data structures
<mrvn> yep.
<BigJ2> i guess I am just trying to figure out how to construct my elements
<mrvn> let l1 = Null in let l2 = Regular (l1, v1) in let l3 = Regular (l2, v2) ...
<mrvn> With Null and Regular you can write your own append, iter, map, ...
<mrvn> But do you really want to? Why not type node = vector list?
<mrvn> Only reason not to use list is for a homework asignemnt.
<BigJ2> ya that is the exact reason
<mrvn> hehe.
<mrvn> The write your own List module kind of assignment.
<mrvn> We all had to do that once.
<BigJ2> why did u first learn ocaml?
<mrvn> University course: Programming languages and concepts
<BigJ2> ya mine is Imperative Programming
<BigJ2> learn ocaml first then C
<BigJ2> ocaml takes a lot of getting used to
<mrvn> Every 2 weeks or so we would look at a different language. Greate way to learn what is out there. Also gave insights into why/how they implement it and the theory behind it.
<mrvn> BigJ2: after scheme ocaml is a breeze.
<BigJ2> is scheme functional?
<mrvn> And ocaml has a lot of "fun".
<BigJ2> ya ocaml is starting to grow on me, but I definitely want to know a lot about C
<mrvn> ocaml and C are quite on opposite sides of the spectrum.
<BigJ2> ya in terms of memory access
slash_ has quit [Client Quit]
<mrvn> no, in terms of concepts
<mrvn> and level.
<mrvn> C is just an universal assembler. Verry low-level and verry imperative.
<mrvn> ocaml is rather high-level and functional. Highly abstract and higher level functions and such.
<mrvn> In C you have to write types, ocaml infers them automaticall.
<BigJ2> thanks for the help. I have to get to work. I will be back
BigJ2 has quit [Client Quit]
<mrvn> could go on for hours. :)
* mrvn waves at the empty air