<olegfink>
c0m: yes, the two definitions are equivalent in ocaml
<c0m>
olegfink: ok, thanks
<c0m>
that's something i don't like
<olegfink>
then use SML ;-)
<c0m>
lol
<c0m>
there's so many equivalencies that it is confusing
<olegfink>
most of the Basis library of SML uses ugly tuples
<Camarade_Tux>
well, gotta go to bed, good night
<olegfink>
once think I don't clearly understand is the distinction between fun and function
onigiri has quit []
<c0m>
those are equivalent
<olegfink>
hmm, judging by my writing I should take a nap too
<olegfink>
they aren't
<olegfink>
function accepts the usual match ... with syntax, fun accepts the names of parameters
<c0m>
oh
<c0m>
what's the difference though
<c0m>
other than the implicit match ability
<Camarade_Tux>
I don't get the rationale either
<olegfink>
Camarade_Tux: they're just completely different
<olegfink>
fun allows you to define a function of many arguments
<olegfink>
fun x y z -> ...
<olegfink>
function instead is just a match <curried arg> with ...
<olegfink>
though haskell seems to combine both (but probably without alternative patterns)
<olegfink>
> :t (\x (h:t) -> h + x)
<olegfink>
(\x (h:t) -> h + x) :: (Num t) => t -> [t] -> t
<Camarade_Tux>
hmmm, I saw my error as soon as I thought about writing a function construct with several args
h3r3tic has quit [Read error: 104 (Connection reset by peer)]
<Camarade_Tux>
and my writing is also starting to suffer badly, night ;)
h3r3tic has joined #ocaml
<c0m>
olegfink: not really, you can do function x y z.. and have access to them in the function body
h3r3tic has quit [Read error: 104 (Connection reset by peer)]
<olegfink>
c0m: can I?
<olegfink>
it's a syntax error
<c0m>
hmm
valross has joined #ocaml
<c0m>
err what i meant was
<c0m>
fun and not using fun are equivalent
<c0m>
like ... let add a b = a + b
<c0m>
and
<c0m>
let add = fun a b -> a + b
<c0m>
and
<c0m>
let add a = fun b -> a + b
<c0m>
all though all are equivalent, what are the difference in them (other than syntax)
<c0m>
*although
<olegfink>
the declarations are equivalent, the former is a shorthand for the latter
<olegfink>
(and fun a b is a shorthand for fun a -> fun b ...)
<thelema>
[let f x y = foo] == [let f = fun x -> fun y -> foo]
travisbrady has quit [Read error: 104 (Connection reset by peer)]
travisbrady has joined #ocaml
ztfw` has joined #ocaml
h3r3tic has joined #ocaml
BigJ2 has joined #ocaml
ztfw has quit [Connection timed out]
<BigJ>
is there any function in ocaml for deleting elements in an array?
<orbitz>
not as far as i know
Amorphous has quit [Read error: 145 (Connection timed out)]
<thelema>
BigJ: no - ocaml arrays don't delete elements efficiently. Batteries has Vect.t which does much better with this kind of usage
<thelema>
but it's not constant time access to elements, it's only log time with a good constant
<c0m>
[(*) 2]
<c0m>
what does that do
<thelema>
although if your array is small, blitting the tail over to "shorten" the array is fast
<thelema>
c0m: it's a function [int -> int] that takes a value and multiplies 2 by that value
<thelema>
c0m: (*) is the multiplication function, and if you give it a single value, you get its partial application
<c0m>
h
<c0m>
ah
<c0m>
(*) masks * as a function
<thelema>
yes, * is an infix operator
<thelema>
(*) is that function
<c0m>
yeah
<c0m>
ok
_unK has quit [Remote closed the connection]
<thelema>
although be careful with this one, you need to write ( * ), or else you'll start a comment.
<c0m>
what about (int -> int) -> int
<thelema>
let f g = g 2
<c0m>
so a function that takes a function
<thelema>
yes, (int -> int) is the first argument
<c0m>
yeah some of the inferred types i have trouble understanding
<thelema>
actually, that function is (int -> 'a) -> 'a
<thelema>
let f g = 1 + g 2
<thelema>
This is (int -> int) -> int
<c0m>
ok so (int -> int) means a function that takes an int and returns an int
<c0m>
and the final -> means which ends up returning an int?
struktured has quit [Read error: 54 (Connection reset by peer)]
<c0m>
sorry for some of the newbie questions
<orbitz>
yes
<c0m>
for some reason i just have a hard time following some
<c0m>
hmm
Amorphous has joined #ocaml
<c0m>
i have a list in front of me
<c0m>
of different expressions and am trying to understand the type inferrence
<c0m>
[fun n -> n+1] end up being ('a -> 'b) -> ('b -> 'c) -> ('a -> 'c)
<c0m>
what exactly does that function do
<c0m>
a variable which gets added with 1 and put into a list?
<c0m>
err
<c0m>
fun f g -> fun x -> g (f x) is those types
<c0m>
sorry
<c0m>
i get that one though
<thelema>
yes, that last function is the composition operator
<c0m>
a function that takes two functions and a param
<c0m>
that ones easy
<thelema>
is the type ok?
<c0m>
but for some reason i can't follow the derivation of the type
<c0m>
maybe the parens are throwing me off
<thelema>
okay, your two input functions are of type ('a -> 'b) and ('b -> 'c)
<c0m>
like if i was given the type and told to write a function that would generate that, i'd be lost
<c0m>
if that helps explain an issue i'm having
<thelema>
and the result when you give it two functions is a function that takes one more value and returns a value
<c0m>
so everything to the left of the last -> are params
<thelema>
the input type of the first function must be the type of the value given
<thelema>
and the output of the first function must match the input of the second
<thelema>
yes, parse function types from right to left.
<thelema>
(They're right associative)
<c0m>
right but how can yo ube sure that the types will match
<c0m>
without explicitly specifying types
<c0m>
for the composition of functions
<c0m>
obviously the compiler does some magic
<c0m>
but if i didn't see the definitions of the actual functions
<thelema>
type variables. 'a is a type variable. it means "any type"
<c0m>
i know, its polymorphic
<c0m>
generic
<c0m>
but when the types of the first function returns 'b and the second functions expects 'b
<thelema>
yes, so the compiler starts with 'a -> 'b -> 'c -> 'd - three parameters plus the output
<c0m>
how can i say that is valid w/o looking at the code definition
<c0m>
for the functions
<monestri>
is there any way to get the head of a list without match?
<c0m>
List.hd
<thelema>
and since the first parameter is a function taking the third parameter, you have : ('c -> 'e) -> 'b -> 'c -> 'd
<thelema>
monestri: as c0m said, but I really recommend not using List.hd
<thelema>
c0m: the compiler has to look at the code to generate the type for that code.
<thelema>
oh, for the functions - it doesn't have to care what the code for the functions passed in - they can have any type that matches the parameter
<monestri>
i hate warnings about not being exhaustive by match
<c0m>
hmm
<thelema>
the output of the first function is passed into the second argument, so we get ('c -> 'e) -> ('e -> 'f) -> 'c -> 'd
<c0m>
what's returned is 'b after a function evaluation on 'c ?
<c0m>
or what's returned is a function that returns a type of 'b
<thelema>
a function that returns a type of 'b
<thelema>
a function that returns a value of type 'b
Yoric[DT] has quit ["Ex-Chat"]
<olegfink>
thelema: thanks for the paper, though both the examples the aurthor lists in 1.1 are of pure haskellish nature.
<c0m>
ah
* olegfink
still has to get to the OO part of ocaml -- seemingly that's the most difficult part in its type system
<mbac>
nobody uses that
<mbac>
the OO part
<thelema>
olegfink: yes - I just think the idea of good type error messages is one that could be introduced to the ocaml world.
<thelema>
mbac: people do use it, but only when they have to.
<c0m>
i'm doing f#
<thelema>
olegfink: OO in ocaml is easy, as long as you don't make a type mistake. :)
<olegfink>
I meant typechecking in OO context
<olegfink>
thelema: (re goog type errors) indeed, I noticed that for most students the type errors were more of the indication that "something is wrong" than "that particular thing is wrong"
<thelema>
olegfink: you'll learn it easily - Variants : Polymorphic Variants :: Records : Objects
<c0m>
('a list -> int) ... The type of List.length is implicitly universally quantified; it could be written something like this: ....(forall 'a)('a list -> int)
<thelema>
c0m: yes.
<c0m>
what's the meaning as (forall 'a) ... as obvious as that question is
<thelema>
c0m: given any type (call it 'a), List.length has type ('a list -> int)
<olegfink>
thelema: learning to use them is indeed easy, but I still have no idea how either record or object typing is implemented in the typechecker
<c0m>
i figured that but i thought there was some kind of programmatic theme there because of the way it was put ... (forall 'a)
<c0m>
rather than .. for all 'a
<thelema>
olegfink: records are explicit, objects... have fun.
<thelema>
c0m: some languages have explicit (forall 'a) and (exists 'a)
<c0m>
hmm
<thelema>
they're not practical. Ocaml's 'a is implicitly forall
<c0m>
something to do with the "value restriction" ?
<c0m>
nvm
<monestri>
so I have two lists of the same size, and match (l1,l2) expression
<monestri>
do I have to worry about exhaustive matches that include those where the sizes are different?
<monestri>
or should I just leave the warning?
<c0m>
depends on the code
<c0m>
or your expected data
<thelema>
monestri: just add [ | _ , _ -> failwith "Different lengths" ] to your match
<monestri>
hmm ok, thanks
<olegfink>
by the way, it's interesting to not that in haskell zip/zipWith work with lists of different lengths
<olegfink>
probably mostly because haskell doesn't have an exception mechanism like ocaml so it's not clear what to do otherwise
<olegfink>
s/not/&e/
<thelema>
olegfink: and because it's lazy, so often you don't get to the end
<olegfink>
indeed
<monestri>
why is List.hd bad?
h3r3tic has quit [Read error: 54 (Connection reset by peer)]
h3r3tic has joined #ocaml
<c0m>
extra work
<c0m>
rather than matching and param binding
kaustuv_ has joined #ocaml
<c0m>
int -> bool * string list ..... is int -> (bool * (string list)) and not int -> ((bool * string) list)
<c0m>
?
<c0m>
ah
<c0m>
list has higher precendence than *
<mbac>
thelema, yes, exactly right
<thelema>
monestri: List.hd is bad because the "empty list case" isn't handled
kaustuv_` has quit [Read error: 110 (Connection timed out)]
<thelema>
The right place to handle empty lists is usually right where you notice the list is empty.
BiDOrD has quit [Read error: 110 (Connection timed out)]
Ched has quit [Read error: 148 (No route to host)]
clog has joined #ocaml
ski_ has joined #ocaml
ikaros has quit ["Leave the magic to Houdini"]
ygrek has joined #ocaml
tmaedaZ is now known as tmaeda
ttamttam has joined #ocaml
rwmjones-afk is now known as rwmjones
BiDOrD has joined #ocaml
mpwd has quit []
mpwd has joined #ocaml
mpwd has quit [Client Quit]
ztfw` has quit [Remote closed the connection]
sgnb` is now known as sgnb
ttamttam has quit ["Leaving."]
<sgnb>
polymorphic recursion merged in trunk!
onigiri has joined #ocaml
<flux>
nice
<flux>
how is it used?
Ched has joined #ocaml
<flux>
let [rec] foo : 'a. 'a -> 'a = .. works as expected
<flux>
actually I'll quote the whole thing from Changes
<flux>
- Explicit polymorphic types and polymorphic recursion. In let definitions, one can write an explicit polymorphic type just immediately the function name; the polymorphism will be enforced, and recursive calls may use the polymorphism. The syntax is the same as for polymorphic methods: "let [rec] <ident> : 'a1 ... 'an. <typexp> = ..."
<flux>
actually this sounds much more interesting if it really works how I assume it does :-o
<flux>
- Explicit naming of a generic type; in an expression "fun ... (type t) ... -> e", the type t is considered abstract in its scope (the arguments that follow it and the body of the function), and then replaced by a fresh type variable. In particular, the type t can be used in contexts where a type variable is not allowed (e.g. for defining an exception in a local module).
<flux>
is this finally a way out of functorized code-pit?
<flux>
maybe I just don't quite understand what that means..
<flux>
but if it is what I think it is, then it's great :)
<flux>
finally a way to use for example Map in a polymorphic function?
<flux>
this is nice as well: - Better error report in case of unbound qualified identifier: if the module is unbound this error is reported in the first place. - less confusing error message for newbies
<flux>
but if 3.12.0 is going to have as big list of changes as 3.11.0, then we'll need to wait for the release for some times still..
<sgnb>
there are already more changes in "Language features" section
marteo has joined #ocaml
<flux>
true
<flux>
perhaps the next release is a "new faetures" release while the previous was "bug fixes" release
munga has joined #ocaml
<flux>
it always surprises me how many bugs are fixed, yet I never seem to encounter them
<flux>
3.11.1: Subtyping is now allowed between a private abbreviation and its definition, and between a polymorphic method and its monomorphic instance. - I wonder if the latter statement holds true for those new polymorphic functions also
<flux>
(haven't heard of them before, randomly found their blog)
Associat0r has quit []
<Camarade_Tux>
morning :)
morse has joined #ocaml
<flux>
morning!
<Camarade_Tux>
morning flux :)
valross has quit [Read error: 110 (Connection timed out)]
lutter has joined #ocaml
lutter has quit [Client Quit]
lutter has joined #ocaml
ygrek has quit [Remote closed the connection]
mishok13 has quit [Read error: 60 (Operation timed out)]
mishok13 has joined #ocaml
olegfink_ has joined #ocaml
Yoric[DT] has joined #ocaml
olegfink has quit [Read error: 110 (Connection timed out)]
morse has quit [Remote closed the connection]
_andre has joined #ocaml
mpwd has joined #ocaml
onigiri has quit [Read error: 60 (Operation timed out)]
mpwd has quit [Client Quit]
julm_ has joined #ocaml
<mfp>
flux: just tried this in 3.12.0+dev5 (2009-09-04)'s toplevel >
<mfp>
# let foo (type a) x = let module M = Map.Make(struct type t = a let compare = compare end) in M.find x (M.add x 1 M.empty);;
<mfp>
val foo : 'a -> int = <fun>
onigiri has joined #ocaml
julm has quit [Nick collision from services.]
julm_ is now known as julm
<sgnb>
interesting
kaustuv_ has quit [Read error: 60 (Operation timed out)]
kaustuv_` has joined #ocaml
<flux>
mfp, extremely nice!
<Camarade_Tux>
I hadn't realized at first, but that's very nice :)
<mfp>
now just have to wait for that 1st-class module patch to be merged :)
<flux>
I was thinking just that :)
<flux>
but that feature should reduce the gains they'd give, no?
<mfp>
it makes it harder to follow the control flow, the same way classes do
<flux>
indeed, they'd be almost like classes. except you could also put types and modules inside them..
<mfp>
but sometimes you need to choose the implementation at run time, and having to add an indirection level manually with classes/records is bothersome, plus you lose the ability to define types, as you pointed out
<mfp>
I find myself doing things like module B(M : MONAD) = struct class virtual foo = object method bar : t -> unit M.t end
<mfp>
and then somewhere else module Impl(M : MONAD) = struct module B_ = B(M) class foo = object inherit B_.foo ... end end
<mfp>
just so that I can pass a B(M).foo value around, and pick the implementation dynamically
<mfp>
it'd be more direct & convenient to pass a first class module, and in this case it doesn't make the program any harder to analyze, relative to the explicit encoding of "runtime dynamism" that uses classes
rwmjones_lptp has joined #ocaml
<flux>
have you checked if the patch still works?
<flux>
mfp, actually can you give a name to the variable with type a?
<flux>
(a: type a) ?
<mfp>
nope, haven't tried the 1st class module patch
<mfp>
flux: let foo (type a) (x : a) = ...
<flux>
argh, right :)
<flux>
I somehow read that (type a) became that first parameter with type 'a, but no..
<flux>
actually the syntax does seem slightly baffling
<mfp>
you can force a function to be polymorphic >
verte has joined #ocaml
<mfp>
# let foo (type a) (x : a) : a = 1;;
<mfp>
Error: This expression has type int but an expression was expected of type a
<flux>
why not let foo (x: type a) ?
<mfp>
yeah, that's what I tried 1st
<flux>
mfp, you can do it anyway, did you read my another extract from Changes?
<mfp>
polymorphic recursion, right
<mfp>
but heaver, syntactically
<mfp>
*heavier
<flux>
perhaps, if only by a bit.
<flux>
you can still do let foo : 'a.'a -> _ -> 'a = .. I suppose
<mfp>
let foo : 'a. 'a -> 'a = fun x ->
<mfp>
let foo (type a) (x : a) : a =
<mfp>
only 3 chars shorter, but the former feels much heavier to me
<flux>
but the former is also more similar to whay you have in the interface
BigJ2 has quit [Read error: 110 (Connection timed out)]
rwmjones_lptp has quit ["This computer has gone to sleep"]
tmaeda is now known as tmaedaZ
mpwd has joined #ocaml
lutter has quit [Read error: 113 (No route to host)]
mpwd has quit [Client Quit]
verte has quit ["~~~ Crash in JIT!"]
onigiri has quit []
travisbrady has quit [Read error: 110 (Connection timed out)]
munga has quit ["Ex-Chat"]
munga has joined #ocaml
mfp has quit [Read error: 110 (Connection timed out)]
<flux>
have these changes been discussed on some mailing list?
stan_ has joined #ocaml
willb has joined #ocaml
c0m has quit [Read error: 110 (Connection timed out)]
<kaustuv_`>
flux: they were discussed in the ocaml meeting last year
<kaustuv_`>
but I'm kind of surprised myself that it was accepted
kaustuv_` is now known as kaustuv
<gim>
sgnb: woah
<flux>
I hadn't heard of that, but honestly even if I had, I'd have assumed it's just talking :)
<flux>
I'm feeling pastelicious, so here's the Changes entry: First-class packages modules. New kind of type expression, for packaged modules: (module PT). New kind of expression, to pack a module as a first-class value: (module MODEXPR : PT). New kind of module expression, to unpack a first-class value as a module: (val EXPR : PT). PT is a package type of the form "S" or "S with type t1 = ... and ... and type tn = ..." (S refers to a module type).
<kaustuv>
fortunately this change is mostly in the type system level because modules are already implemented as records
<flux>
low-impact but highly useful patches are always the best ;)
<kaustuv>
of course you would need to be a special kind of masochist to play with the ocaml type system, but I am glad some people are up to the challenge
<flux>
:)
tmaedaZ is now known as tmaeda
h3r3tic has quit [Read error: 104 (Connection reset by peer)]
h3 has joined #ocaml
mfp has quit [Read error: 110 (Connection timed out)]
_unK has joined #ocaml
mfp has joined #ocaml
Submarine has joined #ocaml
_unK has quit [Remote closed the connection]
stan_ has quit [Client Quit]
ikaros has joined #ocaml
h3 has quit [Read error: 54 (Connection reset by peer)]
h3r3tic has joined #ocaml
h3r3tic has quit [Read error: 104 (Connection reset by peer)]
h3r3tic has joined #ocaml
munga has quit ["Ex-Chat"]
munga has joined #ocaml
h3r3tic has quit [Read error: 104 (Connection reset by peer)]
<flux>
soo, any plans how Batteries is going to take advantage of this new shiny functionality?-)
<palomer>
holy crap, first class modules?
<hcarty>
flux: I'm curious to hear real-world uses for this shiny new functionality - it looks cool, but what does it provide that wasn't there already?
<palomer>
good point
<flux>
hcarty, I think it mostly eliminates the needs of pmap, for example
<flux>
not first class modules
<flux>
but the (type t) syntax
<flux>
and first class modules are useful whenever you want nicely modulified code to be replaceable runtime
<flux>
like mfp's example
<flux>
and first class moduels are (afaiu) 'better' than for objects in the sense that they can contain types and modules
<mfp>
what's next, GADTs?
<flux>
the polymorphic recursion thingy.. well, it's just conveniense, it was possible to do that earlier
<flux>
so the only 'truly new' feature is that (type t)-thingy
<flux>
it was not possible to write that kind of code without rewriting the original code (which you might not have written, in the case of Map, Set and Queue) in a polymorphic fashion
<flux>
atleast not without Obj.magic..
<mfp>
let ret m = let module M = (val m : S) in M.v;; Error: This `let module' expression has type M.t In this type, the locally bound module name M escapes its scope
<flux>
I suppsoe ocaml reins becomes much more useful also, as afaik it's fully functorized
<flux>
mfp, hmm, so not fully first-class then, or is there a workaround..
<mfp>
would be nice to have that become val ret : (module S with type t = 'a) -> 'a
<mfp>
hmm
* mfp
tries something
<mfp>
hoho
<mfp>
# let ret (type a) m : a = let module M = (val m : S with type t = a) in M.v;;
<mfp>
val ret : (module S with type t = 'a) -> 'a = <fun>
<flux>
victory!
<flux>
(I still wonder about the syntax)
<flux>
I have one justification for it: (type a) is something that doesn't appaer in the function's signature
<mfp>
(x : type a) feels more "regular" in general
<mfp>
in the above, that would become let ret (m : module S with type t = type a) = ....
<mfp>
but then you have to repeat the with type ... when unpacking
<flux>
hm, maybe another reason is that that (type a) would leak into the BNF in a much greater fashion
<c0m_>
man, so confusing
seanmcl_ has joined #ocaml
<flux>
mfp, well, if not gadts directly, how about a camlp4-like solution for the type system.. ;-)
seanmcl_ has quit [Read error: 104 (Connection reset by peer)]
<flux>
it'd be way cool from the research point of view atleast
<hcarty>
Does anyone know enough about the implementation to know if using these first-class modules has a run time performance impact?
<hcarty>
I'm looking forward to playing with it to find out more at some point, but that may be a while from now.
seanmcl_ has joined #ocaml
<flux>
no idea, but I'd imagine they'd be similar to records of functions, as kaustuv suggested that they are internally already records?
seanmcl has quit [Read error: 104 (Connection reset by peer)]
seanmcl_ is now known as seanmcl
<flux>
hmm, actually does this new feature in any way reduce the need of functors..
<hcarty>
flux: I'm wondering the same thing.
nb has quit [Nick collision from services.]
seanmcl has quit [Read error: 104 (Connection reset by peer)]
<mfp>
you can replicate a functor via first-class modules, but have to give the signature for the result
<mfp>
given val functor_ : (module S1) -> (module S2) val x : (module S1)
<mfp>
you can turn them into "static" modules with module M1 = (val x : S1) module M2 = (val (functor_ x) : S2)
<flux>
cool
tmaeda is now known as tmaedaZ
<flux>
so what's the type of functor_?
<mfp>
val functor_ : (module S1) -> (module S2)
<flux>
meh, we should have xavierbot here always with the SVN trunk ocaml :)
<flux>
(maybe xavierbot could even support multiple versions)
<mfp>
the fun part starts when you use a more dynamic function, say val functor_ : cmdline -> (module S1)
<flux>
indeed
<mfp>
then you can do module M = (val (functor_ (parse_cmdline ()) : S1)
<flux>
much less work to add alternative behavior
<mfp>
and nothing changes in the rest of the code
<flux>
for example this could enable runtime switching of different Thread-modules?
<mfp>
if you want to access the module with a regular module expression (M), only once
<kaustuv>
can something like this be done now?
<kaustuv>
let rec grow m = let module M = (val m : sig type t end) in grow (val struct type t = M.t * unit end : sig type t = M.t * unit end) in grow (val struct type t = unit end : sig type t : unit end) ;;
<kaustuv>
err, sig type t = unit end
nb_ has joined #ocaml
rwmjones is now known as rwmjones-afk
<mfp>
kaustuv: mixing polymorphic recursion with 1st-class modules?
<mfp>
I can't parse the above... in grow () in grow () ?
<kaustuv>
hmm, weird, that's a cut and paste error
<flux>
I use this oneliner to make clipboard irc-pasteable: xclip -o | tr '\n' ' ' | sed 's/ */ /g' | xclip -i
<kaustuv>
no wait, that parses... the first in grow () is in the definition of grow, the second is use of grow
<kaustuv>
well, "parses"
<mfp>
ic
<palomer>
hrmph, I'm using camlp4 to check (at runtime) if two types are equal. I'm doing this by encoding the types by datatypes. To do this, I need to have a unique identifier for variant and record declarations. how do I get that?
<kaustuv>
by analogy with: let rec f x = let v = x + 1 in f x in f 0 ;;
<kaustuv>
basically I am wondering if the infinite tuple type of units is constructed at runtime...
<kaustuv>
I'm sure I've missed some subtlety
ski_ has quit ["Lost terminal"]
<kaustuv>
hmm, maybe the subtlety is that grow is not well-typed. Must investigate later, off to catch a train.
travisbrady has joined #ocaml
<mfp>
kaustuv: "works"
<mfp>
let rec grow m = let module M = (val m : S) in let x = (module struct type t = M.t * unit end : S) in grow x
<mfp>
let x = (module struct type t = unit end : S);;
<mfp>
then grow x -> hangs
<mfp>
palomer: here's some old code of mine that generates a typename_id value of type Int64.t for each type declaration http://ocaml.pastebin.com/m4764034e
<mfp>
uses typeconv, so the syntax becomes -> type foo = .... with safe_marshal_id
<mfp>
which expands to type foo = .... let foo_id : Int64.t = ...
<palomer>
mfp, isn't that just a case of incrementing an Int64.t everytime?
<palomer>
Int64.t ref
<palomer>
if I went this route, I'll need to be able to expand non variant/record types, how would I do that?
<palomer>
typenames
<palomer>
s/expand non variant types/expand non variant typenames
peddie has joined #ocaml
<palomer>
I'm especially worried when a typename is qualified
<palomer>
nevermind, it's trivial to do
ched_ has joined #ocaml
seanmcl has joined #ocaml
seanmcl has quit [Client Quit]
<mfp>
palomer: in the code I pasted, the id is a function of the type definition --- two types with the same structure have the same id
<mfp>
nominal typing is indeed trivial, as you said
ched_ has quit [Remote closed the connection]
mishok13 has quit [Read error: 110 (Connection timed out)]
Ched has quit [Read error: 101 (Network is unreachable)]
h3r3tic has joined #ocaml
seanmcl has joined #ocaml
lutter has quit [Read error: 60 (Operation timed out)]
Ched has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
_andre has quit ["hamster flu"]
ttamttam has joined #ocaml
onigiri has joined #ocaml
Associat0r has joined #ocaml
BigJ2 has joined #ocaml
h3r3tic has quit ["Segmentation Fault"]
M| has quit [Remote closed the connection]
<BigJ2>
.
<orbitz>
.
<BigJ2>
I am wondering what would be the best way to delete an element from an array and decrement that size of the array
<orbitz>
didn't thelma cover this with you when you asked yesterday?
<BigJ2>
ya he might have I read it over quickly
<BigJ2>
let me check my log
<BigJ2>
he mentioned Batteries, that is a module ?
<thelema>
the batteries package has many modules, one of which is vect.t, which is like an array but allows concat and remove operations as nice as possible
<BigJ2>
i see, I would prefer to learn how to do it in the standard implementation first
rwmjones_lptp has joined #ocaml
<BigJ2>
would the best way be to copy to a new array ?
<orbitz>
yes
<BigJ2>
I will have to do some sorting however first
<BigJ2>
if I say want to delete the i th position in the array
<thelema>
let array_without i a = Array.init (Array.length a - 1) (fun j -> a.(if j < i then j else j-1))
mattiase has joined #ocaml
<BigJ2>
thelema: k I don't fully understand everything in that code, so I will look it over for a bit.
<BigJ2>
thanks
<thelema>
I just wrote it, so it may explode on you in some wierd way, but that's the idea.
<hcarty>
There is a "letopenin" branch in the OCaml Subversion repository as well. Record syntax shorthand, first class modules and some sort of open ... in construct (maybe). 3.12 is looking very cool.
valross has quit [Remote closed the connection]
ulfdoz has joined #ocaml
sramsay has joined #ocaml
h3r3tic has joined #ocaml
<rwmjones_lptp>
gildor, what is this skydeck spam thing on planet.ocamlcore?
<gildor>
rwmjones_lptp: I know, skydeck is a company that use OCaml, but I am not able to filter their blog content
<gildor>
maybe you can have a look and tell me how to filter
<gildor>
or contact jake dohnam
<thelema>
the usual thing is for them to produce a filtered rss
<gildor>
they had a redirect on their */feed to feedburner.com
<gildor>
and the redirect doesn't take into account the preceding category/ocaml/feed
BigJ2 has quit []
kaustuv_ has joined #ocaml
munga has quit [Read error: 113 (No route to host)]
<rwmjones_lptp>
ok, but hmmm
kaustuv has quit [Read error: 145 (Connection timed out)]
ulfdoz has quit [Read error: 60 (Operation timed out)]
stan_ has joined #ocaml
<gildor>
rwmjones_lptp: I agree this is not perfect
<gildor>
I will maybe suspend the feed for a while
_JusSx_ has joined #ocaml
_JusSx_ has left #ocaml []
BigJ2 has joined #ocaml
stan_ has quit [Read error: 131 (Connection reset by peer)]
ygrek has joined #ocaml
<palomer>
hrmph
Ched has quit [Remote closed the connection]
<palomer>
I wonder how type equality/subsumption works with recursive types
<palomer>
like, how do you decide that fix (x -> t) is equal to fix (y -> u) ?
<palomer>
I'm guessing you assume x = y, and then with that assumption you try to find if u = t
BigJ2 has quit []
_JusSx_ has joined #ocaml
_JusSx_ has quit ["leaving"]
_JusSx_ has joined #ocaml
_JusSx_ has quit [Client Quit]
BigJ2 has joined #ocaml
ttamttam has quit ["Leaving."]
slash_ has joined #ocaml
ofaurax has joined #ocaml
BigJ2_ has joined #ocaml
BigJ2 has quit [Read error: 104 (Connection reset by peer)]
BigJ2_ is now known as BigJ2
BigJ2 has quit [Read error: 104 (Connection reset by peer)]
<BigJ2>
is <- always the operator to change mutable fields of a record?
<BigJ2>
or does it apply to all data structures?
<Camarade_Tux>
BigJ2: you don't need to check for the bounds, ocaml will do it for you
<Camarade_Tux>
s.size <- s.size -1
<Camarade_Tux>
<- , not <
<Camarade_Tux>
also your code is probably incorrect since "<- { x = 0.; y = 0.; }" doesn't actually delete
<BigJ2>
the reason I check the bounds is because when I create the vec_store I initialize it to a constant value that is the max size of the array
<Camarade_Tux>
you may have 10 elements, delete the 5th, that would make s.size = 9, but you would still be able to access s.seq.(9)
<olegfink_>
also ocaml arrays already track their length, you don't have to do it yourself.
<olegfink_>
I'm not sure I understand what your code is supposed to do.
<BigJ2>
i realize this but since I create the initial size of the array and initialize it to 0 values I figured that would be the correct implementation of deleting the vectors and I don't access the 0 elements by decrementing