cjeris changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/
danly has joined #ocaml
shawn has joined #ocaml
m3ga has joined #ocaml
m3ga has quit [Client Quit]
postalchris has quit ["Leaving."]
malc_ has quit ["leaving"]
m3ga has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
benny91 has joined #ocaml
<benny91> how could I add a list to a record ?
<benny91> type test = { firstOne:lsit } ;; doesnt work
<mrvn> type test = { l : int list; }
<benny91> ah :)
<benny91> thanks
<benny91> can I pass a type in some way ?
<mrvn> type 'a test = { l : 'a list }
<benny91> thanks :)
<benny91> uh, I remember...
<Smerdyakov> What a strange question.
<benny91> :Z and one more question
<Smerdyakov> P.S.: That "it doesn't work when I type 'lsit'!" was funny. ;-)
<benny91> if I want to add a function, could I use the return type ?
<Smerdyakov> That doesn't make sense.
<benny91> Smerdyakov: ...
<Smerdyakov> Also question marks never have spaces before them in English.
<mrvn> type test = { fn : int -> unit; }
<benny91> mrvn: thanks :o
<mrvn> a function is a type like anything else.
<benny91> Smerdyakov: Really?
<mrvn> s/is/has/
<Smerdyakov> benny91, yes.
<benny91> mrvn: but didn't know how to write that
<benny91> int -> uint makes sense
kig_ has joined #ocaml
<mrvn> same string the interpreter prints as type when you input the function
<Smerdyakov> benny91, I get the impression that you are trying to "learn" OCaml without reading about it.
<Smerdyakov> benny91, please find _some_ good tutorial and read it through before asking more questions.
<benny91> Smerdyakov: yeah yeah...
<benny91> Smerdyakov: I already showed what book I'm using
<Smerdyakov> What book is that?
<benny91> Smerdyakov: but there wasn't mentioned how to declare a function object in a type
<benny91> Smerdyakov: oreilly
<Smerdyakov> If you were reading carefully, you would have understood that function types are not special.
<benny91> Smerdyakov: I DID
<benny91> Smerdyakov: I don't know where you read, that I didn't ...
<Smerdyakov> benny, the fact that you knew how to write a list type but not a function type.
<benny91> mrvn: thanks, I guess the book is a bit "brute force learning" like but it's the best piece I could find so far
<benny91> Smerdyakov: I didn't know about both -- I asked how to declare a list first --- didn't thought that it would be that simple
<mrvn> By the way, why do I have to declare the types in a record? Why can't it infer it from use?
kig has quit [Read error: 60 (Operation timed out)]
<benny91> mrvn: hm
<benny91> mrvn: a record would be without sense then I guess :p
<mrvn> why? It would still be a collection of objects
<benny91> mrvn: wow, that was English done wrong Vol. 12
<benny91> mrvn: a tuple is a collection of objects
<mrvn> different cost of access
<benny91> mrvn: if you want a collection of objects you use them -- if you want a specified structure you use that record -- I guess it's somehow the imperative counterpart to tuples :Z
<benny91> mrvn: but I'm a beginner -- don't ask me :p
<mrvn> you can't have the same typechecking in tuples as with let foo = { bla with x = 1; }
<benny91> mrvn: ?
<mrvn> It makes foo the same type as bla.
<benny91> ok :Z
<benny91> and what is bla there ?
<mrvn> a record
<benny91> and x ? :Z
<mrvn> It makes a copy of bla but with x=1
<mrvn> x is an lable in that record
<benny91> in foo ?
<mrvn> in both, but in foo it is 1
<benny91> ah, I understand :)
<mrvn> avoids having to write let foo = { x=1; y=bla.y; z=bla.z; ... }
<benny91> cool
<benny91> hm, it's 3:40 -- I wanted to get up early tomorrow :|
<mrvn> it is early now. get up.
<benny91> :D
<benny91> naah.. I'll choose to sleep 6h :)
<benny91> so --> thanks once again and aeh, do OCAML-Magic
<mrvn> Obj.magic is evil.
<benny91> cool :o, I can get a black mage while using ocaml ?
<benny91> benny91: is this my nick ?
<benny91> :/, should be benny99 ... whatever
<benny91> am gone then =)
<benny91> sleep well
benny91 has left #ocaml []
shawn_ has joined #ocaml
shawn has quit [Read error: 110 (Connection timed out)]
david203 has joined #ocaml
david203 has left #ocaml []
kig has joined #ocaml
shawn_ has quit [Read error: 110 (Connection timed out)]
kig_ has quit [Read error: 110 (Connection timed out)]
kig has quit [Read error: 104 (Connection reset by peer)]
kig has joined #ocaml
Smerdyakov has quit ["Leaving"]
kig has quit [Read error: 104 (Connection reset by peer)]
shawn has joined #ocaml
kig has joined #ocaml
benny_ has joined #ocaml
benny has quit [Read error: 60 (Operation timed out)]
benny_ is now known as benny
kig_ has joined #ocaml
kig has quit [Read error: 110 (Connection timed out)]
shawn_ has joined #ocaml
shawn has quit [Read error: 110 (Connection timed out)]
G_ has joined #ocaml
bluestorm_ has joined #ocaml
G has quit [Read error: 110 (Connection timed out)]
Ai_Itai has joined #ocaml
Mr_Awesome has quit ["...and the Awesome level drops"]
swater has joined #ocaml
shawn_ has quit ["This computer has gone to sleep"]
_JusSx_ has joined #ocaml
G_ is now known as G
Submarine has quit [Remote closed the connection]
bluestorm_ has quit ["Konversation terminated!"]
kig has joined #ocaml
kig_ has quit [Read error: 110 (Connection timed out)]
ikaros has joined #ocaml
fasta has joined #ocaml
<fasta> What does a, b denote? I'd think it is a tuple, but according to the language spec it should be (a,b).
<_JusSx_> it's a tuple
<fasta> Thanks
<_JusSx_> # let a, b = 2 , 4;;
<_JusSx_> val a : int = 2
<_JusSx_> val b : int = 4
<_JusSx_> # let (a, b) = (2, 4);;
<_JusSx_> val a : int = 2
<_JusSx_> val b : int = 4
<_JusSx_> #
<_JusSx_> let x = 2, 3;;
<_JusSx_> val x : int * int = (2, 3)
<_JusSx_> #
kig has quit [Read error: 110 (Connection timed out)]
ayrnieu has quit ["..."]
ikaros has quit ["segfault"]
rturner has joined #ocaml
bzzbzz has quit ["leaving"]
Amorphous has quit ["shutdown"]
Amorphous has joined #ocaml
fasta has quit ["leaving"]
bluestorm has joined #ocaml
kig_ has joined #ocaml
Smerdyakov has joined #ocaml
kig_ has quit [Read error: 113 (No route to host)]
Riesz has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
Smerdyakov has quit ["Leaving"]
bluestorm has quit ["Konversation terminated!"]
svenl has quit [Remote closed the connection]
svenl has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
pango has quit ["I shouldn't really be here - dircproxy 1.0.5"]
pango has joined #ocaml
svenl has quit []
svenl has joined #ocaml
svenl_ has joined #ocaml
svenl_ has quit [Client Quit]
svenl has quit [Remote closed the connection]
svenl has joined #ocaml
svenl has quit []
bluestorm has joined #ocaml
svenl has joined #ocaml
jlouis has quit [Read error: 110 (Connection timed out)]
Smerdyakov has joined #ocaml
svenl has quit []
svenl has joined #ocaml
svenl has quit [Client Quit]
svenl has joined #ocaml
svenl has quit [Client Quit]
svenl has joined #ocaml
svenl has quit [Client Quit]
svenl has joined #ocaml
swater has quit ["Quat"]
_jol_ has joined #ocaml
_jol_ has quit [Client Quit]
rillig has joined #ocaml
twobitsprite has joined #ocaml
<twobitsprite> isn't (;) just a function like (+) ?
<mrvn> what operator should ; be?
<twobitsprite> shouldn't it just be () -> 'a -> 'a ?
<mrvn> I guess it could be.
<mrvn> But then 1;2 would give a type error and not just a warning.
<twobitsprite> I thought it was like a regular function... but in the toplevel "( ; ) ;;" results in "Syntax error" ... where "( + ) ;;" yields "- : int -> int -> int = <fun>"
<mrvn> and [1;2] would be [2]
<twobitsprite> hmm
<twobitsprite> ok, I guess I've never used it that way
<mrvn> I would say ';' is just a token for the parser to seperate list elements, records labels, commands, etc.
<twobitsprite> that's right... I forgot it was also used to list items...
<mrvn> let a = { x=1; y=2; z=4; }
<twobitsprite> (just started picking up ocaml again after about a yeah hiatus
<twobitsprite> s/yeah/year
<pango> using parser behavior to determine the nature of tokens may not be the way to go, ocaml's parser seems to be full of adhoc hacks...
<mrvn> Sure. but semantic is
<pango> one could say ; is an infix function, if it behaves like one
<mrvn> pango: not in lists and records
<pango> agreed, since functions can be used inside lists and records definitions
<pango> also 3 ; ;; should return 'a -> 'a, not 3
<mrvn> In lists you would need 'a -> ('a | 'a list) -> 'a list for ; in lists.
<pango> that said, thinking of ; as a function of type unit -> 'a -> 'a may help understand how sequence blends in the functional substrate
<mrvn> yeah, just replace ; with a different operator.
<_JusSx_> account on 2
_JusSx_ has quit [Read error: 54 (Connection reset by peer)]
hs` has joined #ocaml
<hs`> hello again
<hs`> anyone knows if there is a way to render text to opengl screen using lablglut only ?
Submarine has joined #ocaml
hs` has left #ocaml []
shawn has joined #ocaml
shawn_ has joined #ocaml
descender has quit [Read error: 110 (Connection timed out)]
shawn has quit [Read error: 60 (Operation timed out)]
rillig has quit ["exit(EXIT_SUCCESS)"]
<ulfdoz> Is there a syntax for definition of infix-operators?
<pango> prefix/infix/postfix is hardcoded depending on the first char of operator identifier
<pango> so if your operator name start with, say, '+', it'll automatically be infix
<pango> (and have the same priority/associativity as +, I guess)
<ulfdoz> hm, sounds quite strange.
jlouis has joined #ocaml
G is now known as Gone
<mrvn> It makes sense if you define your own add/sub/mul/div operators.
<mrvn> And I wouldn't use infix for anything else. too confusing. Defining an infix + for vector addition or matrix additions is fine but don't invent too much new stuff.
<pango> http://caml.inria.fr/pub/docs/manual-ocaml/manual015.html, "The table below shows the relative precedences and associativity of operators [...] For infix and prefix symbols, we write “*...” to mean “any symbol starting with *”.
<pango> and http://caml.inria.fr/pub/docs/manual-ocaml/manual009.html "Prefix and infix symbols"
slipstream-- has joined #ocaml
slipstream has quit [Read error: 60 (Operation timed out)]
mqtt_ has quit [Read error: 110 (Connection timed out)]
hsfb has joined #ocaml
<hsfb> hello once more...
<mrvn> # let hello = function s -> Printf.printf "Hello %s\n" s;;
<mrvn> val hello : string -> unit = <fun>
<mrvn> # hello once more;;
<mrvn> This function is applied to too many arguments, maybe you forgot a `;'
<hsfb> i would like to know now a non-imperative way to iterate on two lists, multiplying each element ListA[i] with ListB[i], and optionally accumulating each multiply result into another "variable"
<mrvn> let fold2 fn l1 l2 = List.fold_left (fun acc x -> (List.fold_left (fn x) [] l2)::acc) [] l1
<mrvn> List.map2 (*) l1 l2
<hsfb> that is beautiful and cryptic
<hsfb> :)
<mrvn> depending on what you mean with each
mqtt has joined #ocaml
<hsfb> also each element of the list is really a float tuple (cartesian point)
<mrvn> that just changes your fn
<hsfb> ok
<mrvn> Do you want C[i] = A[i] * B[i] or C[i][j] = A[i] * B[j]?
<hsfb> the first
<mrvn> let fold2 fn l1 l2 = List.fold_left (fun acc x -> (List.fold_left (fun acc y -> (fn x y)::acc) [] l2)::acc) [] l1 actually.
<mrvn> hsfb: Then a simple List.map2 will do.
<mrvn> Iterators on two lists
<hsfb> yes, now that you pointed, i got there too :)
<bluestorm> if it's you first time with list
<bluestorm> you may want to try to do the recursive function yourselve
<hsfb> List.map2 (fun ((x1,y1),(x2,y2)) -> ((x1*.x2),(y1*.y2))) l1 l2
<hsfb> like this for summing tuples?
<mrvn> hsfb: fun (x1,y1) (x2,y2) -> ((x1*.x2),(y1*.y2)))
<hsfb> *multiplying
<hsfb> okay, thank you very much
<mrvn> 'a -> 'b -> 'c
<bluestorm> let rec multiply la lb = match (la, lb) with [], [] -> [] | hda::tla, hdb::tlb -> hda * hdb :: multiply tla tlb | _ -> invalid_arg "multiply";;
<hsfb> bluestorm: this way you're decomposing the tuples with pattern matching/
<hsfb> ?
<bluestorm> hm yes
<mrvn> hsfb: he works with int lists, not int tuple lists
<bluestorm> (the tuple is only used there to match both lists at the same time)
<bluestorm> hm
<bluestorm> what's your list format ?
<mrvn> (1;2)::(3;4)::[]
mbishop has quit [Remote closed the connection]
<mrvn> (1.;2.)::(3.;4.)::[]
<bluestorm> hm
<mrvn> "also each element of the list is really a float tuple (cartesian point)"
<bluestorm> [(1.,2.); (3.,4.)]
mbishop has joined #ocaml
<bluestorm> hm
<mrvn> So lets do let ( *.. ) (x1, y1) (x2, y2) = (x1 *. x2, y1 *. y2)
<bluestorm> is that the right ( * ) on cartesian points ?
<mrvn> doubtfull.
<hsfb> ?
<bluestorm> hsfb: what do you mean by multiplying cartesian points actually ?
<hsfb> the operation is correct, lets not get into match
<hsfb> *math
<hsfb> :)
<mrvn> There is a vector produce and skalar product
<hsfb> i just need to "weight" each point on list A with a coefficient from list B
<hsfb> understand ?
<mrvn> hsfb: so (x1, y2) * weight?
<hsfb> yes
<mrvn> skalar multiply
<hsfb> true...
_JusSx_ has joined #ocaml
<bluestorm> so the weight is a float ?
<bluestorm> i'd use
<hsfb> true
<mrvn> So you need "(int * int) list -> int list -> (int * int) list"
<bluestorm> let dup f (a, b) = f a, f b
<hsfb> i see where this is
<hsfb> going to end :)
<bluestorm> let multiply = List.map2 (fun a b -> dup (( * ) a) b)
<bluestorm> (multiply lists_weights list_points)
<mrvn> bluestorm: nope
<bluestorm> hm
<hsfb> and then sum all values into a single one!
<bluestorm> mrvn: ( *. ) ?
<mrvn> yep
<bluestorm> hsfb: this should be in at a second time
<mrvn> hsfb: then use fold
<hsfb> yes, so i am in the right path
<bluestorm> List.fold_left your_sum your_zero
<mrvn> List.fold2 (fun (xacc, yacc) (x, y) m -> (xacc +. m *. x, yacc +. *. y)) points weights
<bluestorm> hm
<bluestorm> (0., 0.) ?
<mrvn> + (0., 0.) somewhere
<hsfb> i didn't get the last one... is it supposed to solve everything or be run after that map ? :)
<hsfb> (sry for poor english)
<mrvn> hsfb: it multiplies and summs in one go
<mrvn> Its _fold_s a list into a single variable.
<hsfb> nice
<hsfb> let me try it now
<hsfb> Characters 83-85:
<hsfb> List.fold2 (fun (xacc, yacc) (x, y) m -> (xacc +. m *. x, yacc +. *. y)) l1 l2;;
<hsfb>
<mrvn> List.fold_left2 (fun (xacc, yacc) (x, y) m -> (xacc +. m *. x, yacc +. *. y)) (0., 0.) points weights
<hsfb> there is a syntax error after yacc +. *. ... what goes there ?
<hsfb> m
<hsfb> ok
<mrvn> hsfb: m
<mrvn> # List.fold_left2 (fun (xacc, yacc) (x, y) m -> (xacc +. m *. x, yacc +. m *. y)) (0., 0.);;
<mrvn> - : (float * float) list -> float list -> float * float = <fun>
bluestorm has quit ["Konversation terminated!"]
<hsfb> also, is there any better way to change t from 0.0 to 1.0 (with 0.01 increments) other than while ?
<hsfb> i couldn't find syntax for "for"
<Smerdyakov> Never use loops in OCaml!
<hsfb> :)
<Smerdyakov> Use recursive functions instead, directly or indirectly (through higher-order functions).
<hsfb> is that a bot ?
<Smerdyakov> No, it's pretty standard wisdom in the ML community, I believe.
<hsfb> ok, but i don't believe there is always a way, am i wrong ? :)
<Smerdyakov> You are wrong.
<mrvn> there is a for I believe
<hsfb> let t = ref 0.0
<hsfb> in while !t < 1. do
<hsfb> xxx
<mrvn> *shiver*
<hsfb> t := !t + 0.01;
<hsfb> i couldn't come up with something cleaner, because i need the value of t to use in my bezier drawing function
<mrvn> let rec loop t = if t >= 1. then () else .... ; loop (t +. 0.1)
<hsfb> ok
<hsfb> i can embed this inside a function, right ?
<mrvn> if you add "in loop 0."
<hsfb> where? :)
<mrvn> at the end
<hsfb> can't see it ..
<hsfb> i promise i will rtmf when i get the time :)
<mrvn> make the time
<hsfb> ok, it is working, that fold_left2, rec loop, and all :)
<mrvn> folding is very powerfull in ocaml and very fast.
<hsfb> yes, now is everything generic..
<hsfb> i'm closer to believe you never really need variables
<hsfb> m3ga blog intros this very nicely, from a "c programmer viewpoint"
<hsfb> any reason why using "if t >= 1 then () else ..." instead of if t < 1.0 then ...
<mrvn> keeps the else close to the if.
<hsfb> what do you mean? the other way there is no else
<mrvn> ok, in this case where you have ().
_JusSx_ has quit ["leaving"]
<hsfb> opengl programming is probably not a good opportunity to learn ocaml because it forces you to do imperative stuff all the time...
<hsfb> "not a good" i really mean "not the best"
<mrvn> probably one of the worst
<hsfb> thank you very much mrvn
hsfb has quit [""i'll fold myself now""]
<ulfdoz> Any ideas, why the List.rev has absolutely no influence on the order of output? "List.iter prerr_sieve_remark (List.rev rms)"
<mrvn> impossible
<mrvn> # List.rev [1;2;3];;
<mrvn> - : int list = [3; 2; 1]
<ulfdoz> wuaaaargh. It's getting too late for me! Note to me: If you add a function, call it!
hsfb has joined #ocaml
hsfb has left #ocaml []
_blackdog_ has joined #ocaml
rturner has quit [Read error: 104 (Connection reset by peer)]