cjeris changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/
hsfb has joined #ocaml
<hsfb> hello again
<hsfb> anyone is kind enough to point me how one can have a "pointer to a function'?
<hsfb> based on user input I would like to change the function on a drawing proram
<hsfb> *program
<hsfb> so i need something like
<hsfb> let my_draw = ref hermite ;
<hsfb> and later i can change my_draw
<hsfb> my_draw := bezier ;
<mrvn> hsfb: And your question is?
<hsfb> How can I define and use this function that can be any of many functions ?
<mrvn> !my_draw
<hsfb> tks
Mr_Awesome has joined #ocaml
mbishop_ has joined #ocaml
mbishop has quit [Read error: 60 (Operation timed out)]
mbishop_ is now known as mbishop
<hsfb> is there an easy way to extract a sublist from a list ?
<mrvn> only tail of a list
<mrvn> or List.filter
<mrvn> (which creates new lists)
<hsfb> can i pass a range of positions to filter?
<hsfb> bottom and upper limits ?
<mrvn> nope.
<mrvn> List.fold_left (fun (i, acc) x -> if (i < min) || (i > max) then (i+1, acc) else (i+1, x::acc)) [] list
<mrvn> or something more hand made to not waste tie after max.
<mrvn> s/tie/time/
<hsfb> ok
<hsfb> i'll have another approach
<mrvn> Maybe an BigArray
<hsfb> ok, lets say i have two lists [1;2;3] and [5;6;7]
<hsfb> if i do a [1;2;3] @ [5;6;7], how many elements the resulting list has: 2 or 6 ?
<mrvn> 6, :: would be 2
<hsfb> ok
<hsfb> tks
<mrvn> But @ is expensive.
<Smerdyakov> :: would be ill-typed.
<mbishop> you know, this is what a top level is for :)
<mbishop> experimentation...*cackles*
<mrvn> # List.length ([1;2;3] @ [5;6;7]);;
<mrvn> - : int = 6
<mrvn> Try&Error is so much more fun
<hsfb> yes, but i didn't wanted the first answer, but the second "::"
<mrvn> :: has type 'a -> 'a list -> 'a list
<mrvn> # fun x y -> x :: y;;
<mrvn> - : 'a -> 'a list -> 'a list = <fun>
<mrvn> Why isn't that ( :: )?
<mrvn> Problem with left/right precedence?
<hsfb> oi ?
<hsfb> i thought the :: operator was element :: list
<hsfb> not list :: list
<hsfb> no, you are right... im stupid
<hsfb> the list would be an element then
<mrvn> It is. that's what I wrote.
<hsfb> List.length ([1;2] :: [3;4]);;
<hsfb> This expression has type int but is here used with type int list
<hsfb>
<hsfb> why is that ?
<mrvn> # [1;2;3] :: [4;5;6] :: [];;
<mrvn> - : int list list = [[1; 2; 3]; [4; 5; 6]]
<hsfb> ok
<hsfb> nice
<mrvn> Because the second on needs to be [[3;4]]
<hsfb> i see...
<hsfb> ok, i'm not there yet.. ill have to post around 5 lines, ok ?
<hsfb> let older_points = ref []
<hsfb> let points = ref [0.,0.; 0.,0.; 0.,0.; 0., 0.]
<hsfb>
<hsfb> older_points := [!points] :: !older_points :: [];
<hsfb>
<hsfb> how do i make the last line to work
<hsfb> to append a list to older_points, which is a list of lists
<mrvn> with @, :: builds a new list making it a list list and then list list list and then list list list list ... doesn't type.
<hsfb> ok
<mrvn> Does the order of points matter?
<hsfb> yes
<hsfb> no, not really... on the list of lists no
<hsfb> its working fine now
<mrvn> List.append or @ is no tail recursive so you are somewhat limited on the number of points
<hsfb> ergh
<hsfb> if i run into trouble, i would have to move to array or something /
<mrvn> If it fails there then use List.rev_append (List.rev l1) l2
<hsfb> but reversing a list must also be expensive...
<mrvn> O(List.length)
<hsfb> hm.. but coming back to list.append... if its a linked list like we learned... insertion should be pretty straighforward
<mrvn> List.rev_append (List.rev l1) l2 takes twice as long as @ but is tail recursive.
<hsfb> i'm ignorant about this tail recursive problem
<hsfb> something about the stack usage ?
<mrvn> tail recursive means it doesn't use up stack space on recursions. If you recurse too much the stack runs full and the programm aborts.
<hsfb> tks for explaining
<hsfb> what about doubly linked lists or something like that
<mrvn> Insertion into a list is expensive. The only cheap thing is adding a single element to the front of a list.
<hsfb> i can do that
<mrvn> Because that builds a new List block containing the element and a pointer to the old list.
<mrvn> You can build a doubly linked list using a record with mutables.
<hsfb> i will stick with what i have for now :)
Gone has quit [Read error: 110 (Connection timed out)]
<mrvn> But for append you still would have to find the end of the list by following all elements from head to toe. Unless you keep a reference to the end too.
<mrvn> And you wouldn't have a functional data structure there.
<hsfb> my sw is shining and its time to bed. thank you very much mrvn, you saved my day
hsfb has quit ["ERC Version 5.2 stable pre-release (IRC client for Emacs)"]
<pango> mrvn: :: is an infix constructor, not a function ("type 'a list = :: of 'a * 'a list | []", if it parsed...), so one could expect :: (element, list) to work rather than ( :: ) element list... But neither do, it's hardcoded in the parser
<mrvn> pango: [] is an 'a list so there is no need for the |
<mrvn> pango: One thing is odd though. There is no List.cons as alternative to ::
Riesz has quit ["Leaving.."]
chealer has joined #ocaml
<chealer> what's the syntax error in "if (true) true else false"?
<mrvn> missing then
<mrvn> or (true) is not a function and else is not bound.
* chealer shrugs
<chealer> perhaps time to sleep
<chealer> thanks mrvn
_blackdog_ has quit ["Ex-Chat"]
Mr_Awesome has quit ["...and the Awesome level drops"]
Smerdyakov has quit ["Leaving"]
pstickne_ has quit [Success]
pstickne_ has joined #ocaml
mbishop has quit [Read error: 60 (Operation timed out)]
mbishop has joined #ocaml
Submarine has quit [Remote closed the connection]
benny_ has joined #ocaml
slipstream has joined #ocaml
<pango> mrvn: what I meant is, :: and [] are the 'a list constructors
slipstream-- has quit [Read error: 60 (Operation timed out)]
benny has quit [Read error: 110 (Connection timed out)]
screwt8 has quit [Remote closed the connection]
screwt8 has joined #ocaml
<pango> (beside their unusual names)
jlouis has quit [Remote closed the connection]
G has joined #ocaml
shawn has joined #ocaml
shawn_ has quit [Read error: 110 (Connection timed out)]
pango has quit [Remote closed the connection]
Amorphous has quit [Read error: 104 (Connection reset by peer)]
pango has joined #ocaml
Amorphous has joined #ocaml
skal_ has joined #ocaml
z_ has quit ["Lost terminal"]
rturner has joined #ocaml
mqtt has quit [Read error: 110 (Connection timed out)]
Sparkles has joined #ocaml
Nutssh has left #ocaml []
Submarine has joined #ocaml
Sparkles has quit [Remote closed the connection]
Sparkles has joined #ocaml
* Submarine conf industrielle
bluestorm has joined #ocaml
Submarine has quit [Remote closed the connection]
Sparkles has quit []
Sparkles has joined #ocaml
Sparkles_ has joined #ocaml
Sparkles has quit [Read error: 110 (Connection timed out)]
Sparkles_ is now known as Sparkles
Submarine has joined #ocaml
cjeris has joined #ocaml
Sparkles has quit []
Submarine has quit [Remote closed the connection]
pango has quit [Remote closed the connection]
Sparkles has joined #ocaml
screwt8 has quit [Read error: 104 (Connection reset by peer)]
pango has joined #ocaml
shawn has quit ["This computer has gone to sleep"]
bluestorm has quit ["Konversation terminated!"]
ikaros has joined #ocaml
Sparkles has quit []
chealer has quit ["Konversation terminated!"]
pango has quit [Remote closed the connection]
pango has joined #ocaml
Submarine has joined #ocaml
Ai_Itai has quit ["Leaving"]
Smerdyakov has joined #ocaml
ikaros has quit ["segfault"]
screwt8 has joined #ocaml
Sparkles has joined #ocaml
Sparkles has quit []
postalchris has joined #ocaml
kig has joined #ocaml
<postalchris> Is there a more compact way to represent the predicate "value v matches pattern m" than "(function m -> true | _ -> false) v"?
pango_ has joined #ocaml
bluestorm_ has joined #ocaml
<pango_> postalchris: match m -> true | _ -> false, it's 3 characters shorter ;)
<pango_> oups, forgot 'with', nevermind
datagrok has joined #ocaml
zarvok has joined #ocaml
<postalchris> Is there maybe a camlp4 extension that adds a "matches" predicate?
<pango_> I seldom needed such predicate
<pango_> is m more complex than a constant constructor ?
_JusSx_ has joined #ocaml
<mrvn> I think i have never used a match as truth value.
<postalchris> Yes, it's matching AST sub-trees with "when" constraints
pango has quit [Remote closed the connection]
<pango_> what prevents you from using a if (function m -> true | _ -> false) v then ... else ... <=> match v with m -> ... | _ -> ... transformation ?
<postalchris> Nothing. It's the "| _ -> false" that I'm having to type over and over that's getting on my nerves.
<postalchris> Bc I don't care about the "false" case.
<flux> maybe a simple language extension that would replace FALSE with _ -> false would suffice
<flux> but, it wouldn't help much :))
skal_ has quit [Read error: 104 (Connection reset by peer)]
<pango_> you could compile with -w p (yuck ;) )
<pango_> but then, omitting 'false' cases, you'd get exceptions instead of a noop
<flux> hm, it'd be fun if throwing an exception would actually be a continuation to which you could return with a value..
<datagrok> newbie question here ... I've got two functions, first returns an in_channel (like Pervasives.open_in), one takes in_channel as argument (like Pervasives.input_line). I'd like to apply a filter to the data between the first and second function.
<flux> so you would like to f
<flux> to create a filtered version of in_channel?
<datagrok> that's right
<flux> unfortunately that's not possible without an external process
<datagrok> ah
<flux> but there are 'competing' stream implementations around
<flux> you could try ocaml-net
<datagrok> I'll take a look. Thanks flux
<flux> good luck
<datagrok> If I can relax my requirements a bit so that the "second function" does not have to read from an in_channel, is there a "typical" way of building a program that applies some number of filters to incoming data? A bunch of string list -> string list functions?
<pango_> streams
<datagrok> thanks! looks like what I wanted.
<pango_> extlib has IO objects that may provide an interesting abstraction for the job too, but I haven't used extlib so far
<datagrok> thanks pango_ I'll have a look too
<flux> seems pretty thorough
<flux> albeit not very efficient, if you want to wrap your own data to it, isn't the interface character-based?-o
<flux> hm, actually I might've judged it too fast, there is some block-based thing also..
david_koontz has joined #ocaml
kig has quit [Read error: 110 (Connection timed out)]
jlouis has joined #ocaml
seoushi has left #ocaml []
shawn has joined #ocaml
Sparkles has joined #ocaml
Sparkles has quit [Client Quit]
_JusSx_ has quit [Remote closed the connection]
cjeris has quit [Read error: 104 (Connection reset by peer)]
datagrok has quit ["Leaving"]
datagrok has joined #ocaml
<datagrok> Is there an established OCaml convention for inline documentation?
<lucca> "Yes, the hold it every year..."
<pango_> ocamldoc ?
skal_ has joined #ocaml
zarvok has quit ["BitchX-1.1-final -- just do it."]
<datagrok> aha thanks pango_
G_ has joined #ocaml
dark_light has joined #ocaml
G has quit [Connection timed out]
postalchris has quit ["Leaving."]
bluestorm_ has quit ["Konversation terminated!"]
<twobitsprite> is there support for sockets built into ocaml, or do I have to get a library? I don't see anything in the stdlibs...
<twobitsprite> n/m... found it in the Unix module
datagrok has quit ["Leaving"]
dark_light has quit [Read error: 54 (Connection reset by peer)]
dark_light has joined #ocaml