<tobiasBora>
And by the way, is it possible on linux to make an executable containing both the bytecode program and a minimal ocaml bytecode runner ?
troutwine_away is now known as troutwine
troutwine is now known as troutwine_away
<Denommus>
Drup: meh, but I want them organization!
<Denommus>
Drup: hehe, I'll do it
<Drup>
tobiasBora: since the bytecode runner is going to be plateform dependent, i'm not sure to see the point, compared to just native compiling ...
<tobiasBora>
Drup: Well the problem is that I don't want to waste lot's of time to install on MacOsX and Windows all the dependencies I use on Linux. So the idea would be to compile in bytecode under Linux (with opam...) and then create in a one line command a package for Windows and an other for MacOsX.
<Drup>
tobiasBora: during the day, you can bother adrien on cross compilation
<Drup>
he want testers
q[mrw] has joined #ocaml
badon has joined #ocaml
mort___ has quit [Quit: Leaving.]
<Denommus>
what's the reasoning behind `'a f` instead of `f 'a`?
<Drup>
funnily, someone else asked the same thing recently
<tobiasBora>
Drup: I'm affraid cross compilation would be again more complicated, but I can give it a try ^^
<Drup>
tobiasBora: ask adrien anyway, he likes to be asked about windows porting
<tobiasBora>
Drup: I will, thank you.
<Drup>
Denommus: no other answer than "it was like that in ML"
<tobiasBora>
(I think he is sleeping now ^^)
<Drup>
tobiasBora: hence "during the day" ;)
<Drup>
Denommus: someone pointed out that it made sens if you pronounce it, somehow. Because "a list of eggs" would be said "an egg list" in english
<Drup>
(I'm not completly convinced but, why not :))
<Denommus>
Drup: well, at least f 'a would be similar to function application :P
<Drup>
oh, don't argue with me, I'm not very fond of the reverse application notation for types ^^'
<tobiasBora>
My bytecode cannot be run on a mac virtualbox :
<tobiasBora>
Unknow C primitives "unix.waitpid"
<tobiasBora>
C'est pas censé fonctionner sur tous les OS, ou au moins sur les "unix" ?
<Drup>
tobiasBora: en channel :p
<tobiasBora>
Drup: Euh... Je vois pas ce que tu veux dire ^^
<Drup>
english*
jao has joined #ocaml
jao has quit [Changing host]
jao has joined #ocaml
<Drup>
the documentation for the Unix module will tell you which functions are available in which OS
<Drup>
the bytecode is portable, the Unix primitives ... it depends
* tobiasBora
is just understanding the problem with it's french sentence
* tobiasBora
should go to bed
shinnya has joined #ocaml
<tobiasBora>
Translation : "Isn't it supposed to run on every OS, at least on the "unix" ones ?
<tobiasBora>
From the main website : " Il doit normalement fonctionner sans modifications sur tout système Unix ou compatible Unix, y compris Linux et MacOS X."
<tobiasBora>
(Tr : it [the bytecode] is supposed to work on every unix plateforme unix, including linux and MacOS X
johnnydiabetic has quit [Ping timeout: 255 seconds]
<q[mrw]>
yes
<q[mrw]>
is that not advisable?
<Drup>
then don't compile opam with it
<q[mrw]>
they're incompatible ?
<q[mrw]>
ok..
<q[mrw]>
I guess I get a release
<Drup>
there is no point anyway
<q[mrw]>
why's that?
<Drup>
you can use a switch once opam is compiled
<Drup>
no point in compiling opam with an unstable ocaml version
arquebus has quit [Quit: Konversation terminated!]
rand000 has quit [Quit: leaving]
shinnya has quit [Ping timeout: 240 seconds]
<q[mrw]>
thanks drup..
<Drup>
no problem
<Drup>
once opam is set up, you can get back to the trunk compiler by doing "opam switch 4.03.0+trunk"
<q[mrw]>
ok..
<Drup>
(if you want to know the details, the version of opam you are using is not going to compile on trunk because the build systems used is bootstraped and contain a binary. The magic number has changed in the trunk, so this binnary can't run)
<Drup>
(it's fixed in the dev version of opam, iirc)
<Drup>
(if you think it's silly, yes, I agree)
zpe has joined #ocaml
johnnydiabetic has joined #ocaml
<q[mrw]>
weird thing is I had git repos of both the latest
<companion_cube>
indeed, BatUTF8 doesn't seem to contain normalization/transformation functions for lowercase
<Unhammer>
meant (String.lower "Å") of course; thing is it comes out the wrong encoding, so in the terminal, doing printf "%s!?" (String.lowercase "NÅ") will print "n?"
<ygrek>
String.lowercase deals with ascii only
<def`>
(uucp in your case)
<ygrek>
I am not sure uucp is the right tool here
<ygrek>
it doesn't deal with encodings
<ygrek>
with camomile it will be :
<ygrek>
module C = CamomileLibraryDefault.Camomile
<ygrek>
module CM = C.CaseMap.Make(C.UTF8)
<ygrek>
print_string @@ CM.lowercase "
<Unhammer>
hmm, uucp seems a bit low-level, to_lower working on single ints
<whitequark>
Uucp has some examples
<whitequark>
but indeed it is rather low-level
troutwine_away is now known as troutwine
BitPuffin has joined #ocaml
_andre has joined #ocaml
troutwine is now known as troutwine_away
Eyyub has quit [Ping timeout: 240 seconds]
Eyyub has joined #ocaml
ygrek has quit [Ping timeout: 240 seconds]
<def`>
it's low-level on purpose, it just provides the (hopefully) right primitives to work with unicode
<ggole>
Whinging on IRC, almost like getting things done!
<ggole>
Speaking of which, I gotta look at that merlin thing again
<whitequark>
def`: oh, great
arj has quit [Quit: Leaving.]
philtor has joined #ocaml
englishm has quit [Remote host closed the connection]
englishm has joined #ocaml
avsm has quit [Quit: Leaving.]
philtor has quit [Ping timeout: 260 seconds]
<whitequark>
I wonder if mirage can work without Xen
<def`>
I thought the was the purpose of mirage-unix backend (I never used it, so I don't know)
<smondet>
whitequark: yes the unix backend, and within that you can use either the mirage-tcp stack on top of tun/tap, or the 'native' TCP stack
Eyyub has quit [Ping timeout: 240 seconds]
<smondet>
and there is also the "freebsd kernel module" backend AFAIR
<whitequark>
smondet: who talks about unix? I'm interested in bare metal
<smondet>
ah that's what you meant "without xen" :)
<whitequark>
virtualization is not yet common among ARM...
George has joined #ocaml
<smondet>
well the bit thing today was mirage on xen/ARM
<smondet>
s/bit/big/
<whitequark>
yes
AltGr has left #ocaml [#ocaml]
studybot has quit [Ping timeout: 264 seconds]
studybot has joined #ocaml
<George>
Hi guys, I have a question
penglingbo has quit [Ping timeout: 240 seconds]
<George>
I am writing a functor, of this form
<George>
module My_module (M: ModuleSig) = struct some code ... end
<George>
this compiles well
<George>
I would like to add another non-module argument to the functor
<George>
for example
<George>
module My_module (M: ModuleSig) (var: uint64) = struct some code ... end
<George>
it does not compile
<George>
any idea of the problem?
<smondet>
George: no you need modules (Var : sig val v : uint64 end)
<smondet>
and then use Var.v
<George>
That means a functor only accepts modules as its parameters, us that right?
johnnydiabetic has joined #ocaml
<George>
is
<smondet>
yes,
<George>
hmmm, so you recommend your own version, which looks good
<George>
so, considering your version, can I pass an integer directly for the parameter Var?
<smondet>
no then you need to wrap it also (struct let v = 42 end)
hhugo has joined #ocaml
<George>
OK, I got it. Just for curiosity, why OCaml doesn't allow combination of modules and other terms such as variables or functions in functors, is it technically difficult?
<smondet>
for me it looks like some syntactic sugar away
<smondet>
but i like the idea of a module language and a 'programing' language with clear-ish boundaries
<George>
Thanks by the way, I will check your solution out :)
<def`>
smondet: well, technically this syntactic sugar has a side-effect: you no longer have path for types inside your functors
Hannibal_Smith has quit [Read error: Connection reset by peer]
<smondet>
ah yes, the naming would be crazier :)
<def`>
smondet: it should be possible to mix both… But you're right, making a clear distinction between value and module language is nice
_0xAX has quit [Remote host closed the connection]
<George>
But I guess OCaml tries to combine in in some way too
morphles has joined #ocaml
<ggole>
You could do that with first-class modules, I think
<ggole>
But it would be pretty clumsy
<bernardofpc>
can someone explain what is the use-case for %{ %} in format strings ?
englishm has quit [Remote host closed the connection]
englishm has joined #ocaml
troutwine_away is now known as troutwine
jonludlam has quit [Ping timeout: 250 seconds]
AltGr has joined #ocaml
zpe has quit [Remote host closed the connection]
hausdorff has joined #ocaml
troutwine is now known as troutwine_away
sagotch has quit [Remote host closed the connection]
tane has joined #ocaml
hausdorff has quit [Ping timeout: 255 seconds]
jonludlam has joined #ocaml
penglingbo has joined #ocaml
maattdd has quit [Ping timeout: 255 seconds]
hausdorff has joined #ocaml
hto has joined #ocaml
<George>
An OCaml question
<George>
The following definition works in a function
<George>
now, I would like to have it inside a module (functor)
travisbrady has joined #ocaml
<George>
in this case, inside a let binding
cago has quit [Quit: cago]
<George>
it doesn't compile this time
<companion_cube>
show me the code that doesn't work please :s
nlucaron1 has joined #ocaml
nlucaron1 has quit [Quit: leaving]
nlucaroni has quit [Quit: leaving]
nlucaroni has joined #ocaml
travisbrady has quit [Remote host closed the connection]
travisbrady has joined #ocaml
<George>
module Create_basic (Id: sig val id : int64 end) = struct let create = Basic.({ int_to_dest = (Hashtbl.create 4); features=Id.id; false;}) end
<companion_cube>
and this gives you a syntax error? strange
<companion_cube>
careful not to shadow Id in the scope of Basic
<smondet>
you have a field called `false` ?
<George>
yes, is that wrong?
<George>
it is a Boolean field
<smondet>
`false` is a constructor
<George>
by the way, what do you mean with shadowing?
<companion_cube>
George: if Basic contains a module named Id
<smondet>
but the false is a syntax error
<companion_cube>
within Basic.( ....) Id will not refer to your functor's argument
<George>
hmm, ok. it doesn't. But I will double check
<companion_cube>
smondet: yes, you're right
tidren has joined #ocaml
<George>
oh, man, smondet, you are right
<George>
the problem was with false
<George>
so far!
<companion_cube>
that's how you know the true expert
<George>
that is right
<George>
so, if I want to pass a Boolean as the value, what can I do?
<companion_cube>
{ ...; some_field=false }
<George>
oh, yes
englishm_ has quit [Remote host closed the connection]
<George>
another question. Can I have optional parameter as functor's parameter
<George>
?
englishm has joined #ocaml
<Kakadu>
I've never seen such thing
<companion_cube>
I don't think so
<companion_cube>
but you can provide two functors, one that takes the optional parameter and the other that is applied to the default module
<companion_cube>
module type S = ... module MakeFull(X : FOO)(Y : BAR) module MakeDefault(Y : BAR) = MakeFull(DefaultX)(Y)
<George>
great, thanks
travisbrady has quit [Quit: travisbrady]
englishm has quit [Remote host closed the connection]
troutwine_away is now known as troutwine
pminten has joined #ocaml
englishm has joined #ocaml
englishm has quit [Ping timeout: 260 seconds]
jonludlam has quit [Ping timeout: 260 seconds]
agarwal1975 has joined #ocaml
englishm has joined #ocaml
enquora has joined #ocaml
troutwine is now known as troutwine_away
avsm has joined #ocaml
jonludlam has joined #ocaml
zpe has joined #ocaml
zpe has quit [Ping timeout: 260 seconds]
hausdorff has quit [Remote host closed the connection]
Gonzih has joined #ocaml
travisbrady has joined #ocaml
tidren has quit [Remote host closed the connection]
tidren has joined #ocaml
tani has joined #ocaml
<ygrek>
flux, the problem in webcamviewer is that gc collects Curl.t while it is still in use (this is indicated by "handle leaked" message)
<ygrek>
if you keep the reference to it - everything works fine
eikke__ has quit [Ping timeout: 255 seconds]
jwatzman|work has joined #ocaml
<ygrek>
this worked in 0.6.1 because Curl.t didn't have a finalizer
<ygrek>
still have to investigate why it segfaults
tane has quit [Ping timeout: 240 seconds]
<ygrek>
I suggest that you fix the program to track Curl.t and properly destroy when it is not needed anymore
<ygrek>
thanks for the bugreport (proper issue on github would be cool)
olauzon has joined #ocaml
arjunguh_ has joined #ocaml
tidren has quit [Ping timeout: 272 seconds]
arjunguha has quit [Ping timeout: 245 seconds]
_0xAX has joined #ocaml
George has quit [Ping timeout: 246 seconds]
hausdorff has joined #ocaml
tani has quit [Quit: Verlassend]
AltGr has left #ocaml [#ocaml]
philtor has joined #ocaml
ollehar has joined #ocaml
arjunguh_ has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
avsm has quit [Quit: Leaving.]
jonludlam has quit [Remote host closed the connection]
ygrek has quit [Ping timeout: 255 seconds]
avsm has joined #ocaml
Hannibal_Smith has joined #ocaml
avsm has quit [Client Quit]
philtor has quit [Ping timeout: 240 seconds]
troutwine_away is now known as troutwine
q66 has joined #ocaml
pminten has quit [Remote host closed the connection]
ygrek has joined #ocaml
Kakadu has quit [Ping timeout: 246 seconds]
troutwine is now known as troutwine_away
hhugo has quit [Quit: Leaving.]
zpe has joined #ocaml
Gonzih has quit [Remote host closed the connection]
travisbrady has quit [Quit: travisbrady]
philtor has joined #ocaml
travisbrady has joined #ocaml
<whitequark>
oh cool, I can do let argn k i = Printf.sprintf (match k with `Lhs -> "lhs%d" | `Rhs -> "rhs%d") i
<whitequark>
H-M is magic
arjunguha has joined #ocaml
teiresias has quit [Ping timeout: 256 seconds]
morphles has quit [Ping timeout: 250 seconds]
<flux>
ygrek, hmm, my first attempt even before worrying about it was putting a global to reference http, but I didn't try keeping a reference to http_mt, was that the issue? thanks for the analysis, I'll try playing with it a bit.
travisbrady has quit [Quit: travisbrady]
travisbrady has joined #ocaml
dsheets has quit [Ping timeout: 240 seconds]
struktured has quit [Ping timeout: 240 seconds]
Muzer has quit [Excess Flood]
Muzer has joined #ocaml
teiresias has joined #ocaml
jao has joined #ocaml
hausdorff has quit [Remote host closed the connection]
jao has quit [Changing host]
jao has joined #ocaml
hausdorff has joined #ocaml
englishm has quit [Remote host closed the connection]
<agarwal1975>
anyone know how to represent base types such as “int”, “string”, and “unit” as Parsetree values?
<ygrek>
keeping the reference to curl.t was enough, http_mt seems fine
<whitequark>
def`: or -require ppx_tools.metaquot
<whitequark>
and [%type: int]
Muzer has quit [Excess Flood]
<whitequark>
which is much simpler ;D
<def`>
whitequark: not in my opinion :]
<agarwal1975>
def`: thanks, I was expecting unit to be a tuple of empty list, and other types to have explicit values for them, but I guess not….
<def`>
agarwal1975: well, you can make ocaml behave very strangely by redefining unit as the empty tuple (type unit = (), then it will tell you that () is not unifiable with ())
struktured has joined #ocaml
<def`>
agarwal1975: but that's not the case by default :)
englishm has quit [Remote host closed the connection]
<agarwal1975>
def`: that would be a new type, overriding the builtin unit, but yeah that’s not what I’m going for.
Muzer has joined #ocaml
englishm has joined #ocaml
Kakadu has joined #ocaml
arjunguha has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
<def`>
agarwal1975: yep, but this new type allow to introduce a new, unique, () value!
hausdorff has quit [Remote host closed the connection]
_andre has quit [Quit: leaving]
<agarwal1975>
def`: that is strange, but it doesn’t work for me in the toplevel. I get syntax error if I write “type unit = ();;”
<def`>
agarwal1975: with camlp4 or not?
<agarwal1975>
I just did #require “camlp4”, and get the same error.
<def`>
it's rejected by camlp4, not by the native parser
<agarwal1975>
oh.. so I need to *not* have camlp4. let me try.
<def`>
let x = () type unit = () let f () = () let () = f x;;
<agarwal1975>
def`: is this intentional? What’s the use of this, or is it a bug?
troutwine_away is now known as troutwine
hausdorff has joined #ocaml
<def`>
agarwal1975: I have no idea :), that nobody thought to catch "type t = ()" seems legit, but that the rule to type "()" get affected is beyond me
<agarwal1975>
def`: Even “type t = ()” is questionable. Seems like an omission in the parser. Type theoretically, a tuple of zero types can be considered unit, but apparently OCaml isn’t representing it that way, so I’d say “()” shouldn’t be accepted as a type expression.
stevej has joined #ocaml
<ggole>
Isn't () just a constructor name with the ordinary rules? (Except for the funny name.)
<ggole>
type wat = () of int * int;; () 1 2
<agarwal1975>
ggole: “()” is a value, but I didn’t think it was a type. def` has shown that it can be used as a type.
<ggole>
I don't see how that's the case.
<agarwal1975>
Your example shows it can be used as a “value constructor”. That is different from def’s example.
<def`>
agarwal1975: I agree
<def`>
ggole: the rhs of a type declaration expects… a type
pgomes has joined #ocaml
<ggole>
type unit = <constructor>
<ggole>
Isn't that what's going on?
<def`>
no
<def`>
type unit' = unit = ();;
<def`>
Ahah, accepted, with a manifest it gets even more confusing
<mrvn>
I think too that () gets parsed as Constructor and "type <ident> = <constructor> ..." is allowed
avsm has joined #ocaml
<def`>
it gets parsed as a type_expression, a 0-uple
<mrvn>
def`: type t = () of int
<def`>
mrvn: ah right :P
<agarwal1975>
mrvn, you’ve got it.
<mrvn>
type t = () of int | Foo of float
<ggole>
I'm willing to accept that, but I don't see any evidence in the above example
<def`>
"wtf"
<mrvn>
So () becomes a constructor token
<agarwal1975>
We’ve created a new variant type, which as “()” as a constructor.
troutwine is now known as troutwine_away
<mrvn>
# module () = struct end;;
<mrvn>
Error: Syntax error
<mrvn>
:(
<mrvn>
so () isn't parsed as <Ident>
arjunguha has joined #ocaml
<mrvn>
anyway, type t = () ... is surprising
arjunguh_ has joined #ocaml
<ggole>
It's a lot like true and false
<ggole>
Which are also valid constructor names. type unboolean = false | true;;
Denommus has quit [Ping timeout: 250 seconds]
<agarwal1975>
mrvn: yes, but less so now. It just means we chose a poor name for our constructor, nothing more fundamental is going on.
<def`>
mrvn: in term of the grammar, module expects a mod_longident, constructor a constr_ident
<def`>
mrvn: that's were "()" is distinguished
<ggole>
Although for some bizarre reason, type wat = true of int;; true 1 works, and type wat = true of int * int;; true 1 2 doesn't
<def`>
type unit = ::;;
<def`>
is another special case… A can't explain.
<def`>
I can't explain*
<agarwal1975>
ggole: you have to write true (1,2)
arjunguha has quit [Ping timeout: 260 seconds]
<ggole>
Oh, yeah
<Drup>
def`: having look recently at this part of the parser
<Drup>
() is a constructor
<ggole>
For some reason without the capital letter my brain didn't accept that as right.
<Drup>
same for ::
<Drup>
It's exactly the same than "type foo = Bar"
<ggole>
...because it looks like a function call, of course
<Drup>
just that the constructor is weird
<def`>
Drup: yeah yeah, I just checked
<Drup>
(I know, I changed all that :D
<Drup>
)
<def`>
"why, why, why"
<def`>
It's like… This case is just here to make things confusing.
<Drup>
def`: well, because "type 'a list = :: of 'a * 'a list | []
<ggole>
Except [] isn't a constructor
<Drup>
it's ... almost a constructor
* ggole
tried to overload list literals that way :(
<def`>
Drup: yes, but no.
<Drup>
(it was commented in the parser)
elfring has joined #ocaml
<def`>
Drup: list is defined in the predefined environment
<def`>
but maybe it used to be in pervasives
<Drup>
yes, it used to
<ggole>
option is too, right?
<ggole>
I assume this is because of optional arguments.
<Drup>
when they removed it, they commented the fact that you can redefine []
<Drup>
but not ::
<Drup>
x)
<ggole>
I was surprised to see that commented out in pervasives.ml
<ggole>
Shame pretty printing doesn't handle that case
<Drup>
yeah ...
<Drup>
the pretty printing code is a mess
<Drup>
I touched it just enough so that it at least output valid code
<def`>
Drup: it would be cool if, uhh, someone made a clean new implementation from scratch :)
ygrek has quit [Ping timeout: 260 seconds]
<Drup>
It would be cool indeed
hhugo has joined #ocaml
<Drup>
not rush however, we have quite some time before ocaml 4.03
<ggole>
Would it be hard to make #install_printer also accept values of type Format.formatter -> (Format.formatter -> 'a -> unit) -> 'a t -> unit, with the obvious meaning?
<Drup>
(and I'm not sure how much this patch would fit in the "doesn't change what ain't broken policy")
pjdelport has quit [Quit: Connection closed for inactivity]
troutwine is now known as troutwine_away
hausdorff has quit [Remote host closed the connection]
avsm has joined #ocaml
Anarchos has quit [Ping timeout: 240 seconds]
hausdorff has joined #ocaml
hhugo has quit [Quit: Leaving.]
Eyyub has joined #ocaml
avsm has quit [Client Quit]
Anarchos has joined #ocaml
_0xAX has quit [Remote host closed the connection]
tane has quit [Quit: Verlassend]
<algoriddle>
i just ran into an issue with pretty printing. there's an abstract type t and there exists a function that converts t to concrete_type (t -> concrete_type). concrete_type is something that toplevel can pretty print. I wish I could somehow convince the toplevel to use this function to convert the abstract type to concrete_type and then print it. Is this
<algoriddle>
possible?
<whitequark>
how do you call a function that performs a fold?
<whitequark>
e.g. (fun a b -> a ^ "1" ^ b)
hhugo has joined #ocaml
<whitequark>
a folder?
<bernardofpc>
accumulator ?
<bernardofpc>
(unfortunately, this overloads the meaning of b)
<bernardofpc>
"acc fun", I'd say
<bernardofpc>
it's a long name, but it's a precise name
<whitequark>
I want a short one
arjunguha has joined #ocaml
<algoriddle>
you mean a function that can be passed to a fold?
<bernardofpc>
'a -> 'b -> 'b
<Drup>
whitequark: I call them all "aux"
<def`>
aux, step, or reducer
<Drup>
sometimes with a suffix, if I want them to have a distinctive name during profiling
<def`>
but I don't know any "formal" name
<whitequark>
context: I want a predefined function that does fun x a b -> [%expr [%e a]; [%e x]; [%e b]]
<whitequark>
to curry x in and pass it to (almost) fold_left
<Drup>
oh
jludlam has joined #ocaml
<whitequark>
seq_reduce sounds good
<bernardofpc>
foldifier ?
<def`>
foldificator*
<bernardofpc>
y somewhere ?
<def`>
(:P)
arjunguh_ has quit [Ping timeout: 272 seconds]
<bernardofpc>
I could bikeshed "reduce" because of (fun x acc -> x::x::x::acc)
<Drup>
whitequark: the function is exposed ? reused ?
jonludlam has joined #ocaml
<whitequark>
exposed in Ppx_deriving
<whitequark>
this is very very common
<whitequark>
practically in every deriving at least three times
<whitequark>
(variants, tuples, records)
<Drup>
chain_seq ?
jonludlam has quit [Client Quit]
jludlam has quit [Client Quit]
<whitequark>
chain?
<Drup>
seq_reduce is indeed good
<Drup>
well, it's chaining, along b
<whitequark>
yes, seq_reduce is what I'll use
<bernardofpc>
why "seq", by the way ?
<Drup>
because it produces a sequence
<Drup>
foo ; bar ; baz
<bernardofpc>
oh, the ";" is a syntactical ;
<Drup>
whitequark: shame it's out of order, it would be a lift3 otherwise
<algoriddle>
so it combines expressions to a new expression? (+) should then be renamed to number_reduce :-)
<def`>
mappend
<Drup>
hum, not lift
<whitequark>
there's also: (** [binop_reduce] ≡ [fun x a b -> [%expr [%e x] [%e a] [%e b]]]. *)
hhugo has quit [Quit: Leaving.]
<whitequark>
I wonder how much will ppx_protobuf shrink...
johnnydiabetic has quit [Quit: Goodbye]
hhugo has joined #ocaml
<ggole>
algoriddle: #install_printer?
ollehar has quit [Ping timeout: 250 seconds]
Eyyub has quit [Ping timeout: 264 seconds]
<algoriddle>
ok, but I don't want to write a pretty printer for concrete_type, I just want to tell the toplevel to use its own facilities of printing concrete_type when it encounters type t
<whitequark>
I suppose toplevel could derive that automatically
<whitequark>
or you could just use [@@deriving Show]
dant3 has quit [Remote host closed the connection]
<lgm>
Thanks!
chris2 has joined #ocaml
<whitequark>
meh
chris2 has quit [Client Quit]
chris2 has joined #ocaml
avsm has quit [Quit: Leaving.]
Kakadu has quit [Quit: Konversation terminated!]
ollehar has quit [Ping timeout: 250 seconds]
travisbrady has quit [Quit: travisbrady]
jao has quit [Ping timeout: 256 seconds]
manizzle has joined #ocaml
jprakash has joined #ocaml
Thooms has joined #ocaml
<whitequark>
Drup: so. a complete, readable @@deriving Show is 117 lines
<whitequark>
I think that's pretty great
<Drup>
:)
troutwine_away is now known as troutwine
Submarine has quit [Quit: Leaving]
maattdd has joined #ocaml
<whitequark>
Drup: TEST IT OUT ALREADY
<whitequark>
(ahem)
<whitequark>
honestly I feel that deriving Show could be a good motivation for switching to 4.02, because it absolutely would for me
<whitequark>
every language I know has a simple way to just print a damn value for debugging
<whitequark>
except ocaml
<whitequark>
no, "with sexp" is not what I want, not even remotely
<flux>
oh yeah, well assembler doesn't!
<flux>
:-)
<Drup>
whitequark: I'm working !
* whitequark
casts a heavy stare at flux
<whitequark>
well, who am I to criticize a programmer for taking things literally
<Drup>
let me debug my termination checker x)
englishm has quit [Remote host closed the connection]
<whitequark>
are you solving the halting problem?
<flux>
I suppose assembler is not a great company to be with for a language like OCaml.
<whitequark>
flux: okay, well, javascript doesn't
<Drup>
whitequark: only for restricted class of functions =°
<whitequark>
that's because it's javascript
englishm has joined #ocaml
<whitequark>
before I switched from ocaml to ruby, I never realized just how much did I use `p'
<whitequark>
(which is the equivalent of auto-derived Show, more or less)
<companion_cube>
Drup: stop reinventing the wheel, there are a lot of termination checkers
<Drup>
I know, but mine is more efficient
<whitequark>
famous last words
<Drup>
(and I'm doing research, I have the right to reinvent the wheel)
<companion_cube>
more efficient??
<companion_cube>
is it a termination checker for rewriting?
<Drup>
no, for programs, duuuh.
<Drup>
termination checker for rewriting are useless
<companion_cube>
I thought you could reduce program termination checkers into rewriting termination checkers ^^
<companion_cube>
might be easier for functional languages though
<Drup>
sure, if you don't care about applying your termination checker to real program, you can >_>
troutwine is now known as troutwine_away
<Drup>
anyway, back to debuging
<companion_cube>
that might work for haskell though
englishm has quit [Ping timeout: 255 seconds]
agarwal1975 has quit [Quit: agarwal1975]
<bernardofpc>
maybe that's one for HoTT ?
mort___ has joined #ocaml
arjunguha has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
Thooms has quit [Ping timeout: 255 seconds]
kanzaros has joined #ocaml
rom1504 has joined #ocaml
maattdd has quit [Ping timeout: 240 seconds]
eikke__ has joined #ocaml
thomasga has joined #ocaml
tobiasBora has joined #ocaml
<aggelos_>
hmm, when I find myself having to use first-class modules where I pass in modules A, B, where the sig of A includes a module with sig B, but I need to add a constraint on B.t, I guess I'm doing something terribly wrong?
<aggelos_>
those modules sort of evolved over a period of months, I'm afraid I painted myself into a corner now
<Drup>
self-evolving modules :D
<Drup>
a new life form has been discovered :3
agarwal1975 has joined #ocaml
<Drup>
aggelos_: if you *really* want to do that
FreeArtMan has quit [Ping timeout: 250 seconds]
Hannibal_Smith has quit [Quit: Sto andando via]
<Drup>
you could use a functor somewhere after unpacking your modules
<Drup>
I'm not sure at all how it will interact with first class modules, though
<aggelos_>
Drup: well I don't /have/ to use first class modules, so I'm playing with a functor atm
<Drup>
then you're fine.
<Drup>
whitequark: if I have a block b and a phi in one of the successor of b, does the phi is part of the users of b ?
<whitequark>
you so butchered that sentenc
<whitequark>
but yeah, if phi refers to a block, it appears in the list of users of that block
<Drup>
grmbl
<Drup>
so, to get the list of predecessors of a block, I need to take all the users and filter out the phis ?
oriba has joined #ocaml
<whitequark>
um
<whitequark>
there's also blockaddress()
<whitequark>
take all the users and only leave br, condbr, invoke.
<whitequark>
and indirectbr
<oriba>
I try to compile a lablgtk-program with OCamlMakefile. It seems without linking "gtkInit.cmo", the program crashes. How do I say my Makefile that "gtkInit.cmo" will be used too?
<Drup>
whitequark: how would block adress help me ?
<whitequark>
it would not
<whitequark>
rather the opposite
<Drup>
oh, ok, right
<Drup>
it's slightly annoying :/
<Drup>
whitequark: basically, you are telling me to keep only terminators ?
<whitequark>
yes
<whitequark>
exactly
<Drup>
which make a good amount of sens.
<Drup>
hmm, I should add a "is_terminator" function to the api
<whitequark>
yes
<whitequark>
there's even a C function I think
<whitequark>
and I think we could add more OCaml-implemented functions to the binding, it doesn't have to be as thin
<Drup>
I would prefer to avoid implementing "is_terminator" on the ocaml side, because it means that if there is a new terminator, it needs a fix
<Drup>
the C api will be updated by default, the ocaml one ...
<whitequark>
oh, you can implement it via classify_value
<Drup>
\o/
<Drup>
I always forgot about this function
<Drup>
oh, but, hm
<Drup>
I'm not sure
mort___ has quit [Quit: Leaving.]
<Drup>
(gaah, we need subtyping here)
* Drup
inserts poly variants.
troutwine_away is now known as troutwine
tobiasBora has quit [Quit: Konversation terminated!]
mort___ has joined #ocaml
Sim_n has quit [Read error: Connection reset by peer]
Sim_n has joined #ocaml
struktured has joined #ocaml
tobiasBora has joined #ocaml
mort___ has quit [Ping timeout: 240 seconds]
avsm has joined #ocaml
avsm has quit [Client Quit]
<Drup>
whitequark: related question : what is the quickest path to checking some block has no successor ?
<Drup>
I was going to match the terminator and rule out Br/IndirBr
philtor has joined #ocaml
troutwine is now known as troutwine_away
rand000 has quit [Quit: leaving]
<whitequark>
Invoke allows a successor
<whitequark>
the only blocks without successors are unreachable and ret
<Drup>
ok
jsvgoncalves has quit [Remote host closed the connection]
<whitequark>
the Llvm API really should have functions for that
<whitequark>
you should contribute them or something :D
<Drup>
yeah
<Drup>
first I write them and use them, after I will think about putting them somewhere sensible in the API :p
<Drup>
whitequark: why does "block_terminator" returns an option ? in which case a block has no terminator ?
<Drup>
ill-formated bitcode ?
<whitequark>
if it's still in construction
<Drup>
hum, right
<whitequark>
surprisingly, llvm chose to not segfault here
<Drup>
wow :3
<aggelos_>
Drup: FYI I named the functor has the tentative name HackMeUpScotty
<aggelos_>
as in "KMN, Scotty" :P
<Drup>
come on, type constraints on modules inside functors aren't so terrible :D
Sim_n has quit [Quit: Leaving]
hausdorff has quit [Remote host closed the connection]
shinnya has quit [Ping timeout: 255 seconds]
tobiasBora_ has joined #ocaml
tobiasBora has quit [Read error: Connection reset by peer]
darkf has joined #ocaml
jabesed has joined #ocaml
thomasga has quit [Quit: Leaving.]
shinnya has joined #ocaml
madroach has quit [Ping timeout: 250 seconds]
madroach has joined #ocaml
eikke__ has quit [Ping timeout: 250 seconds]
enquora has quit [Quit: enquora]
* whitequark
glares at [%expr (&&)]))]] in his code
<whitequark>
that's some Perl-level readability.
philtor has quit [Ping timeout: 256 seconds]
<tobiasBora_>
In can't run a bytecode on Mac and Windows because of an error "unknow C primitive 'wait_pid'", however I read the unix/Lwt/Batteries doc and I don't see which function I use could give this error
<tobiasBora_>
The only function which is "touchy" is Lwt_process.pread but in the Lwt_process doc I don't see any problem on others systems...
<Drup>
whitequark: "lightweight" is not the middle name for ppx :(
<whitequark>
it's fairly lightweight actually
<whitequark>
compared to camlp4 at least
hausdorff has joined #ocaml
<Drup>
in camlp4, it would have been << (&&) >>, no ?