x711Li has quit [Read error: Connection reset by peer]
junsuijin has quit [Quit: Leaving.]
sebz has joined #ocaml
virtuoussin13 has joined #ocaml
<virtuoussin13>
In the mli for the event module, there's this line: type +'a event
<virtuoussin13>
what does the plus mean in the type variable (?_
arubin has quit [Quit: arubin]
virtuoussin13 has quit [Quit: ChatZilla 0.9.87 [Firefox 7.0.1/20110930100559]]
hto has quit [Quit: Lost terminal]
hto has joined #ocaml
edwin has joined #ocaml
ygrek has joined #ocaml
ygrek has quit [Remote host closed the connection]
sebz has quit []
Snark has joined #ocaml
everyonemines has quit [Quit: Leaving.]
sebz_ has joined #ocaml
sebz_ has quit [Client Quit]
sebz has joined #ocaml
ygrek has joined #ocaml
sebz has quit [Client Quit]
sebz has joined #ocaml
sebz has quit [Client Quit]
joewilliams is now known as joewilliams_away
avsm has joined #ocaml
sebz has joined #ocaml
ygrek has quit [Remote host closed the connection]
Cyanure has joined #ocaml
Skolem has joined #ocaml
sebz has quit [Client Quit]
<Skolem>
How do I declare a function's return type? I want to declare that foo is of type int-> int. I have let (foo x : int) : int = x + 2, but that's not right... I get a syntax error.
<Skolem>
Ah. let foo (x : int) : int = x + 2;;
<adrien>
or
<adrien>
let foo : int -> int = fun x -> x + 2;;
<Qrntzz>
let foo x : int = x + 2 ;; should be enough
<adrien>
(for the full type)
<adrien>
but your last one should be good for only the return type
<Skolem>
adrien, my last one declares both the type of the argument and the return type, right? (making sure I understand)
<adrien>
nope, it specifies only the return type I think
<adrien>
but why do you want to put it yourself?
<Skolem>
Is the (x : int ) ignored?
<adrien>
is this a reduced case or are you learning?
<Skolem>
I want to put it in myself for debugging.
<adrien>
ok
<Skolem>
To force the compiler to make it that type, to make sure it is what I think it is.
<adrien>
if you use different modules, it's easier and more readable to put that in the module signature
<Skolem>
Ah, thanks for the tip. I haven't worked with modules yet. I'l have to explore that.
<adrien>
well, as soon as you've created a file, you have made your first module ;-)
<adrien>
(foo.ml implicitely defines the module Foo)
<Skolem>
I was not aware of that. Cool.
<Skolem>
So far I've mainly been using ocamlscript, so I'm creating foo, not foo.ml :p
<Skolem>
I could also say let foo (x : int) = (x + 2 : int)
ygrek has joined #ocaml
Skolem has quit [Quit: Skolem]
ttamttam has joined #ocaml
ikaros has joined #ocaml
Skolem has joined #ocaml
Boscop has joined #ocaml
eikke has joined #ocaml
Kakadu has joined #ocaml
ttamttam has left #ocaml []
alang has quit [Read error: Connection reset by peer]
sebz has joined #ocaml
everyonemines has joined #ocaml
lopex has joined #ocaml
<Skolem>
Zarith is amazing. I love being able to say stuff like Z.(~$1 ** q mod p)
<Skolem>
and have it be executed so efficiently.
<everyonemines>
With a power function, you can define that as open Big_int;; let big_power x y z= power unit_big_int (fun x y z -> (mult_big_int x y) mod_big_int z);;
<everyonemines>
I don't think the way you wrote it will mod it at each step, which is needed for efficient ^ of big numbers.
<everyonemines>
er, I meant let big_power z= power unit_big_int (fun x y z -> (mult_big_int x y) mod_big_int z);;
<everyonemines>
....or rather, let big_power z= power unit_big_int (fun x y -> (mult_big_int x y) mod_big_int z);;
emmanuelux has joined #ocaml
<Skolem>
Oh, right. I appreciate the suggestion. I agree it's not efficient this way; that was just an example of the syntax. Your way would be much better.
sebz has quit [Quit: Computer has gone to sleep.]
emmanuelux has quit [Read error: Connection reset by peer]
emmanuelux has joined #ocaml
<Skolem>
fun x y -> Z.((x * y) mod z)
ztfw has joined #ocaml
lopex has quit []
bitbckt has quit [Quit: out]
eikke has quit [Ping timeout: 260 seconds]
bitbckt has joined #ocaml
sebz has joined #ocaml
Associat0r has joined #ocaml
Associat0r has quit [Changing host]
Associat0r has joined #ocaml
eikke has joined #ocaml
everyonemines has quit [Quit: Leaving.]
Associat0r has quit [Quit: Associat0r]
julm has quit [Quit: leaving]
avsm has quit [Quit: Leaving.]
hto has quit [Ping timeout: 260 seconds]
sebz has quit [Quit: Computer has gone to sleep.]
Associat0r has joined #ocaml
Associat0r has quit [Changing host]
Associat0r has joined #ocaml
Associat0r has quit [Client Quit]
sebz has joined #ocaml
hto has joined #ocaml
darkestkhan has joined #ocaml
<darkestkhan>
I have one question: can someone give me example of function of type 'a -> 'b ?
<adrien>
Obj.magic xD (kidding, don't use that)
<asmanur_>
darkestkhan: let rec f x = f x
<asmanur_>
but any function of that type won't terminate / use unpure features.
<darkestkhan>
thx
<darkestkhan>
asmanur_: I know, but it was the last exercise from my list of exercises from lecture of functional programming, and I just couldn't think about such function
<thelema>
darkestkhan: let _ = assert false
<thelema>
or let _ = failwith "Does not return"
<darkestkhan>
thelema: thx for additional examples
<Kakadu>
darkestkhan: does your lections mention Carry-Howard isomorphism?
<darkestkhan>
not yet
<darkestkhan>
(it was first lecture)
<Kakadu>
:)
<Kakadu>
your question is a little bit connected with this isomorphism
<zorun>
Kakadu: it's Curry-Howard
<zorun>
(iirc)
<Kakadu>
zorun: yep
hto_ has joined #ocaml
smerz has joined #ocaml
hto_ has quit [Quit: leaving]
<darkestkhan>
well, I bet we will get to Curry-Howard isomorphism when time comes to it, and in the meantime in coming 3 months we will run through ocaml, haskell and scheme
<preyalone>
Error: This expression has type 'a list but an expression was expected of type string.
<preyalone>
Except the line in question SHOULD create a char list, not a string. It's only the overall function encrypt that returns a string, once all the crypto stuff is finished.
<virtuoussin13>
so, if I say type +'a t = 'a list, and have some object type Foo, and some other object type Bar which is a subclass of Foo
<virtuoussin13>
the a function which takes a t will take not only a Foo list but a Bar list?
<preyalone>
virtuoussin13: Are you responding to my question, or posing your own question?
<virtuoussin13>
posing my own question
<virtuoussin13>
preyalone: what are the columns it's listing as having the wrong type?
<thelema>
virtuoussin13: not quite, but you can cast (x : Foo list :> Bar list)
<preyalone>
virtuoussin13: Error on line 70, characters 40-48
<virtuoussin13>
preyalone: it looks like ocaml thinks your password is a list, not a string
<thelema>
preyalone: it's because you opened List
<virtuoussin13>
yeah, the length is becoming List.length
<thelema>
L69 says "length password", which it interprets as List.length
<virtuoussin13>
from which ocaml infers that password is a list
<virtuoussin13>
if you do String.length it should work
<preyalone>
Thanks, that fixed it.
<thelema>
preyalone: instead of opening list, you can do `module L = List` and then L.foo
<thelema>
similarly `module S = String`
<virtuoussin13>
thelema: I'm confused still, what does covariant type let you do then?
<thelema>
I pretty much only open modules like printf that have distinctive function names
<thelema>
virtuoussin13: type cast
<thelema>
virtuoussin13: ocaml never does automatic type casting, even when it's obvious.
<preyalone>
I'm surprised that OCaml, a functional language, requires you to import the List module before you can use map.
<thelema>
preyalone: there's not only List.map, but also Array.map, Set.map, Map.map, and more.
<thelema>
preyalone: because there's no overloading in ocaml, you have to specify which one you want
<preyalone>
I suppose, but you could just call them map, amap, smap, and mmap.
<virtuoussin13>
oh, so if you have type +'a t, and have the Foo and Bar as above, then the +'a will let you cast a (Bar) t to a (Foo) t?
<thelema>
virtuoussin13: yes. Some types are covariant, some are contravariant, and you can cast the other way.
<virtuoussin13>
gotcha
<thelema>
preyalone: yup. I have a module that I open that has my set of shortcuts like that in it.
<virtuoussin13>
how is the object layer in Ocaml, I've only ever glanced at it
<preyalone>
thelema: I want to use logxor, but I'd rather not specify Int32.logxor or Int64.logxor, but automatically choose the highest supported one. Thoughts?
<virtuoussin13>
preyalone: what do you mean by highest supported one?
<thelema>
virtuoussin13: it's structurally typed, which is interesting for an object layer.
<virtuoussin13>
I'm pretty sure Int64 and Int32 are supported on all platforms?
<preyalone>
An x86 machine doesn't support 64-bit integers, no?
<virtuoussin13>
sure it does
<thelema>
preyalone: Int64 provides 64-bit integers on even 32-bit platforms
<virtuoussin13>
and even if it didn't, you could simulate it in software anyway
<preyalone>
Anyway, I want to logxor two ASCII characters, and I'd rather not fiddle with 32 vs 64 bits if I can manage it.
<virtuoussin13>
if you're just xor'ing two char's, you're restricting yourself to at most 8 bits, so you won't be bitten by the 31 bit limit of native ints in ocaml
<thelema>
the compiler will eliminate the noop conversions
<virtuoussin13>
native ints will be faster than muddling with Int32 and Int64
preyalone_ has joined #ocaml
<preyalone_>
virtoussin13: There's no RegularInt module exporting a function logxor. Only Int32 and Int64 seem to do so.
<thelema>
preyalone: err, lxor
<thelema>
lxor is provided in Pervasives
<mfp>
Char.(chr (code x lxor code y)) ;-)
<virtuoussin13>
val (lxor) : int -> int -> int
<mfp>
3.12's cheapo delimited overloading is handy at times
<virtuoussin13>
oh...I was under the impression you could only define infix functions that have non-alpha numeric characters in tho
<virtuoussin13>
*in them'
<preyalone_>
thelema: Thanks, lxor does the trick!
<thelema>
virtuoussin13: that's correct, users can only define such functions. lxor, land, etc. are built into the lexer as special cases (and are thus keywords)
<virtuoussin13>
hah!
<virtuoussin13>
okay, that explains that
<virtuoussin13>
nice little bit of usability there on the part of the ocaml creators
<thelema>
virtuoussin13: Maybe re-define the lxor infix function....
<virtuoussin13>
is there a roadmap for ocaml? Like, what features are planned for 3.13, when's it going to be released, etc.
preyalone has quit [Ping timeout: 252 seconds]
<thelema>
virtuoussin13: 3.13 will be released when it's ready. There's a changelog in SVN
<thelema>
it looks like 3.12.2 will come out before 3.13
<virtuoussin13>
thelema: I know, I was just wondering if the ocaml team set themselves deadlines or what
<virtuoussin13>
you actually managed to puzzle that out/
<thelema>
It's not the easiest read, but it's got a *lot* of important details
<virtuoussin13>
yeah no kidding
<thelema>
There's still parts I don't get/use much; mainly the section on objects
<thelema>
I've written OO code in ocaml, but find that I can't mix it well with functors, so generally stick to function style
<flux>
and current camlp4 which remains basically undocumented?-(
<thelema>
flux: yes, that I know nothing of. But then I knew nothing of the old camlp4, so...
<virtuoussin13>
flux: there's the wiki....
<virtuoussin13>
good luck with that tho
<virtuoussin13>
whoa, you can have statements that can be evaluated for side effects in a module? When are they run?
<thelema>
virtuoussin13: when that module is instantiated
<thelema>
for modules defined by files, the link order determines execution order
<virtuoussin13>
I was just about to ask
<virtuoussin13>
haha, thanks
<thelema>
for modules in files, they are run in order of file positino
<thelema>
just like everything else
<thelema>
anyway, gotta go. cheers
<virtuoussin13>
thanks for all your help thelema
sebz has quit [Quit: Computer has gone to sleep.]
virtuoussin13 has quit [Quit: ChatZilla 0.9.87 [Firefox 7.0.1/20110930100559]]
Boscop_ has joined #ocaml
sebz has joined #ocaml
Boscop has quit [Ping timeout: 252 seconds]
f[x] has quit [Ping timeout: 240 seconds]
zorun has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]
penryu has left #ocaml []
lpereira has quit [Quit: Leaving.]
preyalone has joined #ocaml
jamii has joined #ocaml
<preyalone>
How can I parse integers from strings in OCaml?
<Kakadu>
preyalone: int_of_string?
<preyalone>
Kakadu: Thanks.
<preyalone>
Kakadu: How can I parse an integer from a string, but manually specify the base/radix?
<_habnabit>
There's nothing in the stdlib.
Cyanure has quit [Remote host closed the connection]
<raphael-p>
preyalone: you can prepend the string with 0x 0o or 0b if hexa, octal or binary
<raphael-p>
but there's no generic builtin function
<preyalone>
Aye, it's looking like that. Merf, I'd like to be able to do parse_int("444", 5).
<_habnabit>
It's easy to write.
<raphael-p>
preyalone: if the answer is 124, I have the code
<raphael-p>
I can copy it somewhere
preyalone has quit [Ping timeout: 252 seconds]
hcarty has quit [Quit: leaving]
Boscop_ is now known as Boscop
Boscop has quit [Changing host]
Boscop has joined #ocaml
laraht has joined #ocaml
laraht has quit [Client Quit]
larhat has joined #ocaml
eikke has quit [Ping timeout: 258 seconds]
edwin has quit [Remote host closed the connection]
Snark has quit [Quit: Quitte]
preyalone has joined #ocaml
<preyalone>
When I run "./ios7crypt -d 1104160b1c1712", I get "Fatal error: exception Invalid_argument("String.sub")". https://gist.github.com/1256809
<preyalone>
Unsure which String.sub call raises the error.
Kakadu has quit [Quit: Konversation terminated!]
<larhat>
gildor, issue 888 in oasis isue tracker is fixed, but setup.ml in last release (0.2.1~alpha1) still has that bug about version ("OCaml version 3.13.0+dev7 (2011-09-22) doesn't match version constraint >= 3.11.0"). Maybe it's better to regenerate setup.ml with new oasis, where that bug is fixed?
<raphael-p>
btw, line 85 could use some deforestation
<raphael-p>
right now the list is traversed twice
<raphael-p>
(not of the utmost importance)
<preyalone>
raphael-p: Yes. In the Haskell version, I compose int_of_string and prepend-0x, then map that over the lists.
<_habnabit>
preyalone: In the future, doing 'export OCAMLRUNPARAM=b' will mean that you get tracebacks on errors.
<preyalone>
_habnabit: Thanks much!
<preyalone>
raphael-p: I just combined the functions into a single function and mapped over that.
<preyalone>
_habnabit: I also need to link with -g, apparently. Does that argument go to ocamlc/ocamlopt?
<_habnabit>
It's an environment variable.
<preyalone>
Oh, I should add -g after b?
<_habnabit>
Oh, you mean when compiling.
<preyalone>
Yar.
<preyalone>
Fatal error: exception Invalid_argument("String.sub") (Program not linked with -g, cannot print stack backtrace)
<_habnabit>
No idea; I always use ocamlbuild and it Just Works.
<preyalone>
hahaha.
<preyalone>
That's what the Clojure folks say when I ask them how to compile a .clj script. "Just use Leiningen, it works for me." It's silly how the core language doesn't make such basic features convenient.
preyalone has quit [Quit: Page closed]
ikaros has quit [Quit: Ex-Chat]
ygrek has quit [Ping timeout: 248 seconds]
schme has quit [Ping timeout: 276 seconds]
abdallah has joined #ocaml
fraggle_ has quit [*.net *.split]
flux has quit [*.net *.split]
adrien has quit [*.net *.split]
alpounet has quit [*.net *.split]
yroeht has quit [*.net *.split]
foocraft has quit [*.net *.split]
explodus has quit [*.net *.split]
patronus_ has quit [*.net *.split]
zzz_ has quit [*.net *.split]
vram0 has quit [*.net *.split]
mejalx has quit [*.net *.split]
emias has quit [*.net *.split]
flux has joined #ocaml
Boscop has quit [*.net *.split]
mjonsson has quit [*.net *.split]
The_third_bug has quit [*.net *.split]
hnrgrgr has quit [*.net *.split]
lopex has quit [*.net *.split]
ztfw has quit [*.net *.split]
milosn has quit [*.net *.split]
mundkur_ has quit [*.net *.split]
pheredhel` has quit [*.net *.split]
mbac_ has quit [*.net *.split]
asmanur_ has quit [*.net *.split]
chambart has quit [*.net *.split]
olasd has quit [*.net *.split]
mehdid has quit [*.net *.split]
gildor has quit [*.net *.split]
emias has joined #ocaml
mejalx has joined #ocaml
vram0 has joined #ocaml
zzz_ has joined #ocaml
patronus_ has joined #ocaml
explodus has joined #ocaml
foocraft has joined #ocaml
yroeht has joined #ocaml
alpounet has joined #ocaml
adrien has joined #ocaml
5EXAAK4YF has joined #ocaml
fraggle_ has joined #ocaml
Boscop has joined #ocaml
mjonsson has joined #ocaml
lopex has joined #ocaml
ztfw has joined #ocaml
milosn has joined #ocaml
The_third_bug has joined #ocaml
mundkur_ has joined #ocaml
pheredhel` has joined #ocaml
mbac_ has joined #ocaml
hnrgrgr has joined #ocaml
gildor has joined #ocaml
mehdid has joined #ocaml
olasd has joined #ocaml
chambart has joined #ocaml
asmanur_ has joined #ocaml
5EXAAK4YF has quit [Read error: Connection reset by peer]
Amorphous has quit [Read error: Connection reset by peer]
eikke has joined #ocaml
emmanuelux has quit [Remote host closed the connection]