Nutssh has quit [Read error: 110 (Connection timed out)]
Kinners has joined #ocaml
Hadaka has quit [Read error: 60 (Operation timed out)]
Hadaka has joined #ocaml
gl has quit [Read error: 60 (Operation timed out)]
liralen has quit ["system"]
noss has quit ["hej då"]
Riastradh has quit [Read error: 60 (Operation timed out)]
liralen has joined #ocaml
Riastradh has joined #ocaml
<pattern>
let foo x = match x with
<pattern>
("abc",y) -> y
<pattern>
| ("",y) -> y
<pattern>
Warning: this pattern-matching is not exhaustive.
<pattern>
Here is an example of a value that is not matched:
<pattern>
("*", _)
<liralen>
hee.
<pattern>
why is this? and what is "*"?
<Smerdyakov>
It should be obvious.
<pattern>
and when i do add this: | ("*",y) -> y
<liralen>
pattern - err, because that doesn't match everything -- such as "*"
<pattern>
Warning: this pattern-matching is not exhaustive.
<pattern>
Here is an example of a value that is not matched:
<pattern>
("**", _)
<Smerdyakov>
"*" is not "abc" and "*" is not "".
<liralen>
pattern - or "a", or "b", or "supercalifragilisticexpialadocious"
<pattern>
so "*" is a wildcard?
<Smerdyakov>
No
<liralen>
pattern - no.
<Smerdyakov>
It's just a convenient example of a string you don't match.
<pattern>
oh
<pattern>
| (_,y) -> y
<pattern>
that shut it up
<Smerdyakov>
What is the full text of your function now?
<liralen>
you may as well only have that line, in context.
<pattern>
let foo x = match x with
<pattern>
("abc",y) -> y
<pattern>
| ("",y) -> y
<pattern>
| (_,y) -> y
<liralen>
that match, even.
<Smerdyakov>
Haha!
<Smerdyakov>
I hope you see how silly that code is.
<pattern>
well, that was just an example
<pattern>
yes
<pattern>
my real function isn't like that
<Smerdyakov>
Okeydoke.
<pattern>
but it was also complaining about the "*"
<pattern>
and i was also confused about why, when i put in the "*" it would complain about "**"
<pattern>
sounds like a candidate for some improved error messages
<liralen>
pattern - it created "*" to offer you a physical example of a string that your non-exhaustive pattern-match didn't match.
<pattern>
yes, i understand now
<Smerdyakov>
pattern, I don't know. It's pretty clear what "*" is, since it's an OCaml expression.
<liralen>
great, then you no longer need 'improved' error messages =)
<pattern>
liralen, if the error message was clear i wouldn't have had to ask
<pattern>
:)
<Smerdyakov>
It _was_ clear.
<pattern>
"*" is not a wildcard, nor is it literraly supposed to be what doesn't match (at least not everything that doesn't match, just one example)
<pattern>
i would call this an obfuscated error message
<Smerdyakov>
I wouldn't.
<pattern>
it should say something like "any sequence of characters apart from those you specified would not match"
<Smerdyakov>
You should interpret OCaml expressions as OCaml expressions.
<Smerdyakov>
Not terms in some language of your invention;.
<pattern>
then, "i most humbly request you either put in more sequences of matching characters or an _ as a default case if you don't care to match more specific sequences of characters"
<pattern>
:)
<liralen>
pattern - I will destroy you!
<pattern>
haha
gl has joined #ocaml
cjohnson has quit ["Drawn beyond the lines of reason"]
<pattern>
type name = First of string * Last of string
<pattern>
what is wrong with that?
<pattern>
i get a preprocessor error
<pattern>
"type name = First of string" works, though
<Smerdyakov>
Use | instead of *....
<pattern>
but i don't want either first or last name
<Smerdyakov>
What _do_ you want?
<pattern>
i want name to represent both at once
<pattern>
so it'd be a tuple
<Smerdyakov>
So then what's with the First and Last?
<pattern>
("John","Smith")
<Smerdyakov>
string * string is the type you want.
<Smerdyakov>
You don't need to define anything.
<pattern>
ah
<Smerdyakov>
[Well SOMEONE is not bothering to read an OCaml tutorial. ;)]
<Riastradh>
Perhaps you meant to want something like this: type name = { first : string; last : string }
<pattern>
i did read about it once
<pattern>
i just don't have one handy
<pattern>
i started digging through the manual
<pattern>
riastradh, yes, maybe that'd work too... but i'm even less familiar with ocaml records
<pattern>
thank you both, btw
<Smerdyakov>
Man, I love the Omega tactic in Coq. Using it makes me feel like the Arch Wizard of the land. The name makes it all the more fun.
anpanman has joined #ocaml
drWorm has quit [Read error: 60 (Operation timed out)]
tomasso has quit ["Leaving"]
palomer has left #ocaml []
Nutssh has joined #ocaml
Nutssh has quit [orwell.freenode.net irc.freenode.net]
anpanman has quit [orwell.freenode.net irc.freenode.net]
<Guillaumito>
I want to use an Hashtbl in a type definition
<Nutssh>
?
<Guillaumito>
so I'm doing something like : "module MyHash = Hashtbl.Make(MyHashedType);;"
<Guillaumito>
and "type mytype = { h : MyHash.t ; };;"
<Guillaumito>
but it tells me that MyHash.t needs an argument
<Guillaumito>
what's wrong ?
<Nutssh>
You need to make a structure module MyType = struct type t = ... let hash = ... let compare = ... end. Then pass that module as a functor argument. There's an example of this in the manual.
<Nutssh>
Hashtbl is a functor from modules (implementing the required signature as given) to modules.
<Guillaumito>
yes I'm doing it
<Guillaumito>
MyHashedType is a struct
<Guillaumito>
but it's like it needs two structure
<Guillaumito>
one for the key and one for the values
<Nutssh>
Compile the first parts with ocamlc -i to see the signature of the module CMI.. CMI.t is an open type. its 'a CMI.t
karryall has quit ["."]
Nate1975 has quit ["using sirc version 2.211+KSIRC/1.2.4"]
<Guillaumito>
Nutssh: ok
<Guillaumito>
Nutssh: thank you very much
<Nutssh>
Sure. Functors can be a bit interesting to use, but very powerful. I still need to learn how to compine them with OO.
<Guillaumito>
I use the Set module for a while now
<Guillaumito>
but no OO
<Guillaumito>
(no OO in ocaml I mean)
<Nutssh>
I know. I've not really started to use ocaml OO. I hope to at some point.
<Guillaumito>
maybe I will try ocaml OO later, but for now, I'm too much a beginner
Nutssh has quit ["Client exiting"]
ott has quit []
ott has joined #ocaml
Guillaumito has quit ["Client exiting"]
Nutssh has joined #ocaml
Guillaumito has joined #ocaml
karryall has joined #ocaml
drWorm has joined #ocaml
Nutssh has quit ["Client exiting"]
Nutssh has joined #ocaml
pattern has quit [orwell.freenode.net irc.freenode.net]
karryall has quit [orwell.freenode.net irc.freenode.net]
det has quit [orwell.freenode.net irc.freenode.net]
Guillaumito has quit [orwell.freenode.net irc.freenode.net]
Hadaka has quit [orwell.freenode.net irc.freenode.net]
jesse_ has quit [orwell.freenode.net irc.freenode.net]
voltron has quit [orwell.freenode.net irc.freenode.net]
_shawnafk has quit [orwell.freenode.net irc.freenode.net]
skylan has quit [orwell.freenode.net irc.freenode.net]
pattern has joined #ocaml
karryall has joined #ocaml
Guillaumito has joined #ocaml
Hadaka has joined #ocaml
jesse_ has joined #ocaml
voltron has joined #ocaml
_shawnafk has joined #ocaml
det has joined #ocaml
skylan has joined #ocaml
* Guillaumito
is away: a table
cjohnson has joined #ocaml
* Guillaumito
is back (gone 00:16:38)
mimosa has joined #ocaml
jesse_ has quit [Read error: 104 (Connection reset by peer)]
* Guillaumito
is away: kawak
giedi has quit [Read error: 60 (Operation timed out)]
* Guillaumito
is back (gone 00:18:11)
<Demitar>
Guillaumito, could you please turn off the announcement of away? It makes it hard to see if it's real activity in a channel by looking at the channel tab. :)
<Guillaumito>
ok :)
Guillaumito has left #ocaml []
<Demitar>
Oh, no! I scared him away! :)
<Defcon7>
can i use open append to "tail" a file starting reading from the end ?
<Defcon7>
or it works only for writing ?
Nutssh has quit ["Client exiting"]
<Demitar>
Could you state that in code? I didn't follow.
<Defcon7>
there is a open flag called "Open_append" that should point the cursor at the end of the file, so if i start reading from here i should get eof, is this right ?
<Defcon7>
and...
<Defcon7>
how can i specify the open flag ?
<Defcon7>
i tried open_in_gen Open_append "/filename"
<Defcon7>
but it says it is a list
<Defcon7>
This expression has type open_flag but is here used with type open_flag list
<Demitar>
Yes, Open_append has the type open_flag, [Open_append] is a list of items with type open_flag, thus open_flag list.
<Defcon7>
how can i access this specific list element ?
<Defcon7>
i was reading the manual about lists but it doesnt explain how to access them
<karryall>
you sound very confused
<Defcon7>
yes i'am :P
<Defcon7>
#let l = ["is"; "a"; "tale"; "told"; "etc."];;
<Defcon7>
val l : string list = ["is"; "a"; "tale"; "told"; "etc."]
<Demitar>
Have you any previous programming experience? (I suspect a case of imperative thinking. :)
<Defcon7>
this is what says the manual about lists
<Demitar>
And what is it you want to do?
<Defcon7>
get a specific list element
<Demitar>
By index?
<Defcon7>
yes for example
<mellum>
You usually don't really want that.
<Defcon7>
-_-
<Demitar>
The primary ways to access a list are, List. iter, map, filter, hd, tl and pattern matching. If you really want to access by index use List.nth.
<Demitar>
I really can't remember when I last used List.nth, I usually just iterate over the elements.
<Demitar>
And I probably should add List.rev to the list.
<Defcon7>
understand me please, i'am new to ocaml, i've seen in the manual that open_in_gen needs the open_flag which is a list but the manual where talking of lists explains how to create them and insert elements, it isnt normal to be confused or lost ?
<Demitar>
Well all you want to do is to create a list.
<Demitar>
And the trivial way to create a list is to use [].
<Demitar>
Now [] is an empty list, [Open_append] is a list with one item. [Open_append;Open_append;Open_append] is a list with three items.
<Demitar>
It's really a constant value which happends to be a list.
wazze has joined #ocaml
<Demitar>
Defcon7, any less confused?
<Defcon7>
yes
<Defcon7>
i figured it out :)
<Defcon7>
but believe me, for a noob the ocaml manual is a bit confusing
<Defcon7>
for example
<Defcon7>
val open_in_gen : open_flag list -> int -> string -> in_channel
<Defcon7>
Open the named file for reading, as above. The extra arguments mode and perm specify the opening mode and file permissions.
<Defcon7>
we know what is the opening mode and we found the way to specify it
<Defcon7>
but what about file permissions ?
<Defcon7>
it talks of permissions and of an int
<Defcon7>
int = 2^32
<Defcon7>
which int ?
<Defcon7>
where i can see what int corresponds to what ?
<Defcon7>
and i get lost :P
<Demitar>
Well file permissions are inherently unportable.
<Defcon7>
it means unix way to specify permissions ?
<Defcon7>
like 7 = rwx 5=rx and ahead
<Defcon7>
?
<Defcon7>
and in what form
<Defcon7>
only 7 for rwx or i have to specify group and others ?
<Defcon7>
it isnt clear
<Demitar>
I think it's the common octal value.
<Demitar>
0o755
<Defcon7>
why dont specify it in the manual ?
<Defcon7>
with something like a table
<Defcon7>
an example
<Demitar>
Feel free to submit a patch. ;-)
<Defcon7>
:P
<Demitar>
I agree it's not as clear as it could be but right now I'm not going to bother.
<Defcon7>
and i understand you
<Defcon7>
but i got a manual not clear as it could and i get bothered when i ask questions
<Defcon7>
i have to kill me ?
<Defcon7>
:(
<Demitar>
Umm? I don't think I followed your reasoning there.
<Defcon7>
not you obviously, you are helping me and i'am thanks to you
<Demitar>
Ah well, the manual is a tad vague when it comes to lowlevel stuff sometimes. I suspect that's mostly a side-effect of it being an interface to the unix layer and is documented there. The parts specific to OCaml are generally quite well documented.
<pattern>
that's funny, i was just going to ask about how ocaml specifies permissions
<pattern>
i ran in to that when looking to use Unix.openfile
<pattern>
wound up using the open_out from pervasives instead
<Demitar>
Well why not use open_in(_bin) instead or do you specifically need it to create a new file?
<Defcon7>
let chid = open_in_gen [Open_append] 0755 "/var/log/mail.log";; is this code right ? it builds succesfully but doesnt works as expected...
<karryall>
pattern: man 2 open
<pattern>
i did need it to create a new file, and i did use open_in anyway
<pattern>
ahh, thanks, karryall
<pattern>
i looked at man 2 chmod
<Defcon7>
i have to use the open syscall format to specify the flag ?
<Defcon7>
O_APPEND ?
<pattern>
[O_APPEND], iirc
<pattern>
i think it wants a list
<Defcon7>
hmm it is for unix.open
<pattern>
or "[Unix.O_APPEND]"
<Defcon7>
i'am using pervasives open_in_gen
<Defcon7>
and it was accepting [Open_append]
<Defcon7>
and builds succesfully
<pattern>
ah, haven't played with open_in_gen, just open_in
<Defcon7>
but starts reading from the begin of the file
<Defcon7>
and i want it to start from the end
<Defcon7>
append should do this but doesnt :P
<karryall>
there's nothinf to read at the end of a file
<pattern>
isn't append for writing at the end?
<karryall>
that's why it's called "the end"
<karryall>
pattern: yes
<pattern>
i think he wants to read backwards
<pattern>
or skip back from the end, like tail
<Defcon7>
yes i have to do something like tail
<Defcon7>
so i want to start from the end
<Defcon7>
i used append but it starts from the begin
<pattern>
i'd guess you'd have to start from the beginning of the file and just skip to the end
<Defcon7>
i thought this before trying append but i dont have found something to measure the file length
<Defcon7>
do you know if theres something ?
<pattern>
system "wc -l" ? ;)
<Defcon7>
hehehe
<karryall>
in_channel_length
<Defcon7>
tnx karryall
gim has joined #ocaml
ott has quit []
wazze has quit ["Learning about how the end letters on French words are just becoming more and more silent, I conclude that one day the French]
wazze has joined #ocaml
lam has quit ["Lost terminal"]
Maddas has joined #ocaml
drWorm has quit [Read error: 60 (Operation timed out)]
gim has quit [Read error: 110 (Connection timed out)]
lam has joined #ocaml
gim has joined #ocaml
tomasso has joined #ocaml
Nutssh has joined #ocaml
Nutssh has quit ["Client exiting"]
wazze has quit ["Learning about how the end letters on French words are just becoming more and more silent, I conclude that one day the French]
wazze has joined #ocaml
stef has quit [Remote closed the connection]
buggs has joined #ocaml
cjohnson has quit [orwell.freenode.net irc.freenode.net]
anpanman has quit [orwell.freenode.net irc.freenode.net]
gim has quit [orwell.freenode.net irc.freenode.net]
liralen has quit [orwell.freenode.net irc.freenode.net]
rox has quit [orwell.freenode.net irc.freenode.net]
whee has quit [orwell.freenode.net irc.freenode.net]
wazze has quit [orwell.freenode.net irc.freenode.net]
lam has quit [orwell.freenode.net irc.freenode.net]
cmeme has quit [orwell.freenode.net irc.freenode.net]
Banana has quit [orwell.freenode.net irc.freenode.net]
smkl has quit [orwell.freenode.net irc.freenode.net]
Riastradh has quit [orwell.freenode.net irc.freenode.net]
owell has quit [orwell.freenode.net irc.freenode.net]
The-Fixer has quit [orwell.freenode.net irc.freenode.net]
Smerdyakov has quit [orwell.freenode.net irc.freenode.net]
srv has quit [orwell.freenode.net irc.freenode.net]
teratorn has quit [orwell.freenode.net irc.freenode.net]
wazze has joined #ocaml
gim has joined #ocaml
lam has joined #ocaml
cjohnson has joined #ocaml
anpanman has joined #ocaml
Riastradh has joined #ocaml
liralen has joined #ocaml
rox has joined #ocaml
whee has joined #ocaml
cmeme has joined #ocaml
owell has joined #ocaml
Banana has joined #ocaml
The-Fixer has joined #ocaml
Smerdyakov has joined #ocaml
srv has joined #ocaml
smkl has joined #ocaml
teratorn has joined #ocaml
anpanman has quit [orwell.freenode.net irc.freenode.net]
cjohnson has quit [orwell.freenode.net irc.freenode.net]
gim has quit [orwell.freenode.net irc.freenode.net]
rox has quit [orwell.freenode.net irc.freenode.net]
whee has quit [orwell.freenode.net irc.freenode.net]
liralen has quit [orwell.freenode.net irc.freenode.net]
Banana has quit [orwell.freenode.net irc.freenode.net]
lam has quit [orwell.freenode.net irc.freenode.net]
cmeme has quit [orwell.freenode.net irc.freenode.net]
wazze has quit [orwell.freenode.net irc.freenode.net]
smkl has quit [orwell.freenode.net irc.freenode.net]
Riastradh has quit [orwell.freenode.net irc.freenode.net]
srv has quit [orwell.freenode.net irc.freenode.net]
owell has quit [orwell.freenode.net irc.freenode.net]
Smerdyakov has quit [orwell.freenode.net irc.freenode.net]
teratorn has quit [orwell.freenode.net irc.freenode.net]
The-Fixer has quit [orwell.freenode.net irc.freenode.net]
wazze has joined #ocaml
gim has joined #ocaml
lam has joined #ocaml
cjohnson has joined #ocaml
anpanman has joined #ocaml
Riastradh has joined #ocaml
liralen has joined #ocaml
rox has joined #ocaml
whee has joined #ocaml
cmeme has joined #ocaml
owell has joined #ocaml
Banana has joined #ocaml
The-Fixer has joined #ocaml
Smerdyakov has joined #ocaml
srv has joined #ocaml
smkl has joined #ocaml
teratorn has joined #ocaml
_JusSx_ has joined #ocaml
Vincenz has joined #ocaml
maihem has joined #ocaml
karryall has quit ["home"]
whiskas has joined #ocaml
Nutssh has joined #ocaml
whiskas has quit []
The-Fixer has quit ["Goodbye"]
The-Fixer has joined #ocaml
cDlm has left #ocaml []
Nutssh has quit ["Client exiting"]
wazze has quit ["Learning about how the end letters on French words are just becoming more and more silent, I conclude that one day the French]
drWorm has joined #ocaml
mattam_ has joined #ocaml
<Demitar>
Could I pack a widget into a GtkTreeView? (lablgtk2)
mattam has quit [Read error: 110 (Connection timed out)]
pattern has quit [Read error: 60 (Operation timed out)]
pattern has joined #ocaml
mattam_ is now known as mattam
tomasso has quit [Read error: 110 (Connection timed out)]
tomasso has joined #ocaml
yun has joined #ocaml
maihem has quit [Read error: 104 (Connection reset by peer)]
Vjaz_ has joined #ocaml
jheffner has joined #ocaml
jheffner has quit [Client Quit]
wazze has joined #ocaml
Kinners has joined #ocaml
_JusSx_ has quit ["BitchX: try our lowfat flavor too!"]