sponge45 changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/
whatthedeuce has joined #ocaml
pango_ has joined #ocaml
<whatthedeuce>
Hello. Is there any reasons that the following code: "function f -> f f;;" does not work? I get the error message: "This expression has type 'a -> 'b but is here used with type 'a". How could I get around this?
<tsuyoshi>
you want to make a function that applies itself to itself?
<tsuyoshi>
or..
<pango_>
do you mean 'function' or 'fun' ?
<tsuyoshi>
it applies its argument to the argument
<pango_>
mmh same error
<tsuyoshi>
hmm
<tsuyoshi>
it is not clear what it should return
<whatthedeuce>
I'm trying to convert the applicative order Y combinator from scheme to ocaml. My code should be equivalent to (lambda (f) (f f))
<tsuyoshi>
yeah.. that is how I would write it in ocaml I guess
<tsuyoshi>
but it really plays havoc with the type inference I think
<tsuyoshi>
if you specify a type for f it might work
ziggurat has quit ["Leaving"]
<tsuyoshi>
but since it's a recursive type I have a hard time thinking of an example that would work
<tsuyoshi>
I guess like
<tsuyoshi>
type foo = (foo -> int);;
<tsuyoshi>
function (f : foo) -> f f;;
<malc_>
malc$ locaml -rectypes Objective Caml version 3.09.0
<malc_>
# let m = function f -> f f;;
<malc_>
val m : ('a -> 'b as 'a) -> 'b = <fun>
<malc_>
so yeah
<whatthedeuce>
Thanks. That works perfectly
<tsuyoshi>
I have a hard time thinking of how that sort of expression would be useful
<Smerdyakov>
Holy craps! That looks nightmare-worthy!
<tsuyoshi>
but then I have no idea what "applicative order y combinator" means
<whatthedeuce>
It's interesting. It lets you define recursive functions without naming them
<whatthedeuce>
The best ocaml equivalent I can come up with is:
<whatthedeuce>
function le ->
<whatthedeuce>
(function f -> f f) (function f -> le (function x -> (f f) x));;
<Smerdyakov>
I humbly submit that the Y combinator has no place in the vast majority of programming languages.
<Smerdyakov>
General recursion has no place in 99% of programming.
<whatthedeuce>
With is, you can define a recursive function (say length) without naming it (ie, it would be of the form: y (function length -> function [] -> 0 | hd::tl -> 1 + length tl))
<tsuyoshi>
Smerdyakov: I think that's going too far
<whatthedeuce>
I doubt it's practical, but it's interesting
<tsuyoshi>
didn't you just name it length though?
<tsuyoshi>
in the length tl part
<whatthedeuce>
No. Length is passed in as an argument to an anonymous function
<tsuyoshi>
I fail to see the distinction
<whatthedeuce>
It's the distinction between let f x = x and function x -> x. The latter is an anonymous function
<tsuyoshi>
well like.. in scheme
<tsuyoshi>
you're saying it's the difference between let and lambda
<tsuyoshi>
no?
<bluestorm>
whatthedeuce: it seemed mw than applicative combinator was used in lambda-calculus for a formal recursion definition
<bluestorm>
but was of no practical use in real life
<beschmi>
tsuyoshi: it's the difference between let and letrec
<whatthedeuce>
In scheme, it lets you define recursive functions with only lambda's
<tsuyoshi>
ok.. so let/letrec are trivially rewritten with just lambda
<beschmi>
tsuyoshi: for general recursion you need one of letrec or the y combinator
<tsuyoshi>
although letrec needs set! too
<Smerdyakov>
Why did y'all use a recursive type for Y? Is there something wrong with this?
<Smerdyakov>
let rec y f = f (fun x -> y f x);;
<whatthedeuce>
I probably came up with a horrible translation into ocaml (I'm new to the language). I just mimicked the scheme version (almost exactly)
<Smerdyakov>
Perhaps you meant to avoid using the 'rec' keyword?
<tsuyoshi>
hmm so are you saying you can implement letrec with just lambda?
<Smerdyakov>
tsuyoshi, certainly not in simply-typed lambda calculus.
<tsuyoshi>
oh ok
<Smerdyakov>
tsuyoshi, but the Y combinator is old news for untyped lambda calculus. :)
<whatthedeuce>
That's right. The idea is implementing recursion without actually naming the function (with "define" in scheme...maybe without "let" in ocaml)
<tsuyoshi>
what is untyped lambda then?
<Smerdyakov>
tsuyoshi, eh? I'm talking about the simplest lambda calculus there is.
<tsuyoshi>
all I know about lambda I learned in scheme
<Smerdyakov>
Then you probably know only about untyped lambda calculus.
<tsuyoshi>
so this simply-typed, untyped - I don't know what it is
<bluestorm>
whatsup103:
<bluestorm>
actually
<bluestorm>
scheme isn't strongly typed
<bluestorm>
so it may allow you things ocaml doesn't
<Smerdyakov>
Scheme _is_ strongly typed.
<bluestorm>
hm
<bluestorm>
hmmmm
<bluestorm>
so
<bluestorm>
Smerdyakov: can i say there is no type inference ?
myerink is now known as pattern
<Smerdyakov>
bluestorm, you can say there is no static type checking!
<tsuyoshi>
well.. the type of a variable can change
<beschmi>
tsuyoshi: simply typed lambda calculus = caml - parametric polymorphism - recursive types - references - a lot more
<bluestorm>
ok
<bluestorm>
thanks Smerdyakov :p
<tsuyoshi>
in ocaml a variable never changes type
<bluestorm>
so i wanted to say that the type inference needed some restriction on the powerfullness of the type system
<bluestorm>
to be decidable
<bluestorm>
so there are some things that can be done in a riche formal type system
<bluestorm>
that scheme may support (because of the absence of static type checking and type inference)
<bluestorm>
and that ocaml may might not support
<bluestorm>
even if it's really corner-case and never used in real life
<Smerdyakov>
bluestorm, move to a type system as rich as Coq's and you stop being able to find practical examples of things you can do in Scheme that you can't do in Coq. :)
<bluestorm>
dunno :p
<bluestorm>
but i'll try Coq soon
<bluestorm>
more generally whatthedeuce i'm not sure that "let's do the same thing as in scheme" is the best way to handle caml
<bluestorm>
because it may makes you overlook some of the caml-scheme differents, and under-appreciate the things that are very far from scheme
<whatthedeuce>
This isn't really for a practical project. I'm just trying to explain the concept to a programmer friend, and I think he would be more responsive to ocaml syntax
<tsuyoshi>
huh.. I read the oreilly book but I don't remember this y combinator
<tsuyoshi>
maybe I skipped that part
<tsuyoshi>
I guess I skipped most of the mathy parts
<whatthedeuce>
I don't think it mentions it. He was just telling me so I could learn how to program in ocaml style. I read about the applicative order y combinator in "The Little Schemer"
<tsuyoshi>
hmm.. I have the little schemer but I couldn't manage to get very far
<tsuyoshi>
it is very sparse writing
<tsuyoshi>
and the first few pages were very obvious
<whatthedeuce>
It's worth reading, if only for the last couple of chapters
<whatthedeuce>
It gets far more advanced
malc_ has quit ["leaving"]
romanoffi has joined #ocaml
rillig has quit ["exit(EXIT_SUCCESS)"]
danly has quit ["Leaving"]
mbishop has quit [Remote closed the connection]
Foxyloxy has joined #ocaml
whatthedeuce has left #ocaml []
danly has joined #ocaml
hedos has joined #ocaml
Smerdyakov has quit ["Leaving"]
Aradorn has joined #ocaml
whatsup103 has quit [Remote closed the connection]
danly has quit [Remote closed the connection]
mbishop has joined #ocaml
batdog is now known as batdog|gone
Aradorn has quit ["This computer has gone to sleep"]
sponge45 has joined #ocaml
romanoffi has left #ocaml []
twobitsprite has joined #ocaml
sponge45 has quit ["zzzzzzzzzz"]
danly has joined #ocaml
danly has quit [Read error: 54 (Connection reset by peer)]
buluca has quit [Read error: 110 (Connection timed out)]
<tsuyoshi>
anyone here ever heard of linda?
<tsuyoshi>
it seems like it would be a natural fit for ocaml
akrito has joined #ocaml
<beschmi>
tsuyoshi: do you have a link for linda? don't think i've heard of it
<tsuyoshi>
that guy has a central server doing all the pattern matching
<tsuyoshi>
which seems like the wrong way to go.. if you do something like the google mapreduce where the matching is distributed it would scale better
<tsuyoshi>
I think I might try to implement this in a distributed mpeg2 encoder
<flux__>
the api descriptions I read apparently doesn't account for retrieving multiple keys asynchronously
<flux__>
and tuples might be better represented as lists in ocaml
<tsuyoshi>
lists? why
<flux__>
well it's difficult to write an api that supports n-tuples
<tsuyoshi>
a list wouldn't work at all.. in a list all the elements have to be the same type
<flux__>
with a language extension you could maybe make it feasible to use lists of Data ("string", Data (42, Data (42.0, ()))
<flux__>
yeah, I was thinking strings :-)
<flux__>
it's a shame ocaml doesn't support any kind of runtime type information
<tsuyoshi>
I'm thinking you would do a preprocessor that would figure out how to convert ocaml data types
<tsuyoshi>
but then.. the preprocessor would have to do type inference
<flux__>
that's a tricky part
<tsuyoshi>
hmm ok this is harder than I thought
<flux__>
yeah, the type information doesn't flow back to camlp4
<flux__>
I wonder though what the new camlp4 can do
<tsuyoshi>
new camlp4?
<flux__>
if it can do that, it'll be great :-)
<flux__>
rumor is (well, a fact) that there's a new, incompatible (?), camlp4 coming
<flux__>
I believe you can get it from the cvs
buluca has joined #ocaml
<flux__>
well, I suppose it still doesn't support that. it would be a tricky feature too, I guess
<flux__>
because after the preprocessor changes the code the type inference would need to be re-performed
<flux__>
(pango pasted it to the channel some time ago)
<tsuyoshi>
hmm.. so what would the syntax look like
<tsuyoshi>
lessee here
<tsuyoshi>
I hate to use keywords like
<tsuyoshi>
"get" and "put"
<tsuyoshi>
I think "in" and "out" are already taken
<flux__>
in is, out isn't
<tsuyoshi>
linda match <pattern> with <expr>
<tsuyoshi>
hmm.. and then.. how do you convert that to something the compiler will ignore
<flux__>
assert false will type into anything
slipstream has quit [Read error: 104 (Connection reset by peer)]
<tsuyoshi>
well.. you need something that creates variable bindings for the expression
<tsuyoshi>
uh.. I forget.. can you match on a string
<flux__>
actually you have it backwards
<flux__>
it's match <expr> with <pattern>
<flux__>
and <expr> could be assert false
<tsuyoshi>
hmm yeah
<tsuyoshi>
damn.. it's only been a couple weeks since I wrote something in ocaml
<flux__>
too bad all the match cases need to be of the same type
<tsuyoshi>
how did I forget so quickly
<flux__>
so I think that's not going to fly
<tsuyoshi>
linda match <expr> with <pattern> -> <expr>
<flux__>
would that do an 'in' then?
<tsuyoshi>
what's wrong with needing to be the same time?
<flux__>
it would match over the whole tuplespace?
<tsuyoshi>
same type
<tsuyoshi>
gah
<tsuyoshi>
flux: what do you mean match over the whole tuplespace?
<flux__>
I was thinking lina match get_stuff with "msg1", number, number2 -> .. | "msg2", string -> .. won't work
<flux__>
what would the match do?
<tsuyoshi>
I think it would be the same as a regular ocaml match
<flux__>
isn't it more like that you need to send a query to linda, and then you can use the normal pattern matching with the result
<tsuyoshi>
so the type for all the cases would have to be the same
slipstream has joined #ocaml
<flux__>
like: let var1, var2 = linda.in' ("msg1", ?, ?)
<tsuyoshi>
oh, well.. there's no standard linda protocol
<tsuyoshi>
it's an idea more than a specification
<tsuyoshi>
I was thinking more that every tuple would go to every node waiting for a tuple
<tsuyoshi>
and then every node would do the pattern matching on its own
<tsuyoshi>
hmm.. but then it might be nice if you could have just one node out of a group get a tuple
<tsuyoshi>
oh but you could do that pretty easily
<tsuyoshi>
just have all the nodes wait for a request tuple.. and then someone makes a request
<tsuyoshi>
and they all reply with a unique identifier
<tsuyoshi>
and whoever's making the request can just reply back to one of them
<tsuyoshi>
but then the more I think about it the more it seems like it needs to deal with patterns of multiple types
pango_ has quit [Remote closed the connection]
<flux__>
maybe you could search for inspiration from the Event-module
pango has joined #ocaml
Skal has joined #ocaml
velco has joined #ocaml
ChoJin has quit ["This computer has gone to sleep"]
love-pingoo has joined #ocaml
slipstream-- has joined #ocaml
<twobitsprite>
I'm still confused about functors... can someone point me to some examples?
<twobitsprite>
I mean, I realize that they're like functions from modules to modules, but I'm having a hard time visualizing their use
slipstream has quit [Read error: 60 (Operation timed out)]
pango has quit [Remote closed the connection]
pango has joined #ocaml
<mattam>
look at the Set module
ikaros has quit [Read error: 110 (Connection timed out)]
ikaros has joined #ocaml
Aradorn has joined #ocaml
Aradorn has quit [Client Quit]
<twobitsprite>
does ocaml have a function composition operator/function? I know they show how to define it in the tutorial, but it doesn't mention if there is one built in...
<mellum>
It doesn't.
<twobitsprite>
odd... I figured that was almost maditory of a functional language...
<twobitsprite>
there are a lot of things left out of the standard lib...
<mellum>
Yeah, the standard library is crap.
<twobitsprite>
that's unfortunate
<twobitsprite>
even extlib leaves one wanting
Aradorn has joined #ocaml
dark_light has joined #ocaml
<dark_light>
is there a way to make a partial search with Map module? I mean: i want in a particular search, the elements "who" and "wh" be different, but i want to search "the first element starting with wh", that should return wh and not who
<dark_light>
i was thinking in manipulating the compare function, but in that approach, "wh" and "who" would be the same key..
Aradorn has left #ocaml []
<dark_light>
(I was trying to change the Hashtbl module to work in that way, but that was very difficult! Hash tables isn't the right structure for what i want..)
Aradorn has joined #ocaml
<dark_light>
oh, in other words: i want a way to do something like.. findp function to find something with certain predicate (a 'a -> bool function), not certain key
<dark_light>
maybe i must change the Map module to a.. MapExt ;-;
<dark_light>
(hmm, maybe extlib has what i want..)
pango has quit [Remote closed the connection]
pango has joined #ocaml
romanoffi has joined #ocaml
Smerdyakov has joined #ocaml
<dark_light>
Smerdyakov, with the ocaml implementation of Map it's possible do something like a find_predicate? i give a 'a -> bool function and the find_predicate returns the first element that sadisfies the predicate
<Smerdyakov>
dark_light, yes. Map.fold facilitates a purely functional but inefficient strategy, and Map.iter facilitates an efficient but nasty strategy using exceptions.
<dark_light>
Hmmm, i was thinking in implementing it in a derivate module, MapExt
<Smerdyakov>
That's beside the point, which is what can be accomplished using the functions provided by Map.
<dark_light>
Smerdyakov, but i can guarantee that, while finding "the first element starting with wh", if there are "wh" and "who", i will find "wh"?
<Smerdyakov>
Yes.
<Smerdyakov>
Though I wouldn't want to commit on the details of the sacrilegious OCaml polymorphic comparison function.
<Smerdyakov>
You will get the items in the order induced by the comparison function you use.
<dark_light>
and, you said I can use Map.iter or Map.fold, but this is O(n).. no way to benefit the log(n) operations of Map?
<Smerdyakov>
That's obviously impossible with a general predicate search.
<Smerdyakov>
Even with direct access to the representation
<dark_light>
hmm :o
<dark_light>
well, i think Map.fold may help if i want to get "a list of all keys starting with wh"
<Smerdyakov>
You should have said you had more precise requirements if you wanted to take advantage of optimizations that they enable. :P
<Smerdyakov>
It certainly looks to me like you must do asymptotically worse using only the functions exposed by Map.
<dark_light>
Hmmmmm.
<dark_light>
maybe i should study some of balanced binary trees :D
<dark_light>
if a tree is optimized to search according the compare function, it may be optimized too for some other functions?
<dark_light>
actually what i want to implement looks more like a data base than a regular data structure
romanoffi has left #ocaml []
romanoffi has joined #ocaml
danly has joined #ocaml
shawn has quit ["This computer has gone to sleep"]
ChoJin has joined #ocaml
Axioplase has joined #ocaml
<tsuyoshi>
dark_light: what are you trying to do exactly?
<tsuyoshi>
I wrote a program that had a similar sort of requirement
<tsuyoshi>
and I just used berkeley db
<tsuyoshi>
but there are a large number of elements to search
<dark_light>
tsuyoshi, a bit of things unrelated things. the simplest is: a associative list/array/whatever of strings that is case-insensitive and supports searching for the beginning of a string
<dark_light>
like, "find the first string that begins with wh"
<tsuyoshi>
how many strings are there?
<dark_light>
s/a bit of things unrelated things/some unrelated things/
<dark_light>
tsuyoshi, maybe 10, maybe 50
<tsuyoshi>
oh
<dark_light>
they may change in runtime
<tsuyoshi>
hmm if you just keep them sorted you can do a simple binary search
<tsuyoshi>
or I guess a tree works better
<dark_light>
tsuyoshi, Hmmmm binary search isn't a thing only for trees?
<tsuyoshi>
no.. you can do a binary search on an array
<dark_light>
Hmmm.. like.. choosing a point in the middle of array to begin?
<tsuyoshi>
I tend to think "array" with binary search because I've been using c for so long
<tsuyoshi>
there's a bsearch() function in the standard c library
<tsuyoshi>
and it searches an array
<dark_light>
my approach in the moment is: a hashtable with all strings lowercase. but searching for strings that begin with some substring isn't very good with hash tables
<tsuyoshi>
there are two ocaml bindings for it out there.. I did my own which I haven't released yet
<tsuyoshi>
but I can send it to you if you want
<tsuyoshi>
it's really overkill for 10-50 items though
<dark_light>
it would be fine :E
ChoJin has quit ["This computer has gone to sleep"]
<dark_light>
well i think for this specific problem i will try to do with a modified Map module
<dark_light>
but i will store many different things, and maybe a "regular" way to store things would be better
<tsuyoshi>
hmm
<dark_light>
like: i will store rooms too (maybe between 100-1000) and some players (maybe between 10-40), and may have to find "all players in a given room" or "all rooms next to a player"
<dark_light>
(that "all rooms next to a player" will be actually very inneficient i think)
<tsuyoshi>
oh in that case you shouldn't have to search at all
<Axioplase>
dark_light: err.. I think that Map.Make on a string might make a tree balanced on that string's chars (though string != char list in Ocaml)
<tsuyoshi>
the players and rooms should refer to each other
<tsuyoshi>
but your original question for a partial match.. the red-black trees in the cf library can do it
<dark_light>
Axioplase, but, how to search using the balanced thing in benefit?
<dark_light>
tsuyoshi, cf?
<Axioplase>
If not, then, make your string a list of chars, and path the way in a 26-ary tree (which is roughly the same as a deeper binary tree.. same complexity)
<tsuyoshi>
unfortunately they don't have the document up for browsing
<dark_light>
Axioplase, i think i can have a good tree for finding what i want with only the Map module, but the module don't seems to provide a way to search things using the tree layout
<Axioplase>
type wtree = Nil | Cons of (char,wtree) list
<dark_light>
hmm.
<tsuyoshi>
val nearest_incr : Key.t -> 'a t -> (Key.t * 'a) Cf_seq.t
<tsuyoshi>
Use nearest_incr k m to obtain the key-value pair ordinally greater than or equal to the key
<tsuyoshi>
k in the map m. Raises Not_found if the map is empty or all the keys are ordinally less.
<Axioplase>
dark_light: Map gives you a balanced binary tree interface. But it doesn't let you search. Think of your tree as an ordered Set
<Axioplase>
(as far as I know)
<tsuyoshi>
(from the cf documentation)
<tsuyoshi>
but this is not a terribly difficult thing to implement yourself, to be honest
<tsuyoshi>
there is a pretty good book on this topic
<dark_light>
Axioplase, so that was my idea, making a derivate module that lets me to search
<dark_light>
i have a terrible problem with functional data structures. sometimes i have to use them in a deeply specialized ways in some "inner" functions, very far from my main function
<dark_light>
if i created the structures from my function, i have to pass them to all child functions
<dark_light>
(like: i loaded the structure from a file, whatever)
<dark_light>
and, i must pass the structure for all specialized functions, this is very verbose for me :(
<dark_light>
with a hash table defined like a constant in a file, i can make specialized functions that i don't need to pass the structure to the function. and, i don't need to pass the structure for the child functions
smimou has joined #ocaml
<dark_light>
like: i create the structure in let _ = .. and if it's functional, i must pass it to inner functions, that must pass it again to the functions that will actually use :(
<Axioplase>
yes.
<Axioplase>
You may try to pass your data with a monad, but I think you're better with what you're doing now...
<dark_light>
there are monads in ocaml?
<Axioplase>
Or, if you only use one of such data at time, just make a global ref...
<Axioplase>
dark_light: there are some monad libs
<dark_light>
Axioplase, when i defined a channel statically with let channel = Event.new_channel();;, half of my implementation problems were dropped
<dark_light>
that's ugly, but the other approach was uglier =(
shawn has joined #ocaml
<dark_light>
Axioplase that what sometimes i use for non-mutable data structures
<dark_light>
but hashtbl are mutable anyway
<Axioplase>
well... State Passing Style or side-effects.. you have to chose... but for clean code's sake, don't mix both at the same time...
<Axioplase>
I'd say that SPS makes your code easier to read/debug
<dark_light>
Hmmm
<dark_light>
sometimes side-effect functions are very convenient.. i can achieve the same syntax doing something like let side_effect arg = general_function state arg in, in each function that would use the side-effect version.. but it seems over-duplication of code :(
_velco has quit ["I'm outta here ..."]
_velco has joined #ocaml
_velco is now known as velco
pango has quit ["Leaving"]
pango has joined #ocaml
bluestorm has joined #ocaml
_fab has joined #ocaml
wnexxb has joined #ocaml
wnexxb has left #ocaml []
twobitsprite has quit [Connection timed out]
Debolaz has joined #ocaml
bluestorm is now known as bluestorm_aw
bluestorm_aw is now known as bluestorm
hedos has quit [Read error: 110 (Connection timed out)]
hedos has joined #ocaml
Aradorn has quit ["This computer has gone to sleep"]
slipstream has joined #ocaml
slipstream-- has quit [Read error: 60 (Operation timed out)]
love-pingoo has joined #ocaml
triple_ has quit [Read error: 104 (Connection reset by peer)]
danly has quit ["Leaving"]
flux__ has quit ["Lost terminal"]
velco has quit ["I'm outta here ..."]
bluestorm has quit ["Konversation terminated!"]
_fab has quit [Read error: 110 (Connection timed out)]
romanoffi has left #ocaml []
love-pingoo has quit ["Connection reset by pear"]
Demitar_ has joined #ocaml
buluca has quit [Read error: 104 (Connection reset by peer)]
buluca has joined #ocaml
Demitar has quit [Read error: 110 (Connection timed out)]