<keep_learning>
octachron: No, did you mean ocamlbuild -use-menhir -package pp_nameoftype calc.byte ?
<ggole>
In trying to allow access to constructor arguments, I've found myself wanting a type that is basically ... -> 'a, for any chain of arguments ...
<keep_learning>
octachron: or Format.printf "%a@." pp_nameoftype e ?
<octachron>
yes, if I read it correctly ppx_deriving convention is to suffix the name of type to the name of the function so pp -> pp_typename
<ggole>
It can be done with GADTs, but the resulting type variable isn't really usable. You can't instantiate it with a particular type, or at least I can't figure out how to.
<companion_cube>
I think you can try to take some inspiration in format strings
<ggole>
So the approach I've taken is to use modules to represent an argument list ending in 'a as a type 'a t in a module Args
<ggole>
But now that needs to contain a Type.t, so I've got recursive modules. :/
<octachron>
ggole: do you mean something like ('a -> 'b -> 'c -> 'd -> 'e) with an access to the last type argument 'e ?
<ggole>
Yep.
<companion_cube>
I think format does this kind of stuff, yes
<companion_cube>
the return type is present in format4's arguments
<octachron>
In this situation I generally just store 'e in a separated parameter:
<companion_cube>
I'm not sure, does your GADT include information about how to build values of type 'a ?
<ggole>
Not this one
<companion_cube>
then you can't copy
<ggole>
Right, that's the problem
<ggole>
I have either print or copy, but not both
<companion_cube>
in the sum (and product) case, you need to add a function in the record, that explains how to build each variant
<ggole>
I *think* that the problem boils down to representing ... -> 'a in a way that can be nicely unified with ... -> s (for a sum type s)
<companion_cube>
can't you take a hlist as parameter?
<companion_cube>
(for each sum variant)
<ggole>
I am, in the second paste
Aang4chi has joined #ocaml
dsheets has joined #ocaml
<ggole>
companion_cube: oh, in the first paste that's what I'm trying to do
<ggole>
Eg, put a Type.t in Arg. But the hlist ends up crossing module boundaries, which kills me.
<companion_cube>
hmm, just define all your GADT at the same place and re-export them in Arg and Type
<keep_learning>
octachron: did you mean pp_typename by pp_prog ( the type of my abstract syntax tree ) ?
MercurialAlchemi has joined #ocaml
<keep_learning>
Format.printf "%a@." pp_prog e still complaining about Error: Unbound value pp_prog
<companion_cube>
we've been talking about making a generic 'a ty type, with a ppx_deriving
<companion_cube>
ggole: would you be interested?
<ggole>
Yeah, that's pretty much the same thing I'm struggling with at the moment
<companion_cube>
I can't find an old snippet gasche gave me
<companion_cube>
:(
arquebus has joined #ocaml
<lewis1711>
is there a way to load multiple modules at once? I can't even separate "#mod_use" with ;;.
rand000 has joined #ocaml
<companion_cube>
grrr, reading old batteries-devel mails
<companion_cube>
sad :/
<octachron>
keep_learning, yes. I think that the error is that you should use the ppx_deriving.std package rather than ppx_deriving
<keep_learning>
octachron: Still error. Sorry I am new to ocaml. ocamlbuild -use-menhir -package ppx_deriving.std calc.byte Error: Unbound value pp_prog
<keep_learning>
Format.printf "%a@." pp_prog e
MrScout has quit [Ping timeout: 246 seconds]
<ollehar>
keep_learning: don't you need to include package ppx_deriving.show?
<keep_learning>
ollehar: You mean ocamlbuild -use-menhir -package ppx_deriving.std -package ppx_deriving.show calc.byte ?
<ollehar>
yeah
<keep_learning>
still the same error
<ollehar>
keep_learning: can you compile without printf pp_prog, or do you get missing pp?
jeffmo has joined #ocaml
<keep_learning>
ollehar: yes, it's compiled without Format.printf "%a@." pp_prog e
<ollehar>
keep_learning: oh, so how about printf "%s" (show_prog prog)?
<keep_learning>
ollehar: Error: Unbound value show_prog
<keep_learning>
Format.printf "%s" (show_prog e)
<keep_learning>
e is parse tree
<ollehar>
hm ok
<ollehar>
but you didn't add [@@deriving show] to the parse tree definition?
<octachron>
keep_learning: Sorry, I missed that, you need to use Ast.pp_prog
<ollehar>
try:
<ollehar>
type prog = command list
<ollehar>
[@@deriving show]
<ollehar>
| Incv | Decv
<ollehar>
and command =
<ollehar>
| Incp | Decp
<ollehar>
| Input | Output
<ollehar>
| Loop of command list
<ollehar>
[@@deriving show]
<ollehar>
AND in your Ast module, add [@@deriving show] to the types.
<companion_cube>
but building records it tough too
<ollehar>
oh, that's the top of the file, sorry ^^
arquebus has quit [Quit: konversation disconnects]
ygrek_ has quit [Ping timeout: 240 seconds]
<octachron>
ollehar: [@@deriving show] apply to the whole set of definitions so having only one is fine
keep_learning has quit [Ping timeout: 246 seconds]
keep_learning has joined #ocaml
<keep_learning>
ollehar: Sorry got disconnected.
<keep_learning>
adding [@deriving show} is not making any difference.
<keep_learning>
type prog = command list [@@deriving show] and command = | Incv | Decv | Incp | Decp | Input | Output | Loop of command list [@@deriving show]
<keep_learning>
Error: Unbound value show_prog
<companion_cube>
do you use 4.02.2 ?
<keep_learning>
companion_cube: I am using OCaml version 4.02.1
<companion_cube>
that might be the issue, extension points have changed
<companion_cube>
and the newest ppx_deriving is tailored for 4.02.2
<ggole>
Error: Cannot safely evaluate the definition of the recursively-defined module Arg, great
<ggole>
I'm only defining a module TYPE, there's not even any values -_-
<companion_cube>
I think you really should avoid recursive modules
<ggole>
I would love to, but I seem to need something like HKTs :/
kushal has joined #ocaml
Simn has quit [Ping timeout: 256 seconds]
yomimono has joined #ocaml
sivoais has quit [Ping timeout: 244 seconds]
<ggole>
Wait, it was something else
<companion_cube>
ggole: did you take a look at my gist?
<companion_cube>
(it's heavy, but it should be quite powerful)
sivoais has joined #ocaml
<ggole>
Yeah, I'm looking at it now
<ollehar>
keep_learning: ok, strange. maybe you should try to update first, but also try just to compile only ast.ml with let _ = printf "%s" (show_prog (prog def here...))
<companion_cube>
I'm writing a print function right now
<ggole>
Hmm, rather than native functions you "interpret" hlists
<ggole>
Maybe that's the way to go...
<companion_cube>
that's more flexible, I think, but slower
<companion_cube>
unless flambda saves us all!!
<ggole>
I'll see how far I get with this
<companion_cube>
(it could, it's basically a lot of unrolling)
<companion_cube>
ggole: are you writing a lib?
<ggole>
Just a toy atm
<companion_cube>
on github, I mena
<companion_cube>
okj
<ggole>
It piqued my interest because it's basically an open-ended runtime version of deriving
<companion_cube>
heh
lopex has joined #ocaml
<keep_learning>
ollehar: I wrote this small code in ast.ml let _ = Format.printf "%s" (show_prog ([Incv, Incv]))
<ggole>
And now I'm fighting with the type checker and don't want to admit defeat
<Drup>
I banged my head against the issue in line 19 quite hard already. The problem boils down to the fact that you can't lift the value restriction over 'ret in t because it is not covariant and I didn't found another way to solve it
<Drup>
Algebr: yes, tyxml's type system is a bit akward. I agree :)
ggherdov has quit []
aurynj has joined #ocaml
<companion_cube>
ggole: I will try; it's more difficult because you also need to build values
<companion_cube>
but I think it's possible
manud has joined #ocaml
<ggole>
companion_cube: I think you need to chain closures: that's how I did it, anyway
<ggole>
afk for a while, I'll come back and take another crack at it later.
<ggole>
Thanks for the responses everyone.
<Drup>
ggole: If you find a way to represent the same type but manage to avoid the value restriction, I'll grateful :D
<Drup>
+be
ggherdov has joined #ocaml
grouzen has quit [Ping timeout: 255 seconds]
<Drup>
keep_learning: did you tried in 4.02.2 ?
<keep_learning>
Drup: no
<Drup>
because, well, it works for me.
<keep_learning>
Drup: Let me try.
<Drup>
Ah !
<Drup>
keep_learning: Add "-use-ocamlfind" as first argument of ocamlbuild
<keep_learning>
Drup: Thank you, It's working with 4.02.1 also
<ollehar>
hah
ngram has quit [Ping timeout: 246 seconds]
Simn has joined #ocaml
Aang4chi has left #ocaml ["ERC (IRC client for Emacs 24.5.1)"]
voglerr has quit [Remote host closed the connection]
octachron has quit [Ping timeout: 246 seconds]
voglerr has joined #ocaml
<ggole>
omfg it works
<ggole>
This may be the most horrible OCaml code I've written since that in-place string truncation that used Obj!
tnguyen has joined #ocaml
grouzen has joined #ocaml
<ggole>
A resounding victory over the type checker and good taste: think I'll celebrate by having dinner.
Haudegen has joined #ocaml
<pippijn>
ggole: what did you do?
mankyKitty has quit []
mankyKitty has joined #ocaml
octachron has joined #ocaml
sspi has quit []
sspi has joined #ocaml
Haudegen has quit [Ping timeout: 255 seconds]
Haudegen has joined #ocaml
hao has joined #ocaml
badkins has joined #ocaml
jeffmo has quit [Quit: jeffmo]
jabesed has quit [Ping timeout: 246 seconds]
ztennix has joined #ocaml
jtfmumm has joined #ocaml
tane has joined #ocaml
Haudegen has quit [Ping timeout: 260 seconds]
yomimono has quit [Ping timeout: 250 seconds]
ztennix has quit [Ping timeout: 250 seconds]
hao has quit [Ping timeout: 240 seconds]
Haudegen has joined #ocaml
Haudegen has quit [Remote host closed the connection]
MrScout has joined #ocaml
Immanuel_ has joined #ocaml
Haudegen has joined #ocaml
octachron has quit [Quit: Leaving]
<Immanuel_>
I have a question related to private type abbreviations
<Immanuel_>
I'm interfacing C++ and ocaml and I want to make sure that the ranges of integer types are correct
jeffmo has joined #ocaml
<Immanuel_>
So I define
<Immanuel_>
uint8 = private int
<Immanuel_>
and int8 = private int
<Immanuel_>
and the appropriate functions to do range checking...
Haudegen has quit [Remote host closed the connection]
<Immanuel_>
Now I wanna check my code
<Immanuel_>
for all the types I wanna use 1 checking function something like this:
<Immanuel_>
let test_conversions (the_fun : int -> 't) (the_val : int) = try let the_t = the_fun the_val in Printf.printf "Numbers are %d\n" (the_t : 't :> int) with | Invalid_argument str -> Printf.printf "Error: %s" str
MrScout has quit [Ping timeout: 246 seconds]
<Immanuel_>
and call that with the relevant constructor and a value to cast...
<Immanuel_>
Now this doesn't typecheck because the type var 't in the signature is too general... what I need to put there is "A type coercible to int"
<Immanuel_>
Is that possible?
osheeta has left #ocaml ["WeeChat 1.1.1"]
Haudegen has joined #ocaml
<companion_cube>
there is no "coercible to int", you just call a function foo -> int, for any foo (if it exists)
<companion_cube>
if you want a relatively safe type for uint8, for instance, you can do module UInt8 : sig type t = private int val make : int -> t option end = struct type t = int let make i = if i>=0 && i < 256 then Some i else None end
<ggole>
companion_cube: so what's the goal, a reflection library for 'generic' programming in terms of 'a ty?
toolslive has quit [Ping timeout: 256 seconds]
Haudegen has joined #ocaml
<ollehar>
is `ty` a keyword or something??
<companion_cube>
no, it's not
<ollehar>
hm no, I get it
<companion_cube>
here we just define a type 'a ty
<ollehar>
mhm
jtfmumm has quit [Quit: My MacBook Pro has gone to sleep. ZZZzzz…]
<companion_cube>
the goal is to have ppx_deriving generate the definition of foo ty from the definition of foo
<ollehar>
cool!
<Drup>
ggole: I just said to jeremy "I don't want all the otherworldly modules leaking out in the combinator library". I think this affirmation would perfectly apply to your success.
ollehar has quit [Quit: ollehar]
<ggole>
Indeed.
<ggole>
I was just thinking about how to sweep them out of sight.
<ggole>
But check out those annotations on Arg! Just wonderful stuff.