<mrvn>
whitequark: now you only need to (re)implement the exn type
<whitequark>
mrvn: soon that will be possible :p
<whitequark>
when open-types is merged
<whitequark>
mrvn: could you help me out with libzmq? I want to implement the missing parts for getting the pubkey of other party, but you seem to know the best way to structure it already
<mrvn>
only in theory. Haven't had time to figure out how the code actualy looks like
<mrvn>
n8
<flux>
whitequark, cool, so ocaml finally gets dynamic typing?-)
<Drup>
no
<whitequark>
flux: no, ocaml gets extensible variants
<whitequark>
like exn
<whitequark>
the concept of open-types seems to be extremely confusing for some reason
<Drup>
:)
<flux>
right, and exn is pretty much a dynamic type. you write code that deal with exn, and you cannot possibly know what values it may have.
squiggnet_ has joined #ocaml
<_obad_>
so wait... would there be a mechanism to extend an existing function's definition when you extend an open type?
<HoloIRCUser2>
Drup: why can't attribute payloads be as arbitrary strings?
<whitequark>
they can: [@@foo "bar"]
HoloIRCUser2 is now known as _obad_andro
<Drup>
there is too many _obad_s in this channel
<Drup>
it's like gremlins, after midnight, they start to multiply them-self.
<Drup>
it's design to write syntax extensions for ocaml, not arbitrary DSLs
<Drup>
(campl4 is intended for that)
<_obad_andro>
I'm sorry for the bother. Xmpp doesn't have that problem though.
<Drup>
use a bouncer =)
araujo has quit [Ping timeout: 255 seconds]
<_obad_andro>
How about [@@@monad Lwt.def = "X"] then let℅X = ...
divyanshu has joined #ocaml
<Drup>
I would use [% ... ] for that
<whitequark>
what's up with this odd obsession to lose two characters?
<whitequark>
in exchange for forcing everyone else to think harder to understand your code
<_obad_andro>
And monad would be a generic extension that would work with Lwt or Fut or whatever, pro used it follows some conventions
tlockney_away is now known as tlockney
<_obad_andro>
whitequark: it's two characters but on a very frequent construct.
<Drup>
is it ?
<Drup>
I mean, I use it, but not all that much
<whitequark>
shorten let to l, fun to f
<whitequark>
also probably should add a bunch of operators like APL
* whitequark
shrugs
<Drup>
and anyway
<_obad_andro>
Yeah if you use lwt... You bind all the time.
<Drup>
I use combinators more
<Drup>
I don't know about you, but I don't write lots of code, I spend more time reading it. and typing speed is clearly not my limitating factor.
<Drup>
if typing speed is so much a limitating factor, you must think really really fast :O
<_obad_andro>
Drup: well it's a free country ain't it...
<_obad_andro>
It affects reading speed as well. I use a strict 80 column limit for example.
<whitequark>
*facepalm*
<Drup>
yes it does, %t is slower for anyone else but you because they are not used to it :D
<Drup>
(and for you, it's the same in fact, because the brain doesn't work by linear scan, so it doesn't matter)
<_obad_andro>
Come on, five letters is not the same as seven. Plus, it's good
tautologico has quit [Quit: Connection closed for inactivity]
studybot_ has joined #ocaml
<_obad_andro>
practice to have extensions that use a user configurable % suffix.
<_obad_andro>
What if i want to use two versions of lwt in the same module?
<Drup>
two versions of lwt ?!
<_obad_andro>
Drup: point is, extensions should allow the user to override their suffix through floating annotations to permit the use to use shorthands if they so desire. Don't you ever use module abbreviations?
<Drup>
_obad_ you're free to defined a ppx for that, and be careful to apply it before other ppxs
<Drup>
-d
<Drup>
I'm certainly not going to include that in lwt's ppx, and I'm certainly not going to be the only one with this opinion
<_obad_andro>
Hmm that's an idea... [@@@ppxsubst "t"="lwt]
<whitequark>
let's just stop discussing it already
<Drup>
whitequark: :D
<whitequark>
I can't think of a less productive way to spend time
<Drup>
whitequark: try to imagine a more obvious operator than >> to make it clear it's a syntax extension :)
<whitequark>
Drup: I already think we should do sequencing with begin%lwt and bury >>
<Drup>
not a bad idea
<_obad_andro>
these seemingly trivial things do have an impact on user acceptance though. some of us are trying to promote ocaml usage in the industry.
<whitequark>
they do not. industry happily uses Java
<_obad_andro>
that's overgeneralizing a bit
<Drup>
whitequark: I will finish the easy part and will do a pull request so that we can have a discussion with the maintainers about the complicated parts ;)
<whitequark>
Drup: agreed
nikki93 has quit [Remote host closed the connection]
<Drup>
whitequark: If you are interested, I already opened a ticket to discuss js_of_ocaml's and eliom's ppxs
tobiasBora has quit [Quit: Konversation terminated!]
q66 has quit [Quit: Leaving]
<Drup>
well, I don't know about nice, but it would be "the right thing to do"™ :)
vladsot has joined #ocaml
nikki93 has joined #ocaml
<_obad_2_>
jesus reading those tickets it appears that there is going to be a profusion of ppx extensions. that's going to cause clashes and build problems. I think a set of conventions should be defined so that syntax extensions can coexist peacefully.
<whitequark>
that is the whole idea behind ppx. camlp4 extensions aren't capable of coexisting
<Drup>
the syntax defined in those tickets are compatible
<Drup>
what is the issue ?
<_obad_2_>
what about name clashes?
<_obad_2_>
also, is there a rule that says that syntax extensions should not touch undecorated nodes?
<_obad_2_>
there will be order and activation issues I think.
<Drup>
ppx can touch everything :)
<Drup>
and yes, ppx are not commutative
<_obad_2_>
see... and then you would have to be able to specify, for each file, which ppx extensions and their order.
<Drup>
but they are composables
<_obad_2_>
ocamlbuild tags are not ordered though
<_obad_2_>
so there needs to be an agreed-upon convention for activating, deactivating and specifying the order of extensions using e.g. floating annotations. maybe a meta-extension?
<whitequark>
I guess ocamlbuild will have to be fixed
<_obad_2_>
that would be on a per-file basis. so in your whole project you could activate the smallest set containing all your needed extensions, and then override them ona per-file basis.
rgrinberg has quit [Quit: Leaving.]
<whitequark>
it's not an issue with ocaml compiler; ocamlc allows you to define order perfectly well
<_obad_2_>
and you could have some renaming annotations.
<whitequark>
it's a buildsystem issue.
<whitequark>
what you suggest is too complex and fragile.
<_obad_2_>
yes but build systems do matter... software is too complex these days to be buildable with simple invocations to ocamlc/ocamlopt
<whitequark>
as I've said: build systems will have to be fixed.
rgrinberg has joined #ocaml
<_obad_2_>
what's wrong with a standard set of annotations to define syntax extensions in source files?
<_obad_2_>
that way the semantics would be more explicit and not depend on out-of band tags / makefiles / oasis flags / whatever
<Drup>
it's not idiomatic in ocaml to have pragmas
vladsot has left #ocaml []
<_obad_2_>
it's not idiomatic to have %extension points
<Drup>
well, it is now.
<_obad_2_>
I tell you that shit's gonna explode in our faces
<Drup>
if you want to design a new build system like ocamlbuild but using pragmas .. go on.
<_obad_2_>
no I don't want to touch the build systems
<_obad_2_>
what I want is to define standard annotations that well-behaved syntax extensions will read to re-configure themselves
<_obad_2_>
I mean [@@@floating "annotations"]
<Drup>
"well-behaved syntax extensions"
<Drup>
totally prevent stuff to explode.
<_obad_2_>
just like well-behaved software packages... ./configure && make && sudo make install
<whitequark>
hahaha
<whitequark>
you clearly have never tried to actually maintain a distribution
<Drup>
I don't find the mantis ticket for "let!"
<_obad_2_>
ok how about this. rule (1) a well-behaved syntax extension (WBX) SHALL read and obey floating annotations of the form [@@@well-behaved ...] ; rule (2) if a @@@well-behaved annotation exists, then the WBX SHALL NOT do anything unless it is activated from the well-behaved annotation
fraggle_ has quit [Read error: Connection reset by peer]
<Drup>
are you in a W3C committee ? :)
<whitequark>
clearly some kind of committee
<_obad_2_>
no, SHOULD I apply to be in one?
<Drup>
I haven't told you the worse, in fact
<Drup>
ppx are executables.
<Drup>
I mean, full blown executables that can do anything.
<_obad_2_>
yeah... they could launch sensible-browser and fetch an XML schema
<Drup>
or rm -rf your home.
<whitequark>
I was thinking "do rm / -rf", but this is considerably worse
<_obad_2_>
hmm... looks like ocamlc only accepts one -ppx
<whitequark>
sounds like a bug
<whitequark>
are you trying it on 4.02.0dev+trunk?
<_obad_2_>
and shouldn't -ppx cat work?
<_obad_2_>
4.01.0
<_obad_2_>
debian 4.01.0-3
<whitequark>
try dev+trunk.
<_obad_2_>
is the github mirror ok?
<_obad_2_>
I mean... is it up-to-date for that purpose
<whitequark>
opam switch 4.02.0dev+trunk
<Drup>
yes, the github mirror is ok
<_obad_2_>
whitequark: thanks :) getting used to all that opam goodness
<_obad_2_>
back in my days we had to write a letter to inria to get a copy. and then we would write another letter to the FSF to get a copy of gcc.
<Drup>
your days are before my birth :p
<_obad_2_>
just joking I would just download the tarball over my 38400 baud link
<_obad_2_>
multiple -ppx args accepted by 4.02.0+dev4-2014-04-03
<whitequark>
is there a less horrible way to get an int64 from its binary serialization than to pluck out bytes from a string one by one?
<Drup>
ooh
<Drup>
() is a constructor
<Drup>
(I couldn't find it in the constant category, I was confused)
<whitequark>
hm, extlib plucks
<whitequark>
I guess I could always make a cext if I really need it
<Drup>
"type foo = ()" <- it works :D
<whitequark>
um, yeah?
<whitequark>
# type foo = () | true | false;;
<whitequark>
type foo = () | true | false
<whitequark>
# true;;
<whitequark>
- : foo = true
<Drup>
I knew about true and false already
<Drup>
you can do magic stuff
<_obad_2_>
I was expecting the -ppx argument to be a unix-style filter, but it's given input and output temporary file names.
<_obad_2_>
all that shit because of windows.
<Drup>
weren't you talking about converting industrial users previously ?
<Drup>
:]
<whitequark>
whoa, type x = true of int;; works
<_obad_2_>
also trying to convert those to swich to linux :)
dapz has quit [Quit: My MacBook Pro has gone to sleep. ZZZzzz…]
<whitequark>
ThatTreeOverTher: where did you get LLVM?
<Drup>
whitequark: error position in ppx is a tricky thing.
<ThatTreeOverTher>
whitequark, LLVM or the bindings?
<whitequark>
ThatTreeOverTher: they come from the same place
<ThatTreeOverTher>
LLVM came from Arch Linux's pacman
<ThatTreeOverTher>
I installed llvm-ocaml from OPAM then pacman
<whitequark>
hrm... hard to say without looking closer. what version is it?
<ThatTreeOverTher>
"llvm-ocaml-3.4-1"
<whitequark>
also, since LLVM tends to assert when it doesn't like something, using it from toplevel is not a good idea. it's too easy to lose all your work
<ThatTreeOverTher>
I wish I knew what that meant :)
<whitequark>
what do you not understand?
<ThatTreeOverTher>
what does "using it from toplevel" mean and why do "asserts" affect my work when I do so?
<whitequark>
using it from toplevel means using it from the interactive ocaml interpreter
<whitequark>
i.e. the ocaml command, or utop
<ThatTreeOverTher>
ah, I'm using ocaml-top, the editor with an embedded interpeter
<whitequark>
"asserts" means that LLVM checks internal consistency all the time and if you pass the wrong arguments, it will abort the entire process
<whitequark>
without warning
<whitequark>
so you better use it in batch mode
dapz has joined #ocaml
<ThatTreeOverTher>
what does "batch mode" mean? and I'm using an editor with an embedded interpreter, I won't lose my work
<whitequark>
you probably will lose all unsaved changes
<whitequark>
batch mode means that you should just save the source to a file and run it
dapz has quit [Client Quit]
<ThatTreeOverTher>
ignoring my choice of editor for a moment, do you know why I'm getting this error?
dapz has joined #ocaml
<whitequark>
because the bindings you built have toplevel support broken
<whitequark>
it's a bug in the LLVM buildsystem. I *think* I have fixed it. perhaps something else broke it again, or perhaps my fix was wrong
<ThatTreeOverTher>
so what can I do about this?
<whitequark>
nothing really
<ThatTreeOverTher>
meaning it's impossible for me to run any OCaml code that creates LLVM bytecode?
<whitequark>
no, it's impossible to run it from toplevel
<ThatTreeOverTher>
so what can I do to run OCaml code that creates LLVM bytecode?
<whitequark>
I've already told you. save your code to a file, compile that file and run the result.
<Drup>
ThatTreeOverTher: "ocamlbuild -use-ocamlfind -package llvm foo.native" with foo your main module
<Drup>
(add the other relevant packages, of course)
<ThatTreeOverTher>
Drup, unfortunately I'm getting a Syntax error
<ThatTreeOverTher>
on line 8, characters 0-2
<Drup>
yes, remove the # pragmas
<whitequark>
ThatTreeOverTher: fyi: I've checked the archlinux package and it appears that LLVM is built in a way that permits to use it from toplevel
<whitequark>
report a bug against llvm-ocaml in archlinux, I guess
<whitequark>
oh, nevermind, it's easy. extensions are supposed to remove all %nodes
<whitequark>
so there's no printer for them
<Drup>
whitequark: it shouldn't raise an assert failed, though
<_obad_2_>
that's not very friendly...
<_obad_2_>
I mean, if I invoke -dsource it should still work
<Drup>
the error message is sensible
<whitequark>
well, ideally it would just print
<_obad_2_>
yeah
<Drup>
("Unknown extension node")
<whitequark>
no, just print it back
<whitequark>
it's for -dsource
jao has quit [Ping timeout: 265 seconds]
<_obad_2_>
and anyway it does print [@@@] attributes
zzing has left #ocaml []
<_obad_2_>
actually for what I wanna do I need to use [@@]; I want something that all extensions can look at.
<_obad_2_>
so I'm proposing [@@ppx ext_1;ext_2;...;ext_n] at the beginning to explicitly enable extensions, where ext_i is [<id> "="] <id> <arg1> ... <argn>
<Drup>
there is a mailing list, go on :)
<_obad_2_>
example: [@@ppx getenv; t = monad Lwt; ifdef "IFDEF"]
tautologico has joined #ocaml
<_obad_2_>
meaning: enable extension getenv; extension monad with argument Lwt, aliased as "t"; extension ifdef with argument "IFDEF"
<_obad_2_>
if a [@@ppx] node appears, all extensions that do not appear explicitly must be disabled
<whitequark>
extensions already accept arguments at command line.
<whitequark>
and you cannot reorder them with your thing anyway
<_obad_2_>
the whole point is to allow per-file configuration without having to dick around in build stuff
<_obad_2_>
build systems = nightmare
<_obad_2_>
with this approach, just make sure all used extensions are in the chain, then configure them per file.
<_obad_2_>
the reordering thing is true...
<tautologico>
you're thinking all that so that you can type let%t instead of let%lwt ? :)
<_obad_2_>
looks like this might end up as a meta-extension after all
<whitequark>
so you didn't solve any existing problem, but want to impose a standard on all extension authors *and* users.
<_obad_2_>
no I'm thinking ahead
<whitequark>
can't wait to use this.</sarcasm>
<_obad_2_>
assume you're using lib1 and lib2, each using their own extensions
<_obad_2_>
you bring them together into a common source tree
<whitequark>
each will have their nodes prefixed by library name
<_obad_2_>
now you have to adjust build flags on a per-file basis
<whitequark>
that is all.
<_obad_2_>
that assumes they only work on nodes having attributes
<_obad_2_>
they are free to do other things...
<whitequark>
well, they shouldn't.
<tautologico>
yeah
<_obad_2_>
well fact is they will end up doing stuff. people will just use it.
<tautologico>
if extensions start to mess around with unadorned AST nodes, then all hope is lost
<Drup>
tautologico: that's going to happpen if you want to keep a lightweitgh syntax
<whitequark>
excellent. if people will realize that this doesn't work, they will complain to extension author, and the extension will be fixed or abandoned.
<Drup>
cf the two links for eliom and js_of_ocaml I gave earlier
<tautologico>
Drup: I didn't see them
<_obad_2_>
the invisible hand of the free software marketplace?
<tautologico>
I prefer to have lightweight syntax for my extensions, but I also have to consider that my users will want to use my extension with other extensions
<whitequark>
absolutely nothing stops the extension authors from ignoring your protocol either.
<_obad_2_>
whitequark: true
<_obad_2_>
but that's like saying : nothing prevents people from buying products without CE / UL labels
<_obad_2_>
so there is no point in having those standards
<whitequark>
there actually is
<whitequark>
products without certification can't be sold
<_obad_2_>
not true for UL I think
<whitequark>
I don't think I've ever heard of anyone not buying product X because it doesn't have an UL label
<whitequark>
I don't think most people even *know* what it means
<_obad_2_>
ok fine but there are other labels and other contexts.
philtor has quit [Remote host closed the connection]
dapz has quit [Quit: My MacBook Pro has gone to sleep. ZZZzzz…]
<whitequark>
ThatTreeOverTher: it is a trivial error. I will suggest finding it yourself, as you probably don't want to ask the channel each time you get one.
<ThatTreeOverTher>
whitequark, I'm learning the language, and I need help. I'll need less help after I've come to understand a little more, but as of now this channel is my only lifeline. I don't quite get it, as I'm providing build_add with the two llvalues that are i32_type, the name of the value, and the builder, but it says I apply the function to too many arguments still.
<whitequark>
you forgot ;
<whitequark>
at the end of the line with build_add
<ThatTreeOverTher>
why would I need a semicolon?
<ThatTreeOverTher>
oh I see
<ThatTreeOverTher>
well now my application compiles but segfaults
<xenocons>
whitequark: we were discussing the diff between yield and return ages ago
<xenocons>
(i realise like 6 hrs has past since that discussion ;p)
<whitequark>
nono, I remember that
<whitequark>
I don't see any point in list comprehensions honestly, given you have proper closures
<xenocons>
oh, point was that yield <> return
<whitequark>
ahh
<whitequark>
well, you're defining a coroutine basically
<xenocons>
not saying its good\bad (infact most of the time perf isnt favourable for me so i abandon comprehensions)
<whitequark>
half a coroutine, since it cannot receive values from outside
<xenocons>
right
<whitequark>
you could do exactly same using a closure and a mutable cell in ocaml
<whitequark>
since yield is a keyword and not an API entry point (like in Ruby)
<xenocons>
right, essentially you could define it yourself
<xenocons>
but would it really be of much benefit
<whitequark>
exactly
<xenocons>
i do find something that yields 'desireable' elements to be useful though, but 'choose' is just as appropraite
<xenocons>
i think ocaml has something similar (im sure)
<whitequark>
List.filter
<xenocons>
similar enough i guess
<whitequark>
well, Enum.filter, if you insist on using generators
<whitequark>
but if you want to start from lists, yea
<xenocons>
[1;2;3;4] |> List.choose (fun x -> if x < 3 then Some x else None);; = [1;2] same result as filter, except filter can be written more succinctly
<xenocons>
List.filter ((<) 3) [1;2;3;4] i guess
<whitequark>
exactly
<xenocons>
only difference is if you wish to utilise something like >>= maybe
<xenocons>
where choose can be useful i guess
<whitequark>
[1;2;3;4] |> List.filter ((<) 3) ?
<whitequark>
or do you mean using the option monad
<whitequark>
?
<xenocons>
yeah option monad
<xenocons>
guess you open Option in ocaml to get it?
<whitequark>
nope
<whitequark>
ocaml doesn't really have monads in stdlib at all
<xenocons>
ahh ok
<whitequark>
it also doesn't have typeclasses so that is another problem
<xenocons>
yeah, but not *too much* of a problem
<whitequark>
I disagree :/
<xenocons>
you like type classes? or you think monads less useful without
<whitequark>
the hoops you need to jump through to use arithmetics or indexing in ocaml are ridiculous
<xenocons>
e.g. the +. vs + thing?
<whitequark>
.() for arrays, .[] for strings and .{} for... idfk, something else
<xenocons>
+ in ocaml not a polymorphic function
<whitequark>
yes, +., +/, Int32/64.add, and so on
<xenocons>
ah right yeh
<xenocons>
it is a hurdle... however you end up writing less type signatures
<whitequark>
I write them anyway in .mlis
<xenocons>
ah
<xenocons>
any reason?
<xenocons>
tbh i found an annoying problem in ocaml where you can open 2 namesspaces that have the same function
<xenocons>
and not realise that you are using the wrong 1 hehe
<whitequark>
hm well, people usually write documentation in mlis and ascribe phantom types there
<xenocons>
sometimes type sigs help resolve that ambiguity
<xenocons>
ah
<xenocons>
right
<whitequark>
so all publicly visible modules always have mlis
rgrinberg has joined #ocaml
<whitequark>
it's great practice
<xenocons>
yeh, it sounds so
rgrinberg has quit [Quit: Leaving.]
<whitequark>
Drup: your ppx code is... mildly disgusting, but at least I can understand it without drugs. which is not true when talking about camlp4
<whitequark>
I suppose quotations would make it much more clear, but we're not there yet
<whitequark>
it's funny, I actually wanted to implement the {foo||foo} thing in the language I've been developing. I wonder how well would it fare in ocaml
<xenocons>
hehe, looking at rust its really ocamly
<whitequark>
rust is great
<xenocons>
yeah digging it
<xenocons>
wish it'd hurry up and prod ready
Simn has joined #ocaml
NoNNaN has quit [Remote host closed the connection]
NoNNaN has joined #ocaml
Anarchos has joined #ocaml
wwilly has joined #ocaml
<wwilly>
bonjour
eizo has joined #ocaml
<Anarchos>
salut wwilly
clan has joined #ocaml
osnr has joined #ocaml
axiles has joined #ocaml
NoNNaN has quit [Ping timeout: 272 seconds]
tautologico has quit [Quit: Connection closed for inactivity]
NoNNaN has joined #ocaml
claudiuc has quit [Remote host closed the connection]
nikki93_ has joined #ocaml
nikki93 has quit [Ping timeout: 252 seconds]
yacks has quit [Ping timeout: 265 seconds]
yacks has joined #ocaml
ggole has joined #ocaml
ollehar has joined #ocaml
wwilly has quit [Remote host closed the connection]
wwilly has joined #ocaml
avsm has quit [Quit: Leaving.]
tane has joined #ocaml
rand000 has joined #ocaml
clan has quit [Quit: clan]
avsm has joined #ocaml
avsm has quit [Client Quit]
Anarchos has quit [Quit: Vision[0.9.7-H-20140108]: i've been blurred!]
arrays has joined #ocaml
maattdd has joined #ocaml
araujo has quit [Quit: Leaving]
maattdd has quit [Ping timeout: 240 seconds]
maattdd has joined #ocaml
arrays has quit [Quit: Page closed]
divyanshu has joined #ocaml
ruzu2 has joined #ocaml
ruzu has quit [Ping timeout: 252 seconds]
studybot_ has quit [Remote host closed the connection]
<_obad_2_>
I get: findlib: [WARNING] Interface topdirs.cmi occurs in several directories: /home/obad/.opam/4.02.0dev+trunk/lib/ocaml, /home/obad/.opam/4.02.0dev+trunk/lib/ocaml/compiler-libs ... ideas?
nojb has joined #ocaml
<nojb>
define a gadt by type _ t = I : int -> int t | S : char -> char t
<nojb>
and now: type any_t = U : 'a t -> any_t;;
ruzu2 has quit [Read error: Connection reset by peer]
<nojb>
I would like to define the function map_any : ('a t -> 'b) -> any_t -> 'b by fun (U x) -> f x but it does not type check
<nojb>
how to make it work ?
maattdd has quit [Ping timeout: 240 seconds]
ruzu has joined #ocaml
<nojb>
sorry, that should be [fun f (U x) -> f x] obviously
divyanshu has quit [Quit: Computer has gone to sleep.]
tobiasBora has joined #ocaml
ruzu has quit [Read error: Connection reset by peer]
<ggole>
I don't think that is sound.
ruzu has joined #ocaml
<_obad_2_>
I get: findlib: [WARNING] Interface topdirs.cmi occurs in several directories: /home/obad/.opam/4.02.0dev+trunk/lib/ocaml, /home/obad/.opam/4.02.0dev+trunk/lib/ocaml/compiler-libs ... ideas?
<_obad_2_>
sorry...
<_obad_2_>
wrong window
maattdd has joined #ocaml
ruzu has quit [Read error: Connection reset by peer]
ruzu has joined #ocaml
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
<ggole>
nojb: what are you trying to do there?
angerman has joined #ocaml
<nojb>
ggole: just trying to understand gadts.. Suppose that you have a gadt like ['a t] above and you want to stuff objects of type ['a t] for different ['a]s inside a, say, Hashtbl.t; You should be able to do this after wrapping them up inside a universal type like [any] above. And you should be able to use these elements as argument of functions which have type ['a. 'a t -> 'b]. Now you might want to write a higher order function that
<nojb>
takes one such function and returns the corresponding function any -> 'b. But this requires some care evidently...
<ggole>
The problem with wrapping things in an existential that way is that you "forget" what the type of the GADT is
<mrvn>
nojb: you need 'a t -> 'a
shinnya has joined #ocaml
<mrvn>
nojb: and your any needs a constructor for every 'a you want to store.
<nojb>
mrvn: why?
<mrvn>
Because you need to match on the constructor to get the type.
<ggole>
My GADT-fu is pretty weak, but it seems to be that the usual approach to "this element can be any leg of the GADT" is builders rather than existentials
<ggole>
Basically, heterogeneous lists
<mrvn>
The problem is to extract an element of a specific type out of the hashtable you need runtime type information. 'type any = Any: 'a -> any' does not provide that.
<nojb>
mrvn: yes, except that I do not want to *extract* the underlying element, simply pass it to a function that is equipped to handle elements of *any* such type.
<nojb>
just to be clear: the following works:
<mrvn>
nojb: no, not any but every
<mrvn>
nojb: any such type would be 'a
<nojb>
right
<nojb>
so the following works:
<nojb>
type 'a t = I : int -> int t | S : string -> string t
<nojb>
let f : (type a) a t -> int = function I n -> n | S s -> String.length s;;
<nojb>
type any = U : 'a t -> any;;
<nojb>
let g (U x) = f x;;
<nojb>
so that I can do g (U 12) => 12
<nojb>
and g (U "Hello") => 5
<mrvn>
f gives me a syntax error
<nojb>
sorry
<ggole>
let f : type a . a t -> ...
<nojb>
write
<nojb>
right
<nojb>
sorry about that
<nojb>
so one can do
<nojb>
let h = Hashtbl.create 3;;
<mrvn>
# g (U (I 12));;
<mrvn>
- : int = 12
<nojb>
yes
<nojb>
sorry about the typos
<nojb>
so you can see how it works
<nojb>
Hashtbl.add h 1 (U (I 12));;
<nojb>
g (Hashtbl.find h 1) => 12;;
<nojb>
So one can definitly do it this way...
<nojb>
My question was about how to write the type of a function that produces [g] from [f]
<mrvn>
The problem is that 'a t needs to declare every possible type.
<nojb>
mrvn: what do you mean ?
<mrvn>
val make : ('a t -> int) -> (any -> int)?
<nojb>
yes
<mrvn>
nojb: In an universal container I want to put in every possible type. Not just those listed in the 'a t type.
divyanshu has joined #ocaml
divyanshu has quit [Client Quit]
<mrvn>
# let make f = function (U x) -> f x;;
<mrvn>
Error: This expression has type a#4 t but an expression was expected of type a#4 t
divyanshu has joined #ocaml
<mrvn>
The type constructor a#4 would escape its scope
<nojb>
right I do not understand that type error
<ggole>
When you match against a GADT, the associated type variables can't be part of the return type
<ggole>
You run into this problem with type any : 'a t -> any, because the 'a is such a type variable
<nojb>
ggole: I can't see how 'a is part of the return type of [make] ... can you explain ?
<ggole>
I might not have phrased that very well
<ggole>
The 'a is passed to f, so it "escapes" the limited scope
<ggole>
"Return type" is more confusing than helpful, sorry.
<mrvn>
but why is that a problem?
<nojb>
ggole: ok, but it works if [f] is defined globally instead of being passed as a parameter (see the example above with [f] and [g])
<ggole>
It's a soundness problem.
<mrvn>
looks like GADT functions are no longer first class.
<ggole>
They're first class, just confusing and hard to work with.
<mrvn>
nojb: consider this: let h : type a . a t -> a = function I n -> n | S s -> s;;
<mrvn>
let make f = function (U x) -> f x;;
<mrvn>
val make : type a . (a t -> a) -> (any -> a)
<mrvn>
nojb: How should that type well?
<mrvn>
ggole: can you give an example that is unsound where the return type does not contain a "type a"?
<ggole>
Good question.
<mrvn>
ggole: I can't think of anything where you can construct g explicitly but which would be unsound through a higher level function.
<ggole>
References, maybe
<mrvn>
ggole: should already fail when you build the g by hand. But maybe there could be cases where by hand gives an error but through higher level succeeds.
q66 has joined #ocaml
q66 has quit [Changing host]
q66 has joined #ocaml
avsm has joined #ocaml
<mrvn>
The problem with GADTs is that a lot of the time you have to match the GADT even if all branches of the match are identical. The match is just there so the type inference can verify each type manually.
avsm has quit [Quit: Leaving.]
<mrvn>
This works: let make () = function (U x) -> match x with | I i -> f (I i) | S s -> f (S s);;
<mrvn>
This fails: let make f = function (U x) -> match x with | I i -> f (I i) | S s -> f (S s);;
<mrvn>
How do I have to annotate f to show that it is a GADT function?
<_obad_2_>
sorry to interrupt.. in 4.02 when I go module P = Printf it doesn't show the module signature anymore. is this a bug?
<mrvn>
in the toplevel or ocamlc -i?
<_obad_2_>
toplevel
<ggole>
I don't see anything in the changelog about it
<ggole>
Ask about it on the mailing list, I guess.
<_obad_2_>
whitequark: you mean with location info? looks like Ast_mapper.run_main uses Location.report_exception
<whitequark>
ah, great. thanks
<_obad_2_>
so I guess one would Location.register_error_of_exn for one's own exception
tautologico has joined #ocaml
dapz has joined #ocaml
<jpdeplaix>
whitequark: ok. Thanks for the information.
pminten has quit [Remote host closed the connection]
marr has joined #ocaml
waneck has quit [Ping timeout: 265 seconds]
<Nuki>
Bonjour, j'ai une petite question à propos des types fantômes. J'en utilise pour un petit exercice personnel. Le soucis, qui n'en est pas réellement un, c'est que j'ai une fonction qui doit extraire des information d'un seul des constructeur de mon. Donc dans la signature, j'ai utilisé [< truc ] pour garantir à la compilation qu'on ne puisse lui donner qu'une seule portion des données (excusez le terme hasardeux), malheureusement,
<_obad_2_>
et donc?
<tautologico>
malheureusement...
<Nuki>
Ah oui, désolé, limite de taille, je l'oublie chaque fois
<Drup>
Nuki: #ocaml-fr pour les questions en francais
<Nuki>
Ah désolé
<whitequark>
google translate does a really nice job doing fr→en
<Nuki>
(Sorry, I didn't knwo ocaml-fr :)
dapz has quit [Quit: My MacBook Pro has gone to sleep. ZZZzzz…]
dapz has joined #ocaml
dapz has quit [Client Quit]
maattdd has quit [Ping timeout: 240 seconds]
dapz has joined #ocaml
ollehar has quit [Ping timeout: 252 seconds]
ollehar has joined #ocaml
<ThatTreeOverTher>
whitequark, I now get assertions... could you help me understand them? I have: http://pastebin.ca/raw/2706776
angerman has quit [Quit: Gone]
* whitequark
sighs
<ThatTreeOverTher>
:9
<whitequark>
first, compile your OCaml code while passing -g to ocamlopt
<whitequark>
second, run it under gdb and when it fails, tell gdb to print backtrace ("bt")
<whitequark>
then you will see at which line it fails
<tautologico>
it seems a problem in the type of your function
<ThatTreeOverTher>
whitequark, how do I do the first thing? I'm not quite sure I understand
<ThatTreeOverTher>
i have: ocamlbuild -use-ocamlfind -package llvm dropletc.native
<whitequark>
add "true: debug" to your _tags
<whitequark>
add "true: debug" to your _tags file
maattdd has joined #ocaml
struktured has joined #ocaml
angerman has joined #ocaml
inr has quit [Ping timeout: 245 seconds]
inr has joined #ocaml
dapz has quit [Quit: My MacBook Pro has gone to sleep. ZZZzzz…]
jao has joined #ocaml
jao has quit [Changing host]
jao has joined #ocaml
eizo has joined #ocaml
avsm has quit [Quit: Leaving.]
<nickmeharry>
Looks like I'm not the only one with compilation touble this morning.
<nickmeharry>
Anybody know how to pass a multi-word argument to the linker from ocamlbuild?
<nickmeharry>
Specifically, I'm trying to get it to take -framework Cocoa without mangling it.
<Simn>
We define MODULE_EXT to be either cmx or cmo, but it seems really crude like this.
eizo has quit [Ping timeout: 240 seconds]
lostcuaz has joined #ocaml
angerman has quit [Quit: Gone]
<whitequark>
not use makefiles? :)
jonludlam has joined #ocaml
<HoloIRCUser>
Makefiles simply cannot depend on directory contents, nor on dynamically changing dependency graphs.
<ggole>
There's a tool for listing dependencies, ocamldep, but I can't remember enough about it to say whether it would be of use in that situation.
HoloIRCUser is now known as _obad_grrrr
Submarine has quit [Quit: Leaving]
<ggole>
The ocamldep(1) command scans a set of OCaml source files... and outputs dependency lines in a format suitable for the make(1) utility... Dependencies are generated both for compiling with the bytecode com‐ piler ocamlc(1) and with the native-code compiler ocamlopt(1).
<mrvn>
makefiles can generate dynamic dependencies on the fly.
<_obad_grrrr>
Dependency generation tools don't cut it when you have multi stage dependencies e.g meta programming. Ocamlbuild does it right because it maintains a dynamically updatable dependency graph.
<ggole>
Probably still beats typing all that shit by hand.
<mrvn>
that's just a matter of making the tools complex enough
<whitequark>
but makefiles simply aren't
<mrvn>
makefiles are turing complete
<_obad_grrrr>
You have to generate deeps and then either reinvoke make or include the generated files, that kind of thing doesn't work well.
<mrvn>
or use secondary expansion
<Simn>
IIRC the original makefile was created with the ocamake tool years ago.
<Simn>
We just update it by hand since then.
<whitequark>
mrvn: turing completeness is irrelevant
<mrvn>
whitequark: turing completeness means you can do anything in make that you can do in any other language.
<whitequark>
I know
<_obad_grrrr>
Been there done that.... Buildroot does a lot of that and it's unreadable and very error prone.
<ggole>
Let's write our build system in assembly. It's turing complete, too.
<whitequark>
in OISC assembly.
<ggole>
Yeah, simulators are probably available.
<Drup>
in brainfuck, it's even more interesting.
<whitequark>
you won't believe me if I said that OISC is quite commercially successful
<whitequark>
Drup: take a look at what OISC is :p
<_obad_grrrr>
Automake isn't too bad. The Linux kernel makefiles are very good, but they are are too intimately tied to the config system....
<ggole>
Portions of x86 are OISC-like, I hear.
<whitequark>
yes, the page fault handler is
<Drup>
tautologico: I still don't understand how haskell people can bear cabal's package management
<Drup>
it's so terrible ...
<_obad_grrrr>
Good luck counting the $$$s when using secondary expansion. It's*horrible*.
<tautologico>
yeah, cabal's dependency resolution (actually cabal-install) is bad, among other things
<tautologico>
but it's the standard, so people use workarounds when they need them
<Drup>
tautologico: well, afaik, the workarounds are "use the new sandbox feature in order that, when it blows, it blows only in the sandbox"
<Drup>
I haven't found any good solution to any cabal issue which was not "just nuke everything and reinstall"
<tautologico>
:)
Nuki has quit [Remote host closed the connection]
nikki93 has joined #ocaml
struktured has quit [Ping timeout: 240 seconds]
waneck has joined #ocaml
clan has joined #ocaml
Arsenik has quit [Remote host closed the connection]
tobiasBora has quit [Quit: Konversation terminated!]
struktured has joined #ocaml
squiggnet has quit [Read error: Connection reset by peer]
elfring has quit [Quit: Konversation terminated!]
studybot_ has joined #ocaml
squiggnet has joined #ocaml
lostcuaz has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
nikki93 has quit [Remote host closed the connection]
tlockney is now known as tlockney_away
Simn has quit [Quit: Leaving]
ikaros has joined #ocaml
Kakadu has quit [Remote host closed the connection]
rgrinberg has joined #ocaml
tani has quit [Quit: Verlassend]
HoloIRCUser has joined #ocaml
nikki93 has joined #ocaml
_obad_grrrr has quit [Ping timeout: 276 seconds]
ollehar has quit [Ping timeout: 252 seconds]
ollehar has joined #ocaml
dapz has joined #ocaml
Thooms has quit [Quit: WeeChat 0.3.8]
ikaros has quit [Quit: Ex-Chat]
jbrown has joined #ocaml
avsm has quit [Quit: Leaving.]
nikki93 has quit [Remote host closed the connection]
rand000 has quit [Quit: leaving]
nikki93 has joined #ocaml
ggole has quit []
nikki93 has quit [Remote host closed the connection]
rgrinberg has quit [Quit: Leaving.]
dapz has quit [Quit: My MacBook Pro has gone to sleep. ZZZzzz…]
racycle__ has quit [Read error: Connection reset by peer]
racycle has joined #ocaml
dapz has joined #ocaml
shinnya has joined #ocaml
dapz has quit [Quit: My MacBook Pro has gone to sleep. ZZZzzz…]
jonludlam has quit [Read error: Operation timed out]
darkf has joined #ocaml
dapz has joined #ocaml
mdenes has quit [Quit: WeeChat 0.4.2]
Anarchos has quit [Quit: Vision[0.9.7-H-20140108]: i've been blurred!]
studybot_ has quit [Ping timeout: 252 seconds]
ontologiae has quit [Ping timeout: 240 seconds]
madroach has quit [Ping timeout: 252 seconds]
madroach has joined #ocaml
NoNNaN has quit [Remote host closed the connection]
NoNNaN has joined #ocaml
struktured has quit [Remote host closed the connection]