<det>
nlv11757_, you have to write a printer for each type
<nlv11757_>
haha darn, I was affraid that might be the answer
<nlv11757_>
thanx anyway
<det>
Someone yesterday expressed interest in writing a camlp4 extension to generate a print from type descriptions
pango has quit [Remote closed the connection]
<nlv11757_>
yeah, like generic haskell
<det>
Hrm? Doesnt regular Haskell do that with deriving Show?
<nlv11757_>
ow sure, but generic haskell offers writing of type-indexed functions
<nlv11757_>
so write a function for products and sums and you can generically handle all user defined datatypes
<nlv11757_>
Im probably doing generic haskell short by this description :) so don't shoot me
<det>
I would prefer the type class approach
<nlv11757_>
for example, you can write a generic eq function for all datatypes extremely elegant in generic haskell
<nlv11757_>
it has lot's of usefull applications
<det>
you mean an eq function of 'a -> 'a -> order?
<det>
not 'a -> 'b -> order?
* Msandin_
just recently wrote a generic string_of_<type> deriver, derived from the camlp4 tutorial..., handles constructed and tuple types...
<nlv11757_>
I mean the; a -> a -> Bool
<det>
Msandin_, Nice, too bad you can't combine that with Type Classes :(
<Msandin_>
"type <definition> with string_of", the real aim is to handle "with map, fold" as well...
<det>
Msandin_, That is very awesome
<Msandin_>
det: well, Ocaml doesn't have them, so... can't really have that...:)
__DL__ has joined #ocaml
<Msandin_>
But deriving in Haskell, isn't magic, it's just the Haskell compiler having special knowledge about how to instantiate certain typeclasses mechanically...
<det>
Msandin_, yeah, exactly like what you are doing
<nlv11757_>
I know it's not magic, it's just handy :)
<Msandin_>
Yup, handy dandy:)
pango has joined #ocaml
Snark has quit [Read error: 110 (Connection timed out)]
smimou has joined #ocaml
<kHebSkik>
morning (GMT+1)! does anyone know a binding or package for genetic algorithms?
solarwind has joined #ocaml
* kHebSkik
enjoys the silence :)
<Msandin_>
kh: what kind of stuff are you looking for?:)
<kHebSkik>
Msandin_: just something that let's me get up to speed with GA searching
<Msandin_>
How do you expect to use it? Write a module specific for your task and apply a functor?
<kHebSkik>
Msandin_: yes, something like that...define what the chromosomes codify and direct the search.
* Nutssh
used ocaml for a GA project for a class.. The app-specific knowledge is mostly factored out, though not to the level of a functor.
* Msandin_
did too, functorized, but directing search, well... one writes a functor with the genome type, mutation and fitness functions, and go to town... probably a bit specific and naive:/
<Msandin_>
(hm, not functor, module)
<kHebSkik>
Msandin_: but no ready applications come to mind, except for the ones you wrote yourself?
<kHebSkik>
(applications == implementation of mutation, combination, etc.)
_fab has joined #ocaml
<Msandin_>
I sort of think it's all a bit too specific, but it is fairly abstracted, I think you could do useful things, but I'm not really sure there's enough reuse to be worthwhile
<Nutssh>
Same.. I figured I could always turn it into a functor in the future if I needed to.
<Nutssh>
Mine is more along the lines of a library of functions. It should be fairly reusable.
<kHebSkik>
Msandin_: Nutssh: thanks!
<Msandin_>
hb: the signatures are at http://rafb.net/paste/results/oImMim58.html, for whatever thats worth, code is available by request if u want to take a look (I would need to package it)
<Nutssh>
google for comp440 at my university for my codebase.
<kHebSkik>
Msandin_: thanks, but only if you have the time...
<kHebSkik>
Nutssh: what university would that be?
<Nutssh>
rice university, (from my hostname)
<kHebSkik>
Nutssh: sorry, a bit knew to IRC, how could I have found that out?
<Nutssh>
/whois nutssh
<Nutssh>
no problem. Didn't know you didn't know.
<kHebSkik>
Nutssh: thanks
<nlv11757_>
ok im getting annoyed with ocaml :) what is wrong with this"
<nlv11757_>
:
<nlv11757_>
let foldl1 op (x::xs) = fold_left op x xs in foldl1 (+) (1::2::3::[])
<nlv11757_>
it's giving me a hard time about the usage of (+)
<mflux>
works for me
<mflux>
have you tried it in an interactive session?
<nlv11757_>
it works in interactive session, but not when i simply run ocaml on it?
<nlv11757_>
or is it because i have to decorate my .ml file with verbose statements to make it a real ocaml module or something like that
<mauke>
works here
<mauke>
(assuming open List and stuff)
<nlv11757_>
:O
<nlv11757_>
ok this even pisses me off more lol
<mauke>
does it complain about "in"?
<mauke>
what's the exact error message?
<mflux>
nlv11757_, my theory is that your +-operator is messed up?-)
<nlv11757_>
it's the default one i hope :D
<nlv11757_>
i get weird messages saying that it's Int -> Int -> Int (that isnt weird) but used as (a->b) -> (a->b) -> ...........
<mauke>
what is Int?
<nlv11757_>
i mean int :) im a Haskell programmer hehe
<nlv11757_>
ok im taking a break from this :) later
<mauke>
can you post a minimal but complete example that exhibits the problem?
<det>
nlv11757_, O'caml has nicer syntax for lists, btw
<det>
[1;2;3]
_fab has quit [Remote closed the connection]
gim has joined #ocaml
kHebSkik has quit ["using sirc version 2.211+KSIRC/1.3.11"]
_fab has joined #ocaml
<nlv11757_>
ah I knew that det, but since it didnt work, I kind of changed a lot of things to see what the problem was
<nlv11757_>
including changing [1;2;3] to 1::2::3::[]
<nlv11757_>
:D
<nlv11757_>
here is the example:
<nlv11757_>
>open List
<nlv11757_>
>let foldl1 op (x::xs) = fold_left op x xs
<nlv11757_>
>foldl1 (+) [1;2;3]
<nlv11757_>
this doesnt work because foldl1 is unbounded, but if i make a main function which does this call
<nlv11757_>
i get the problem i described ealier
<nlv11757_>
he complains about the (+) being ('a -> 'b) -> ('a -> 'b) -> 'a -> 'b instead of int -> int -> int
<rossberg>
you haven't redefined (+) somewhere?
<rossberg>
try annotating ((+) : int -> int -> int)
<rossberg>
to find out
<nlv11757_>
nope
<nlv11757_>
but he reckognizes that (+) is int -> int -> int, but he has a hard time with the *use* of the (+) here
<nlv11757_>
which is ('a -> 'b) -> ..... accoording to ocaml
<rossberg>
ok, I parsed your previous sentence the wrong way round...
<rossberg>
what type does it infer for your def of foldl1 then?
<nlv11757_>
val foldl1 : ('a -> 'a -> 'a) -> 'a list -> 'a = <fun>
<nlv11757_>
exactly what I wanyt
<nlv11757_>
-y
<nlv11757_>
thats why i cant crack the fact that foldl1 (+) [1;2;3] causes problems like this
<nlv11757_>
it *has* to be a syntax thing
<rossberg>
what did you mean earlier, when you said foldl1 is "unbounded"?
<nlv11757_>
ok if i just have a top-level definition let foldl1 = ...
<nlv11757_>
and then have on a separate line a call to foldl1
<nlv11757_>
its not possible
<nlv11757_>
i get the message that foldl1 is unbonded
<nlv11757_>
+u
<rossberg>
ah, I think I see your problem now
<nlv11757_>
good :)
<rossberg>
you cannot just put an expression on a line in an .ml file
<rossberg>
it will be parsed as part of the preceeding declaration
<nlv11757_>
owwww
<nlv11757_>
he thought i was giving main as an extra parameter to my foldl1 call
<nlv11757_>
omg
<rossberg>
as if you wrote let foldl1 op xs = bla foldl1 (+) [1;2]
<rossberg>
something like that
<rossberg>
try let _ = expr
<nlv11757_>
he actually though i was calling it like this: 'foldl1 (+) [1;2;3] main'
<nlv11757_>
lol
<nlv11757_>
layout rules make errors so useful sometimes :)
<nlv11757_>
thanx a lot in any case rossberg
<nlv11757_>
so top-level structure is always a let right?
<rossberg>
yes
<rossberg>
np
<nlv11757_>
Still adapting a bit from the Haskell world, so most questions are stupid syntax-like :)
<rossberg>
yes, Haskell syntax is much more fun anyway
<nlv11757_>
well, I dont want to start a language war :P but I prefer Haskell anydays hehe
kHebSkik has joined #ocaml
kHebSkik has quit [Client Quit]
kHebSkik has joined #ocaml
kHebSkik has left #ocaml []
kHebSkik has joined #ocaml
kHebSkik has left #ocaml []
shawn has joined #ocaml
* Msandin_
feels his head hurting...
<nlv11757_>
:) another thing to hurt the head over....can top-level let bindings be mutually recursive?
<nlv11757_>
in ocaml that is
<nlv11757_>
only backward references probably
<Msandin_>
let rec?=)
<mflux>
let foo = bar and bar = foo
<mflux>
of course that specific example won't work ;)
<mflux>
oh yeah, and 'let rec'
<nlv11757_>
ah darn, ocaml has let rec. i forgot :)
<nlv11757_>
thanx
<Msandin_>
my head is hurting over the ugly functor signatures one gets as one tries to extract code reuse without a plan=(
<nlv11757_>
:D
<Msandin_>
or rather, I have a plan, but ive grown convinced is a bad one
shawn_ has quit [Connection timed out]
<nlv11757_>
shooting off something in an early stage hurts...but is best sometimes :)
<Msandin_>
lookie, my "tywith now generates "string_of_<type>" and "map_of_<type>" functions for alias and variant types, including tuples and type constructors (obvious for map)...
<Msandin_>
map_<type> ofcourse
<Msandin_>
next comes fold_<of>, then it's time to consider record and object types...
<nlv11757_>
:) good going
<nlv11757_>
im just boring myself with writing a pp for some sourcetree so i can import it directly into haskell :P
mattam has joined #ocaml
skylan_ has joined #ocaml
skylan has quit [Read error: 113 (No route to host)]
CosmicRay has joined #ocaml
capashen has joined #ocaml
<capashen>
hi !
<capashen>
can somebody tell me what a' means in this result: val somme_f : ('a -> float) -> ('a -> float) -> 'a -> float = <fun> ?
solarwind has quit [Read error: 54 (Connection reset by peer)]
<Smerdyakov>
capashen, universally quantified type variable
<capashen>
variable which became a float here ?
<capashen>
(sorry for my bad english)
<capashen>
(d'ailleurs je sens que la plupart son francais ici mais bon ;) )
<capashen>
+t
<Smerdyakov>
No. If you haven't seen this before, then you should either read about it in the tutorial in the manual, or ignore it.
<capashen>
ok thx
Msandin_ has quit [Read error: 110 (Connection timed out)]
CosmicRay_ has joined #ocaml
CosmicRay_ has quit ["Client exiting"]
<nlv11757_>
is there an OCaml equivalence to the haskell function composition (.)
capashen has left #ocaml []
<Smerdyakov>
I'm not aware of any in the standard library.
<nlv11757_>
k
<Smerdyakov>
(Neither language requires that such a thing be built in; you can implement it easily yourself.)
gim has quit [Read error: 104 (Connection reset by peer)]
<nlv11757_>
my next question was what the syntax was for using functions as infix operators with just that motive :)
<nlv11757_>
but i thought...if there is something standard for it....might as well use it
<Smerdyakov>
Operators are infix.
<Smerdyakov>
I don't think there's a way to use arbitrary identifiers as infix.
<nlv11757_>
not? in haskell you can use `
<Smerdyakov>
But not in OCaml.
<nlv11757_>
like a `foo` b
<Smerdyakov>
But not in OCaml.
<nlv11757_>
pitty
<nlv11757_>
-t
<Smerdyakov>
You want to use an operator in this case anyway, right?
<nlv11757_>
nm, just a bit of language confusion on my side
<nlv11757_>
i have it know
<nlv11757_>
-k
Skal has joined #ocaml
gim has joined #ocaml
<mattam>
let (+<=>+) x y = ...
j_n has joined #ocaml
CosmicRay has quit [Read error: 110 (Connection timed out)]
CosmicRay has joined #ocaml
_fab has quit [Read error: 110 (Connection timed out)]
Submarine has quit ["Leaving"]
pango has quit ["Leaving"]
_fab has joined #ocaml
vezenchio has quit ["I live in a yurt on the steppes of Sheepfuckistan. That's why."]
pango has joined #ocaml
Snark has joined #ocaml
Submarine has joined #ocaml
_fab has quit [Read error: 113 (No route to host)]
_fab has joined #ocaml
Snark has quit ["Leaving"]
humasect has quit ["Leaving.."]
_fab has quit [Read error: 60 (Operation timed out)]
zzorn_away has quit ["They are coming to take me away, ha ha"]
Submarine has quit ["Leaving"]
CosmicRay has left #ocaml []
_fab has joined #ocaml
CosmicRay has joined #ocaml
mlh has joined #ocaml
CosmicRay has quit ["Client exiting"]
Zaius has joined #ocaml
<Zaius>
greetings gentlemen
<Zaius>
how do i unescape a string?
<Zaius>
i thought there should be an obvious solution which i havent found yet
<Riastradh>
'Unescape?'
<mauke>
define "unescape"
<Zaius>
doing the opposite of String.escaped
mustachio has quit ["As for other flattop men, the haircut seens to say, "I work hard and play hard. I'm a survivor. I am self-sufficient. I live ]