<mrvn>
Scanf.Scan_failure "scanf: bad input at char number 19: ``int_of_string''".
<Juzor>
ok ...
<mrvn>
You can use %Lx to get the full 64bit.
<Juzor>
yes but it has to be "infinite"
<mrvn>
Otherwise 32bit ocaml ends at 0x7fffffff and 64bit ocaml at 0x7fffffffffffffff
<mrvn>
Then you need bignum.
<mrvn>
and probably your own hex->bignum parser
<Juzor>
my goal is to recode the big_int modules so i have to recode a rec function which convert it
<Juzor>
i think it's more a math problem than using good tools
<mrvn>
Start with 0, then recursively take up to 16 chars, shift the result by <num chars> * 4 to the left, convert the chars to int64, add it to the result and recurse.
<mrvn>
Slightly better: take less chars on the first loop so that the remainder is a multiple of 16.
<mrvn>
Or simpler to understand: start with 0, recursively multiply the result by 16, add the first char converted to int and recurse.
<Juzor>
woot nicely done, its a pretty good solution but it has still a limit in the conversion. I think its good thank you
<mrvn>
If you use an integer representation with no limit then the conversion has no limit.
<Juzor>
ok i'll try ty
<mrvn>
If you represent ints as string you can also just take 2 chars at a time, convert them from hex to int to char and store them in the result string directly.
<Juzor>
for that I represent int as a List of char
Tobu has joined #ocaml
<mrvn>
lowest digit first?
<Juzor>
yes i reverse it for calcs
<mrvn>
there you go then. just start at the end and conver 2 hex chars to a char at a time.
<Juzor>
yep !
Kakadu has joined #ocaml
<mrvn>
would be more efficient to use a list of int32 or int64.
<Ptival>
Juzor: so you're an Epitech student? :)
<mrvn>
but efficiency probably isn't the goal.
<Juzor>
My bad i have already switched to a list of int
<Juzor>
Yes good shot ptival
<Juzor>
you too ?
<Ptival>
no
<Ptival>
I helped one the past few days
<mrvn>
int is difficult as that is 31bit signed or 63bit signed.
<Ptival>
who wanted to recode bigint :p
<Juzor>
You get a lot of student from epitech ?
<Juzor>
yes
<Juzor>
mrvn: ok
<Juzor>
Ptival: what was he's nickname ?
<Juzor>
Yoy ?
<Ptival>
eaSy60 or something
<Juzor>
oh ok
<mrvn>
Juzor: do you have +, -, * already?
<Ptival>
mrvn: I think they need to parse strings in an arbitrary base
<Juzor>
just made + and - working at *
<Ptival>
which makes it slightly more complicated
<Juzor>
no, his solution might work
<mrvn>
Ptival: yeah, for arbitrary base you need to multiply by the base
<Juzor>
we have to do binary, octal, dec, hex
<Juzor>
it's not every bases
<mrvn>
if you can do dec you can do every base
<mrvn>
saves you having to do octal as well
<Ptival>
yeah, the problem is "not a power of 2"
<mrvn>
anything not a power of the base you are using internally is a problem.
<Juzor>
yes I'll just focus on basics operator before converting
<Ptival>
mrvn: exactly
Juzor has quit [Ping timeout: 252 seconds]
zcero has joined #ocaml
Juzor has joined #ocaml
Juzor has quit [Read error: Connection reset by peer]
Juzor_ has joined #ocaml
<djcoin>
Juzor_: good news for ya
<djcoin>
I was hacking just for fun to get the hexa2int function working
<djcoin>
But in the doc, the funtion already exist !
<djcoin>
int_of_string convert to hexa if it starts by 0x
<djcoin>
:>
<mrvn>
Does it have to be a list to represent the int?
<mrvn>
djcoin: only for small ints
<Juzor_>
yep
<Juzor_>
sry have trouble with my connection
<djcoin>
Ho sorry
<Juzor_>
no prob thanks for helping
Juzor_ is now known as Juzor
<Ptival>
djcoin: I think the point of their project is to code it themselves
<Ptival>
I don't know up to what primitives
<Juzor>
recode partialy big_int our on way
<Juzor>
brb
Juzor has quit [Quit: WeeChat 0.3.7]
KDr2 has quit [Remote host closed the connection]
Juzor has joined #ocaml
cdidd has joined #ocaml
Tobu has quit [Ping timeout: 260 seconds]
Tobu has joined #ocaml
zcero has quit [Read error: Operation timed out]
avsm has quit [Quit: Leaving.]
thomasga has joined #ocaml
<mrvn>
Juzor: Do you have to implement mul and div?
<mrvn>
mul included. But no div and only to_hex for printing.
<mrvn>
I need at least a divint to print in other bases.
Juzor_ has quit [Read error: Operation timed out]
Juzor_ has joined #ocaml
Juzor_ has quit [Client Quit]
<mrvn>
the simple school multiplication takes O(n^2) and gets rather slow with bigger numbers.
Tobu has quit [Ping timeout: 272 seconds]
Tobu has joined #ocaml
Juzor has joined #ocaml
<Juzor>
mrvn: re
Juzor_ has joined #ocaml
<Lor>
flexlink is evil.
<Lor>
Because it is needed to compile itself, a pre-built binary is a must.
<adrien>
yes but it's not evil
<Lor>
But because all the paths are hard-coded in the binary, it is impossible (or at least extremely inconvenient) to rebuild it in a different environment.
Juzor has quit [Ping timeout: 249 seconds]
<adrien>
you haven't seen the situation without it
Juzor_ is now known as Juzor
<Lor>
Moreover, the standalone flexlink binary package seems to be broken, I could only use the ones in the mingw ocaml package and in overbld for bootstrapping.
<adrien>
hmm?
<adrien>
had no issue myself
<adrien>
but haven't used the veyr latest one
<adrien>
bbl
lihaitao has quit [Remote host closed the connection]
<mrvn>
Juzor: How does your solution look so far?
<Juzor>
mrvn: since we talk nothing is done sry, I have to do some other things in C prog
<mrvn>
well, you had add already.
<Juzor>
yes
zcero has joined #ocaml
rixed has joined #ocaml
jimmyrcom has joined #ocaml
Tobu has quit [Ping timeout: 272 seconds]
Tobu has joined #ocaml
Juzor has quit [Quit: WeeChat 0.3.7]
testcocoon has quit [Ping timeout: 272 seconds]
jamii has joined #ocaml
testcocoon has joined #ocaml
zcero has quit [Ping timeout: 244 seconds]
Kakadu has quit [Quit: Page closed]
jamii has quit [Ping timeout: 252 seconds]
testcocoon has quit [Quit: Coyote finally caught me]
Cyanure has quit [Remote host closed the connection]
jamii has joined #ocaml
<mrvn>
and?
<Ptival>
can max be <0 ?
<Ptival>
rec?
Tobu has quit [Ping timeout: 260 seconds]
<Drakken>
mrvn the code has two issues: It has one thing that doesn't need to be there, and more importantly, it's missing one thing whose absence makes some of the code useless.
<Drakken>
The second issue affects the program's behavior.
<Drakken>
Ptival no and no.
<Drakken>
The "rec" is normal and expected for that kind of code.
<Ptival>
Drakken: why?
<Drakken>
why what?
<Ptival>
why is the rec normal and expected?
ivan\ has quit [Ping timeout: 252 seconds]
<Drakken>
Because what would be the point of a nonrecursive function there?
<Ptival>
what's the point of this aux function anyway?
<Ptival>
it's defined locally, called only once, and does not actually recurse
tomprince has quit [Ping timeout: 252 seconds]
<Drakken>
Normally one would expect it to recurse.
tomprince has joined #ocaml
<Drakken>
It's obviously supposed to read n characters from the stream.
<Drakken>
emphasis on _supposed_
<Ptival>
so is this function ever used?
<Ptival>
that no one found that O_o
<Drakken>
Yes, it's the function that reads the character stream.
ivan\ has joined #ocaml
gasche has joined #ocaml
<mrvn>
Drakken: The "let rec" would indeed indicate that it should recurse. But as I read it it stores one token from the stream into the buffer unless the stream if EOF or the buffer full.
<Drakken>
right. It just reads one character.
<mrvn>
at most one
<Drakken>
yep.
<Drakken>
Apparently that's the desired behavior for toplevels.
Tobu has joined #ocaml
<Ptival>
yes
<Ptival>
so that it doesn't try to read more than you feed it
<mrvn>
s/succ n/self (n+1) s/ would make more sense
<mrvn>
Ptival: then the caller should set max=1
<Ptival>
mrvn: yes
<mrvn>
Drakken: what happens if you add the recursion?
<Drakken>
it works the same (effectively) for files.
<gasche>
haha Drakken, still thinking hard about this one
<Drakken>
as a user, I can't tell the difference, although I assume it must be reading more characters at a time.
<mrvn>
Drakken: unless max=1 anyway
<Drakken>
right.
Ulrar has joined #ocaml
<Ulrar>
Hi, which of List or String is the is lighter ?
<Drakken>
gasche good morning!
<mrvn>
Ulrar: apples and oranges
<Ulrar>
That's for recoding the big_int module
<gasche>
hi
<gasche>
:D
<gasche>
Ulrar, why would you do that?
<Ptival>
hahaha, yet another big_int recoder :D
<mrvn>
Ulrar: a char list takes 24 times the space compared to a string.
<Ulrar>
gasche: For school
ulfdoz has joined #ocaml
<Ulrar>
Okay, thanks
<gasche>
but a list can be appended to in constant time
<mrvn>
gasche: takes O(n) for length though.
<mrvn>
Ulrar: do you have to use a list? A int32 array or bigarray would be better.
<Ulrar>
No, we can use whatever we want
<gasche>
int32 ? :/
<gasche>
Ulrar, which operations do you need to write?
<mrvn>
gasche: 32bit integer type.
<gasche>
yes, but the boxing
<Ulrar>
add, sub, mul, div, mod
<gasche>
hm
<mrvn>
Ulrar: div of big -> big -> big?
<gasche>
I don't remember about these frankly not-so-exciting things, but if you can find left-to-right algorithm for all of them, lists would be fine
<mrvn>
debug [|1l;2l;3l|];; urgs, you better use a bigarray there
<gasche>
mrvn, throwing Obj.magic at beginners is eww
<gasche>
just use Extlib/Batteries's dump
<mrvn>
Ulrar: debug x will show you the memory layout of x
<gasche>
(or point them to the relevant chapter of DA-OCAML so that they can learn more about it directly)
<mrvn>
gasche: and teach him how to install that first? :)
<gasche>
easy
jamii has quit [Ping timeout: 265 seconds]
<Ulrar>
Okay, thank you
<gasche>
it should be a matter of git clone, make, make install
<gasche>
(ok, there may be *some* dependencies, but few)
<gasche>
and that's frankly a more useful skill
<mrvn>
Ulrar: anyway, conclusion is to use string or a char Bigarray if you want to operate on chars, array or int Bigarray for ints or int32/intnat/int64 bigarray as third option.
<mrvn>
But that only applies if you care about memory consumption. A more wastefull type might be easier for your code.
<gasche>
does performance count?
<gasche>
shouldn't we optimize for the most elegant code instead?
<gasche>
(though I agree in this case a natural integer indexing may also be useful)
<mrvn>
gasche: elegant? Better go for most understandable code
<gasche>
(I still would try to write those operations on digit streams (~ list) because it's fun)
<Ulrar>
I think I'll use String, will be easier for me
<gasche>
but you are restricted to base 256, which kinds of sucks when you could use say 2^25
<mrvn>
Ulrar: then you have to convert from char to int and back all the time. But you can wrap that into a helper function
<gasche>
(or even more on a 64 bit machine)
<mrvn>
gasche: That's why I used int32
<gasche>
but int32 need to be tagged/untagged, why bother?
<gasche>
s/tag/box/
<mrvn>
gasche: you mean boxed.
<mrvn>
:)
<mrvn>
gasche: Instead of 2^25 you should use 2^24 so conversion to/from hex is simpler.
<mrvn>
or 2^28
ulfdoz has quit [Ping timeout: 260 seconds]
smondet has joined #ocaml
<gasche>
anyway, I need to go
zcero has joined #ocaml
<gasche>
have a nice day
gasche has quit [Quit: Leaving]
<mrvn>
Ulrar: are you familiar with 2s-complement?
<Ulrar>
Mh, no
<mrvn>
How do you intent to store negative numbers?
<Ulrar>
With a bool I think
<Ulrar>
negative = true
<mrvn>
that works but it makes subtraction difficult.
<mrvn>
You have to convert 3 - 5 to - (5 - 3).
<mrvn>
cpus store negatives using 2s-complement, which is -x = (lognot x) + 1. The most significant bit is the sign bit.
<mrvn>
The advantage is that you just need an add function and negate.
<jonafan>
the documentation on the site is ... inadequate
<pippijn>
I think you need to write wrappers just like when you interface with C
<jonafan>
yeah maybe that would be easier than dealing with Js.Unsafe
<jonafan>
although i'm still not sure how to do things like create an object.
<pippijn>
I don't know :)
<pippijn>
there is api docs
<jonafan>
they're terrible and useless
<jonafan>
"Use the syntax extension jsnew c (e1, ..., en) to build an object using constructor c and arguments e1 to en."
Kakadu has joined #ocaml
<Kakadu>
thomasga: hi!
<Kakadu>
thomasga: Do u remember my problem when ocp-* compilers work very long time (5x of normal compiler time)?
<jonafan>
i think i'm decoding this js crap
<thomasga>
Kakadu: yes, we found the cause
<thomasga>
it should be fixed in the next release (we are testing to see if the fix is safe)
<thomasga>
the slowness only occurs when you do "module M = X" when X is very big
<Kakadu>
thomasga: thanks a lot!
<Kakadu>
thomasga: but I don't think that this behaviour happens only in this case
<mfp>
which API would you rather use, expand (part 1 @@ min_suffix) (byte *** positive_int64) = (1, 0L) or expand_min1 (byte *** positive_int64) 1 = (1, 0L) ?
<mfp>
i.e., a famility of functions expand_minN/expand_maxN vs. a few combinators that allow to define the operation for arbitrary lengths
<flux>
wow, ocaml has finally achieved the key c++ feature, pages long error messages..
<flux>
too much repetition in there, though
<mfp>
I guess that means I'll stay with the direct-style API until I figure out how to make the combinatorial one work
<flux>
so, what cool have people cooked up with GADTs so far?-)
<mfp>
that was triggered by this snippet: let c5 = tuple5 c c c c c in assert_equal ~printer:(K.pp c5) (!!1, !!2, !!0, !!0, !!0) (expand (part 1 @@ part 2 @@@ min_suffix) c5)
<mfp>
no GADTs or even first-class modules (which I was using at first) there
<mrvn>
flux: typesafe printf/scanf without the format string compiler magic, universal container and get/set <type> .... universal functions.
<mrvn>
flux: and I made an example for compile time alignment checks when extracting intX_t from a string but with pure phantom types that seems better.
<mfp>
mrvn: do GADTs bring anything new to the table relative to traditional functional unparsing?
avsm has joined #ocaml
<mfp>
and did you get the compile-time alignment check to work? I seemed to remember from the ML that there was some problem (or were you just told not to "overuse" GADTs? ;-)
<mrvn>
mfp: let get : type a . a kind -> str -> off -> a = function kind str off -> match kind with Int -> get_int str off | Float -> get_float str off
<mrvn>
mfp: how do you write that without GADT?
<mfp>
mrvn: I meant regarding typesafe printf/scanf
<flux>
hmm, I wonder if GADTs would allow me to express the hook system I once implemented unsafely
<mrvn>
mfp: Well, you can define your own GADT instead of being restricted to the compiler builtin format string.
<mrvn>
flux: They allow you to define a universal list without Obj.magic.
<mfp>
mrvn: I mean, you could already to typesafe printf without format strings with Danvy's functional unparsing... without using GADTs
<flux>
mrvn, it sounds to me it might fit that purpose then..
<mfp>
so wondering if GADTs allow a better encoding or something
<mrvn>
mfp: sure. the syntax is better I think and you can use the same GADT for printf and scanf.
<mfp>
ah the latter sounds nice
<mrvn>
One thing I wonder is how good ocaml will be at optimizing the GADT away.
<mrvn>
Like the above "get" example. Is "get INT" slower than "get_int"?
djcoin has joined #ocaml
<mrvn>
Another use for GADTs is to ensure lists of equal length so you can skip the | (_::_, []) | ([], _::_) -> assert false
<mfp>
hmm is (fun kind str off -> ....) compiled differently from (fun kind -> fun str off -> ...)? because you could specialize manually with let get_int = get INT in that case (only losing inlining?) given let get : type a . a kind -> str -> off -> a = function Int -> get_int | Float -> get_float (unless that doesn't type?)
<mfp>
duh, 1st part irrelevant
<mrvn>
mfp: yes, verry differently.
<mfp>
because it's (fun kind -> match kind with .... -> ) anyway, not (fun kind -> fun str off -> ...)
<mrvn>
mfp: or rather you anearly always have to annotate the type for GADTs and do some lifting.
<mrvn>
type inference doesn't work well for GADTs. Somehow the type system doesn't notice when it should switch to GADT features and when it doesn't need to.
<mrvn>
flux: With GADT you can define 'type 'a data = { fn : 'a -> unit; } type callback = Callback : 'a data -> callback' and then use match callback with Callback x -> x.fn x
Kakadu has joined #ocaml
<mrvn>
The callback is the independent of the type of the data stored in it.
skchrko has quit [Ping timeout: 246 seconds]
Kakadu has quit [Client Quit]
Kakadu has joined #ocaml
Kakadu has quit [Read error: Connection reset by peer]
Kakadu has joined #ocaml
skchrko has joined #ocaml
Kakadu has quit [Ping timeout: 246 seconds]
Kakadu has joined #ocaml
Kikaxa has joined #ocaml
Kikaxa has left #ocaml []
err404 has quit [Ping timeout: 245 seconds]
Submarine has quit [Ping timeout: 246 seconds]
skchrko has quit [Quit: ChatZilla 0.9.88.1 [Firefox 11.0/20120314111819]]
Kakadu has quit [Ping timeout: 276 seconds]
Kakadu has joined #ocaml
err404 has joined #ocaml
Tobu has quit [Ping timeout: 260 seconds]
<Lor>
Sheeeessh. oasis-based setup.ml expects to be run under cmd.exe, not a cygwin shell.
<adrien>
there is only one rule
<adrien>
don't mix everything
<adrien>
and cygwin (and msys) don't make that terribly easy to achieve
<Lor>
flexlink cannot be used under msys
<Lor>
So I have to do everything under cygwin.
<Lor>
It seems that md is just a built-in in cmd.exe. I don't see how setup.ml can work under any setting if it tries to just run the _command_ "md".
<Lor>
Also, it barfs with paths of the form C:/...
<adrien>
"md"?
<Lor>
The old dos alias for mkdir.
<Lor>
A rare case where a dos command is shorter than the unix equivalent.
Kakadu has quit [Quit: Konversation terminated!]
gildor has joined #ocaml
Tobu has joined #ocaml
<Lor>
Hm, no, actually the "md" is just fine since it goes through Sys.command which is uses cmd.exe under windows.
<Lor>
The problem is that a "c:/..." path isn't grokked so it tries to run 'md ""' and _that_ fails.
jamii has joined #ocaml
<jonafan>
well... i think my js_of_ocaml experiment is a failure
<adrien>
Lor: "C://" should be handled by all windows tools afaik
<Lor>
Yes, I just discovered the problem was the reverse.
<Lor>
It didn't handle a path of the form /cygdrive/c/...
<Lor>
I'm beginning to think it wasn't such a hot idea after all to use Batteries to avoid writing some simple utilities and data structures.
<Lor>
Just due to that dependency I have now had to compile and install camomile and batteries so many times that it's eating all the time I saved.
jamii has quit [Ping timeout: 244 seconds]
smondet has quit [Remote host closed the connection]
Cyanure has joined #ocaml
emmanuelux has quit [Read error: Connection reset by peer]
thomasga has quit [Quit: Leaving.]
thomasga has joined #ocaml
thomasga has quit [Client Quit]
albacker has quit [Ping timeout: 246 seconds]
oriba has joined #ocaml
err404 has quit [Remote host closed the connection]