<adrien>
everyonemines: but if you make sure the version used is not polymorphic, you already get a big speedup
<adrien>
start there
<everyonemines>
I wonder if you get speedup with pattern matching.
<adrien>
hevea can be really annoying
<everyonemines>
Instead of using if statements.
<adrien>
pattern matching is slower iirc
<everyonemines>
How do you tell when it's slower or faster?
<everyonemines>
I'm pretty sure it's faster in some cases...
<adrien>
testing, reading the assembly
<ousado>
it will translate to a jump table if possible, no?
<everyonemines>
I mean, when do you expect it to be faster?
<adrien>
last time I tried, "compare" was slower to make when using match ... with and I don't think min or max would be faster (prove me wrong; I don't see how to code it)
<everyonemines>
Or am I writing the match in a slow way?
<thelema>
everyonemines: not so good, I expect, as you'll end up doing two comparisons
<thelema>
L7 is better
<thelema>
except for the "then x"
<thelema>
oh, clip. n/m
<adrien>
slowest way I think :P
<ousado>
ocaml enforces sequential evaluation of pattern matches, right?
<thelema>
ousado: the semantics are that. It can optimize in any equivalent way
<ousado>
yes
<adrien>
t(min) : 4.171226
<adrien>
t(clip) : 6.273421
<adrien>
t(clip_int) : 0.753052
sebz has joined #ocaml
<adrien>
with only "0" as arguments always
<adrien>
let clip x a b = match (x>a, x<b) with
<adrien>
let clip_int x (a : int) (b : int) = match (x>a, x<b) with
<adrien>
so, what about specifying these ": int" ? :P
<flux>
adrien, sufficient to specify 'x' as int :)
<adrien>
heh, right ;-)
<adrien>
btw:
<adrien>
t(min) : 4.274784
<adrien>
t(min_int) : 0.188068
<everyonemines>
So if you add type annotations, the comparison goes faster?
<thelema>
everyonemines: yes
rixed has quit [Ping timeout: 240 seconds]
<adrien>
and I think that profiling the code shows what's happening:
<adrien>
t(min) : 15.584658
<adrien>
t(min_int) : 0.188475
<adrien>
also, from the profiling: 33.80 3.90 3.90 300000005 0.00 0.00 compare_val
<adrien>
so, a third of the time is used in the polymorphic comparison function
<everyonemines>
I compiled my 2 clip versions, results:
<everyonemines>
version 1 0m2.886s
<everyonemines>
version 2 0m2.795s
<everyonemines>
if statements win!
<everyonemines>
....in this case, but probably not always
<everyonemines>
OK, I re-ordered the pattern matching and now it's 0m2.794s
<everyonemines>
PATTERN MATCHING WINS
<thelema>
probably within statistical error
<adrien>
and cpu frequency switch and power saving effects
<everyonemines>
Nope, it's repeatable.
<everyonemines>
The actual difference is a bit larger with repeated trials, I was just amused by the .001s difference.
avsm has quit [Quit: Leaving.]
kizzx2 has joined #ocaml
<kizzx2>
any OcalIDE users around?
<kizzx2>
it may sound really silly :P but how do you invoke "ocamlbuild" from OcalIDE?
<everyonemines>
I tried let clip2 (x:int) (a:int) (b:int) = if x>a then (if x<b then x else b) else a;;
<everyonemines>
but it's the same speed.
<everyonemines>
Am I doing it wrong?
<everyonemines>
You're not using the actual min_int function right?
<everyonemines>
or value rather, the default min_int
<adrien>
kizzx2: can you make a Makefile and invoke it from ocalide,
<adrien>
?
bitbckt has joined #ocaml
<everyonemines>
OK, nevermind, I compiled to a different location. The type annotations make it much faster.
<adrien>
=)
<everyonemines>
Thanks for that tip, by the way.
<edwin>
everyonemines: let clip2 (x:int) (a:int) (b:int) = if (x > a && x < b) then x else if x < a then a else b;
<adrien>
:-)
<edwin>
would that help? to have just one branch for most common
<everyonemines>
edwin: Nope, it's 1.66 instead of 1.28
<everyonemines>
er, off by 10x but you get the idea
<edwin>
does ocamlopt short-circuit?
<thelema>
edwin: yes
<everyonemines>
Beats me.
<edwin>
ah it'd be better if it didn't in this case
<everyonemines>
You shouldn't assume the answer is usually X.
<thelema>
edwin: why?
<everyonemines>
It might usually clip.
<edwin>
btw doesn't sse3 or sse4 have some clip builtins?
<edwin>
but the overhead of a function-call to a C stub would probably hurt
<hcarty>
kizzx2: I haven't used it in a long time, but I think the simplest approach is to create a project with OcaIDE's ocamlbuild support and then compile however Eclipse does its compilation
<adrien>
let clip3_int (x:int) (a:int) (b:int) = if x<=a then a else (if x<b then x else b)
<adrien>
is much faster for me btw
<adrien>
(I swapped the two branches)
<adrien>
hmmm; I don't know why I tried that actually... but it's faster... but I have no idea what I had in mind when I tried it
<thelema>
everyone: how are you testing?
<everyonemines>
I'm using time on a big for loop.
<everyonemines>
Compiling with ocamlopt.
<edwin>
but what are your clip limits? is it really 0 and 255 always?
<everyonemines>
clip2 i 500 5000
<everyonemines>
adrien: I got the same speed.
<everyonemines>
You're probably using different clip inputs, I tried to balance them.
<adrien>
and clip2 gets as fast as my clip3 when I use -inline 1000; and clip_int (first try) gets twice as fast with -inline 1000
<adrien>
I'm using 0 0 0
<adrien>
anyway, I'm done playing; I'm going to hit hevea on the head
<adrien>
or simply give up
<everyonemines>
So the lesson I learned is, polymorphic functions are slow.
<hcarty>
everyonemines: Some are slow relative to optimized type-specific versions
<hcarty>
everyonemines: Polymorphic comparison is one example
ohwow has left #ocaml []
<everyonemines>
I noticed that type annotations didn't help with max and min, unlike >
<adrien>
it's easy to see how int comparison can be much faster ;-)
<thelema>
everyonemines: that's because of the bug you pulled up on mantis
<everyonemines>
Still not as fast as native max/min :-
<thelema>
everyonemines: for a microbenchmark, yes
<everyonemines>
But I was looking at the (actually problematically slow) polymorphic compare.
`fogus has joined #ocaml
<hcarty>
everyonemines: I don't know how well it's advertised in general, but there are a fairly large number of blog posts, mailing list posts and other sources talking about optimizing inner loops in OCaml by eliminating polymorphic comparison
<everyonemines>
The issue isn't > itself, it's calls to polymorphic functions.
<everyonemines>
If the type is known, it's faster.
<hcarty>
Is that true for every function?
<hcarty>
Every polymorphic function that is
<everyonemines>
I'm guessing....most of them.
<hcarty>
I doubt List.map suffers terribly. But <, >, =, compare, etc. all dig into the dirty underbelly of OCaml to do what they do
emmanuelux has quit [Ping timeout: 244 seconds]
<hcarty>
Polymorphic comparison is slow in part because it dives into the underlying structure of values. Most other functions involving polymorphism don't need to do that.
<everyonemines>
On a related note, I think I could write a faster array sort function than the stdlib has.
<everyonemines>
Would that be worthwhile?
<thelema>
everyonemines: sure, if it benchmarks well, we can put it into batteries
<thelema>
hcarty: not true for most functions. Compare is special because the compiler will insert specialized code for a few types.
<thelema>
hcarty: the builtin polymorphics, compare and (=), are improved by knowing types
<thelema>
I can't think of anything else
<everyonemines>
So if you want to sort arrays faster, use let cmp (x:int) (y:int) = compare x y;;
<everyonemines>
?
<thelema>
arrays of ints. and I think batteries has a faster int.cmp than even specializing compare
<thelema>
hcarty: do you know of any other functions improved by type knowledge?
<everyonemines>
external compare : int -> int -> int = "caml_int_compare"
<everyonemines>
Interesting.
<hcarty>
thelema: No - I had thought min and max might be, but maybe not.
<hcarty>
thelema: There aren't many more grossly polymorphic functions in OCaml
<thelema>
hcarty: nope, min and max are plain ocaml functions, no special optimization
<everyonemines>
Yeah, seeing that was what got me started.
<hcarty>
I guess you could write type-specialized min and max functions using type-specific compare
<everyonemines>
Polymorphism isn't really ocaml's strength...actually, I think Core does that?
<hcarty>
I don't think Batteries has anything like that yet.
<hcarty>
Core may
<hcarty>
everyonemines: Polymorphism as it exists in polymorphic comparison goes against how most of OCaml works
<everyonemines>
Yeah, but in theory you can transfer type knowledge downward and specialize.
<hcarty>
OCaml doesn't do that. MLton does for SML.
<thelema>
everyonemines: the specialization of comparison operators is the only way that types affect codegen
<hcarty>
Or, OCaml doesn't do that in general.
<hcarty>
thelema: Right
<everyonemines>
Yeah. I know, whole program compilation, makes compilation slower.
<hcarty>
It also makes the compiler more complex and makes performance less predictable
fraggle_ has quit [Quit: -ENOBRAIN]
<hcarty>
Not that I would complain if functors suddenly became performance-hit-free in OCaml :-)
<everyonemines>
What do you use for btrees, then?
<everyonemines>
I guess there's probably something in batteries.
<hcarty>
There are btree implementations on github if not in Batteries.
<everyonemines>
If you pass map.make a specialized compare it should be decent though, right?
<thelema>
avltree is in batteries, but I find that if I'm not using the tree as a map or set, I need to write my own tree anyway
<thelema>
everyonemines: yes
<hcarty>
thelema: On the topic of premature optimization - I was going to grumble about always requiring threading IO-overhead in Batteries before the recent module split you made for 2.0. Then I realized I've been using threaded Batteries almost exclusively without trouble.
<thelema>
:)
<thelema>
it's hard to notice, as IO is pretty expensive anyway
<thelema>
it's optional now - if you compile with threads, the batteriesThread module will be ... hmm, maybe it doesn't quite work. I need to put the init into a .cmx
<thelema>
I just realized that linking a .cm[x]a doesn't actually inject code at startup
<hcarty>
thelema: It doesn't? I thought toplevel phrases were evaluated in the linked module(s).
<thelema>
.cmx files, yes. .cmxa files don't automatically link in all .cmx files contained within
<hcarty>
Ah, of course.
lopex has quit []
<kizzx2>
adrien, hcarty: to answer my own question, OcalIDE (like its Java counterpart) builds continuously, i need to go to Project -> Properties and add the ocamlbuild targets there
<kizzx2>
every other configuration can be typed in _tags
<adrien>
working fine now?
<kizzx2>
adrien: yeah :)
<adrien>
=)
<kizzx2>
i was looking at Project -> Build but the button was also grayed
<kizzx2>
it turns out it would build continously once i have added the target
<tac-tics>
The app is written in C using the NDK which compiles C down to the proper assembly
<tac-tics>
thanks :)
milosn has joined #ocaml
<_habnabit>
eh? wouldn't scala or clojure be better for that?
<preyalone>
Which module (regular OCaml, not Batteries) includes the regex functions?
<_habnabit>
lagged.
<_habnabit>
preyalone, Str
<preyalone>
Error: Reference to undefined global `Str'
<_habnabit>
okay?
<tac-tics>
_habnabit: I don't know Scala or Clojure, but I know C, and I know enough Haskell to churn out the code i need in Ocaml
<preyalone>
Ah, I had to add #load "str.cma" ;; to the beginning in order for OCaml to find Str.
<preyalone>
Okay... ocaml can't find Str unless I add a #load directive, but ocamlc can't compile because it doesn't recognize the syntax. How do I compile a .ML file so that it can access the Str module?
<_habnabit>
normally I use ocamlbuild for compilation so I don't have to muck around with invoking ocaml{c,opt} myself
<kizzx2>
preyalone: man ocamlc
<_habnabit>
way less tedious
<kizzx2>
preyalone: if you want to use ocamlc, you need to explicitly type str.cma some where
<kizzx2>
preyalone: for example something like `ocamlc (some other flags to tell where the libs are) str.cma my_program.cmo -o out`
<kizzx2>
again i've switched to ocamlbuild so ive forgotten how to do it proper :P
<_habnabit>
ocamlbuild is really the way to do it.
<kizzx2>
hey guys, how can i specify that a functor accepts an argument that should implements multile signatures?
<kizzx2>
preyalone: so unless for training/learning purpose you should go ocamlbuild
<_habnabit>
kizzx2, module type Bar (Fred: Ord) (Foo: FooSig)
<preyalone>
kizzx2: Hmm, thanks.
<kizzx2>
_habnabit: doesn't that create a functor with 2 parameters?
<preyalone>
Does ocamlbuild come with official OCaml, or do I install it separately?
<_habnabit>
kizzx2, wait, what
<_habnabit>
kizzx2, you want this to implement /both/ interfaces?
<kizzx2>
_habnabit: well i want to specify that `Bar` needs to implement both
<kizzx2>
yes
<kizzx2>
and Ord.t should equal to FooSig.t
<kizzx2>
for `Bar`
<_habnabit>
make a module type that includes both
<kizzx2>
sorry
<kizzx2>
i meant `Fred` should implement both
<kizzx2>
:P
<kizzx2>
preyalone: separately, i'd personally go with GODI
ztfw has joined #ocaml
<kizzx2>
preyalone: well you know what, maybe it comes with it by default
<kizzx2>
not sure :P
<_habnabit>
so, module type FredSig = sig include Ord include FooSig end
<_habnabit>
(doesn't ocamlbuild come with non-godi ocaml as well?)
<preyalone>
kizzx2: How does GODI compare with Batteries? Wild guess: GODI is like CPAN and Batteries is like ActiveState Perl.
<_habnabit>
batteries is just an extended stdlib
<_habnabit>
since the default ocaml stdlib is kinda anemic
<kizzx2>
preyalone: GODI is like CPAN, Batteries is like writing Haskell in OCaml, or boost in C++
<kizzx2>
preyalone: i.e. it liberates you from the malnutritioned language :P
<kizzx2>
_habnabit: Error: Multiple definition of the type name t. Name smust be unique in a given structure or signature
<_habnabit>
yeah, there's syntax to clobber that
<_habnabit>
and I can't remember it offhand
<kizzx2>
i thougth it woudl be quite common?
<preyalone>
kizzx2: "like writing Haskell in OCaml" <- That's funny, I started with Haskell and decided to give OCaml a try.
<_habnabit>
I've never needed to do this
<tac-tics>
preyalone: I don't think that's too uncommon, Haskell is the most successful of the FP languages
<tac-tics>
at least in IRC idle count
<kizzx2>
preyalone: that will give you the much needed function composition (|-) operator and also teh `where` syntax (omg can't live without this) and also F#'s pipeline operator |>
<tac-tics>
what does F#'s |> do?
<preyalone>
tac-tics: I'd say Lisp is more successful, measured by popularity, but no need to quibble.
<preyalone>
If you know of a way to check if a string contains a substring without having to use the Str module, let me know. :)
preyalone has quit [Client Quit]
ygrek has joined #ocaml
emmanuelux has joined #ocaml
penryu has joined #ocaml
ttamttam has joined #ocaml
kizzx2 has quit [Ping timeout: 248 seconds]
eikke has quit [Ping timeout: 258 seconds]
Boscop__ has joined #ocaml
Boscop_ has quit [Ping timeout: 245 seconds]
<_habnabit>
that's some crazy indentation
<_habnabit>
... that's some crazy code
<tac-tics>
_habnabit: looks like someone was a GNU programmer :P
ttamttam has left #ocaml []
<tac-tics>
(or maybe it's the Linux coding style that uses 8 spaces....)
<_habnabit>
that's hard tabs.
<_habnabit>
but indenting in for nested let is pretty crazy
<tac-tics>
yeah
<thelema>
at least the try isn't extra indented
<_habnabit>
... and this code is insane anyway
<thelema>
yup, pretty inefficient.
<_habnabit>
the `with _ -> ()` tells me exactly how he writes his python code too. :(
<hcarty>
_habnabit: I removed the ... non-standard indentation and "rec" from main
<thelema>
if Filename.basename Sys.argv.(0) = "scriptedmain" then main()
<hcarty>
_habnabit: Still perhaps non-standard code, but a bit easier on the eyes
<bitbckt>
what. the.
<hcarty>
thelema: It could be scriptedmain.ml or scriptedmain.exe...
<_habnabit>
what if you're running ./scriptedmain/test.ml
<thelema>
hcarty: not if compiled as instructed
<thelema>
and it could be foo.exe, if the executable was renamed
<hcarty>
thelema: True re: the instructions
eikke has joined #ocaml
<thelema>
let chop_nofail s = try Filename.chop_extension s with Invalid_argument -> s
<thelema>
if chop_nofail (Filename.basename Sys.argv.(0)) = "scriptedmain" then main ()
<hcarty>
I like it
<hcarty>
It's an odd approach to a relatively odd task
preyalone has joined #ocaml
mnabil has joined #ocaml
<preyalone>
I've installed the Getopt module. getopt.cma is in /usr/local/lib/ocaml/site-lib/getopt/. But when I compile with "ocamlc -o ios7crypt -linkall str.cma getopt.cma ios7crypt.ml", I get "Error: Unbound module Getopt".
<thelema>
preyalone: it looks like getopt installed via findlib
<thelema>
a record is a sum type, like a tuple but with names
<thelema>
err, product type
<preyalone_>
k
<thelema>
variants are sum types - like enumerations in other languages but better
<thelema>
because data can be attached to alternatives
<thelema>
type tree = Empty | Node of tree * int * tree
<preyalone_>
Is the difference simply that records have named values while variants don't?
<thelema>
no, records hold n things at once, variants hold one of n things
<thelema>
type foo = {first_name: string; last_name: string}
<thelema>
type foo = First_name of string | Last_name of string
<preyalone_>
tree is a variant, foo is a record?
<thelema>
with the first, you have a first name and a last name
<thelema>
with the second, you have a first name *or* a last name
<preyalone_>
Aye.
<preyalone_>
In Haskell, both forms are just called records.
<thelema>
odd.
<preyalone_>
I understand the purpose of both forms, I use them frequently. If a record is small enough, I just use a variant to describe it.
<thelema>
I understand them as being pretty orthogonal.
<thelema>
ah, you're thinking record vs. tuple
<thelema>
type foo3 = (string * string)
<thelema>
tuples can replace small records
<preyalone_>
yup
<thelema>
variants... not so much, unless you really want an extra dose of type safety and want to pattern match to get at values
<preyalone_>
Do you have getopt installed? I'm not sure why I'm getting a type error on line 43.
<thelema>
the type of specs should be: type opt = char * string * (unit -> unit) option * (string -> unit) option
<thelema>
the first two fields I see no problem with, but the third field seems wrong - "Some password"?
<preyalone_>
Yep. I'm basing my code off the sample.ml file that comes with getopt. I'm having trouble making sense of the individual arguments. Not necessarily their types, but their purpose.
<preyalone>
I want to set the mode in addition to setting "password" to the option of -p, but I don't know how to get Getopt to do this. https://gist.github.com/1254768
orbitz_ has quit [Quit: Reconnecting]
orbitz has joined #ocaml
<thelema>
preyalone: you might need () around your functions in line 28 and 29
<thelema>
and then the variant constructor "Some", as you have nones on lines 30 and 31
<thelema>
odd. the specific error you're having would be useful to help
<thelema>
oh... you're using , to separate list elements
<thelema>
it should be [1;2;3], not [1,2,3]
<preyalone>
got it.
<thelema>
both are valid syntax - the first is a list of three elements each an int
<thelema>
the second is a list of one element, that being a tuple of three ints
<preyalone>
tuples are comma delimited, lists are semicolon demlited?
<thelema>
lists are semicolon delimited bounded by [], arrays are semi delim'ed bounded by [| |]
<thelema>
tuples don't have to be bounded by anything, but often are bounded by normal (), just for precedence
<preyalone>
thelema: In sample.ml, the specs list is bounded by [ ].
<thelema>
yup, it's a list.
<thelema>
(1;2;3) is an expression that says to evaluate 1, throw the result away, then evaluate 2 and throw the result away and then evaluate 3
<thelema>
same without ()
<thelema>
you need [] to make a list
<preyalone>
thelema: I got the code working with just [ and ], so there's something funny going on.
<preyalone>
OHHHHHH. [| and |] bound arrays, but not lists.
<preyalone>
The crucial difference between arrays and lists was lost on me for a second.
<preyalone>
Now my program has a logical bug. In sample.ml, when you run ./sample -x with no arguments to -x, it correctly prints "Fatal error: exception Getopt.Error("Option -x must have an argument")"
<preyalone>
But in ios7crypt.ml, you should get the same error by entering ./ios7crypt -e or ./ios7crypt -d with no arguments.
<preyalone>
Instead, when you do ./ios7crypt -e/-d, nothing happens. the program silently quits.
<preyalone>
wait a minute... is that because in the current code, i never access password and hash? stupid lazy programming
<thelema>
ocaml isn't lazy.
<thelema>
do you actually set password or hash?
<thelema>
ocaml isn't lazy unless you ask for it specifically.
<Qrntzz>
there is lazy evaluation
<Qrntzz>
but it isn't needed in most of the cases
<thelema>
Qrntzz: you have to ask for it specifically.
<Qrntzz>
indeed
<Anarchos>
Qrntzz i remember streams in caml light :)
`fogus is now known as fogus-away
<preyalone>
all: The problem is not lazy evaluation; even when I print out the values of password and hash, I get the same problem. Instead of an error about missing arguments, the program quits silently.
<thelema>
well, if main is being called, at least one of the clauses in the match statement will be called (or an exception will be raised in parse_cmdline, which we've seen gives output.
<thelema>
preyalone: try getting rid of your main testing routine.
<thelema>
also, main and usage don't need to be [let rec] -- a simple [let] will suffice
<thelema>
the modification to the match expression is a bad one - you should be explicit on all match cases, ocamlc will check on compilation if you've missed any cases
<thelema>
also, hard tabs for indent aren't proper style.
<thelema>
and it's guaranteed that no other value could be matched by the type of mode.
<hcarty>
thelema: I was able to install ocamlgsl through odb.ml
<preyalone>
I commented out the main testing bits and just wrote main "ios7crypt", but it still ignores missing arguments to -e and -d.
<thelema>
dunno. possibly a bug in getopt, although I'd be surprised. I don't use getopt, for really simple stuff I use the Arg module in the stdlib, and for complex stuff, I have my own arg2
<thelema>
hcarty: great. Can you put a comment in oasis-db about that?
<thelema>
hcarty: I'll promote gsl to testing.
* thelema
should set a stable sometime.
preyalone_ has joined #ocaml
thomasga has joined #ocaml
thomasga has quit [Client Quit]
preyalone has quit [Ping timeout: 252 seconds]
Associat0r has quit [Quit: Associat0r]
<hcarty>
thelema: Done.
<hcarty>
thelema: Thanks for updating the package!
eikke has quit [Ping timeout: 245 seconds]
<preyalone_>
I think I found the problem. The with _ bit hides all errors.
<thelema>
ah, yes it would.
<hcarty>
preyalone_: let () = ... is generally safer than let _ = ...
<hcarty>
preyalone_: It will let you know if you're ignoring something you don't intend to.
<thelema>
try this instead: "let chop_nofail s = try Filename.chop_extension s with Invalid_argument -> s in if chop_nofail (Filename.basename Sys.argv.(0)) = "scriptedmain" then main ()"
<hcarty>
Or, rather, let you know if you are ignoring a non-unit value
<thelema>
hcarty: try ... with _ -> ()
<hcarty>
thelema: Ah, oops.
<hcarty>
preyalone_: The comment stands, but is not directly applicable to this topic :-)
<preyalone_>
Bugger, there's no reason to use exceptions in regex matching. Just return Some match or None.