<grom358>
why on earth do you want todo that though?
<kinners>
slashvar[lri]: yeah, I wasn't crystal clear on what I meant... getting late here :)
<mflux>
maybe you should suggest the sematics how automatic rec/no rec would work and we can evaluate if those rules would be sensible
<slashvar[lri]>
this example is silly, of course, but, within the interactive toplevel, it may happen.
<grom358>
mflux: what problems would there be if let rec replaced let?
<slashvar[lri]>
an other point is that a recursive and a none recursive abstraction are compiled the same way ...
<mflux>
grom358, well with existing code there could be many unforeseen problems
<slashvar[lri]>
are not compiled, sorry
<grom358>
anything else?
<kinners>
I notice that scheme (the version I was using anyway) still needs letrec even though a normal procedure definition is recursive (due to scoping of local definitions)
<mflux>
grom358, I think you could write all the code one nowadays writes without 'let rec' with 'let rec' too, by renaming some identifiers
<mflux>
so it would be no problem
<grom358>
bascially I am just trying to understand if let rec is just back compatible thing. And if were starting from scratch if they would be any reason to have the both of them
<mflux>
although I personally don't mind the distinction
<slashvar[lri]>
in CDuce, every named functions are recursive, you don't need a let rec, but in the language function are not lambda but mu
<mflux>
I think haskell doesn't allow any redefining of identifiers
<mflux>
if ocaml did that too, then 'let rec' could be automatic
<slashvar[lri]>
grom358: no it's not back compatible, "it's a feature" and a choice
<mflux>
but with redefining 'let rec'/'let' are nice to have
<grom358>
slashvar: okay then. What is the benefit of it? why do you or want to do let f = 1 in let f n = f + n in f 1 ;; ?
<mflux>
grom358, do you think let x = x + 1 should be allowed?
<mflux>
grom358, I mean, the rules to determine the proper scope to be used could be complex
<mflux>
in any case more complex than they are now; if it's not rec, use previous definitions, if not, use the current one
<mflux>
let x = x + 1 would mean x binds to an earlier x, yet let x y = if y > 0 then x (y - 1) else 42 would mean x binds to the same statement?
__DL__ has joined #ocaml
<mflux>
and how about let x = function y -> if y > 0 then x (y - 1) else 42 ?
<grom358>
u lost me there. What are you doing there?
ejt has quit ["leaving"]
<grom358>
I am newbie to OCaml
<grom358>
not to programming. But been researching all the various languages. So far have done a bit of the following: Ruby, Python, Scheme, Lisp, OCaml, C, C++. I have a lot of experience with Java
<mflux>
I'm defining a silly function that returns 42 when given 0 or less and when called with any other value it returns the value a function x with y - 1
<mflux>
and per your interpretation it would call the function itself recursively, with current interpretation it would call another function defined earlier
<mflux>
'function' is a way to define a lambda function
<Herrchen>
the decision to have both is something related so which values may be recursive definitions and which not
<grom358>
mflux: okay. I see. But why rebind to same symbol yet use the definition of the earlier symbol?
inka has quit []
bzzbzz has joined #ocaml
<Herrchen>
something else than a function shouldn't be recursive (in general it may not terminate to calculate the result, there may not be any result)
<mflux>
herrchen, let rec l = [1; 2; 3] :: l..
<Herrchen>
in imperative programming languages you have no such problems, because their functions are no first class citicens
<grom358>
basically, what is benefit of rebinding the symbol? and use the earlier binding of the same symbol name to define it?
<mflux>
grom358, well, maybe because it may look useful at times
<Herrchen>
mflux: well I know there are ... - but these are somehow very special cases (nice but special cases)
<mflux>
it might bring some 'imperative feel' to it
<mflux>
some may not agree with me here.. ;)
<mflux>
considering a loop that counts numbers from 10 to 0
<Herrchen>
well but in general defining recursive values that aren't functions isn't a good idea
<mflux>
let rec iterate n = Printf.printf "%d\n%!" n; let n = n - 1 in Printf.printf "Now going to %d..\n" n; iterate n
<mflux>
of course, you could just use n'
<grom358>
mflux: it doesn't worry me too much having both. Just trying to understand where it would be useful to have let and go let x y = x (y - 1) or what not
<Herrchen>
but it's a function not a non-functional value
<mflux>
let dosomething f = let f = Printf.printf "Calling f.."; let v = f () in Printf.printf "Called f\n" in f (); f (); f ()
<Herrchen>
grom358: its about having one mechanism for defining values and have the same construct behave the same
<mflux>
whops
<mflux>
let dosomething f = let f = Printf.printf "Calling f.."; let v = f () in Printf.printf "Called f\n"; v in f (); f (); f ()
<mflux>
so, debugging is one case!
<mflux>
and let f -> let f ()
<Herrchen>
grom358: you have to understand that not like in C or Java functions in ML are first class citizens
<grom358>
yeah.. I have done a bit with higher-order functions in Scheme
<kinners>
mflux: have you tried g'caml?
<mflux>
kinners, nope
<Herrchen>
so why should "let x in x + 1" behave different to "let fac n = if n = 0 then 1 else n * fac (n - 1)"
<mflux>
I have downloaded and compiled it, though ;)
<grom358>
haven't used letrec yet though. But I take it Scheme is the same when it comes to letrec as OCaml
<kinners>
mflux: it'd be interesting to see what the speed penalty is, apparently it is faster than runtime type dispatching, maybe just a single array lookup to get the required function...
<mflux>
kinners, hmm, I thought it would be all compile time?-o except (obviously) when you use dynamic stuff
<mflux>
it is all decidable, isn't it?
<mflux>
well
<mflux>
maybe I took that wrong
<mflux>
it shouldn't be slower than passing functions as parameters to the called functions
<mflux>
but it'd be nice if it were faster than that
<slashvar[lri]>
hum, deciding wether a function is recursive or not ? you can't call it decidable, since you don't have a real answer until the user specify it
<mflux>
it could be, if the compiler would automatically compile specializations, but I doubt it does
<mflux>
slashvar[lri], we were talking about gcaml
<mflux>
I think we were ;)
<slashvar[lri]>
mflux: sorry, I may miss some part of the discussion ;)
CosmicRay has joined #ocaml
<slashvar[lri]>
mflux: You talk about generics ? if I remember well it's involving some dynamic features
<mflux>
slashvar[lri], yeah. it has the 'dyn'-type
<mflux>
with runtime casting into something else
<mflux>
(with runtime checking of course, otherwise you could just use Obj.magic ;)
<slashvar[lri]>
(there's some generic type support inside .net vm needed by generics in c#)
<slashvar[lri]>
I've not already take a look at generics
<mflux>
I've only droo^H^H^H^Hlooked at the documentation/website
<slashvar[lri]>
but, if it's implied dynamic (safe) type cast, it's implied a runtime penality
<kinners>
the dyn feature is seperate from the generic feature afaik
<mflux>
yeah
<mflux>
it also allows dynamically checked data marshalling/unmarshalling
<mflux>
structural equality is sufficient to pass it
<mflux>
so you can pass data between different executables too
<mflux>
and then there is type safe dynamic loading too I think
<mflux>
or maybe I've just extrapolated this in my head ;)
<mflux>
in any case, even if gcaml ever were integrated into ocaml (and I believe there are no current plans for doing that), it'd still be years off
<slashvar[lri]>
Last time I heard Xavier (and some others from crystal team) talk about dynamic loading he wasn't talking about generics ...
CosmicRay has left #ocaml []
<slashvar[lri]>
(just to finish about, let rec for grom358, there's 2 points for me, in the toplevel multiple definition can often occurs with ambiguous semantics and second some users would prefer explicitely state what they want rather than rely on an obscure decision made by the compiler.)
<grom358>
slashvar: okay
<slashvar[lri]>
this more a design issue (and maybe cultural, most functionnal language have this notion of explicit declaration of recursivity)
* slashvar[lri]
back to his flow analysis and pseudo-"fucking"-types-system and subtyping algorithm ...
<Submarine>
hi slashvar[lri]
<slashvar[lri]>
hi Submarine
<Submarine>
slashvar[lri], do we know each other?
<Submarine>
I mean, in real life
<slashvar[lri]>
maybe we have met at ens (my co-director is G. Castagna)
<Submarine>
aaah
<slashvar[lri]>
or at some conf ...
* Submarine
likes Beppe
<slashvar[lri]>
héhé ;)
Herrchen has quit ["bye"]
<slashvar[lri]>
Hum, if you where at G. Necula talks in february, we have met here
<slashvar[lri]>
(but I was very very tired this day ... I'm afraid I have missed some parts of the talk ... )
Gueben has joined #ocaml
grom358 has quit []
<Smerdyakov>
slashvar[lri], I can explain anything you missed. ;)
kinners has quit ["leaving"]
Submarine has quit ["Leaving"]
palomer has joined #ocaml
<palomer>
is ocaml easier to install/use in windows than sml?
Submarine has joined #ocaml
veleno has joined #ocaml
<veleno>
why i can't do this: let rec choose (k,xs) = match (List.lenght xs) with... ?
<Submarine>
sorry?
<veleno>
Submarine: i get a "Unbound value List.lenght"
<Gueben>
veleno, i don't understand the goal of this function
<veleno>
to get the list of sublists of length k of a given list
<Gueben>
for example : only [1,2] [2,3] [3,4] for choose(2,[1,2,3,4) ?
pango has quit [Read error: 60 (Operation timed out)]
<veleno>
Gueben: you got it
<Gueben>
ok
<veleno>
the function works properly, but it alwasy arises that exception that i have to catch
palomer has quit ["Leaving"]
er has quit [Read error: 110 (Connection timed out)]
<Gueben>
what shlould nsegs do when length of lst < n ?
<Gueben>
just rise the exception ?
tintin has joined #ocaml
GuebN has joined #ocaml
GuebN has quit [Read error: 54 (Connection reset by peer)]
<vincenz>
I still fail to see why you can't use + for floats AND ints. Think about it, the operator = is also a 'a -> 'a -> true. Then you could have + be a 'a -> 'a -> 'a. There is no issue of 4.5 + 3 because those are not both of the same type. Of course the 'a is too generic but if the type system were amplified to allow restricted polymorphism, then that would be fine.
<Submarine>
type inference
<Nutssh>
The problem is (None + None) : 'a option ?!?!?!?
<mellum>
There's no fundamental reason. It was just a choice.
<Nutssh>
You'd need some sort of higher order type system or type classes to indicate that (+) is OK for number-like things, but not for all things.
<vincenz>
Submarine: = does not create type-inference issues
<vincenz>
and it's 'a -> 'a -> bool
<Submarine>
so?
<vincenz>
Nutssh: well if you could restrict general types it would be fine
<Submarine>
you can't declare + to be 'a -> 'a -> 'a
<vincenz>
Submarine: so why does it pose issues with type inference?
<Submarine>
what does it mean to add a boolean to a structure object?
<vincenz>
It's an issue with the fact it should only be for 'a in (int, float) but for the rest, what is the type inference issue?
<vincenz>
Submarine: Both are the same type8
<Submarine>
woops
<vincenz>
'a -> 'a (both parameters must be same type)
<Submarine>
what does it mean to add two structure objects together?
<Nutssh>
vincenz, exactly, thats what type classes or a higher order type system let you do --- because they're more powerful (but with their own disadvantages)
<Submarine>
well: type inference problem:
<vincenz>
Hence me saying, you need to RESTRICT types
<Submarine>
but then you cannot do 2 + 3.
<vincenz>
but I don't see it as a type inference problem, but a problem with the restriction
budjet has joined #ocaml
<Submarine>
or you have to add subtyping
<vincenz>
Most people throw "type inference" at my head, but I fail to see why
<Submarine>
well
<vincenz>
restriction, yes, failure to infere, no
<Submarine>
what is the type of fun x y -> x + 3?
<Submarine>
woops fun x -> x + 3?
<Submarine>
int -> int?
<vincenz>
obvious
<vincenz>
yes
<vincenz>
3 is an int
<vincenz>
+ : 'a -> 'a -> 'a
<Nutssh>
vincenz What should be the type of 'let f x = (fun y -> x+y)' be?
<Submarine>
but is 3 + 5. a legitimate expression?
<vincenz>
not 'a -> 'b -> 'c
<vincenz>
Submarine: No
<vincenz>
'a -> 'a
<vincenz>
note the same letter
<vincenz>
Nutssh: 'a -> 'a -> 'a
<vincenz>
let f x = (fun y -> x = y)
<vincenz>
same difference
<Nutssh>
vincenz, then 'f None None' would be correctly typed.
<vincenz>
Nutssh: again
<vincenz>
it's a problem of RESTRICTING your types
<Nutssh>
There's a difference, (=) is defined on all types. (+) is not.
<vincenz>
but besides that I fail to see the reason why it would not infere
<vincenz>
Many people say "you cant have that cause you need a dynamic system" Imho, no you can do it with static typing if types can be restricted
<Nutssh>
vincenz, if we inferred my 'f' as you propose, then 'f None None' would typecheck, what happens when you run it?
<vincenz>
You're obviously failing to hear what I say
<j_n>
how would it be possible to restrict the types of the (+) operator
<vincenz>
That is a different issue
<j_n>
to a subset of all types
<Nutssh>
I am asking you a specific question, could you answer it?
<vincenz>
Nutssh: Again...yes, the typesystem needs to be changed to allow restriction of types, but why would it fail inference
<Submarine>
vincenz, ok, it's possible with type constraints
<j_n>
you'd have to add a new kind of polymorphic type
<vincenz>
right
<j_n>
?
<vincenz>
something like ('a with constraint 'a one of ...)
<vincenz>
Why is :: the ONLY data-constructor that can be done infix?
<Nutssh>
vincenz, inferring that is going to be tricky in the general case. you could specialcase int/float.
<Nutssh>
vincenz, lots of dataconstructors can be done infix.
<vincenz>
Nutssh: well something like ('a where 'a elemof {int, float})
<vincenz>
of course it becomes quickly complex if you alllow the set to contain dynamic types, you'd need some sort of ordering between types to remove those that are more specific than others, blah, I'm not a type-specialist
<vincenz>
I mean polymorphic, not dynamic
<Nutssh>
How would you infer let h f g = (fun x -> f g f x) if f&g have some sort of constrained types as you propose. It gets nasty as you expect.
<vincenz>
It does
<vincenz>
but it should be possible imho
<Nutssh>
vincenz, it can be done. It has been studies. Thats what type classes or a higher order type system let you do --- because they're more powerful (but with their own disadvantages, eg, type inference can be nonterminating, which is why its not used.)
<vincenz>
Nutssh: type classes allow you to "enlarge" a type constraint
<vincenz>
this doesn't need to do that
<Nutssh>
define "enlarge" == more restrictive or less restrictive?
* vincenz
wishes that there were more infix data=constructors beisdes ::
<Nutssh>
If you mean more restrictive, then it would be necessary.
<vincenz>
less restrictive
<vincenz>
cause you define a new type "derive" it from an existing type which has the operator...and blammo
<vincenz>
that's why haskell needs runtime stuff, it almost works like oo
<vincenz>
except it's not visible
<vincenz>
(And you can't polymorph stuff to other things, just for typechecking purposes)
<vincenz>
anywho, I'm out of my leauge
<Nutssh>
vincenz, see the syntax section of the manual. Nothing special with ::
<Nutssh>
Usually each time you use a variable, you never unconstrain its type, but can only restrict/constrain it further.
<vincenz>
Nutssh: it's the only one tho
<vincenz>
Nutssh: yes but I meant, if you define your own structure and you also want it to have (+)
<vincenz>
nm
bzzbzz has quit ["leaving"]
<vincenz>
Nutssh: :: is the only infix data constructor :/
<vincenz>
I wish there were more
<Nutssh>
Whoops, yeah, I am wrong. It is a keyword.
<vincenz>
And I wish you could also have symbolix data constructors with no alphanumeric
<vincenz>
eugh...you know what I mean
<vincenz>
type 'a list = :: of 'a * 'a list | [] is not possible
<Nutssh>
You can get close type 'a list = :: of 'a * 'a list | Nil
<Nutssh>
And thats not that bad of a restriction. Its only syntax.
<vincenz>
Yes but it's flawed
<vincenz>
Type 1 :: Nil
<vincenz>
you get ::(1, Nil)
<vincenz>
Type ::(1, Nil) you get a "what?"
<Nutssh>
:) ''Don't do that''?
<vincenz>
And you can't use modulenames, so anywhere you want to use that, you'd have to seclude the list
<vincenz>
Can't do ModuleName.::
<vincenz>
so it's pretty useless
<vincenz>
Unless you don't use lists anywhere you use that custom ::
<vincenz>
Big limitation imho
<vincenz>
(that and having :: as the only one ;) )
<vincenz>
I mean, ocaml already limits names.... no Capitals for variables. Why not take it abit further and say no :xxx for operators, only for data constructors
<Nutssh>
Thats not that bad of a restriction. Its only syntax.
<vincenz>
I know
<vincenz>
it'd be great tho
<vincenz>
remove the :: from special handling and make any :symbolsymbol as an infix dataconstructor
<vincenz>
Ocaml does that for instance
<vincenz>
I mean...haskel
<vincenz>
(it's late, it's friday..)
<Nutssh>
And if you're not doing matching, why not do, eg let (!!) x = Foo(x) and let the inliner sort it out.
<vincenz>
yes but the great power of infix is matching mostly
<vincenz>
imho
<vincenz>
Just looks cleaner
* Nutssh
thinks it depends on circumstance.
<vincenz>
Well I defined this type 'a cluster that's kind of like a list
<vincenz>
but matching it...yick
<vincenz>
All these ugly names
<Nutssh>
Maybe there's a better interface to it than matching. Eg, List.fold/List.map vs match...
<vincenz>
nono
<vincenz>
I have to match my dataconstuctors
<Nutssh>
Why?
<vincenz>
?
<vincenz>
euhm..duh?
<vincenz>
how else do you get to the data inside?
<Nutssh>
I don't have to match :: in almost all of my uses of List. Nor do I use 'match' with hash tables and so on.
<vincenz>
so how do you traverse down a list?
<Nutssh>
I don't. List.fold/List.map/List.iter do it for me.
<Nutssh>
... most of the time.
<vincenz>
Won't do it for me this time ;)
<Nutssh>
Maybe you want a visitor pattern. (Eg, how CIL works.)
<vincenz>
nop
<vincenz>
when adding something to a cluster, I have to travel down the list, keep the stuff I have popped off in a second list, when I find a match, match this list with the popped off list
<vincenz>
heh...it was so heavy I had to add in a windowing thing to keep the computation down :/
<Nutssh>
If its an internal type, use short mnenomic names in the sum type declaration, and document what they mean?
budjet has quit [Remote closed the connection]
<vincenz>
I guess
<vincenz>
Anyways I oughta get going to home
<vincenz>
bbl
<vincenz>
And if you want to look at the clustering to think of a way to optimize it, I'll paste it later ;)
Snark has quit ["Leaving"]
budjet has joined #ocaml
Gueben has quit ["Leaving"]
vezenchio has quit [""Under democracy one party always devotes its chief energies to trying to prove that the other party is unfit to rule—and bot]
vezenchio has joined #ocaml
budjet has quit [Remote closed the connection]
<vincenz>
re
afnom has joined #ocaml
budjet has joined #ocaml
TeXitoi has quit ["leaving"]
znutar has joined #ocaml
budjet has quit [Remote closed the connection]
monochrom has joined #ocaml
derfvc has joined #ocaml
smimou has quit ["?"]
veleno has quit ["Client exiting"]
vezenchio has quit [""Under democracy one party always devotes its chief energies to trying to prove that the other party is unfit to rule—and bot]