<smtb>
I thought that I could use ~name:(`One "name_goes_here")
<Drup>
No, that's not how you do forms
<Drup>
basically, you create a function taking the various parameters of the form as parameters of the function (and they also correspond to parameters of the service you want to build). Then you pass this function to get/post_form.
<smtb>
Maybe I am going about this the wrong way. Lets say I am just trying to build a page with only a button that says "google" and links to "www.google.com" when pressed. Is string_button the best way to go about this?
<smtb>
basically I am just trying to replicate the <button> tag
mcclurmc has joined #ocaml
<Drup>
eliom's fancy form thingy is slightly overkill for that :D
<Drup>
you can use the function Eliom_content.Html5.F.Raw.button if you don't want anything fancy and just the direct html element
<smtb>
Is is not achievable with string_button?
<smtb>
I am just trying to learn how to replicate different html elements right now. I just started using Eliom
mcclurmc has quit [Ping timeout: 245 seconds]
<Drup>
It's achievable, it will just be a bit akward. You will have first to create an external service linking to www.google.com then use this service with the form.
nojb has joined #ocaml
rgrinberg has quit [Quit: Leaving.]
<smtb>
So I have to use string_button in a form context? I cant just use it like div, h2, p, etc... when I register a service ?
<Drup>
I don't understand the question.
<Drup>
oh, right
<Drup>
yes.
<smtb>
Yes I can use is just like div?
<Drup>
Yes you have to use it in a form context
<Drup>
if you want a button out of a form context, use Raw.button
<Drup>
It's here for that.
<smtb>
Ok thanks for the help, I will go back and read more about form use.
<Drup>
no problem :)
marynate has quit [Read error: Connection timed out]
rgrinberg has joined #ocaml
skchrko has quit [Ping timeout: 264 seconds]
rgrinberg has quit [Quit: Leaving.]
rgrinberg has joined #ocaml
ygrek has joined #ocaml
skchrko has joined #ocaml
c74d has quit [Read error: Connection reset by peer]
uris77 has quit [Quit: leaving]
marynate has joined #ocaml
marynate has quit [Ping timeout: 255 seconds]
c74d has joined #ocaml
c74d has quit [Read error: Connection reset by peer]
c74d has joined #ocaml
nojb has quit [Quit: nojb]
nojb has joined #ocaml
nullcat has joined #ocaml
enitiz has quit [Quit: Leaving]
nojb has quit [Quit: nojb]
anemator has joined #ocaml
anemator has quit [Client Quit]
samrat has joined #ocaml
samrat has quit [Ping timeout: 250 seconds]
samrat has joined #ocaml
vanila has quit [Quit: Leaving]
<nullcat>
can someone explain why 'a is contravariant and 'b is covariant in " type (-'a, +'b) t = 'a -> 'b "
chinglish has quit [Quit: Nettalk6 - www.ntalk.de]
<nullcat>
Drup "Thus, vegetable soup recipes are a subtype of tomato soup recipes." Whaat... i got confused. Is it a typo?...
<nullcat>
Shouldn't it be "tomato soup recipe is a subtype of vegetable soup recipes"
<Drup>
No typo.
<nullcat>
umm. seems that I always mix the meaning of "subset" into "subtyping". let me think it over...
marynate has joined #ocaml
marynate has quit [Max SendQ exceeded]
marynate has joined #ocaml
<nullcat>
it's good to have some daily life example to make a better understanding. But what if I have a very complex type def of a function to think about? Is there any formal method?
marynate has quit [Max SendQ exceeded]
marynate has joined #ocaml
<Drup>
oh sure, On complex examples, it's easier to reason about it with the rules (which are, if 'a t is covariant, then 'a :> 'b => 'a t :> ' b t. If 'a t is contravariant, then 'a :> 'b => 'a t <: 'b t)
<nullcat>
Drup eureka! thx
<nullcat>
i see
<nullcat>
"I notice that in English, the word “of” indicates covariance, while the word “for” indicates contravariance. For example, “Soup” is covariant: tomato soup is soup of tomatoes. “Recipe” is contravariant: tomato soup recipe is recipe for tomato soup." this comment is precious
<Drup>
I tend not to rely on natural languages to think about formal systems, because it's as often wrong as it is right, *especially* english.
<nullcat>
um thx for the advice
<Drup>
(English is very very inconsistent ...)
<nullcat>
em...
<nullcat>
i have "types and programming language" by my side. I think it's time to read it
marynate has quit [Ping timeout: 240 seconds]
marynate has joined #ocaml
tane has joined #ocaml
matason has joined #ocaml
kapil__ has quit [Quit: Connection closed for inactivity]
<whitequark>
gasche: why can't ocamldep look into cmis?
<def`>
whitequark: because cmis don't exist yet when you compute dependencies
<whitequark>
why can't they exist?
<whitequark>
this seems like a buildsystem issue and not compiler
<def`>
you compute the dependencies in order to build the cmis, not the otherway around?!
<pippijn>
whitequark: what would become better if it could?
<whitequark>
pippijn: no spurious dependencies
<whitequark>
but def` is right
<whitequark>
if you have open in a mli, you need to pause looking at current mli, compute cmi for that referenced module, then start again
<def`>
yep, to be precise, you really need to interleave typechecking and dependency computation… That's likely not worth the effort
<def`>
For the problem on the mailing-list… I think just making sure that the actual filename matches the module name could be enough
<def`>
(E.g when looking for BAR, the filesystem returns bar.ml, when looking for Bar, the filesystem returns bar.ml, ocamldep considers that modules exist for both BAR and Bar, although compilation will never succeed when taking bar.ml as BAR)
<def`>
(a ugly workaround coming to my mind would be to either readdir or fctnl(fd, F_GETPATH, _) and check that the actual filename matches)
<mrvn>
The sane way to do dependencies is to output them as a side effect of compiling.
<def`>
yep, actually it might not be as hard as gasche says -- just output global module names is you search for them
<def`>
pause compilation, resume compiler after the dependency is solved. But, is it cleaner…
<mrvn>
In ocaml modules have to be compiled in the right order, or not?
<def`>
what do you mean? compilation order doesn't matter as long as dependencies are satisfied
<def`>
(-> linking order does matter though :))
RossJH has joined #ocaml
<mrvn>
def`: if Foo depends on Bar then Foo.ml(i) can't be compiled before Bar.mli
<def`>
yes
<mrvn>
That is a problem for generating depends as side effect.
<def`>
unless you consider that all requested modules go though Env.read_pers_struct (typing/env.ml)
<def`>
it's the place where you can output a request and wait for it to either resume compilation or fail
contempt has quit [Remote host closed the connection]
<mrvn>
"output a request"? Like have a compile-daemon and throw all files at it and it will sort them as needed?
<def`>
yes
<pippijn>
javac does that
<pippijn>
javac finds all dependencies in the file system by itself
<def`>
if java does it, it must be a good practice :D
<pippijn>
def`: I don't see a problem with that way
<pippijn>
but I haven't thought about it much
<def`>
well, it's just putting more work in the compiler (to make the frontend more user-friendly… this, in general, is a good goal)
<def`>
the trickiest part I can see is that the control flow between compiler and build-system is now much more complicated (not something unix IPCs are good for)
<pippijn>
yes
<pippijn>
that is true
<mrvn>
In ocaml that can be a problem. Sources can be generated from mly/mll (or other tools), need ppx or camlp4. The compiler might not be able to understand the depended on file.
<def`>
that's why you need support from buildsystem
<def`>
the compiler will only output "I use Bar from lib/bar.cmi" or just "I need Bar, give me the path when it is ready"
<def`>
(well "will"… I am projecting a bit too much :P)
<mrvn>
def`: where does it get lib/ from?
<def`>
mrvn: include path if module is already compiled, build-system otherwise (that's the "complicated control flow" part)
<mrvn>
def`: lib/bar.mli might not exist yet
samrat has joined #ocaml
<def`>
mrvn: answer between parenthesis
<mrvn>
Worst case the compiler can only say "I'm looking for bar.cmi, gimme gimme gimme"
<def`>
the point is the compiler needs no knowledge of the filesystem as long as you can provide a cmi given a module name
<def`>
you can just stop the compiler, spawn another process producing this cmi, and resume
<mrvn>
diethyl: no, no, no. But it normaly works.
<mrvn>
ups
<mrvn>
ewin
<mrvn>
Thinking about it makes me realize that ocaml is maybe the worst language for this stuff
<def`>
build-system has been a problem for a long time ;)
<mrvn>
In C you just compile every *.c file on its own without care of order. YOu then can output the depends on .h files for rebuilds on change. In ocaml you need to topologically sort before/during build.
_5kg has quit [Ping timeout: 255 seconds]
<pippijn>
mrvn: that's one of the best parts of ocaml
<pippijn>
disallowing mutual dependencies by default
<pippijn>
I try to write my C++ code that way, as well
<pippijn>
as few mutual dependencies as possible
<mrvn>
pippijn: when you need it it is a big pain. recursive module syntax is ugly.
<pippijn>
in C++ (and java, and C), you often find that everything depends on everything
<def`>
I agree with pippijn, I like the semantics, but the compiler command is a bit crude (that's one of the things I found the most cryptic when beginning)
<pippijn>
def`: I made a build system for ocaml, but I still don't know the compiler command :)
contempt has quit [Remote host closed the connection]
<mrvn>
module M = struct type t = Foo | Bar end module type M = sig type t end module MAKE(M : M) : M with type t = M.t= struct type t = M.t end module N = MAKE(M) let x = N.Foo;;
<mrvn>
Error: Unbound constructor N.Foo
<mrvn>
Can I make it so N.Foo exists?
<def`>
(about the command, I would really like that such inter-process flows were natural and easy to express in UNIX…)
<pippijn>
mrvn: include M?
<def`>
(coming back to real world, smaller improvements on the command are possible and would be nice!)
<def`>
mrvn: you need to expose the constructors in the module type
<mrvn>
pippijn: nope
<pippijn>
module MAKE(M : M) : M with type t = M.t= struct include M end
<mrvn>
pippijn: ahh, up there.
<pippijn>
oh right
<pippijn>
it's not in M
<pippijn>
mrvn: do you need : M?
<pippijn>
I'm not sure you can
<pippijn>
unless you also put the type in the signature
<mrvn>
pippijn: same error wiht include in the functor
<pippijn>
yeah
<pippijn>
I thought so
<pippijn>
MAKE(M : M) <- this part doesn't know there is a Foo inside the passed module
<mrvn>
pippijn: without "(M : M)" it is a syntax error
<mrvn>
A functor needs a module type.
<pippijn>
mrvn: I know, I was thinking s/) : M/)/
<pippijn>
but that wouldn't help
bezirg has joined #ocaml
<mrvn>
pippijn: it's a syntax error. Needs to be (ModuleName : ModuleTypeName)
contempt has joined #ocaml
<pippijn>
mrvn: module MAKE(M : M) = struct include M end
<pippijn>
but it doesn't help
<pippijn>
because M is restricted to be M
<pippijn>
(you chose bad names)
<def`>
mrvn: if you add the Constructors to module type M, they will be available in N, and the equality between N.t and M.t won't be exposed
<def`>
otherwise, no way :)
<pippijn>
right
<pippijn>
14:00 < pippijn> unless you also put the type in the signature
<pippijn>
I meant the constructors
<mrvn>
def`: It's a functor. It's doesn't know what constructors the user might have
<pippijn>
you need to put the type definition in there
<pippijn>
mrvn: I don't think you can achieve what you want
<pippijn>
you need to redesign
<mrvn>
module N' = struct include M include N end
<mrvn>
Error: Multiple definition of the type name t.
<mrvn>
That doesn't work either. :(
<def`>
module N' = struct include M include (N : module type of N with type t := M.t) end
<def`>
lightweight, easy :D
<pippijn>
yeah
<mrvn>
module N' : sig type t = M.t = Foo | Bar val x : M.t end
<mrvn>
thx.
<def`>
I don't know how much expressivity would a module system need to express all thoses cases cleanly… Interesting question :).
<def`>
But I have to go, bye!
contempt has quit [Remote host closed the connection]
<mrvn>
def`: I think the functors "with type t = M.t " should already do that.
<def`>
mrvn: the problem here is that M has no such constructors
<def`>
so no, with type t = M.t can't do that
<mrvn>
but the "with" exposes the details ot M.t to the resulting module. It could expose the cosntructors too
<def`>
nop
<def`>
M has already been constrained to have type M, so M.Foo is no longer in M (your names :P)
<def`>
what would be needed is some way to express constraints on a module type while retaining the original module type
<mrvn>
def`: "constrained to have type M" would make it abstract. The "with" overrides that and makes it normal again.
<mrvn>
def`: so your argument falls flat
<def`>
sure
<mrvn>
def`: but if you don't like it there then "sig type t = ... end" could copy the constructors from input to output
contempt has joined #ocaml
contempt has quit [Remote host closed the connection]
<mrvn>
I think "with type t = M.t = ..." makes more sense. It's a special syntax for constraining modules without loosing the constructors.
lordkryss has joined #ocaml
AlexRussia has quit [Ping timeout: 264 seconds]
AlexRussia has joined #ocaml
nojb has quit [Quit: nojb]
govg has quit [Ping timeout: 244 seconds]
bezirg has quit [Ping timeout: 240 seconds]
contempt has joined #ocaml
_5kg has joined #ocaml
nojb has joined #ocaml
_5kg has quit [Ping timeout: 256 seconds]
contempt has quit [Read error: Connection reset by peer]
oscar_toro has joined #ocaml
nojb has quit [Quit: nojb]
contempt has joined #ocaml
bluebelle has joined #ocaml
ontologiae has joined #ocaml
huza has quit [Ping timeout: 240 seconds]
oscar_toro has quit [Ping timeout: 256 seconds]
bezirg has joined #ocaml
Hannibal_Smith has quit [Quit: Leaving]
Haudegen has quit [Ping timeout: 245 seconds]
contempt has quit [Remote host closed the connection]
pgomes has joined #ocaml
mort___ has joined #ocaml
azynheira has joined #ocaml
Haudegen has joined #ocaml
ggole has joined #ocaml
q66 has joined #ocaml
bluebelle has quit [Quit: Lost terminal]
fraggle_ has quit [Read error: Connection reset by peer]
mort___ has quit [Quit: Leaving.]
bezirg has quit [Ping timeout: 250 seconds]
samrat has quit [Quit: Computer has gone to sleep.]
_5kg has joined #ocaml
fraggle-boate_ has quit [Ping timeout: 244 seconds]
azynheira has quit [Quit: Leaving]
pgomes has quit [Quit: Leaving]
ggole has quit [Ping timeout: 244 seconds]
BitPuffin has joined #ocaml
baz_ has joined #ocaml
hugomg has joined #ocaml
Thooms has joined #ocaml
darkf has quit [Quit: Leaving]
arboris has quit [Remote host closed the connection]
fraggle-boate has joined #ocaml
_5kg has quit [Ping timeout: 264 seconds]
mort___ has joined #ocaml
baz_ has quit [Quit: baz_]
neutronest has joined #ocaml
nojb has joined #ocaml
contempt has joined #ocaml
ebzzry has joined #ocaml
chinglish has joined #ocaml
ontologiae has quit [Ping timeout: 240 seconds]
bezirg has joined #ocaml
fraggle-boate has quit [Ping timeout: 265 seconds]
fraggle-boate has quit [Remote host closed the connection]
uris77 has joined #ocaml
mort___ has quit [Quit: Leaving.]
Thooms has quit [Quit: WeeChat 1.0.1]
t4nk950 has joined #ocaml
<t4nk950>
Hi all, I have a list of tuples like the following [(1, "foo"); (2, "bar"); (1, "bar")]. How can I write a function with a parameter n that returns the first tuple where the first element is equal to n?
<t4nk950>
example (first_tup 1) would return (1, "foo")
bezirg has quit [Ping timeout: 245 seconds]
<t4nk950>
Or I guess returning the index would also work
<mrvn>
List.assoc 1 list?
<mrvn>
but that is probably not the answere you where looking for
<mrvn>
let rec first_tup n = function (x, s) as t when x = n -> t | x::xs -> first_tup n xs | [] -> raise Not_found
<t4nk950>
@mrvn: Let me take a look at that function
<mrvn>
let rec first_tup n = function (x, s)::_ as t when x = n -> t | x::xs -> first_tup n xs | [] -> raise Not_found
<t4nk950>
Thanks for your help
<t4nk950>
let me fire up utop
<mrvn>
You recurse over the list till you hit the right tuple or the end of the list
mcclurmc has joined #ocaml
<ggole>
List.find
<ggole>
(If you need the pair rather than just the second element.)
<t4nk950>
ggole: I agree that would normally work but I will not know the second element in the tuple
<ggole>
You don't need to, .find takes an arbitrary predicate
<t4nk950>
mrvn: Is that so I could, for example, call sort on the list and everything will sort based on the first element in each tuple?
<mrvn>
t4nk950: no. Thats so you can't use any of the predefined functions and have to create them all yourself first
struktured has joined #ocaml
<t4nk950>
oh I see. For an exercise I guess
<ggole>
t4nk950: sort takes an arbitrary comparator, so you can do that with regular lists too
<ggole>
(It would be pretty silly to not allow that.)
vanila has joined #ocaml
jabesed has joined #ocaml
oscar_toro has joined #ocaml
mengu has joined #ocaml
<jabesed>
so I had an error while opam updating custom_printf.112.06.00
<jabesed>
is this a known issue
<jabesed>
or is my system borked
<t4nk950>
Is it possible to write entire real world programs using only functional programming or is dropping down to imperative programming often necessary?
<flux>
you will need an imperative runtime to run your program
<flux>
unless you have a functional operating system
<whitequark>
you still have an imperative CPU :)
<flux>
and if you have that, you will need a functional CPU..
<whitequark>
and I don't think a useful notion of a functional CPU exists
<flux>
but the imperative runtime doesn't need to be written by you
<flux>
so your program could remain purely functional
<flux>
I don't think such runtimes exist for ocaml, though. but haskell provides one.
<ggole>
There have been functional CPUs
<ggole>
No successful ones.
<flux>
hmm, what kind of CPU did Symbolics have :)
<t4nk950>
Ok, aside from the main loop and all the imperative instructions that everything is compiled down to. Is it possible?
<flux>
t4nk950, yes. take any Haskell program that dosen't do unsafe tricks and I think it should fit the bill.
<ggole>
I was thinking of things like the reduceron, rather than Lisp machines.
<flux>
I suppose Clean as well works for this
<whitequark>
ggole: ohhh interesting
<ggole>
Lisp machines just had support for Lisp operations
ontologiae has joined #ocaml
<ggole>
Things like CDR coding
<vanila>
what's CDR coding?
<ggole>
A tagging scheme for representing lists more compactly.
<whitequark>
ggole: I'm not sure if you can really call it "functional"
<whitequark>
I mean, it directly executes functional code
<whitequark>
it's still imperative
<whitequark>
like the ocamlrun is
<flux>
he wasn't talking about the functional cpu, but LISP cpu
PM` is now known as PM
* adrien
wants functional RAM
<ggole>
whitequark: yeah, I think that's the closest there's been though
<whitequark>
I don't think you can have truly functional CPUs until some major advances in say
<whitequark>
semiconductor engineering
<whitequark>
maybe not even semiconductor
<ggole>
Maybe the dataflow architectures? But I don't really know much about those.
<whitequark>
no, I was thinking about memory that garbage-collects itself
<ggole>
Oh, hmm.
<whitequark>
say, a linked list would be literally linked on molecular level
<whitequark>
then instead of a GC cycle, you just... wash away the garbage
<whitequark>
I could call that a functional CPU. probably nothing less
<whitequark>
you'd probably do away with the notion of CPU at all
<ggole>
Sounds a bit like the DNA computers
<whitequark>
you would have computation directly on memory, such as how it happens in a cell. you have enzymes floating around, and binding sites everywhere
<struktured>
I want my own biological system to be functional
<whitequark>
yes
<ggole>
Seems latency would suck, but bandwidth would be unbelievable
<whitequark>
it's quick.
<ggole>
Instead of 256-bit accesses, you would have 256GB accesses.
<whitequark>
DNA polymerase spins at 80,000rpm
<struktured>
first thing I'd do is use that computer to compile opam packages
<whitequark>
multiply it by the number of them, which will be somewhere on the order of nanomoles
<whitequark>
i.e... 10^17 ?
<mrvn>
whitequark: That is like spaghetti sort. For each number cut a spagheti in a coresponding length. Take all spaghetti loosely in a hand and put them on a flat surface. Voila, instantly sorted by length.
<t4nk950>
I feel like spaghetti sort is just sleep sort moving in the opposite direction
<t4nk950>
shortest first
<mrvn>
t4nk950: doesn't sleep sort take O(largest number) time?
<t4nk950>
Yes but it can be scaled, just like spaghetti sort
<mrvn>
t4nk950: and you can't easily pick out the shortest out of a bunch of spaghetti. Only the longest.
<mrvn>
So spaghetti sort taks O(n) time. Better than sleep sort if you have large gaps in the numbers.
rgrinberg has joined #ocaml
<jabesed>
t4nk950: the short answer is "yes you can", and its been done many times... the not so short answer is depends on your definition of "functional"
oscar_toro has quit [Ping timeout: 240 seconds]
fraggle_ has joined #ocaml
mengu has quit [Read error: Connection reset by peer]
mengu has joined #ocaml
lordkryss has quit [Quit: Connection closed for inactivity]
jabesed has quit [Ping timeout: 244 seconds]
t4nk950 has quit [Ping timeout: 246 seconds]
rgrinberg has quit [Quit: Leaving.]
struktured has quit [Ping timeout: 250 seconds]
chinglish has quit [Quit: Nettalk6 - www.ntalk.de]
t4nk168 has joined #ocaml
rgrinberg has joined #ocaml
mengu has quit [Remote host closed the connection]
mengu has joined #ocaml
mengu has joined #ocaml
mengu has quit [Ping timeout: 264 seconds]
smtb has quit [Quit: Page closed]
arj has joined #ocaml
hekmek has quit [Quit: Verlassend]
uris77 has quit [Quit: leaving]
q66[lap] has joined #ocaml
samrat has quit [Ping timeout: 255 seconds]
rgrinberg has quit [Quit: Leaving.]
Hannibal_Smith has joined #ocaml
struktured has joined #ocaml
Thooms has joined #ocaml
matason has joined #ocaml
samrat has joined #ocaml
nojb has joined #ocaml
ingsoc has quit [Quit: Leaving.]
rgrinberg has joined #ocaml
nojb has quit [Quit: nojb]
samrat has quit [Ping timeout: 244 seconds]
samrat has joined #ocaml
q66[lap]_ has joined #ocaml
nojb has joined #ocaml
ontologiae has quit [Quit: WeeChat 1.0]
alkoma has quit [Remote host closed the connection]
q66[lap] has quit [Ping timeout: 250 seconds]
mcclurmc has quit [Remote host closed the connection]
mcclurmc has joined #ocaml
t4nk168 has quit [Quit: Page closed]
mcclurmc has quit [Remote host closed the connection]
tani has joined #ocaml
bytbox has quit [Remote host closed the connection]
nullcat has joined #ocaml
tane is now known as Guest75912
Guest75912 has quit [Killed (hitchcock.freenode.net (Nickname regained by services))]
tani is now known as tane
<Leonidas>
I'm wondering whether I should split my one-module library into smaller pieces like API object definitions, API accessor functions and the like. What is the best way to go about recursive modules?
nojb has quit [Quit: nojb]
<whitequark>
step 1: consider not doing that
<whitequark>
step 2: strongly consider
<whitequark>
step 3: try exposing everything in a private module and referring to it from public modules instead
nojb has joined #ocaml
<Leonidas>
whitequark: the idea with private modules is quite good, I ofen move the mli away while trying stuff out.
<Leonidas>
just saw that packed libraries exist, that sounds interesting. I'm looking at how cohttp does it
<whitequark>
don't need packed libraries
<whitequark>
just don't install the .cmi
<whitequark>
corresponding to the private module
<whitequark>
it won't be accessible then.
q66[lap]_ has quit [Read error: Connection reset by peer]
q66[lap] has joined #ocaml
<Leonidas>
So, a 1200 line private module is fine? hmm.
q66[lap] has quit [Read error: Connection reset by peer]
<whitequark>
why not
<nojb>
many of dbuenzli’s libraries are in a single file
q66[lap] has joined #ocaml
q66[lap] has quit [Client Quit]
<Leonidas>
whitequark: ok, but is there a better way to make a public module than to make a file which aliases dozens of functions from the private module?
<Leonidas>
it would end up looking like let foo = Private.foo etc. Maybe there is some ppx magic for this? :-)
govg has joined #ocaml
<whitequark>
just use your editor
<whitequark>
or, uh
<whitequark>
include Private in the implementation
<whitequark>
and in the mli you want docs anyway
<Leonidas>
oh, yeah, totally missed that.
<Leonidas>
wouldn't it be better to open instead of include?
<nullcat>
I got a question on variance in subtyping again. I understand "type (-'a, +'b) t = 'a -> 'b" but what about "type ('a, 'b) t = ('a * 'b) -> 'b". How do know the variance of 'a and 'b?
<Leonidas>
no, I'm not. My function returns a [> `Success of json | ... ] and I want to make it return a [> `Success of something_else | ... ]
<nojb>
the problem is that the default case in channels_history e -> e forces the the type of the anonymous function to be ‘a -> ‘a
<mrvn>
>|=?
<Leonidas>
mrvn: Lwt.(>|=) is Lwt.map
<mrvn>
yeah, line 9 should be e -> ft e or something
<Leonidas>
why? e is everything besides `Success so that should be just fine?
<mrvn>
Leonidas: but you aren't using a GADT so all cases have the same type
<nojb>
the tag `Success can’t have different payload types in a single polymorphic variant type
<Leonidas>
oh, that's interesting.
<vanila>
since when does ocaml have GADTs?
<Leonidas>
yes, that's exactly what I meant by "range"
<Leonidas>
vanila: 4.00
<mrvn>
Leonidas: you have to deconstruct and reconstruct all the other cases so ocaml can infer the new resulting type.
<Leonidas>
mrvn: ok. that's not really practical as there can be a lot of cases. So, should I look into GADTs?
<Leonidas>
So far I've avoided them.
<Leonidas>
for a lack of usecase
<mrvn>
Then you have to rewrite everything and still have to match all the cases
<Leonidas>
ah. then I just use a new tag name and be done with it.
<mrvn>
way easier
<Leonidas>
I would have thought that if I have a type [ `A | `B ] and match on on a single constructor and a catchall, ocaml would be able to infer that the catchall case doesn't include the single constructor I matched earlier.
<mrvn>
many do.
<nojb>
it doesn’t work like that
<nojb>
what you can do is: type t = [ `B ] type s = [ `A | t ]
<Leonidas>
is that a deficiency in ocaml or actually problematic in the theory behind it?
<mrvn>
Only GADTs handle the type per variant seperately. And you have to anntotate that.
<nojb>
then match x with `A -> … | #t -> ...
<vanila>
but I thought ocaml doesnt have type siganturals
<vanila>
signatures
<vanila>
so how can you use gadts?
<pippijn>
vanila: ocaml has type signatures
<mrvn>
e.g. let foo : type a . a foo -> a = function Foo x -> x
<vanila>
grea
<vanila>
great*
<mrvn>
vanila: GADTs look like this: type _ foo = Int : int -> int foo | Float : float -> float foo. Each variant can have a different type.
<vanila>
my favorite feature from haskell is in ocaml now :D
<Leonidas>
nojb: hmm, that's interesting.
<Leonidas>
but probably not worth the hassle, I'm making things complicated for little payoff
bezirg has joined #ocaml
bezirg has quit [Ping timeout: 264 seconds]
nojb has quit [Quit: nojb]
hu has joined #ocaml
hu has quit [Ping timeout: 264 seconds]
jonludlam has joined #ocaml
enitiz has joined #ocaml
keen__________22 has quit [Read error: Connection reset by peer]
r0ok has joined #ocaml
r0ok has quit [Changing host]
r0ok has joined #ocaml
keen__________22 has joined #ocaml
matason has quit [Ping timeout: 245 seconds]
smtb has joined #ocaml
<smtb>
Hi, any Eliom users here?
matason has joined #ocaml
<Drup>
=')
<Drup>
Don't ask to ask.
<smtb>
Hey Drup, thanks for the help yesterday. I figured out the button issue.
<Drup>
=)
<smtb>
Trying to figure out all the pieces of Eliom makes me feel like a new OCaml user again. haha
bezirg has joined #ocaml
t4nk321 has joined #ocaml
mengu has joined #ocaml
<t4nk321>
Consider the function: "let rec sum l= match l with | [] -> 0 | hd :: tl -> hd + sum tl;;". Coming from an C background, this seems incredibly inefficient. Is the ocaml compiler smart enough to optimize this to the point that it is just as efficient as a pointer based approach?
<t4nk321>
Recursion should never be used in C or Python to sum elements of a list
<Drup>
not under this form, no
<mrvn>
t4nk321: first think you want to do is make it tail recursive
<mrvn>
After that the most expensive thing is following the indirection in the list. The rest is irelevant.
<t4nk321>
What would be the best/most efficient way to sum elements in a list in OCaml, then?
<mrvn>
t4nk321: doesn't matter if it is C or ocaml. You never wan't to iterate over a list > length 20 or so if you care about speed.
mengu has quit [Ping timeout: 245 seconds]
<Drup>
t4nk321: do you know what tail recursion is ?
<mrvn>
t4nk321: let sum list = let rec loop acc = function [] -> acc | x::xs -> loop (x + acc) xs
matason has quit [Ping timeout: 244 seconds]
<mrvn>
aka. let sum = List.fold_left (+) 0
<mrvn>
and isn't that löast so much shorter to type that your solution?
tane has quit [Quit: Verlassend]
<mrvn>
t4nk321: the tail recursive answere is like you would do it in C, right?
<tokenrove>
t4nk321: you can examine the generated assembly code with ocamlopt -S. at least for the form you've given, the generated code could definitely be better.
<t4nk321>
In C I would use and integer total and a pointer to the current position
<mrvn>
int sum(list *list) { int acc = 0; while(list) { acc += list.data; list = list->next; } return acc; }
<mrvn>
t4nk321: now instead of the while you do recursion and you have my first answere
<t4nk321>
But recursion introduces stack and jumping overhead
<mrvn>
t4nk321: nope. lookup tail recursion
<t4nk321>
OK, ill take a look at that
<tokenrove>
and then compare the assembly for mrvn's answer, which compiles down to a simple loop
<mrvn>
t4nk321: the c and ocaml code should give verry similar asm.
MercurialAlchemi has quit [Ping timeout: 245 seconds]
kakadu has quit [Remote host closed the connection]
matason has joined #ocaml
t4nk321 has quit [Ping timeout: 246 seconds]
vpm has quit [Remote host closed the connection]
nullcat has quit [Quit: My Mac has gone to sleep. ZZZzzz…]