talzeus has quit [Remote host closed the connection]
csakatoku has joined #ocaml
eikke has quit [Ping timeout: 268 seconds]
struktured has joined #ocaml
shinnya has quit [*.net *.split]
BitPuffin has quit [*.net *.split]
pango has quit [*.net *.split]
ski has quit [*.net *.split]
mal`` has quit [*.net *.split]
quelu has quit [*.net *.split]
brendan has quit [*.net *.split]
Nahra has quit [*.net *.split]
mrvn has quit [*.net *.split]
quelu has joined #ocaml
brendan has joined #ocaml
ski has joined #ocaml
Nahra has joined #ocaml
pango has joined #ocaml
BitPuffin has joined #ocaml
Nahra has quit [Changing host]
Nahra has joined #ocaml
mrvn has joined #ocaml
shinnya has joined #ocaml
strmpnk has quit [Ping timeout: 264 seconds]
strmpnk has joined #ocaml
mal`` has joined #ocaml
ftc has joined #ocaml
ftc has quit [Client Quit]
peterbb has quit [Ping timeout: 240 seconds]
peterbb has joined #ocaml
peterbb has quit [Ping timeout: 245 seconds]
peterbb has joined #ocaml
jpdeplaix has quit [Ping timeout: 248 seconds]
talzeus has joined #ocaml
testcocoon has joined #ocaml
jpdeplaix has joined #ocaml
chambart has quit [Ping timeout: 252 seconds]
BitPuffin has quit [Ping timeout: 268 seconds]
Drup has quit [Quit: Leaving.]
ocp has joined #ocaml
gnuvince has joined #ocaml
gnuvince has quit [Changing host]
gnuvince has joined #ocaml
strobegen has joined #ocaml
struktured has quit [Ping timeout: 240 seconds]
hnrgrgr has quit [Ping timeout: 240 seconds]
hnrgrgr has joined #ocaml
ollehar1 has quit [Ping timeout: 260 seconds]
breakds has joined #ocaml
thizanne has quit [Ping timeout: 245 seconds]
thizanne has joined #ocaml
ftc has joined #ocaml
ocp has quit [Quit: Leaving.]
breakds has quit [Quit: Konversation terminated!]
csakatok_ has joined #ocaml
shinnya has quit [Ping timeout: 240 seconds]
csakatoku has quit [Ping timeout: 264 seconds]
ollehar has joined #ocaml
osa1 has joined #ocaml
platypine has quit [Ping timeout: 245 seconds]
osa1 has quit [Quit: Konversation terminated!]
struktured has joined #ocaml
kaka22 has joined #ocaml
<kaka22>
hi guys
<kaka22>
i am writing a wrapper for C. a C function is like this: bool sc_open(int *v);
<kaka22>
how can i express this in Ocaml?
<whitequark>
what's the semantics of v?
<kaka22>
it would be something like:
<kaka22>
whitequark: v is the pointer to a value that will be written to by sc_open() when it is run
<kaka22>
i am trying this:
<whitequark>
does it capture the pointer?
<kaka22>
whitequark: what do you mean by "capture"? in C, i would call sc_open() with a pointer to an int variable, to get back updated value after sc_open()
<kaka22>
like this:
<kaka22>
int v;
<kaka22>
if (sc_open(&v)) ....
yacks has quit [Quit: Leaving]
<kaka22>
i have no idea how to express this in Ocaml with "external"
<kaka22>
trying: external cs_open ....
<kaka22>
then stuck, have no idea how to express the pointer, and also bool as return value of function
<kaka22>
whitequark: you just finished the code when we were talking??
<whitequark>
yes
<kaka22>
whitequark: thanks!!
<whitequark>
you're welcome.
<kaka22>
ok i undestand your code. but then this is expressed like this in Ocaml interface:
<kaka22>
external sc_open unit -> int = "sc_open"
<kaka22>
...
<whitequark>
you need to compile a stub library with the function I posted above in order for this to work
<whitequark>
then, use "external sc_open : unit -> Int32.t option = "ocaml_sc_open"
<kaka22>
so the value of 'v' will be returned at the output, right. or '0' otherwise, but this doest really reflect the original semantics of sc_open()
<whitequark>
no, as you can see the return type is Int32.t option. so if sc_open returns false the ocaml wrapper returns None, otherwise it's Some v
<kaka22>
because 'v' can get legal value of 0
<whitequark>
Val_int(0) is how OCaml represents None internally.
ollehar has quit [Ping timeout: 248 seconds]
<kaka22>
oh...
<kaka22>
so in ocaml i would use this like:
<kaka22>
if sc_open != None then begin ... end;
<kaka22>
is that correct?
<whitequark>
no. first, you need to call sc_open with a unit argument, i.e. "sc_open ()"
<whitequark>
second, you probably want to use pattern matching. "match sc_open () with None -> (* nothing *) | Some v -> (* v contains the value*)"
<kaka22>
oh i see ...
<whitequark>
btw for compiling the stub library, you may find ocamlmklib useful. ocamlmklib foo.ml foo_stubs.c -o foo should do it.
<kaka22>
whitequark: awesome, let me try, thanks!
<kaka22>
whitequark: yes i know how to link, just confused on how to express C code in interface ...
NoNNaN has quit [Ping timeout: 240 seconds]
NoNNaN has joined #ocaml
csakatok_ has quit [Remote host closed the connection]
csakatoku has joined #ocaml
csakatoku has quit [Ping timeout: 240 seconds]
csakatoku has joined #ocaml
struktured has quit [Ping timeout: 245 seconds]
ftc has quit [Quit: Leaving.]
ftc has joined #ocaml
<ftc>
can you pair a pattern matching statement with an if statement?
<kaka22>
flux: yes i saw that but find the manual too dry. some sample code would help me much faster
<whitequark>
kaka22: yes, any github account works.
<whitequark>
I think it needs GH account for commenting. silly you can't turn it off, but that's what we have
ollehar has joined #ocaml
<flux>
personally I think initializers aren't as useful as the general form of: class foo = fun arg1 -> let _ = Printf.printf "Some initiliation code" in object method get_arg1 = arg1 + 0 end;;
<flux>
as that allows giving the initial value for 'var's
<flux>
actually no need for that class foo = fun arg1 -> let .., plain class foo arg1 = let .. works. haven't used those things, or ocaml for that matter really :(, for some time
<flux>
the chapter 12 on classes on RWO mentions both styles
<kaka22>
flux thanks i am going to register a GH account now
<whitequark>
please do note that finalizers are *not* destructors.
<whitequark>
there are no guarantees that a finalizer will be run deterministically or run at all.
<kaka22>
no gurarantees? so what is the point of having them?
<kaka22>
so how can i destroy my object?
<whitequark>
finalizers are used to free external resources when the object dies. however, that's just a last-resort measure.
<whitequark>
if you mean "how do I free memory", then you don't: GC takes care of that automatically
<whitequark>
if you mean "I have some external resources associated with the object", then provide an explicit method to free them, *and* register a finalizer.
<kaka22>
whitequark: right, i want it to free external resources
<whitequark>
yeah, explicit #destroy plus finalizers will work. just remember this is not RAII.
<kaka22>
oh finalizer in Ocaml is really different from every other languages. it should be easier like others, isnt it?
<whitequark>
well, not from every other language, just different from C++.
<whitequark>
Ruby, Python, Java, .NET and most languages in general have finalizers which work like this.
<kaka22>
whitequark: but they hide all the details, and usually i never have to know what Gc is
<kaka22>
my first class method get this error:
<kaka22>
The method test has type 'a -> 'b -> 'c -> unit where 'c is unbound
<kaka22>
so i have a class, which got 2 argument to the initializer
<kaka22>
and method test(a, b, c)
<whitequark>
ok, you're not using count
<whitequark>
so ocaml cannot infer its type.
<kaka22>
whitequark: but i havent used the other two either (code & addr), and it doesnt complain?
<whitequark>
shows one error at a time
<kaka22>
i see
<kaka22>
in the code above that, i have:
<kaka22>
| Some csh -> ();
<kaka22>
i thought that way is ok to save the value of csh. but later, in test(), i cannot access to csh
<kaka22>
how can i fix this?
<kaka22>
i mean: | Some bsh -> ()
<flux>
match is scoped like: (match a with .. )
<flux>
so whichever bindings you have inside match disappear after that initializer
<flux>
or that match more precisely
<flux>
so if you need to keep the values around longer you either return it, or maybe in case of objects, you assign it into a value
<kaka22>
flux: i changed the code to this:
<kaka22>
| Some v -> let bsh = v;
<flux>
that's probably not a valid ocaml fragment in your code.. and let is not an assignment, it is scoped binding syntax
<flux>
so let works like: (let a = 42 in expr)
<flux>
let bsd = v; <- that is not (let bsd = 42 in ..)
<kaka22>
flux: no, i dont want to do anything next, but only save that value, and done
<flux>
well, that's not the way to do it then :)
<kaka22>
oh, what is wrong then?
<flux>
some ways maybe to achieve your goal: let bsh = match foo with Bar v -> v
<flux>
let maybe you can use mutable variables (if you are using objects), variables can be assigned with <-
<flux>
or you can use the same let _foo = .. in -kind of syntax in the beginning of the class as you used in the previous code
<flux>
what I mean to say that this is meaningless to ocaml: (match 1 with 1 -> let a = 1)
<flux>
legal version: (match 1 with 1 -> let a = 1 in ())
<flux>
but it is equally useless
<flux>
because the scope of a ends ends before the end of the scope of let
<flux>
and the scope of let ends before the end of match
<flux>
what can be done is: let interesting_value = (match 1 with x -> x + 42) in .. (* interesting_value is now 43 *)
<flux>
of course, the scope of interesting_value ends when the scope of that 'let' ends..
<kaka22>
ok this is getting even more confused for me :-(. what is the best way to fix the code i posted just to save value of bsh for test() to use later?
<flux>
what should the value of 'bsh' be if bs_open returns None?
<flux>
I'm thinking, None
<kaka22>
in that case, test() would refuse to run, like return 0 at output
<kaka22>
if bsh is not None, test() return something positive
<flux>
do you need _mode and _arch after the bs_open call?
<kaka22>
yes i do. that code using it is not implemented yet
<kaka22>
the more i code with ocaml, the more i like it, but the syntax is still quite confused to me so far ...
<flux>
so basically your code needs to consider both cases
<flux>
either bsh is None or it isn't
<kaka22>
oh i see. the code looks quite better now, thanks flux
<kaka22>
let me implement more code to my class to see how it is going ...
<flux>
btw, labeling those things like _mode might not be a good idea, as the compiler ignores warnings on unused _variables by default. or maybe that's exactly why you did it?
<flux>
usually _names are used in pattern matching indicating when you want to (maybe) ignore a value but you still want to give it a name
<kaka22>
flux: oh now, i did that unintentionally. thanks for this info!
chrisdotcode has joined #ocaml
chrisdotcode has quit [Remote host closed the connection]
chrisdotcode has joined #ocaml
chrisblake has quit [Ping timeout: 246 seconds]
chrisdotcode is now known as chrisblake
<kaka22>
now i have another problem with that class: i put it into one .ml file, and reference to it from another one
<kaka22>
in this file, i just "open Classfile"
<kaka22>
but then compiler complains about no implementations provided ...
<kaka22>
do i need to do anything to refer to a class in another module?
ygrek has quit [Ping timeout: 252 seconds]
zpe has joined #ocaml
<adrien>
wmeyer: how did you get that error?
<adrien>
wmeyer: I cleaned the tree between each run because I was switching versions; that might be the difference
ttamttam has joined #ocaml
mchqwerty has joined #ocaml
csakatoku has quit [Remote host closed the connection]
csakatoku has joined #ocaml
csakatoku has quit [Remote host closed the connection]
csakatoku has joined #ocaml
csakatoku has quit [Remote host closed the connection]
csakatoku has joined #ocaml
zpe has quit [Ping timeout: 252 seconds]
<adrien>
wmeyer: more than a branch, it's more testing for more people that is needed
<flux>
kaka22, how do you compile it?
<flux>
kaka22, you need to compile classfile.ml before the one that uses it
ftc has quit [Quit: Leaving.]
Neros has quit [Ping timeout: 245 seconds]
<kaka22>
flux: i found the bug: turn out that the order of linking is important
<kaka22>
my code refers to another file, and that file must be linked before my code. that is the problem
<kaka22>
flux: yes you are absolutely right
Arsenik has joined #ocaml
<whitequark>
kaka22: ocamlbuild handles topological sorting (and many more) for you
hyperboreean has quit [Ping timeout: 260 seconds]
<adrien>
but with side-effects in module initialization, especially with C bindings, you can get annoying things
hyperboreean has joined #ocaml
<kaka22>
that might be the reason, as i have C bindings
Arsenik has quit [Remote host closed the connection]
csakatoku has quit [Remote host closed the connection]
zpe has joined #ocaml
csakatoku has joined #ocaml
<adrien>
well, it really depends on the specific case
<adrien>
difficult to foresse
<adrien>
foresee*
csakatoku has quit [Ping timeout: 246 seconds]
csakatoku has joined #ocaml
zpe has quit [Ping timeout: 264 seconds]
<ollehar>
early birds
<ollehar>
can I use lwt to invoke a function 30 times each second?
fayden has quit [Read error: Operation timed out]
<ollehar>
nm, on_timer
fayden has joined #ocaml
zpe has joined #ocaml
<gasche>
whitequark: I heard from jpdeplaix that he got segfault by using the LLVM bindings
yezariaely has joined #ocaml
<gasche>
I think this is a design defect for an OCaml binding (even though the underlying C++ API may well specify that segfaults may happen in case of misuse), and there should be a (possibly optional) layer of dynamic checking to prevent that
<gasche>
but I never saw the faulty examples so you would have to ask him directly
<whitequark>
gasche: this will be very hard to do in general. main problems:
<whitequark>
1) LLVM in Asserts builds checks various very nontrivial invariants with assertions, and if they fail, just aborts. There's nothing I can do.
<whitequark>
2) LLVM's data structures, mainly llcontext/lltype and llmodule/llvalue, have an ownership contract incompatible with OCaml's GC. this can be theoretically solved by wrapping each llvalue in a tuple which keeps the reference to its llmodule, but I'm not sure if that's worth it or if it will solve the problem completely.
<whitequark>
I'm somewhat leaning to "yes" for 2), but it's also a huge amount of work
Kakadu has joined #ocaml
anderse has joined #ocaml
<gasche>
I see
<gasche>
are those properly documented in the binding interface?
<whitequark>
I'm already going down that road by converting the data structures which don't have owned pointers to use OCaml's GC, but that would break API so I'm blocked on the (lack of) backwards compat policy in LLVM, for the moment.
<whitequark>
(documented) yes, it is.
<gasche>
ok
<whitequark>
gasche: personally, I spend a lot of time in C-land, so segfaults don't scare me very much. do you (as an OCaml user) think it would be a big problem for people adopting the LLVM bindings?
<gasche>
well
<gasche>
OCaml programs never segfault
<gasche>
the norm in OCaml-land is that segfault come from a bug that is not your fault
<gasche>
(you can in fact get genuine segfault by marshalling, but that's rather rare)
<gasche>
the major culprit is "buggy C binding"
<gasche>
so if people use your library and get a segfault, they will assume that it has a bug somewhere, usually in the way it handles memory
zpe has quit [Ping timeout: 260 seconds]
<gasche>
I have little experience with C binding, so I'm not sure whether you can do something meaningful when LLVM abort (ie. problem (1))
<whitequark>
it's not about the binding. it aborts precisely because when it detects such a condition, its internal state is invalid.
<gasche>
I guess you don't have much options (the "good" experience would be to get an OCaml exception raised, but....), so this will come down to "use gdb to find out where the problem is"
<gasche>
it's really unfortunate that the (absence of) error-handling policy forces us to debug OCaml programs as if they were C program
<whitequark>
theoretically you could throw the whole compilation context out and start again, but the problem is that in Release LLVM builds, it won't abort, just silently misbehave and/or crash (it's common for it to not crash but produce invalid result, in practice.)
skchrko has quit [Quit: Leaving]
<whitequark>
you don't need gdb, it prints a sensible message and a backtrace itself.
<gasche>
ah
<gasche>
I'm surprised by how much the Release situation sucks
<whitequark>
the rationale here is that asserts involve a very big amount of often costly checks. so you couldn't compile as fast as you can (which is one of main LLVM goals) if you do them all the time.
<whitequark>
they really are costly -- Release+Asserts builds can be 10x or more slower than just Release builds.
<gasche>
indeed, but you could probably implement the checks more efficiently by adding some bookeeping logic for it in the implementation
<gasche>
(I mean, dynamic languages don't rebuild the whole dynamic context by inspecting the call stack at each check, they move dynamic type representations around instead)
mchqwerty has quit [Remote host closed the connection]
<gasche>
but well
<whitequark>
well, it almost always asserts in conditions which result from blatant interface or algorithmic errors
<gasche>
I get the point that compile time is a bottleneck for C++ :p
mchqwerty has joined #ocaml
<whitequark>
interfacing it from Ruby was *much* harder; OCaml's typechecker catches like 90% of what could become a segfault/assert in my Ruby bindings
<gasche>
I can't helpfully comment more as I don't know anything about those bindings, just hearsay
<whitequark>
I see.
<whitequark>
there's also one thing to consider, the fact that you use LLVM to generate very unsafe code (and sometimes run it right in your process, with JIT).
<gasche>
I'd say that the "ultimate" OCaml binding would run enough dynamic checks to avoid aborts, and either expose a clear explicit memory-handling interface (with gracious failure modes) or (better) encode the ownership logic through some devilish tricks to make it understood by the OCaml GC
<gasche>
(eg. keeping a list of things you own on the OCaml-side is not unheard of, rwmjones does that in some of its bindings)
<gasche>
I perfectly understand that this may require unbounded amount of work (and it is debatable whether you want to re-implement sanity checking in the binding when that is logic that lies in the project itself)
<adrien>
wmeyer: I can imagine something which would explain your current issue; if you build again, does the issue persist?
<whitequark>
I could just convert all llvalue's into tuples of (llmodule,llvalue). I'll look into how costly/complex that is, sounds doable.
<adrien>
wmeyer: without cleaning: only "make $foo"
<gasche>
I would be interested in better documentations about how to attack bindings with libraries using refcounting or explicit ownership disciplines
<gasche>
(in particular with the new ctypes stuff)
<gasche>
I have never done that myself
<whitequark>
gasche: reimplementing asserts is intractable. unfortunately this is not even up to a question. consider this: it will abort in codegen or optimization passes for structurally valid IR which passes/the codegen cannot understand.
<whitequark>
this will basically require me to reimplement every single assert and track the changes in them.
<whitequark>
I think LLVM was implemented this way not so much because of speed, but because it's often impossible to sensibly define how to recover from an error.
<whitequark>
say you use an intrinsic which your codegen does not understand. what next? the best you could ever do is to show a message to the user and die.
<whitequark>
LLVM does just that.
<gasche>
well
<whitequark>
I think we can agree on distributing the Release+Asserts build from opam and letting anyone who wants it faster to compile it on their own, it's not hard.
<gasche>
I may want to experiment with producing LLVM IR programs in a live-coding environment (eg. in my OCaml toplevel)
<whitequark>
what do you think?
jonludlam has joined #ocaml
<whitequark>
hm, I think I've seen some API to intercept fatal errors, let me look.
<gasche>
but I tend to agree that if their design choices make errors impossible to catch, then it's not the responsibility of the binding author to paper over that
<whitequark>
no, it aborts anyway, just lets you call your own error handler.
<whitequark>
gasche: re live coding: that's a very interesting idea and I just recently wrote a patch which actually allows one to use LLVM in toplevel,
<gasche>
from an OCaml user p.o.v., it would be nice to be able to, say, wrap the LLVM computation in a separate process to be safe from failures
<gasche>
but that's probably a project that could be kept separate from the LLVM binding
<gasche>
(eg. if my end goal is to produce some LLVM IR, which is marshallable by design, I could run all computations on this new process and then get the IR back)
<whitequark>
note you can get an abort while constructing the IR very easily.
<gasche>
besides, I'm not sure it is convenient to write something portable for that (I don't remember which of the Windows ports support Unix.fork)
<whitequark>
I think the right approach here is the one taken Haskell's llvm-general: it defines a set of ADTs resembling LLVM IR which you can construct, then marshall with the language and flatten to LLVM IR elsewhere.
<gasche>
makes sense
<whitequark>
(windows & fork) that'll be only Cygwin, not native, and it's so slow you won't want to use it.
<gasche>
but as my "separate process" idea, it can be built *on top of* clean bindings to what's actually exposed as an interface
<whitequark>
clean as in?
<gasche>
hm
anderse has quit [Quit: anderse]
<gasche>
in this occurrence it meant "close to the C binding interface"
<whitequark>
that's my current goal, yes
<whitequark>
talking about C bindings, do you think there's a binding for mmap syscall?
<whitequark>
I'll need that for LLVM's new JIT.
<gasche>
there should be one in Bigarray or Unix
Vendethi_ has joined #ocaml
jonludlam has quit [Read error: Operation timed out]
<whitequark>
unix doesn't have one
<whitequark>
Bigarray doesn't seem either
Vendethi_ has quit [Remote host closed the connection]
Vendethi_ has quit [Remote host closed the connection]
syntropy has joined #ocaml
Vendethi_ has joined #ocaml
Vendethi_ has quit [Remote host closed the connection]
Vendethi_ has joined #ocaml
Vendethi_ has quit [Read error: Connection reset by peer]
zpe has quit [Ping timeout: 252 seconds]
Vendethi_ has joined #ocaml
kaka22 has quit [Quit: Leaving]
Vendethi_ has quit [Remote host closed the connection]
dsheets has joined #ocaml
Simn has joined #ocaml
Radditz has joined #ocaml
Vendethi_ has joined #ocaml
Vendethi_ has quit [Remote host closed the connection]
Vendethi_ has joined #ocaml
ontologiae has quit [Ping timeout: 240 seconds]
<gasche>
Kakadu: that looks like an install problem that is not really opam-related (by which I mean that building the package from sources yourself would probably run into the same error)
Vendethi_ has quit [Remote host closed the connection]
<gasche>
I'd guess 'qmake' is the command not found, but I have no idea why
Vendethi_ has joined #ocaml
Vendethi_ has quit [Read error: Connection reset by peer]
Vendethi_ has joined #ocaml
Vendethi_ has quit [Remote host closed the connection]
Vendethi_ has joined #ocaml
platypine has joined #ocaml
platypine has quit [Changing host]
platypine has joined #ocaml
Vendethi_ has quit [Remote host closed the connection]
<Kakadu>
with bash -c 'echo WTF && which qmake' I get same 'command not found`
<gasche>
eikke: I don't understand your caml-list post
<eikke>
which *might* be some valid answer when using the unsafe variant
platypine has quit [Ping timeout: 260 seconds]
<eikke>
but in the safe case should raise an exception, just like `(%caml_string_get16) "a" 0` does
<gasche>
It looks like a bug indeed
<gasche>
if I'm correct, it should work as you expect in bytecode
<eikke>
hmh, not sure, think I tried that as well and it failed
<eikke>
but I might be mistaken and remember badly
<eikke>
when using utop, bytecode versions are used, right?
<gasche>
no, it behaves in the same way
<gasche>
(just tested)
<eikke>
think I tried it (through ocplib-endian) from utop, and it returned 0 as well
kaka22 has joined #ocaml
<kaka22>
hi guys
<kaka22>
what is the format string for Int64? i tried %llx & %lx but nothing works
<kaka22>
this is on linux 64-bit machine, if that matters
s4muel has quit [Ping timeout: 245 seconds]
<johnelse>
kaka22: %Ld if you want it printed as decimal
<johnelse>
%Lx for hex
<kaka22>
johnelse: thanks. it is different from C
Vendethi_ has joined #ocaml
_andre has joined #ocaml
IbnFirnas_ has quit [Read error: Connection reset by peer]
IbnFirnas_ has joined #ocaml
<gasche>
oh.
IbnFirnas_ has quit [Read error: Connection reset by peer]
IbnFirnas_ has joined #ocaml
<gasche>
eikke: I think I found the bug, and it's nasty
<gasche>
testing right now
<eikke>
I looked into the compiler code but couldnt find anything too fishy immediately, and didnt have much time to proceed
<eikke>
so, cool :-) looking forward to read the patch
yacks has joined #ocaml
<gasche>
indeed
csakatok_ has quit [Remote host closed the connection]
csakatoku has joined #ocaml
<kaka22>
whitequark: in your code at https://gist.github.com/whitequark/7313774, why dont you just return Val_int(v), but have to insert it into another block (allocated by caml_alloc_small())?
csakatoku has quit [Remote host closed the connection]
csakatoku has joined #ocaml
<kaka22>
hmm to handle it later with "match..." i guess
<eikke>
is there a way to let ocamlopt dump some/all of its intermediate forms when compiling a module?
<whitequark>
kaka22: that's the contract of the type 'a option
<whitequark>
basically.
<kaka22>
whitequark: this line: Store_field(result, 0, caml_copy_int32(v));
<kaka22>
can i write it to:
<whitequark>
None is Val_int(0), Some x is a block of size 1 with tag 0 and the 'a inside
<kaka22>
Store_field(result, 0, Val_int(v));
<kaka22>
whitequark: can i?
<whitequark>
kaka22: yes, but you would need to change Int32.t option to int option in the signature.
<kaka22>
what is the difference between Int32.t and int??
<whitequark>
range. int is a 31- or 63-bit integer.
<whitequark>
Int32.t is, well, 32-bit.
<kaka22>
when int is 31 bit, and when it is 63-bit?
<whitequark>
I don't know what your API uses so I chose the conservative variant.
<whitequark>
int is 31-bit on 32-bit architectures and 63-bit on 64-bit ones.
<whitequark>
of common ones: 32-bit: arm, x86, etc. 64-bit: amd64.
<kaka22>
i see
<kaka22>
whitequark: on this line: result = caml_alloc_small(1, 0);
<kaka22>
why dont we use caml_alloc(), but caml_alloc_small() ?
<whitequark>
more efficient
<adrien>
alloc in the minor heap?
BitPuffin has joined #ocaml
<gasche>
eikke: you can have a nice segfault with (set64 "" 0 0)
<kaka22>
ok, so what is the common sense here: when to use caml_alloc_small(), and when to use the other?
<adrien>
kaka22: I meant: you usually don't have to wonder but in some specific cases you might want what isn't the default behaviour and ocaml lets you chose
<gasche>
kaka22: use 0x1000L
<adrien>
kaka22: try 0x1000L
<gasche>
:]
<adrien>
:p
zpe has quit [Ping timeout: 245 seconds]
<gasche>
(and *I* tested)
<gasche>
as a side note
<gasche>
the way most language handles implicit conversion is terrible
gour has joined #ocaml
<gasche>
Haskell does it somewhat right
<gasche>
but Java is an absolute pain to deal with
<whitequark>
anything C-derived for that matter
<gasche>
go explain your students that when you have (double x) and you do (double y = x*10/100), it works, but (double y = x*(10/100)) doesn't
<gasche>
java is what I have to teach
<gasche>
(of course (double y = x/5 will behave as expected))
<eikke>
gasche: "mksize_t which is (or can be) unsigned"
<gasche>
hm
<eikke>
that sounds rather scary to me :P
<gasche>
mlsize_t, that's a typo
<gasche>
isn't that the C convention to return sizes and indices in an unsigned type?
<eikke>
depends, there's size_t and ssize_t
<gasche>
:D
<gasche>
*that* is crazy
<eikke>
most things return ssize_t so (-1) is a valid result value (denoting error)
<eikke>
size_t is used as an argument, ssize_t as a result
<gasche>
I'm used to size_t
<gasche>
I wonder why I don't remember ssize_t at all
<gasche>
ah
<gasche>
it seems ssize_t isn't standard C
<adrien>
gasche: C99 probably
<gasche>
it probably didn't exist at the time at which the runtime was implemented
<adrien>
gasche: the additional "s" means "signed" iirc
<eikke>
indeed
<gasche>
I got that
<gasche>
web-browsing seems to indicate that ssize_t is in a recent POSIX spec, but not in any C standard
<eikke>
I'm not very familiar with exact C versions etc... I'm happy if my stuff compiles, and read prototypes from manpages, picking up types on the go
<adrien>
C89 is the lowest standard you should care about
<adrien>
C99 introduces some things which are not vital but oftn _much_ nicer
<adrien>
including better types, designated initializers for structs, ...
strobegen has quit [Quit: Leaving.]
<eikke>
analysis & patch look sensible, unless idx comes close to MAX_SIZE_T I guess
strobegen has joined #ocaml
<kaka22>
gasche: adrien the appendix L works, thanks!
BitPuffin has joined #ocaml
darkf has quit [Quit: Leaving]
csakatoku has joined #ocaml
demonimin has quit [Ping timeout: 252 seconds]
wolfnn has joined #ocaml
<whitequark>
eikke: I think MSVC still doesn't implement C99 completely.
<jpdeplaix>
whitequark: LLVM aborts ?? IMHO, no. It got a null pointer when the internal types are not good and tries to apply, then segfaults.
<whitequark>
eikke: everything else does, so that boils down to supporting msvc.
<whitequark>
jpdeplaix: was that an Asserts build ?
kaka22 has quit [Quit: Leaving]
<gasche>
but in any case ssize_t seems not to be C99 anyway
<whitequark>
jpdeplaix: I often see LLVM compiled without Asserts by default, ie: in debian, in llvm from opam, ...
Vendethi_ has quit [Remote host closed the connection]
<eikke>
whitequark: I pretty much only target a single platform when writing software (both professionally as well as side-projects)
demonimin has joined #ocaml
ollehar has quit [Ping timeout: 264 seconds]
<jpdeplaix>
I've just answered your post on the mailling-list
<jpdeplaix>
whitequark: Asserts build ?
<adrien>
gasche: it's fairly weird; I'm asking around
Vendethi_ has joined #ocaml
<jpdeplaix>
ah ! « MAIS C'EST DÉGUEULASSE !!!! »
<whitequark>
jpdeplaix: (read your reply) LLVM has an enormous amount of asserts checking for various preconditions
<jpdeplaix>
eummh sorry: « But that's horrible »
dsheets has quit [Ping timeout: 252 seconds]
dsheets_ has joined #ocaml
<whitequark>
jpdeplaix: not sure I follow
Vendethi_ has quit [Read error: Connection reset by peer]
<jpdeplaix>
asserts in library are almost the worst choice to do IMHO
<jpdeplaix>
(but that's C++ so, it's kinda comprehensible)
<adrien>
don't complain about llvm or I'll make you use webkit!
<whitequark>
well, LLVM uses a combination of ErrorOr and asserts. for recoverable conditions exceptions are too costly and require RTTI
<whitequark>
$ git grep assert lib |wc -l
<whitequark>
6637
<whitequark>
I've had your idea to make a checking interface to LLVM but that quickly faded
Vendethi_ has joined #ocaml
Vendethi_ has quit [Remote host closed the connection]
Vendethi_ has joined #ocaml
Vendethi_ has quit [Write error: Connection reset by peer]
Vendethi_ has joined #ocaml
<eikke>
is cmm generation before or after inlining?
breakds has joined #ocaml
rand000 has joined #ocaml
sepp2k has joined #ocaml
Vendethi_ has quit [Read error: Connection reset by peer]
<whitequark>
jpdeplaix: looking at your bugs on llvm.org now
<whitequark>
you really should have posted bitcode, no one would (understandably) bother compiling your project
<whitequark>
you didn't even post build instructions
<whitequark>
jpdeplaix: by the way I just tried to compile it and there's no package monad-exn in opam
jonludlam has quit [Ping timeout: 240 seconds]
Radditz has quit [Quit: ChatZilla 0.9.90.1 [Firefox 25.0/20131025151332]]
Vendethi_ has joined #ocaml
Vendethi_ has quit [Read error: Connection reset by peer]
<whitequark>
jpdeplaix: overall I would be happy to help you work with the bindings and improve them if they're missing something.
ocp has joined #ocaml
Kakadu has quit [Ping timeout: 250 seconds]
jonludlam has joined #ocaml
Vendethi_ has joined #ocaml
talzeus has quit [Remote host closed the connection]
Vendethi_ has quit [Read error: Connection reset by peer]
talzeus has joined #ocaml
talzeus has quit [Ping timeout: 246 seconds]
Vendethi_ has joined #ocaml
<whitequark>
what's the convention for labelling boolean arguments? ~is_signed:bool or ~signed:bool ?
<companion_cube>
what you prefer :)
Vendethi_ has quit [Remote host closed the connection]
<kaka22>
now i want to mix some "if then else" into the "let ....." part, how can i do that?
<kaka22>
i try with begin ... end block, but ocaml report error
<kaka22>
for ex, i want to set "x = 1" if _arch ==1, otherwise x = 2. how can i change that code ?
<kaka22>
i still don get used to the way "initializer" works yet
<flux>
let x = if _arch = 1 then 1 else 2 in ..
<flux>
you don't need initializer for that either :)
<flux>
initializer is for when you want to do some operations on the already constructed object
<kaka22>
flux: so when do i need initializer?
struktured has joined #ocaml
<flux>
btw, be aware that == is not a great operator to use. it means 'pointer equivelance'. it works the same as = for basic primitives like integers and booleans, but not the same for things like strings
csakatoku has quit [Ping timeout: 264 seconds]
<ggole>
== is reasonable for mutable objects
<ggole>
Using it on values is pretty suspicious though
<flux>
use of == when beginning ocaml programming is very highly suspicious :)
<adrien>
gasche: yeah, apparently ssize_t is >= SUSv2
<adrien>
nothing in C99
<flux>
wasn't it so that Jane Street Core even disabled == by default
<gasche>
yezariaely: not segfaulting ? :p
<flux>
it did something similar to = as well, though
<ggole>
They gave it a more explicit name
<yezariaely>
gasche: obviously :-p
<kaka22>
flux: now if i want to write some code with "match", how can i mix with above "let ... in" code?
<ggole>
(And gave the old one an unsatisfiable type, iirc)
<kaka22>
i tried: ...let ... in match .... with
<gasche>
the bug is that sometimes the out-of-bound check doesn't fire when it should
<kaka22>
but error
<gasche>
so the expected behavior is an "out of bounds" error
<yezariaely>
ah, I see. thanks.
<kaka22>
the error code is like: let .... in match ... with ... in
<flux>
let () = match a with 42 -> printf "hello" in ..
shinnya has joined #ocaml
<flux>
(for example)
<gasche>
note that "let .. in" in class declarations is only useful for data that is shared between instances
<gasche>
if you want an per-object initializer, there is proper support for that (initializer)
<flux>
gasche, not if your class has arguments
<flux>
gasche, initializers are no good for setting object variable initial values
<kaka22>
oh so tricky. let me try ....
<gasche>
hm
<gasche>
flux seems to understand what you want to do better
SDLo22 has joined #ocaml
avsm has quit [Quit: Leaving.]
<SDLo22>
I've been looking through the List. module but can't seem to find what I need. How can I input 2 lists [1; 2; 3; 4; 8] [2; 4; 7; 8; 9] and output a list of the common values -> [2; 4; 8]?
jonludlam has quit [Ping timeout: 246 seconds]
<ggole>
Usually you would use sets for that
<flux>
sdlo22, 1) concatenate lists 2) sort them 3) find values that are consecutively in the list
<ggole>
If the lists are sorted it wouldn't be too hard to write though
jonludlam has joined #ocaml
<SDLo22>
I'll have a go at doing it using the way flux explained as long as there isn't something in sets that would do it really easily
<SDLo22>
Cheers guys
<kaka22>
in ocaml, can i assign 2 tuples like this? :
<kaka22>
let (a, b) = (c,d);
<kaka22>
seems impossible, so any alternative?
<syntropy>
kaka22: It is possible, what is the problem?
<ggole>
let (a, b) = (c, d) in ... is fine
<ggole>
But it isn't "assigning two tuples"
<gasche>
well Set can do it really easily indeed, it's Set.inter
<gasche>
( SDLo22 )
<SDLo22>
Perfect
<ggole>
Most of the ceremony would be getting elements in and out of the sets
<SDLo22>
thanks a lot
<gasche>
you'll still have work to do to understand how to convert a list into a set and back
<gasche>
but it's an useful knowledge to acquire about OCaml, I think
jonludlam has quit [Ping timeout: 240 seconds]
<ggole>
module IntSet = Set.Make (struct type t = int let compare = compare end) let intset_of_list list = List.fold_left (fun set elt -> IntSet.add elt set) IntSet.empty list
struktured has quit [Read error: Operation timed out]
<kaka22>
ok, my code is like:
<kaka22>
match x with
<kaka22>
| a b -> let c = d;
<kaka22>
...
<kaka22>
error in the "let" line
<ggole>
; is not a valid thing to put after let like that
<kaka22>
what is the problem?
<ggole>
let is an expression, not a statement
<gasche>
let c = d in ... ?
<syntropy>
"let" is not an assignement
<kaka22>
gasche: but i have nothing behind for "in ..."
breakds has quit [Remote host closed the connection]
<ggole>
The | a b pattern is also wrong
<ggole>
What are you trying to do?
Drup has joined #ocaml
<syntropy>
kaka22 : "let" introduces a name for a construct , it doe not assign a value to a variable
<kaka22>
ggole: hard to explain what i am doing, since it is complicated
<gasche>
(and wrong)
<kaka22>
so how to fix that "let" part?
<gasche>
we cannot tell you without knowing what this should mean
<kaka22>
gasche: i think so. ocaml is so hard to get it right for newbie
<gasche>
you should give the whole code snippet and explain what you want it to do
<gasche>
"let c = d" doesn't mean much in isolation
q66_ is now known as q66
<gasche>
and it's not clear that there is a one-to-one mapping of constructions you know from other languages into OCaml; you may have to restructure the code a bit
djcoin has joined #ocaml
<gasche>
(which is why we're helpless without actual precise context)
<flux>
kaka22, if you cannot put 'in' after a let, you are either making a top-level definition, or a mistake :-)
<flux>
kaka22, if you want to get values out of a 'match' you need to remember that 'match' is an expression with a value. each of the patterns result in a value being returned, which ends up being the value of the match expression
eikke has quit [Ping timeout: 252 seconds]
<flux>
for instance: let (foo, bar) = (match x with 0 -> (0, 1) | _ -> (1, 0)) in .. (* now foo and bar have (0, 1) or (1, 0), and the values have been moved outside the match expression)
<flux>
it is times like these when I think that ocaml reuses the same keywords a bit too much..
<gasche>
revised syntax uses "val" for top-level "let", makes sense
<kaka22>
flux: this seems what i want... let me try ....
<gasche>
I don't personally care for this one
<gasche>
but beginners sometimes write "let x = ... in let foo = bar;;", which I found very puzzling at first but is in fact rather natural
<gasche>
(note that explicit "val" wouldn't help here)
chambart has quit [Read error: Connection reset by peer]
<flux>
gasche, what would they write with a 'val' then?
<flux>
let x = .... in val foo = bar?
<gasche>
yes
<flux>
well, you can just say 'val' can never be 'inside' something like that
jonludlam has joined #ocaml
<flux>
it's more difficult to communicate about a let
<gasche>
this is what I tell them
<flux>
because there are two kinds of lets
<gasche>
but in fact, there is no really convincing reason not to allow (<local decl> in phrase)
kakadu has joined #ocaml
<kaka22>
flux: actually your sample code above is not really what i want to achive. i will paste the code out ...
<ggole>
It's a touch clumsy to have a binding around a function, too
<flux>
gasche, I don't think I follow..
<ggole>
let f = let q = ref 0 in fun x y -> ...
<flux>
what would be a better solution?
<ggole>
People seem to want to write let q = ref 0 in let f x y = ...
<flux>
would be the way to do it without involving two classes
<kaka22>
flux: i see what you mean, but if in my branch, i dont access writeback, i can get away with that, no?
<flux>
then later on, when you check the condition with match, you can check it like: match arch, writeback with | I1 a, Some writeback -> (* now you have writeback deconstructed here *) | I2 a, _ (* ignore writeback *) -> ..
Vendethi_ has joined #ocaml
<kaka22>
if arch == I1 then read writeback, else dont ...
<flux>
well you cannot conditionally define values to be in scope
<flux>
regardless if you use them or not later
<flux>
it must be possible to just read the code's structure and see what variables are accessible there
<kaka22>
maybe, i am not sure. but in other dynamic language like Python, this is possible ...
<flux>
point a finger in the code, read the code towards the top of the file and say, "this line is able to access cc, writeback, id, addr and arch"
<flux>
there is no "also it can access writeback if that condition is true"
<Drup>
kaka22: the important part here is "dynamic"
<Drup>
kaka22: do you realize how unsafe what you're asking is ?
<syntropy>
kaka22, I think you are misunderstanding the meaning of "let a= b in ... "
Vendethi_ has quit [Read error: No route to host]
<kaka22>
Drup: oh, so ocaml is not as "dynamic" as Python?
<Drup>
kaka22: ocaml is not dynamic at all.
<flux>
most definitely not
<flux>
and we like it that way :)
<kaka22>
new to me, i dont know this
<syntropy>
" let a = b in X" means that in the context of X , I will use a as a shortcut for b. It does not create any variables
<kaka22>
syntropy: yes i think so. so "let a = b" doesnt assign b to a?
<kaka22>
what it really does then?
<flux>
well, syntropy's explanation is great but it doesn't consider the side effects, only the value
<kaka22>
then my code is completely wrong, since i want to accesss to cc, writeback later, in other method (of that class)
<flux>
no, your code looks fine regarding that
<flux>
all those things are inside let a = b in ...
<flux>
so they are able to refer to the binding 'a'
<kaka22>
flux: so in the code you posted, i can access all those cc, writeback, ... in methods of bs_in class?
<flux>
yes
<flux>
but the thing about let bindings..
<flux>
for example, if you have let value = Random.int() in (value + value)
<flux>
then whichever random integer you got will be the same
<flux>
so value is bound to the value of Random.int () at that time
<flux>
(actually it's called Random.int 42)
<kaka22>
i see, but that is fine to me, cause i dont do anything like that
<flux>
sure
<flux>
if you later on have another (let value = 42 in (value + value)) then this uses its own value binding, that much is obvious
<flux>
and of course the scope of 'value' ends at the end of the last closing parenthesis and the old binding, if there was one, become visible again
<kaka22>
sure, since all of those are read-only vars
<flux>
yep, so that works fine with the 'binding' or 'short-cut' way of thinking
<gasche>
kaka22: why are you using classes?
<gasche>
if you are a beginner, you should probably try to avoid them at first
<gasche>
they are certainly not necessary to write good code
<gasche>
(and they allow beginner to indulge in their habits with other languages and write bad code)
<flux>
indeed classes are an advanced subject in ocaml
<kaka22>
gasche: to learn ocaml :-)
<flux>
but I suppose it's possible to start with them as well :-)
<gasche>
of course you may be hacking on already-existing code that uses object-oriented programming, and then it's fine
<flux>
I think it's the logical way for someone new to ocaml to go if they are familiar with objects.. but I sort of doubt it's the easiest :)
<gasche>
flux: we have a nice expression in french for that, "se mettre des bâtons dans les roues"
<kaka22>
i am writing from scratch, that is why there is so many problems fo rme
<gasche>
which document are you using to learn OCaml?
<kaka22>
gasche: some tutorials i found
avsm has joined #ocaml
<kaka22>
then i started reading some code, and hacking some more
<gasche>
which ones?
<kaka22>
gasche: tutorials?
<gasche>
so the idiomatic english translation seems to be "to put a spoke in my wheel"
<Drup>
gasche: english people have only one wheel ? that explains a lot. :)
<gasche>
kaka22: I think that picking a good learning document would be a more efficient way to learn OCaml than getting sparse explanations from the IRC chan
<johnelse>
I think the equivalent english saying is "to put a spanner in the works" :)
<kaka22>
gasche: absolutely.
<kaka22>
what do you recommend?
<gasche>
so the french expression has the idea that you're adding difficulties, but that may not stop you from succeeding; it's just much harder (for no real useful purpose)
<gasche>
I'm not exactly sure
<gasche>
there is Real World OCaml that's just out, and which is available freely online
<kaka22>
as newbie, my impression on ocaml is that it is so weird and different from other imperative languages (such as python). i read docs and tutorials again and again, but it seems only writing code is a good way to improve skills
<gasche>
of course you need practice
<ggole>
It's not an imperative language, really
<gasche>
but the mistakes you're making right now should have been prevented by a good document
<ggole>
There are imperative features, but the smooth path is fairly functional
<kaka22>
but let say i am really impressed with you guys on this IRC. certainly the best community out there, people are so friendly here. in other channels (#C is one notable), i would get bashing immediately when i open my mouth
<kerneis>
just to have an idea of the level of madness
<ggole>
I guess people bitch whether you add things to the language quickly or be conservative
<kerneis>
:-)
<kerneis>
C is much more sensible (even if the memory model - copied from C++ - is somewhat broken)
<ggole>
The last few C standards haven't exactly set the world on fire either
<gasche>
you're being a bit unfair, at least they (C/C++) did a real effort on specifying the memory model
<gasche>
it's maybe not as resilient as Java's, but I think they did a pretty good job
<gasche>
I'm not surprised that memory model researchers find a thing or two to criticize, but the intent is noble and the realisable seemed reasonable to me
<whitequark>
it's somewhat insane. there are parts of it literally no one understands.
<adrien>
there's some technical stuff that happened
<adrien>
then ???
<adrien>
then this blog post
<adrien>
??? seems to be marketing people getting involved
<whitequark>
I don't see a problem with the blog post
<adrien>
in any case, this mentions clearly that they are using the MSVC header
<adrien>
s
<adrien>
which
<adrien>
THEY CANNOT DO
<whitequark>
why?
<adrien>
they're proprietary
syntropy has joined #ocaml
<whitequark>
without a license?
<adrien>
hmm?
<whitequark>
I doubt MS doesn't put *any* license on the headers, that would prohibit you from even developing applications
<adrien>
your lack of faith is disturbing :)
<adrien>
you get an EULA with MSVC, there's a license in the headers, and both of them are fairly ugly iirc
<adrien>
in any case, you're going to be forbidden from redistributing them
<whitequark>
adrien: they don't redistribute headers
SDLo22 has quit [Quit: Page closed]
<whitequark>
the toolchain is supposed to go in place of MS's compiler, not the whole SDK or VS itself
<adrien>
yeah, which is a bad approach in all honesty
<adrien>
it's not even clear you can use MS headers with something else than MS compielrs
<adrien>
compilers*
<adrien>
but this means that this doesn't give you a free toolchain and this is not on track to do so
<adrien>
which look completely stupid considering that mingw-w64 provides free headers and libraries that fill in the gap in the standard conformance of MS' CRT
mcclurmc has quit [Remote host closed the connection]
<whitequark>
developing a free toolchain isn't a goal of llvm/clang? rather, developing a good compiler is
<whitequark>
as I understand it, it's also (supposed to be) abi-compatible with msvc
<whitequark>
also, what prevents one from reusing headers from mingw-w64?
<adrien>
why haven't they started with them?
<kaka22>
i want to return a list with this code, but got error: this expression has type bool, bu an expression was expected of type unit ...
<adrien>
they're using very proprietary stuff right now
<kaka22>
pls can somebody tell me what is wrong?
<adrien>
it's not clear the whole project can be legally used!
<whitequark>
adrien: if I understand it correctly, the motivation for clang@windows is to have a modern compiler that works.
<whitequark>
so one could use c++11/14 in llvm itself, chrome, ...
<adrien>
kaka22: you seem to be trying to use mutation inside the anonymous function
<adrien>
kaka22: "=" is equality test, not affectation
<adrien>
kaka22: you should try to use one of the "fold" (left or right) functions in the List module
<adrien>
kaka22: you'll have to understand them but they should help you do what you want and nicely
<kaka22>
oh i cannot append to a list with l = l @ [a] ?
<ggole>
Lists are immutable
<adrien>
whitequark: even if it cannot be legally used? and gcc works on windows; it's also quite frustrating to see duplicated efforts on one difficult topic
mcclurmc has joined #ocaml
<Drup>
kaka22: affectation is *only* done by "let bla = bli in blu"
<Drup>
kaka22: "bla = blu" is the equality test
<whitequark>
adrien: gcc also works on everything else clang/llvm support
<Drup>
kaka22: also, if you are trying to reverse a list, this is a terrible technique :p
<ggole>
I think he just wants List.map, actually
<adrien>
whitequark: windows is a special case
rwmjones has quit [Ping timeout: 246 seconds]
<kaka22>
so if list is immutable, how can i append to it? since i want the output is a list
<ggole>
You make a new list with another element on the front
<ggole>
elt::list returns list with elt "consed" onto the front
<kaka22>
what i want is like: list = []; for x in somelist do list.append(new myclass x) end
<ggole>
Use List.map for that.
<Drup>
kaka22: you should really follow the tutorial we gave you
<kaka22>
looking at fold_left, but not sure what to use as the first argument
<kaka22>
and if list is immutable, then i have no idea how to append at each iteration of the loop
<Drup>
kaka22: it will explain all this stuff far better than what we are trying to do here
<ggole>
List.map (new myclass) somelist
<syntropy>
kaka22, you are trapped by your knowledge of imperative language
<kaka22>
ok i see. let me go thru it first ....
<kaka22>
syntropy: yes no doubt. i guess this is why most newbies struggle with ocaml
<whitequark>
adrien: I think gcc doesn't attempt to replicate msvc's abi
<whitequark>
so still not quite a duplicate
<kaka22>
oh right, list.map is what i need ..
rwmjones has joined #ocaml
<adrien>
whitequark: it does
<adrien>
there's one missing C++ ABI compat
<adrien>
and it's improving
<whitequark>
I see, interesting
<adrien>
it was quite frustrating because this windows support for llvm came out of the blue
<whitequark>
still, that adds windows support for anything using llvm as a backend.
<whitequark>
rust, d, ...
<adrien>
yup, noone is denying what this brings but there's two decades of reverse-engineering of microsoft/windows stuff, including for things which MSDN gets wrong
<adrien>
and no communication before the announcement
<kaka22>
when using ocaml class, i can access to its method with class#method. how about class variable? can i use same way class#var to access its variable?
<kaka22>
looking at some tutorials, they all seem to turn to method for every access
gour has quit [Disconnected by services]
gour_ has joined #ocaml
ocp has quit [Ping timeout: 240 seconds]
<kerneis>
kaka22: yes
<Drup>
kaka22: "variables" (in the object-oriented meaning of the term) are just methods without arguments
<kerneis>
Drup: ocaml makes a difference between methods of no argument and variables
<Drup>
kerneis: yes, and val are not accessible, as opposed to method, hence my sentence
<kaka22>
i can access myclass#id, myclass#addr
<kaka22>
right?
<kaka22>
or not?
<kerneis>
kaka22: ah, this is yet another thing
<Drup>
kaka22: I already told you, and I'm going to do it again : follow some tutorials we gave you and stop trying to use OO in ocaml.
<Drup>
kaka22: you're learning a new language with a différent paradigms, you're not going to succeed by applying what you know about other languages.
gour_ is now known as gour
<kaka22>
think you are right. it is not like i am not trying, but ocaml is significantly more time consuming to learn than anything else i know, so i am struggling ....
<syntropy>
kaka22, in order to give you a perspective, I have still not really used the OO part of Ocaml ( except for playing with phnatom type)
<adrien_oww>
kaka22: Drup is right: OO in OCaml is an advanced feature
<Drup>
kaka22: it's only because you're trying the wrong way. If you take the good approach, ocaml is not that hard to learn.
<kaka22>
most of other languages i can learn in a day, but it seems Ocaml would take a month ....
<syntropy>
kaka22: in other words, you are trying to learn Ocaml by starting with some of the most advanced feature
<syntropy>
kaka22: How many non-imperative language do you know?
<kaka22>
syntropy: ocaml is the first one i am serious about
<kaka22>
haskell or #F i took some quick looks only
<syntropy>
kaka22: So you are trying to learn a new programming paradigm alltogether ... Not so surprisingly, this takes time.
<Drup>
kaka22: and to be honest, OO is probably one of the most "alien" feature of ocaml. it's *very* different than OO in regular object oriented programming language.
<ggole>
Forget objects and look at basic types, functions, tuples, records, ADTs
<kaka22>
Drup: ok it seems harder than i thought
strmpnk has quit []
<adrien_oww>
kaka22: without objects in ocaml, you can do almost everything that is done using objects in other languages
strmpnk has joined #ocaml
<adrien_oww>
and with objects in ocaml, you do vastly different things than what you do with objects in other languages
<Drup>
kaka22: ocaml itself is not, just don't try to use OO
<syntropy>
kaka22: The problem is that in normal OO language, the OO part is essential to organize the code.
<adrien_oww>
I haven't done object code in months
<adrien_oww>
most people here are probably in the same case
<adrien_oww>
really, admit it for now, and after you get some practice, you'll see how they're different
<kerneis>
the only use case I know for objects in OCaml (except advanced type trickery) is a visitor pattern to make dealing with huge ASTs easier
<Drup>
(and don't get us wrong, the OO part of ocaml is really great, you can do fantastic stuff with it, it's just not what you would expect when you are coming from an OO programming language)
<kerneis>
(like in CIL or Frama-C)
<Drup>
kerneis: js_of_ocaml too :p
<syntropy>
kaka22: In Ocaml, you should organize your code using type, function and then module. You shoud first learn that objects are not a necessity and then revisit this part of the language
<gour>
the ""Object-oriented programming is an exceptionally bad idea which could only have originated in California." --Edsger Dijkstra is cited in the nimrod tutorial (http://nimrod-code.org/tut2.html)
<whitequark>
kerneis: also, GUIs
<Drup>
gour: every single Dijkstra quote is great :D
<gour>
:-)
cesar_ has joined #ocaml
<gour>
Drup: btw, have you looked at nimrod?
cesar_ is now known as Guest40487
<Drup>
I have heard of it several time, but not really looked
<Drup>
only once in the begining, it looked like a fake strong type system who behave like C in practice
<whitequark>
"arrogance in CS is measured in nanodijkstras"
<gour>
i really like a lot about it, but if ocaml makes something out of lablqt/wxocaml, i'll settle on ocaml
<kaka22>
ok might be some dirty hack, but i added methods that return all those variables. code runs well, but yes i would need to improve it later when i am more experiences on ocaml
syntropy has quit [Quit: Page closed]
<Drup>
gour: I read it, yes
<Drup>
and I still feel the same
<gour>
why 'fake type system' ?
<Drup>
look at the way it encode Maybe !
<Drup>
I mean, this is completly wrong and terrible
<whitequark>
Drup: how does it do that?
<Drup>
whitequark: by checking a boolean property of an object and returning the element or nil
<gour>
iirc, Maybe is just example how it can be done, not real implementation in the language itself
<gasche>
there would be a case to be made for this kind of encoding, eg. in dependently-typed systems
<gour>
s/can/could
<gasche>
in lower languages, Typed Racket would be a reasonable example of real-world use of "predicate typing" (if this boolean condition is true then...)
<whitequark>
Drup: sounds like a regular discriminated union ?
<Drup>
whitequark: look at the implementaiton.
<Drup>
"If it were to be set to False then accessing the value field would cause a runtime exception. Nowadays in some cases this error can be detected at compile-time."
<Drup>
it's an encoding you do if you have dependend pair
<gour>
Drup: do you consider Ada has strong type system?
<gour>
'cause i'm told that nimrod has the same type-safety...
<ggole>
Strong isn't a very precise word with which to describe type systems.
<gour>
ggole: that's a good point
<gasche>
Ada does some stuff like allowing to put arbitrary integer bounds on integer types that you cannot realistically hope to control statically always
<Drup>
I was told that nimrod had the same type safety than Rust too, which prove that some people don't understand anything
<ggole>
It can mean "no implicit conversions", or maybe "sound", or a few other things
<gasche>
when you see this kind of Ada code, and you know that people didn't have the expertize to do Coq proofs everywhere, you *know* that some dynamic checking will be involved, and that the static analysis will be partial
<gasche>
this isn't the case of a notion as fundamental as "a sum type"
<Drup>
sum type should be a mandatory primitive for every language, except maybe dependents one (because you can re-encode it)
<ggole>
It's useful to be able to type array indexes strongly though
<ggole>
(Particularly for the kinds of programming Ada was intended for.)
<whitequark>
I'm amazed go doesn't have a sum type
<companion_cube>
go doesn't have much in its type system
<companion_cube>
no generics, no sum types (not even unions)
<ggole>
Yeah, it's pretty basic. If you don't have them, then you end up manually encoding them into bits or silly things like that.
<Drup>
go is C++ which compile fast. :p
<companion_cube>
well, their argument is "lol interfaces"
<whitequark>
companion_cube: structural interfaces are good but somewhat orthogonal
<companion_cube>
yep
<gour>
Drup: does it mean that Rust is also not particularly type-safe lang?
<gasche>
well some people think that coercion to interface types subsume bounded polymorphism
<companion_cube>
rust has typed unions
<Drup>
gour: no, it means some people have no idea what they are talking about :)
<companion_cube>
I mean, sum types
<Drup>
Rust is type-safe
<gour>
ahh, ok. :-)
<gour>
too bad it has such a noisy syntax
<ggole>
Rust is supposed to be entirely sound apart from explicit (marked) unsafe bits afaik
<ggole>
I'm not sure whether that goal was achieved or not, though...
<Drup>
gour: because nimrod's syntax is better ? :p
<gour>
Drup: well, i admit nimrod's one is nicer :-)
<Drup>
you have strange tastes
<gour>
you don't like python?
<gasche>
the problem with Rust is that the type system is constantly changed for pragmatic reasons
<gasche>
at this point it's quite certain that the current rules in rule are unsound
<Drup>
gour: I don't like indentation based programming languages, no
<companion_cube>
it's not stable, but it looks pretty powerful
<gasche>
and they will not become sound before a lot more work in put on doing proofs
<Drup>
gour: but that's not my point
<gasche>
but it's maybe ok to have a type system that *tries* to be sound without actually being sound
<gour>
Drup: ahh, ok. isn't ocaml in the same categoy having layout rule?
<gasche>
that's one way to make progress, and everybody has done that in the point at some point
<ggole>
gasche: right, but I think this is a different problem to "oh, you can just mutate that and it won't be safe".
<Drup>
gasche: well, as long as the unsoundnes is considered as a bug and is fixed, it's ok
<Drup>
gasche: the language is very young
<ggole>
The intention is pretty clearly a memory safe language (excluding the unsafe subset).
<ggole>
And they've gone to some lengths to try to tame, ie, iterator invalidation
strobegen has quit [Write error: Broken pipe]
Guest40487 has quit [Ping timeout: 245 seconds]
<gasche>
I think the current process of Rust development is not conductive of correct type systems
<gasche>
they do consider unsoundness to be bugs, but (at least from what I can see from the outside) they don't invest the necessary effort to make sure those bugs don't actually happen
avsm has joined #ocaml
<gasche>
mutating a type system without proving things is like writing a program without testing anything
<gasche>
you look at it, and you try to think hard about whether it's correct, and sometimes by using it you actually find a bug
avsm has quit [Client Quit]
<gasche>
but you will never write bug-free code this way
<gasche>
(except if you write formal proofs of course, but that's usually not the realistic scenario)
<ggole>
Beats just giving up though
<gasche>
sure
<gasche>
but it's not completely satisfying to us ivory tower cold-hearted perfectionists
<gasche>
it's not exactly "ok" (but already quite exciting)
<ggole>
It's sign of forward progress, at least
<whitequark>
gasche: doesn't ocaml do pretty much the same thing?
<companion_cube>
they're trying to implement a complicated type system that has few (no) equivalents, don't they?
<Drup>
basically, ML + linear types
talzeus has quit [Read error: Connection reset by peer]
<gasche>
whitequark: no, they don't
<Drup>
gasche: I find it ok for such a young language
<gasche>
new type system features in OCaml have always been followed or preceded by a formal paper proof of its correctness (usually in a *restricted* setting)
<gasche>
sometimes the correct stuff had to be adapted to fit OCaml in a way that was a bit unsatisfying
syntropy has joined #ocaml
<gasche>
(eg. nobody would swear that our first-class modules are exactly as in Claudio Russo's papers and therefore certainly absolutely sound)
<gasche>
and there is no up-to-date, maintained formal proof of the whole system
<gasche>
but each feature is described in a formalism where it is well-understood
<whitequark>
I see
<gasche>
GHC has a particularly good record of doing something reasonable in their "core language" formalism, which (for the type system part) is System FC
mcclurmc has quit []
<gasche>
they have a solid formalization of a rather complicated kernel language, and then they compile everything in the surface language (type classes, type families...) down to it
<gasche>
in practice this compilation is sometimes flaky, and some parts are still unsound (moreso than for OCaml because they do really weird stuff sometimes), but the process itself is right
kaka22 has quit [Quit: Leaving]
<Drup>
and sometimes, someone find a bug and garrigue is all panicked for a week :3
* nicoo
changes Drup's injectivity.
gowel is now known as gargawel
<gasche>
the injectivity bug is the first "real" bug we've had in a long time
<gasche>
there have been other bugs about GADTs before, but they were implementation bugs rather than conceptual issues
<gour>
so, for you guys, there is no question what to pick from the {nimrod, ocaml, rust} set
<Drup>
if you are not afraid by instable stuff, rust may be a good experience, it's young and lively and quite interesting. Just don't expect it to be stable and all ironed out
<nicoo>
gour: Mmmmh, I played a bit with Rust, and I'm pretty sure it has its uses. But most of the stuff I do, I would still do in OCaml
<nicoo>
And as Rust said, Drup is still immature and unstable
<nicoo>
Oooops
<nicoo>
Drup: Sorry, honnest mistake :3
<nicoo>
And as Drup said, Rust is still immature and unstable*
<gour>
is ocamlpro team still behind wx(ocaml)?
eikke has quit [Ping timeout: 264 seconds]
chrisdotcode has joined #ocaml
<gasche>
I think so, but they also tend to work on things that clients are ready to pay for, so if nobody shows active interest in WxOCaml it will not be a priority
cesar_ has joined #ocaml
cesar_ is now known as Guest95506
<gour>
gasche: that's ok. i just wonder whether it will be wxocaml or wxqt, someone mentioned qt once here
<companion_cube>
gasche: you mean someone paid for ocp-build or ocp-indent? :p
<nicoo>
companion_cube: First rule of ocp-build is that you do *not* speak of ocp-build :]
<gasche>
hm qtocaml I guess
<gasche>
I don't know which one you should choose gour
<companion_cube>
:}
<gasche>
and regarding your question about Rust
<gasche>
I think I would consider using it if I was doing system programming
<companion_cube>
nicoo: second rule of ocp-build is that you do *not* build ocp-build
<nicoo>
Hehe
<gasche>
and I'm quite happy with Rust as a language experiment
<whitequark>
ocp-build?
Picolino has joined #ocaml
<nicoo>
whitequark: OCamlPro's new square whee^W^W build system.
<nicoo>
(Note that this was a slight against companion_cube, not OCamlPro ;)
<gasche>
hm
<gasche>
I'm not saying OCamlPro isn't happy to help the community with some additional stuff
<gasche>
but merely pointing out that if someone here is interested in paying for WxOCaml development (or knows someone that is), it's the best way to make sure there will be something usable on the long term
<companion_cube>
I'd rather pay for implicits ^^
<whitequark>
implicits?
<nicoo>
companion_cube: You mean implicit parameters? I'm really not fond of that kind of features
<nicoo>
feature*
<Drup>
nicoo: implicit as in type classes
<nicoo>
Drup: Ah, yeah.
<companion_cube>
well it's related
<gasche>
type classes constraints *are* implicit parameters, aren't they?
<companion_cube>
implicits make typeclasses easy to implement and use
<Drup>
yeah, it's exactly the same, presented in a different way
<companion_cube>
but I'd be happy with "only" typeclasses
<nicoo>
companion_cube: Yeah, but implicits are full of potential for abuse.
<companion_cube>
right.
<companion_cube>
so, just typeclasses then :)
<whitequark>
implicit parameters?
* nicoo
would definitely be happier with « just » typeclasses.
<Drup>
nicoo: try do program in a dependtly typed language without implicit parameters
<Drup>
You're going to have fun
<Drup>
I assure you.
<nicoo>
Drup: You program quite diferently in dependently typed languages, though.
<gour>
gasche: both wx & qt bindings for ocaml look good to me...i'm going to choose the one receving more/better support
<Drup>
indeed
Guest95506 has quit [Remote host closed the connection]
yezariaely has quit [Quit: Leaving.]
<gasche>
(I'd like to point out that my comment below was a form of criticism of Rust, but not meant to deter people from using the language; I think it's a very exciting development for a new language)
<rks_>
gasche: below ?
<gasche>
(the problem with language designers is when they ignore the scientific knowledge we've accumulated over years about design mistakes, or when before they start listening they've screwed things so deeply that most hope is lost; Rust is certainly not in that situation, and it can only improve if more people willing to prove stuff start contributing)
<gasche>
yeah, above
<gasche>
I meant "a few minutes ago"
<companion_cube>
I think they're trying to first have a type system that doesn't make the language unusable
<companion_cube>
but they definitely know the state of the art in typing
thelema_ has joined #ocaml
not_mcclurmc has quit [Remote host closed the connection]
<companion_cube>
(unlike go designers)
<gasche>
go designers have different aesthetics and let other things guide their design process
<nicoo>
companion_cube: gotta love covariant generics (and mutability) :)
<gasche>
I think it's mostly pointless to bash them, I can only let them go their own way and hope that people will find what they're looking for in it
<adrien_oww>
gasche: have you tried a carreer in politics? :D
<gasche>
in practice people that use Go seem happy with it
<companion_cube>
indeed, but I really believe that not having generics in go is a huge mistake
<Drup>
(mostly segfaults, that is.)
<whitequark>
the main advantage of go seems to be "it's not C"
<companion_cube>
they should have known better
<whitequark>
which *is* an advantage
<Drup>
whitequark: it's not C++*
* whitequark
shrugs
<companion_cube>
learning from the history of java, for instance
<gasche>
if they can get programmers to be more productive than they previously were, well, good for them
<whitequark>
Drup: well, Go is pretty much C without the low-level parts. C for applications, something like that
thelema has quit [Ping timeout: 272 seconds]
<gasche>
if finally they find out that they should maybe have cared about type systems, it will be too bad for their users (but those have been warned enough), and maybe one more good lesson
<whitequark>
I'd say C++ has a different niche
ocp has joined #ocaml
<Drup>
whitequark: Go was done because google was sick of C++ compilation time, and it's the main design process "C++ wich compile fast"
<gasche>
also in practice maybe good language design isn't always the dominant factor for productivity
<ggole>
See: javascript
<gasche>
whitequark: or efficient python
<gasche>
(without the too high-level parts)
Kakadu has quit [Quit: Page closed]
Neros has joined #ocaml
<whitequark>
"undefined is not a function" is such a productivity boost.
<whitequark>
Drup: I really don't see the C++ bits in Go.
<whitequark>
gasche: have you considered interpreting other people's thoughts as a day job? :D
<companion_cube>
"efficient python" is how I should think of go, right
<whitequark>
without a separate AOT translator, of course, just tweaks to the regular JIT.
<nicoo>
whitequark: Ah, I see. asm.js is much worse that what I thought.
<whitequark>
nicoo: what bothers me most is how Mozilla just ran and made it a PR topic.
<nicoo>
They did ?
<whitequark>
like, for example, it happened with Raspberry Pi
<whitequark>
google for "asm.js", you'll see
<Drup>
nicoo: why "worse" ?
<whitequark>
it's an incredibly specific and delicate technical decision, yet it was deliberately promoted for some reason
* whitequark
shrugs
<Drup>
I agree with the part "Why is asm.js a JavaScript subset?"
<Drup>
but in the other hand, mozilla tried something like that before, and it didn't had any sucess, for this precise reason
<Drup>
(it was not a subset of javascript)à
<nicoo>
whitequark: I'm not sure I agree with all your points, but no time to argue now (realized I'm hungry, and I need to fix my bike to leave the lab)
<nicoo>
Drup: I didn't remember ams.js was so constrained.
<Drup>
it's an asm
<Drup>
nothing more, nothing less
<Drup>
it's even in the name
<Drup>
I don't even understand how people got it wrong
<nicoo>
Drup: I was, for instance, expecting to be able to be passed a JS string, and see it as an array of chars. Seems it is not the case.
<nicoo>
Apart from doing the simulation pipeline for a game (or perhaps some crypto) in asm.js, I don't really see the use-case right now (I don't dev in-browser stuff either, though)
<nicoo>
Drup: Yes, I understand this. I just don't see how a compiler can generate meaningfully-big fragments of code in asm.js
<whitequark>
nicoo: asm.js is a formalization of what emscripten generates.
<Drup>
nicoo: the same way it generates asm for regular architectures ? :x
<whitequark>
nicoo: in fact one of the authors of the spec is also the author of emscripten.
djcoin has quit [Quit: WeeChat 0.4.1]
<nicoo>
Drup, whitequark : Yeah, but what happens when you interact with the DOM/the UI/whatever ? Do you need to copy/convert any single value you grab to a format suitable for asm.js, then call the asm.js code ?
Xenasis has joined #ocaml
<Drup>
ah yeah, that's the not so funny part, sure;
<Xenasis>
How do I install Coq properly if I have OCaml version 4 or up?
<whitequark>
nicoo: exactly
<whitequark>
it works just as a C library hooked to ocaml would work.
<whitequark>
for pretty much same reasons.
<nicoo>
whitequark: Except that quite a few things (strings, big arrays, ...) do not need to be copy-converted.
* nicoo
goes away for good, now
<whitequark>
bad analogy :]
Xenasis has left #ocaml []
dsheets_ has quit [Ping timeout: 264 seconds]
<mrvn>
apropo the discussion about finalizers this morning
<mrvn>
Who else is with me saying that ocaml should call all finalizers on exit?
<whitequark>
you mean do a GC cycle at exit?
<mrvn>
whitequark: yes, with all global variables removed.
cesar_ has joined #ocaml
cesar_ is now known as Guest91498
dsheets_ has joined #ocaml
<whitequark>
mrvn: I'm not sure if that's safe, since finalizers can refer to them.
<whitequark>
in fact, since you can do everything in a finalizer, there's no guarantee they will ever finish running.
<mrvn>
whitequark: then they will remain reachable till the finalizer is run and removed.
<mrvn>
there should probably be a limit how often the GC should run, like run until nothing can be freeed anymore.
<whitequark>
.net has a timeout
<companion_cube>
mrvn: I suppose you have in mind shared resources that would not be released because the finalizer doesn't run?
<companion_cube>
like file locks or whatever?
<ggole>
You really need to handle that gracefully anyway
<mrvn>
companion_cube: sure, or posix ipc objects.
<ggole>
In case the power goes out or your process is OOM-killed or the sysadmin nukes it
<mrvn>
if the power goes out then everything is gone anyway
<ggole>
Or there's a bug in some C code you call, or whatever
<companion_cube>
I'm not sure that's the same
<companion_cube>
if your process is sigkill'd you cannot free the resources
<whitequark>
mrvn: is there something in OS which doesn't get released when the process dies?
<companion_cube>
if it's sigterm'd then you *should* release
<mrvn>
whitequark: posix ipc objects
<whitequark>
weird
<companion_cube>
also, temporary files/sockets
<ggole>
Well, the kernel will eat all of those
<mrvn>
whitequark: they are shared between processes so they survive a process dying.
<ggole>
But anything that sudden unexpected death would leave in an unwanted state needs to be thought about
<whitequark>
what ggole says.
mcclurmc has joined #ocaml
<mrvn>
temp files that don't use O_TEMPFILE also need to be removed
<mrvn>
anyone know where the work on a preemptive ocaml is done?
ocp has quit [Quit: Leaving.]
mcclurmc has quit [Remote host closed the connection]
mcclurmc has joined #ocaml
sepp2k has quit [Quit: Konversation terminated!]
<nicoo>
mrvn: Temp files that do not use O_TEMPFILE need to be removed from code ;)
<mrvn>
nicoo: O_TEMPFILE is still verry new
<nicoo>
Yup.
<mrvn>
is there even a patch for ocaml for O_TEMPFILE yet?
<nicoo>
No idea; if not, should be done (and my to-procastinate list probably isn't the right place for it)
<mrvn>
dsheets_: when I come back from my trip with The Doctor, you know, in the blue box.
<mrvn>
ups, ewin
rwmjones has quit [Ping timeout: 246 seconds]
Kakadu has joined #ocaml
wmeyer` has joined #ocaml
wmeyer has quit [Remote host closed the connection]
syntropy has quit [Quit: Page closed]
malvarez has joined #ocaml
rwmjones has joined #ocaml
milosn_ has joined #ocaml
adrien_o1w has joined #ocaml
ggole has quit []
gour has quit [Read error: Connection reset by peer]
milosn has quit [Ping timeout: 240 seconds]
adrien_oww has quit [Ping timeout: 260 seconds]
mcclurmc has quit [Remote host closed the connection]
mcclurmc has joined #ocaml
Anarchos has joined #ocaml
skchrko has quit [Quit: Leaving]
mcclurmc has quit [Remote host closed the connection]
_andre has quit [Quit: leaving]
pango has quit [Remote host closed the connection]
orbitz has quit [Ping timeout: 245 seconds]
orbitz has joined #ocaml
maurer has left #ocaml []
pango has joined #ocaml
milosn has joined #ocaml
milosn_ has quit [Ping timeout: 272 seconds]
ftc has joined #ocaml
dch has joined #ocaml
ftc has quit [Client Quit]
w0rm_x has joined #ocaml
hto has quit [Quit: Lost terminal]
hto has joined #ocaml
ontologiae has quit [Ping timeout: 246 seconds]
MaVOP has joined #ocaml
<wmeyer`>
ping adrien
<whitequark>
hi wmeyer`
<wmeyer`>
hi whitequark
<MaVOP>
Hey, is there a predefined List. function for finding the diff between one int list and another? Like this [1;1;2;2;3;3;4;4;5;5] [5;3;4;3] = [1;1;2;2;4;5]
<wmeyer`>
I assume it needs to be sorted
<MaVOP>
well providing the lists are already sorted
<MaVOP>
if thats easier
<wmeyer`>
I'd convert this to sets and use the Set
<whitequark>
wmeyer`: how's the windows patch?
<wmeyer`>
whatever it's sorted or not
<wmeyer`>
I am waiting for adrien
<MaVOP>
okay, thanks wmeyer
<wmeyer`>
module Set = Set.Make(struct type elt = int let compare x y = x - y end);; let diff_list l1 l2 = let s1 = List.fold_left Set.add Set.empty l1 let s2 = List.fold_left Set.add Set.empty l2 in Set.elements (Set.diff s1 s2);;
<MaVOP>
Perfect
<MaVOP>
thanks a lot!
<wmeyer`>
you are welcome
<wmeyer`>
adrien send me an email when you are back
<wmeyer`>
we have to fix the issue, or I will revert the patches (or fix it myself)
<dsheets_>
mrvn, wut? tripping?
<mrvn>
huh?
<dsheets_>
<mrvn> dsheets_: when I come back from my trip with The Doctor, you know, in the blue box.
<dsheets_>
who?
<mrvn>
dsheets_: < mrvn> ups, ewin
<mrvn>
sorry
<dsheets_>
ooo ups is oops, sry
<mrvn>
and yes, Doctor Who. :)
<dsheets_>
just a jump to the left and then a step to the right...
<mrvn>
"It's smaller on the outside." "That's a first."
<companion_cube>
mrvn: don't forget to bring back ocaml 17.6 on a usb stick, if you wander with the Doctor
Picolino has quit [Ping timeout: 245 seconds]
jlouis has quit [Ping timeout: 246 seconds]
jlouis has joined #ocaml
Picolino has joined #ocaml
w0rm_x has left #ocaml []
peterbb has quit [Quit: leaving]
bentnib has quit [Remote host closed the connection]
bentnib has joined #ocaml
ollehar has quit [Ping timeout: 264 seconds]
<MaVOP>
module Set = Set.Make(struct type elt = int let compare x y = x - y end);; Error: Signature mismatch: Modules do not match: sig type elt = int val compare : int -> int -> int end is not included in Set.OrderedType The field `t' is required but not provided
<MaVOP>
:/
<companion_cube>
you need Set.Make(struct type t = int ..... end)
<companion_cube>
you see, the module Set.Make takes as argument must contain a "t" type, not an "elt" type
k4nar has joined #ocaml
<jpdeplaix>
whitequark: I forgot the « .git » at the end of the url :/
skchrko has joined #ocaml
<adrien>
wmeyer`: I'm going to try Xavier's test case in less than 30 minutes
Newuser has joined #ocaml
<Newuser>
Hello guys.
<Newuser>
Is anyone on?
<Anarchos>
Newuser yes yes
<Newuser>
Hey
<Newuser>
I wanted your opinion on whether I should learn OCaml.
<Newuser>
I have some experience with OOP and imperative languages but not functional.
<companion_cube>
well then, if you're curious that might be a very interesting experience for you
<Newuser>
I was looking for a very powerful language like Haskell.
<Newuser>
Or mathematica.
<companion_cube>
what do you mean by "powerful" in this context?
<Newuser>
Speed, large library, high degree of complexity.
<Newuser>
And OCaml supports imperative, func and OOP so it seems like a good fit for me.
<companion_cube>
I'm not sure "high degree of complexity" is something you should wish a language had :D
<companion_cube>
otoh ocaml has a decent amount of libraries (including big "standard libraries" like core), is fast, and has many features
<companion_cube>
so it may be indeed what you're looking for
<Newuser>
I mean syntax level higher then something like a BASIC dialect
<companion_cube>
depends on what you would like to write in the functional language you learn
<companion_cube>
oh, right. then ocaml definitely has a more powerful syntax
<companion_cube>
(in the "more expressive" sense)
<Newuser>
Well, some of the programs I would write would be for math, physics and engineering.
<def-lkb>
if you want to make use of your imperative idioms, ocaml is a good fit (I would'nt recommend OOP ones :P)
<companion_cube>
let's say you can still write some imperative code, yes
<Newuser>
"OCaml is a general purpose industrial-strength programming language with an emphasis on expressiveness and safety"
<companion_cube>
I don't know much about numeric algorithms
<Newuser>
What do you mean by safety?
<Newuser>
For security purposes like NSA?
<companion_cube>
ah, safety is the absence of bugs, I'd think
<Newuser>
Oh
<companion_cube>
means that OCaml tries to make it harder to write bugs
<companion_cube>
the type system is very helpful in this respect
<Newuser>
Ok then.
<Newuser>
Does OCaml have a web framework?
<Kakadu>
Newuser: ocsigen
<Newuser>
Oh, that's nice. Thanks.
Drup has quit [Quit: Leaving.]
<Newuser>
I think OCaml will be a nice language for me then.
Drup has joined #ocaml
<companion_cube>
Newuser: then welcome :)
<Newuser>
Oh, you can utilize C and Fortran libraries?
<def-lkb>
you'll have to write bindings for them, but yes you can
tane has joined #ocaml
<Newuser>
Been programming in Fortran 77 and 95 from ages
srcerer has quit [Quit: ChatZilla 0.9.90.1 [Firefox 24.0/20130910160258]]
avsm has joined #ocaml
<def-lkb>
There is support for manipulating c & fortran arrays from ocaml side.
Kakadu has quit []
<Newuser>
Was OCaml made from Caml?
<def-lkb>
Caml light?
srcerer has joined #ocaml
darkf has joined #ocaml
<Newuser>
Yeah
jonludlam has quit [Remote host closed the connection]
<dch>
Newuser: also, http://opalang.org/ written in ocaml to generate JS. never had the need to use it, but awesome all the same.
<def-lkb>
Yes, Caml light is the direct ancestor of OCaml.
<Anarchos>
Newuser ocaml is done in ocaml, as the java compiler is done in java
rwmjones has quit [Ping timeout: 246 seconds]
<Newuser>
Uh, is there an IDE for OCaml?
<def-lkb>
Are you more Emacs, vim or eclipse?
<Newuser>
Eclipse is what I use normally.
<Newuser>
But I downloaded from the OCaml website.
<Newuser>
Now I have no idea what to do
<def-lkb>
Vim* (also deserve a capital :P)
<Newuser>
xD
<Newuser>
I have two things, OcamlWin and Browser
<def-lkb>
Do you know the Real World Ocaml book?
<def-lkb>
https://realworldocaml.org/ should be a good starting point if you don't know what to do after unpacking.
<Newuser>
Oh, thanks
<Newuser>
Ok, so I checked the book out on github. It told me to go to the website for installation instructions. And on realworldocaml.org but see little instructions
<dsheets_>
Installation instructions, avsm>
<Newuser>
?
<avsm>
I'm actually updating the site at the moment
<Newuser>
Oh wow, the author is right here.
Newuser has quit [Quit: irc2go]
rwmjones has joined #ocaml
<companion_cube>
come on avsm, you scared him/her! :D
<jpdeplaix>
besides, what is the equivalent for to_string ?
mcclurmc has joined #ocaml
Arsenik has quit [Remote host closed the connection]
Newuser has joined #ocaml
<Newuser>
Who registered thisÉ
ontologiae has joined #ocaml
Newuser is now known as n
n is now known as Newuser
Newuser is now known as NewUser
NewUser is now known as Newuser1
zamN has joined #ocaml
<zamN>
hey how do i make a variable of a certain type? i.e. I have: type blah = int * char option * int. How do I make something of type blah? I'm trying: let r : blah = (1, Some 'a', 2);; but i get unbound constructor transition
<Anarchos>
let (r:blah) =....
<zamN>
oh wow
<zamN>
i mispelled it
<zamN>
x-x
ollehar has joined #ocaml
<zamN>
actually taht doesnt work Anarchos
<Anarchos>
zamN let me test it
<zamN>
er, i got it now
<zamN>
it was declared inside of my module
<zamN>
so I had to do Module.blah
<Anarchos>
let r : blah = (1,Some 'a',2);; val r : blah = (1, Some 'a', 2)
<Anarchos>
zamN or "open Module"
<zamN>
what does that do?
<zamN>
the former
<zamN>
val r : blah = (1, SOme 'a', 2)
<Newuser1>
What advantage, if any, does OCaml have over Lisp, haskell, scheme, smalltalk etc?
Drup has quit [Quit: Leaving.]
Drup1 has joined #ocaml
<companion_cube>
Newuser1: hi back!
<Newuser1>
Thanks companion_cube.
<companion_cube>
compared to lisp/scheme/smalltalk, ocaml is strongly typed and has pattern matching, objects, algebraic types
<companion_cube>
compared to haskell, it's not as extreme - you can still write imperative code
<Newuser1>
Haskell doesn't matter. I just don't like Haskell for some reason
<def-lkb>
compared to haskell (and all other mainstream programming languages), a powerful module system
<Newuser1>
But like, I have some experience with lisp and smalltalk
<companion_cube>
hmmm, right def-lkb
<companion_cube>
Newuser1: ocaml is quite different, because of the typing, whereas lisp and smalltalk are very dynamic languages
<Newuser1>
Well, I will just give OCaml a try then. Thanks.
Newuser1 has quit [Quit: irc2go]
<adrien>
wmeyer`: around? my patch from last week fixes XL's issue
<companion_cube>
looks really defiant :D
<adrien>
(which, in all honesty, is not surprising considering the patch)
<zamN>
ugh. types are confusing in ocaml -_-. So If I want to access members of a type I would have to match them right?
<companion_cube>
zamN: if the types are algebraic types, yes, it's better
<zamN>
how else can i access them?
<companion_cube>
zamN: what are the types you're talking about, more precisely ?
<companion_cube>
zamN: do you export the definition of nfa?
<zamN>
yeah
<zamN>
well, nfa in that paste == Nfa.nfa
<companion_cube>
do you have a .mli file?
<zamN>
no
<companion_cube>
hmm
<def-lkb>
The typer seems to disagree.
<zamN>
my program is set up in this way: module type NFA = sig .. template .. end -- module NfaImpl = struct .. end
<zamN>
module Nfa : NFA = NfaImpl;;
<companion_cube>
ahah!
<companion_cube>
that makes the Nfa.nfa type abstract
<zamN>
yeah
<companion_cube>
zamN: as a beginner, you shouldn't need module type/module in a single file
<zamN>
since in NFA i only have: type nfa;; whereas in NfaImpl I have type nfa = ...;;
<companion_cube>
the simplest is to have a flat .ml file
<zamN>
companion_cube: school project >_>
<companion_cube>
and maybe a .mli file to restrict the view
<companion_cube>
zamN: does the project require this architecture?
<def-lkb>
zamN: you can't pattern match on an abstract type
<zamN>
yes it is required
<zamN>
def-lkb: but is it abstract inside of NfaImpl?
<zamN>
where i redefine the type
<zamN>
well, define
<def-lkb>
zamN: it is abstract outside of NfaImpl
<companion_cube>
it's not abstract in NfaImpl, but it becomes when you write module Nfa : NFA = NfaImpl
<zamN>
ah okay
<companion_cube>
you may write module Nfa : NFA with type nfa = Nfa.nfa = NfaImpl
<companion_cube>
(ugh, starting to become repetitive)
<zamN>
companion_cube: I'm basically just trying to learn this stuff in the interpreter before writing it inside of NfaImpl
csakatoku has joined #ocaml
<companion_cube>
oh ok
<def-lkb>
well more exactly, in NfaImpl everything is transparent. as c-cube said, when defining Nfa the ": NFA" constrains the type nfa to be abstract.
<zamN>
so its kind of irrelevant
<zamN>
I guess i can just define all this tuff in the interpreter
<companion_cube>
yes, maybe you don't need to focus on modules right now
<zamN>
yeah, i want to learn types first x_x
<companion_cube>
start with the types and pattern matching
<companion_cube>
look at the ocaml.org page I linked above :)
<zamN>
ah yeah once i declared everything in the interpreter it works :D
<companion_cube>
great!
<zamN>
okay, so now lets do it the sane way (with named parameters)
<companion_cube>
don't forget that two record types cannot share the same names
<companion_cube>
(not in the same module)
<zamN>
yeah that shouldn't be an issue
<zamN>
I only have these 2 types
<zamN>
I just hope doing it this way won't make me have a lot of headaches
<companion_cube>
records have many nice features in ocaml, that you'll probably discover later, so it's important you know them
<zamN>
omg this is amazing ^_^
<zamN>
companion_cube: but this is the last ocaml project :x
<zamN>
<-- programming languages student
<companion_cube>
maybe you'll be enlightened and wish to use it on your own ;)
gnuvince has quit [Ping timeout: 246 seconds]
<zamN>
heh, maybe. I was thinking about taking the compilers course which is all Ocaml
<zamN>
I'll have to write a TON more ocaml before I even think about that though
platypine has joined #ocaml
<Anarchos>
companion_cube what are the nice features of records for you ? Mutable in place ?
<companion_cube>
mutability also comes handy from time to time
<zamN>
companion_cube: is there any way i can redefine a record? Or would I have to recreate the whole thing every time?
<Anarchos>
companion_cube what is functional update ?
<companion_cube>
zamN: what do you mean? change a value of a record type?
<companion_cube>
Anarchos: { r with field=value;}
<zamN>
yea
<companion_cube>
zamN: so, the syntax is just there! :)
<companion_cube>
type point = { x : float; y : float; }
<companion_cube>
let pt = { x=1.0; y=2.0;} in { pt with x=42.0; }
Picolino has quit [Ping timeout: 246 seconds]
Drup1 is now known as Drup
<zamN>
companion_cube: but that is at declaration
<zamN>
I mean after pt is made
<companion_cube>
the right part of "in" creates a new value, distinct from pt, if that's what you asked for
<zamN>
i'm saying: let z = {s=1;fs=[1;2];t=[(1, Some 'a', 2)]};;
<zamN>
if I want to change the value of s
<zamN>
z.s = 2 just compares. z in { z with s = 7; };; gives me a syntax error
<companion_cube>
yes, you write { z with s = 2; }
<zamN>
oh.
<companion_cube>
{ z with s = 2 ; } is a value
<companion_cube>
it means "same record as z, except for the field s"
<zamN>
oh nice.
<zamN>
how would you do the same with a tuple?
<zamN>
you would have to recreate it?
<companion_cube>
Anarchos: you may look at the pattern matching on records, if you don't know it :p
<companion_cube>
zamN: you would have to recreate it
<Anarchos>
companion_cube ok :)
<companion_cube>
because you can't name the "fields"
klltkr has joined #ocaml
<def-lkb>
Anarchos: another nice feature of records is higher rank polymorphism
<Anarchos>
def-lkb higher rank ??
<companion_cube>
oh, the quantification thing?
<companion_cube>
type 'a continuation = { call: 'b . ('a -> 'b) -> 'b; }
<companion_cube>
hmm, not sure it's useful in this case, but whatever
<def-lkb>
Anarchos: well nice in this context is subject to interpretation, but it's a reasonable way to that level of expressivity if needed
<wmeyer`>
adrien: it throws an error
<wmeyer`>
for m
<wmeyer`>
for me
<Anarchos>
companion_cube oh ok as in method types ?
crocket has joined #ocaml
<companion_cube>
yes, you can do this with records
<crocket>
hi
<kerneis>
hi crocket
<crocket>
I want to learn ML's module system. Which ML between SML and OCaml should I learn?
<companion_cube>
crocket: both should be fine
<crocket>
yo
<companion_cube>
but OCaml is still evolving and has many other nice features
<crocket>
companion_cube: How does OCaml differ from SML?
<crocket>
Object?
<companion_cube>
SML is a standard language, OCaml isn't
<companion_cube>
thus ocaml has gained many features over time, objects, poymorphic variants, and last but not least GADTs
chrisdotcode is now known as chrisblake
<wmeyer`>
adrien: try first with "make world.opt"
<def-lkb>
Ocaml module system allows both generative and applicative functor application, and also offers first-class modules / packages.
<adrien>
wmeyer`: running it now
<Drup>
SML is a mostly *frozen* standard ...
<companion_cube>
my point exactly
csakatoku has quit [Remote host closed the connection]
csakatoku has joined #ocaml
<adrien>
wmeyer`: reproduced!
<crocket>
huh
<crocket>
PHP also has accumulated lots of features and has gotten worse because of added features.
<crocket>
I don't know what applies to OCaml.
<companion_cube>
crocket: I don't think php and ocaml core contributors are on the same level :]
<crocket>
classes were added to PHP, and PHP became an ugly monster.
<wmeyer`>
adrien: good. thanks, can you try to fix it now>
<crocket>
companion_cube: I'll see.
<def-lkb>
s/PHP/ocaml
<def-lkb>
makes sense.
<companion_cube>
oh come on
<adrien>
wmeyer`: yeah
Picolino has joined #ocaml
<companion_cube>
nothing forces you to use classes in ocaml :)
<adrien>
no guarantee but I'm on it
<crocket>
def-lkb: ???
<crocket>
So you guys want to forget about classes even with OCaml.
<crocket>
At least, python classes are not monstrous.
<wmeyer`>
crocket: just because in OCaml, there are better abstractions
<def-lkb>
crocket: adding classes in any language should be considered a crime. OCaml just got objects slightly less wrong than other languages.
<companion_cube>
wow, you're actually an extremist, def-lkb
<crocket>
def-lkb: C++ and smalltalk?
<wmeyer`>
crocket: try your self modules if you are fancy and you will see ;-)
<crocket>
Javascript objects are pretty cool although they are not easy to use.
<def-lkb>
crocket: ok for smalltalk. I am still trying to find the object system in C++
csakatoku has quit [Ping timeout: 272 seconds]
<wmeyer`>
crocket: may I ask, why do you need objects? What kind of programming patterns you are after need classes?
<crocket>
wmeyer`: object doesn't require class.
<crocket>
wmeyer`: Javascript doesn't have classes but objects.
<wmeyer`>
crocket: that's fine, prototype objects are fine
<wmeyer`>
<crocket>
Object inheritance that doesn't suck.
<wmeyer`>
no, I am not asking about features, I am asking about patterns that lead to abstractions
<crocket>
wmeyer`: objects seem to simplify code.
<wmeyer`>
in other way, what kind of programs you want do using classes or objects that can't be done using modules or records
<crocket>
If you need to bind the same data structure to many function calls, objects simplify.
<wmeyer`>
just this?
<crocket>
yes
<wmeyer`>
how about calling a function on this?
<companion_cube>
also, objects make it easy to have several implementations of the same interface
<Drup>
or not.
<crocket>
But this is a tremendous benefit for readability.
<Drup>
companion_cube: or modules.
<companion_cube>
and choose which implementation to use at runtime
<companion_cube>
(e;g. ocamlnet)
<wmeyer`>
companion_cube: that's legitimate, but nevertheless still does not justify objects
<companion_cube>
why not?
<wmeyer`>
because you have records with functions and first class modules for that!
<crocket>
wmeyer`: objects enable different patterns of coding than FP.
<wmeyer`>
I'd say dynamic dispatch is a key thing
<companion_cube>
first class modules are not suitable for this.
<wmeyer`>
and convenience of binding late
<wmeyer`>
companion_cube: why not?
<companion_cube>
they don't allow you to do much with the types they contain
<crocket>
wmeyer`: If they are better alternatives to objects, maybe.
<companion_cube>
because "the type variable may escape its scope"
<wmeyer`>
companion_cube: that's also legitimate, but records sort this out too
<companion_cube>
err, no
<wmeyer`>
no?
<companion_cube>
besides, I'd rather use objects than many first class modules
<companion_cube>
the latter's syntax is really ugly
avsm has quit [Quit: Leaving.]
<wmeyer`>
crocket: glad to hear that, try modules, <period>.
<def-lkb>
wmeyer`: with more serious than most of my previous interventions, I find objects quite suited for representing large entities with a dynamically known and changing interface. like processes in an operating system
<crocket>
wmeyer`: I'd like to try OO, FP, and modules.
<wmeyer`>
def-lkb: I agree. The other pattern I like are rules system
<wmeyer`>
where each rule is a function
<wmeyer`>
parsing combinators
<crocket>
wmeyer`: So you don't use classes in OCaml?
<wmeyer`>
crocket: I did try, and found them rendundant. (Coming from C++ background)
<wmeyer`>
for instance parsing rules or pretty printing rules
<wmeyer`>
you can't do this with first class modules - no dynamic dispatch. And with records is cumbersome - no inheritance.
<crocket>
wmeyer`: Michael O Church also doesn't use the "O" part in OCaml.
<wmeyer`>
other part of story is that clasess are good for encoding some of the properties of the progam using row types
<companion_cube>
that's because he already has an "O"?
<def-lkb>
+1 companion_cube :D
<companion_cube>
"call me objective church" :D
<crocket>
wmeyer`: "with records is cumbersome"?
<wmeyer`>
yes it is
<adrien>
wmeyer`: holy crap, I was either high or zombified when I made my third patch
<def-lkb>
Objects, in the specific case of ocaml, are sometime used to encode extensible records.
<wmeyer`>
because to inherit you have to create another type iwth additional field representing the inherited record, which is not transparent
<crocket>
Do people use OCaml in any important projects?
<companion_cube>
some use it for finance, some other for tools dedicated to the analysis of (critical) software
<crocket>
wmeyer`: Your last statement is rather opaque.
<adrien>
wmeyer`: I think I made something as demo for Jacques and then forgot it was only a demo/example
<def-lkb>
(though this is mostly due to the expressivity of ocaml' object model and the lack of proper extensible records in the language than an intrisic quality of OOP :P)
<def-lkb>
(nice, that's exactly what I had in mind!)
<wmeyer`>
adrien: please correct. submit the patch and I will review it and apply it :-) Simple as that.
* wmeyer`
switches to learnig mode
<adrien>
wmeyer`: it's building
<wmeyer`>
def-lkb: thanks! More of it can be done, paramtric polymorphism too.
<wmeyer`>
( similar to constraint in classes )
<def-lkb>
wmeyer`: on a more practical side, a few month ago, you told me about an OpenGL UI toolkit. did you made any progress on it?
<Drup>
wmeyer`: are you working actively on this ? I you got use extensible records, I promise you a hug.
<Drup>
(or a beer, if you prefer)
gour has quit [Quit: WeeChat 0.4.1]
<def-lkb>
(… and with implicit values, we should be able to add support for first-class fields, sugared with a nice ppx extension …)
<nicoo>
Drup: Can't a guy want both ?
<companion_cube>
Drup: "free as in free hug"?
<companion_cube>
with implicit values, we can do pretty much what we want...
<def-lkb>
companion_cube: with implicit values AND Obj.magic
<companion_cube>
nah
<companion_cube>
just implicit magic objects
<nicoo>
let air = crap in [...] companion_cube wheel;; (* let's see how much you like implicits *)
<companion_cube>
let reinvent ?#(shape=square) wheel = ...
<nicoo>
♥ ♥ ♥
<def-lkb>
companion_cube: Obj.magic is not expressive enough for trve hackers. alone it can't work around value restriction, you need to combine it with packages to get fully polymorphic magic values
<companion_cube>
I want higher-rank Obj.magic!
<nicoo>
companion_cube: By the way, I don't se a clean way to have multiple instances of a single typeclass (over different datatypes) in a single scope.
<companion_cube>
with implicit typeclasses as first-class objects!
<nicoo>
(using implicits)
<companion_cube>
nicoo: I think that if implicit are optional arguments that are automatically "filled-in", it's ok
<companion_cube>
because then you can still specify by hand the one you want
<companion_cube>
the same way you specify an optional argument
<def-lkb>
nicoo: I am not sure to see the problem. can you explain ?
<nicoo>
companion_cube: Yes, but you lose a lot of what makes friendsh^W typeclasses magic.
<companion_cube>
I don't think so
<wmeyer`>
Drup: hug is too much Drup, tooo much. A glass of mango juice is fine :D
<companion_cube>
because you only need to specify it if there is an ambiguity
<wmeyer`>
(yeah, I might some time now)
<nicoo>
def-lkb: About implicits, or about “implementing” typeclasses as a bunch of implicit parameters ?
<companion_cube>
and besides, if you provide the top instance, it should be re-used in the body of the function that is parametrized by the typeclass
<def-lkb>
nicoo: about having multiple instances in a scope, over different datatypes
<wmeyer`>
adrien: how is that going
* wmeyer`
behind his consolete
<adrien>
issue fixed and patch ready, I'm sending it
<wmeyer`>
thx
<nicoo>
def-lkb: Well, if I understand C³'s proposal correctly, he wants implicit and use them to say “Expecting "Ord a => type" is the same thing as exepecting an implicit argument compare of type ('a -> 'a -> int)”. But if I have multiple instances in scope, I have to de-ambiguise by hand, which is going to be a PITA.
csakatoku has joined #ocaml
<def-lkb>
nicoo: hmm, if you have multiple instance.
<nicoo>
(And, comparing to Haskell's typeclasses, you lose that very desirable feature which is that the compiler can infer which instance you wanted)
<adrien>
beeeeeed
<def-lkb>
in the function constrained by Ord a, you don't care as the you are polymorphic over a, the instance will be chosen by caller
<nicoo>
'night, adrien
<companion_cube>
nicoo: you shouldn't have multiple instances for the same type in scope
<wmeyer`>
adrien: not so fast adrien
<companion_cube>
not often
<wmeyer`>
adrien: let me check up your patches at first
<nicoo>
def-lkb: Yes. What I meant is that you need to add boilerplate at the call-site to deambiguise
<companion_cube>
nicoo: the implicit would obviously need to choose the instance depending on the type
<nicoo>
companion_cube: I didn't mean “for the same type”
<def-lkb>
in the context where you call the function and have to provide an instance, either you fixed the a so you know the actual type, or the 'a is still polymorphic and you share the constraint.
<companion_cube>
well, it's useless if it cannot do it by itself
<nicoo>
companion_cube: Ok. That would be pretty slick, then.
<companion_cube>
heh :)
<nicoo>
Sorry I misunderstood what you meant.
<companion_cube>
right, actually you would need stuff like let print_list ?#(show:'a ord) (l :'a list) : string = ..... to be used to provide an implicit for list types
<companion_cube>
err, s/'a ord/'a show/
<def-lkb>
nicoo: if you only have one instance per type, there is no need to disambiguate
<nicoo>
def-lkb: As I said, it seems I misunderstood C³
MaVOP has quit [Quit: Page closed]
<def-lkb>
nicoo: ah ok, so I was just as confused as you were :)
<nicoo>
Glad to feel less alone.
<zamN>
can I use a match inside of a match?
<Drup>
nicoo, def-lkb : practice more agda, guys.
<companion_cube>
zamN: yes, but you can probably do everything in the same match
<zamN>
i.e. match blah with (h::t) -> match h with (a, b, c)
<Drup>
zamN: you ca do better
<companion_cube>
zamN: match blah with ((a,b,c) :: t) ->
<nicoo>
Drup: I wasn't expecting Agda-style implicits, but Scala-style implicits, which are a (much) weaker version.
<Drup>
I don't know Scala, but yeah, you can't get Agda powerfulness, for obvious dependently typed reasons.
<adrien>
wmeyer`: any issue yet?
csakatoku has quit [Remote host closed the connection]
<nicoo>
Drup: Scala implicits are such that you may have at most one non-implicit parameter
<Drup>
nicoo: it's the same in agda
<Drup>
nicoo: in respect to type contraints
<Drup>
it's just that Agda type contraints are very powerful
Anarchos has quit [Quit: Vision[0.9.7-H-280704]: i've been blurred!]
<wmeyer`>
adrien: no, but I am checking twice
<wmeyer`>
adrien: you may go to bed now, I really think it works, thank you
<def-lkb>
I will do the same. good night everyone!
<nicoo>
Drup: Yes, I “played” a bit with Agda, I remember.
<zamN>
is there an easy way to check the result of a function without making a custom print?
<nicoo>
zamN: What do you mean ?
<Drup>
zamN: not really, but you can use the top level
pango_ has joined #ocaml
<adrien>
wmeyer`: \o/
<adrien>
night
<Drup>
it may print some simple stuff.
<zamN>
i want to make sure my function returns a transition list
<zamN>
otherwise this makes debugging hell x_x
csakatoku has joined #ocaml
pango has quit [Ping timeout: 272 seconds]
rand000 has quit [Quit: leaving]
tane has quit [Quit: Verlassend]
osa1 has joined #ocaml
Picolino has quit [Ping timeout: 265 seconds]
rwmjones has quit [Ping timeout: 246 seconds]
mcclurmc has quit [Remote host closed the connection]