mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab Ocaml 3.10.0 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
Smerdyakov has quit ["restarting X"]
Smerdyakov has joined #ocaml
Cygaal has quit [Read error: 104 (Connection reset by peer)]
jlouis_ has joined #ocaml
mr_hugo has joined #ocaml
<mr_hugo> helloo
<mr_hugo> is anyone there ?
jlouis has quit [Read error: 110 (Connection timed out)]
<mr_hugo> i can't figure out why this: http://pastebin.com/d5b9ad14b doesn't work... i don't know where to put the ;; and the ; :S
lde has quit [Remote closed the connection]
<Smerdyakov> Well, let's take a look!
<mr_hugo> thank you
<Smerdyakov> You forgot an 'in'.
<mr_hugo> hmmok
<mr_hugo> i already changed that
<mr_hugo> let me upload it
<mr_hugo> gives-me an error in line 6 :/
<mr_hugo> i feel so noob at this hehehe
<Smerdyakov> What is the error message?
<mr_hugo> "Unbound record field label tag"
<mr_hugo> but xml has a tag, it comes from module Xml
<Smerdyakov> You probably have the wrong name for it.
<mr_hugo> here
<Smerdyakov> I don't see any fields defined there.
<mr_hugo> val tag : xml -> string
<Smerdyakov> Have you read an introduction to OCaml, or are you just guessing at how it works?
<mr_hugo> just guessing :P
<Smerdyakov> OK, then I'm not going to help you.
<mr_hugo> why ?
<Smerdyakov> Because you can't learn programming languages effectively by guessing
<mr_hugo> life is too short for bad books and lousy documentation :P
<mr_hugo> unfortunatly thats what happens in OCaml :/
<Smerdyakov> I don't think so. There are some guides that other folks have used successfully.
<mr_hugo> well i read through ocaml-tutorial
<mr_hugo> and its not so good :/
<abez> If you want to grope in the dark you could use the interpretter, it'll tell you the types as it goes.
Mr_Awesome has quit ["aunt jemima is the devil!"]
seafoodX has joined #ocaml
pete__c has joined #ocaml
oracle1 has quit [Remote closed the connection]
netx has joined #ocaml
oracle1 has joined #ocaml
mr_hugo has quit [Read error: 110 (Connection timed out)]
Zzompp has quit ["leaving"]
Zzompp has joined #ocaml
Smerdyakov has quit [Remote closed the connection]
Smerdyakov has joined #ocaml
puks has quit [Read error: 110 (Connection timed out)]
Smerdyakov has quit ["Leaving"]
doy has left #ocaml []
slipstream has joined #ocaml
slipstream-- has quit [Read error: 110 (Connection timed out)]
iratsu has joined #ocaml
buluca has quit [Read error: 113 (No route to host)]
ednarofi has quit [Read error: 104 (Connection reset by peer)]
ednarofi has joined #ocaml
<flux> pango, yeah, that's what I was talking about
<flux> pango, now if only mr_hugo came back for that url ;)
bluestorm_ has joined #ocaml
netx has quit ["Leaving"]
netx has joined #ocaml
netx has quit [Client Quit]
netx has joined #ocaml
<cpst> what does OCaml just do mod 32 arithmetic on integer overflow?
<cpst> why, not what
<cpst> and 2^32 :P
<bluestorm_> hm
<bluestorm_> actually it's 2^31 arithmetic
<bluestorm_> (for the built-in 'int' type)
<cpst> yeah, but why?
<cpst> isn't that an error?
<bluestorm_> i'd say there is no runtime check for performance reasons
<cpst> why bother typing your program if you still get errors like that?
<bluestorm_> 90% of applications doesn't use such big numbers
<cpst> it's unsafe and incorrect
<bluestorm_> hm
<bluestorm_> it's a matter of compromise
<cpst> isn't the point of using a typed language like OCaml to avoid errors like this that plague C code?
<cpst> or do we only do it when we can make it fast?
<bluestorm_> if you want to avoid these, you a dedicated big-int type
<cpst> but then you use bignums for everything
<bluestorm_> providing a non-checked type that will suit better to most user is not a bad thing
<bluestorm_> hm
<cpst> whereas jump-on-overflow is one instruction
<cpst> that is usually predicted away
<bluestorm_> «
<bluestorm_> Yes, except that not all processors have overflow flags. The Alpha
<bluestorm_> and the MIPS don't, for instance.
<bluestorm_> »
<cpst> still seems like a bad comprimise to only have safety when it is efficient
iratsu has quit [Remote closed the connection]
schme` has joined #ocaml
ednarofi_ has joined #ocaml
ednarofi has quit [Read error: 104 (Connection reset by peer)]
schme has quit [Read error: 110 (Connection timed out)]
leo037 has quit [Read error: 110 (Connection timed out)]
ygrek has joined #ocaml
crabstick has joined #ocaml
crabstick_ has quit [Read error: 110 (Connection timed out)]
Tetsuo has joined #ocaml
piggybox_ has joined #ocaml
ygrek has quit [Remote closed the connection]
Submarine has joined #ocaml
Submarine has quit [Client Quit]
piggybox has quit [Read error: 110 (Connection timed out)]
seafoodX has quit []
piggybox has joined #ocaml
seafoodX has joined #ocaml
piggybox_ has quit [Success]
smimou has quit ["bli"]
rwmjones has joined #ocaml
lde has joined #ocaml
seafoodX has quit []
Cygal has joined #ocaml
ednarofi_ has quit [Read error: 104 (Connection reset by peer)]
seafoodX has joined #ocaml
Cygal is now known as Cygaal
leo037 has joined #ocaml
crabstick_ has joined #ocaml
love-pingoo has joined #ocaml
ulfdoz has quit [Read error: 60 (Operation timed out)]
crabstick has quit [Read error: 110 (Connection timed out)]
buluca has joined #ocaml
tty56 has quit [Read error: 60 (Operation timed out)]
tty56 has joined #ocaml
Cygal_ has joined #ocaml
tty56_ has joined #ocaml
Alleria has joined #ocaml
ktne has joined #ocaml
<ktne> hello
<ktne> how one defines a function type in ocaml?
<ktne> can i do type fn_type = int -> int -> int;?
<flux> yes
<flux> try it :)
<ktne> hmm
<ktne> i'm actually working with f# :)
<flux> I suppose such a basic thing would work there too
<ktne> ah
<ktne> yes
<flux> but my machine is performing apt-get installing for a moment, so it's the perfect escape for lunch ->
<ktne> i mistakenly added some variable
<ktne> like x:int ->
<ktne> thanks :)
tty56 has quit [Read error: 110 (Connection timed out)]
Cygaal has quit [Read error: 110 (Connection timed out)]
Demitar has quit [Read error: 113 (No route to host)]
<ktne> how do i define a mutually recursive type?
<bluestorm_> 'and'
<bluestorm_> type ... and ...
<ktne> oh
<ktne> thanks :)
tty56 has joined #ocaml
tty56_ has quit [Read error: 110 (Connection timed out)]
crabstick_ has quit []
crabstick has joined #ocaml
mr_hugo has joined #ocaml
<mr_hugo> hi there
<mr_hugo> how do i print a list in OCaml ?
<mr_hugo> with a for loop ?
<rwmjones> mr_hugo, List.iter is your best bet
xavierbot has quit [Remote closed the connection]
<mr_hugo> sweet
xavierbot has joined #ocaml
<rwmjones> list of what?
<rwmjones> let xs = [ 1; 2; 3; 4 ] ;;
<xavierbot> val xs : int list = [1; 2; 3; 4]
<rwmjones> List.iter print_int xs ;;
<xavierbot> 1234- : unit = ()
<rwmjones> or something like this:
<rwmjones> Printf.printf "[%s]\n" (String.concat (List.map string_of_int xs));;
<xavierbot> Characters 63-65:
<xavierbot> Printf.printf "[%s]\n" (String.concat (List.map string_of_int xs));;
<xavierbot> ^^
<xavierbot> This expression has type string list but is here used with type string
<rwmjones> oops
<rwmjones> Printf.printf "[%s]\n" (String.concat ", " (List.map string_of_int xs));;
<xavierbot> [1, 2, 3, 4]
<xavierbot> - : unit = ()
puks has joined #ocaml
Flynsarmy has joined #ocaml
ktne has quit [Read error: 113 (No route to host)]
pango has quit [Remote closed the connection]
<Flynsarmy> What makes Ocaml good for teaching introductory programming?
pango has joined #ocaml
cpst has quit []
<bluestorm_> Flynsarmy: i'd say strong typing a different programming paradigms
<bluestorm_> (i'd guess imperative and functional are the most attractive for introducory programming teaching)
<flux> one thing is that you don't need to introduce many concepts with the simplest program
<flux> print_string "hello world" works - well, perhaps you need to introduce types..
Tychom has joined #ocaml
Flynsarmy has quit ["ChatZilla 0.9.78.1 [Firefox 2.0.0.6/2007072518]"]
piggybox has quit ["Leaving"]
piggybox has joined #ocaml
Demitar has joined #ocaml
ktne has joined #ocaml
<ktne> hello
<ktne> is there a function in f# that converts a string to a byte[] and back?
dmentre has joined #ocaml
<bluestorm_> i don't know about f# but you can code that easily
<bluestorm_> using Array.init
<ktne> ok
Mr_Awesome has joined #ocaml
mav_ has joined #ocaml
mav_ has quit [Client Quit]
mav has joined #ocaml
CRathman has joined #ocaml
ulfdoz has joined #ocaml
loufoque has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
<loufoque> isn't the fact that the actual type of a polymorphic class can sometimes not be deduced before some specific member functions are used considered a flaw in the language?
<bluestorm_> hm
<flux> loufoque, it is unclear how that would be fixed, though, unless an allowed fix would be to automatically convert the class into a polymorphic one
<flux> loufoque, do you mean simply cases like: class foo = object method bar _ = 42 end ?
<flux> which could be fixed with class foo = object method bar _ = 42 method baz = bar 7 + 13 end
<flux> but what should the type of the class be without such a definition?
<bluestorm_> doesn't class ['a] foo = object method bar (_ : 'a) = 42 end work ?
<flux> this would be one option: class foo = object method bar : 'a. 'a -> int = fun _ -> 42 end
<bluestorm_> hm
<flux> bluestorm_, sure, but is that was the user expects?
<bluestorm_> your one looks better
<bluestorm_> (user-wise)
<flux> I suppose that could be an option in a future version of the language; I think such signatures are quite a recent addition
<flux> but otoh I'm not involved in the language development :)
smimou has joined #ocaml
<loufoque> actually, I'm quite the OCaml newbie. I'm talking about something like class ['a] stack = object (self) val mutable list = ( [] : 'a list ) method push x = list <- x :: list end;;
<xavierbot> actually, I'm quite the OCaml newbie. I'm talking about something like class ['a] stack = object (self) val mutable list = ( [] : 'a list ) method push x = list <- x :: list end;;
<xavierbot> ^^^^^
<xavierbot> Characters 15-20:
<xavierbot> Parse error: currified constructor
<loufoque> when I do let s = new stack, the type of s is not yet deduced
<loufoque> it's '_a stack
<loufoque> the type will only be deduced once push is called
<flux> loufoque, hm, why is that a problem?
<flux> the whole '_a-thing exists because of mutable values
<flux> but I think the solution is quite novel
<loufoque> having a variable whose type is not determined in the middle of my code disturbs me
<flux> loufoque, you can spell it out if you want
<flux> let s : int stack = new stack
CRathman has quit ["ChatZilla 0.9.78.1 [Firefox 2.0.0.6/2007072518]"]
<bluestorm_> loufoque: that's not an object problem
<bluestorm_> let stack = ref [];;
<xavierbot> val stack : '_a list ref = {contents = []}
<bluestorm_> if 'a were truly polymorphic
<bluestorm_> i could put an int, then a float
<bluestorm_> and the list would end ill-typed
<bluestorm_> (another less obvious case of seeing '_a is with the monomorphism reduction)
<loufoque> depends on your definition of polymorphic
<bluestorm_> let id x = x;;
<xavierbot> val id : 'a -> 'a = <fun>
<bluestorm_> let f = id id;;
<xavierbot> val f : '_a -> '_a = <fun>
<bluestorm_> that one is pretty strange
<bluestorm_> but is based on the same idea
<loufoque> strangely enough, I find C++ templates simpler than the OCaml parametric polymorphism system. (I'm a C++ developer trying to get initiated to OCaml)
<bluestorm_> hm
<bluestorm_> i heard of people doing multi-stage programming with C++ templates
<bluestorm_> OCaml parametric polymorphism can't do that, so i think it's conceptually simpler
<bluestorm_> (altought that does not mean that you'll find it easier to learn)
rwmjones has left #ocaml []
<bluestorm_> loufoque: if you want to learn the simple part of ocaml, you shouldn't begin with the object extension
<flux> loufoque, perhaps you can find more similarities in the module system and c++ templates - except for the implicit instantiation
<bluestorm_> from my experience (wich is very poor concerning object-orientation), it's the part were the typing is the more subtle and tricky
<loufoque> I guess that would be because object-oriented programming is stateful
<bluestorm_> hm
<bluestorm_> other parts of Ocaml (or SML) are stateful
<bluestorm_> i think it's related to subtyping
<bluestorm_> (the other part of OCaml wich has subtyping, polymorphic variants, is tricky too)
<loufoque> flux: modules seem to just be namespaces
<bluestorm_> hm
<flux> loufoque, you missed the piece where you have module functors
<bluestorm_> and interface restriction
dmentre has left #ocaml []
<flux> such as: module FooMap = Map.Make(struct type t = int let compare a b = Pervasives.compare b a end)
<bluestorm_> hm flux
<bluestorm_> do you think computing things at compile-time would be possible within the module system ?
<flux> no
<bluestorm_> hm
<bluestorm_> can functors be recursive ?
<flux> if they can, I don't know if you can have a "base case" so you would exit the recursion..
<loufoque> it seems what's missing compared to C++ templates for example, is specialization of modules for specific types.
<loufoque> which indeeds allows to exit recursion
<bluestorm_> hm
<bluestorm_> ad-hoc polymodulomorphism ^^
leo037 has quit ["Leaving"]
<loufoque> is there a way to have state without using the evil garbage collector?
<bluestorm_> hm
<bluestorm_> what's the relation between state and garbage collector ?
<bluestorm_> even purely functional languages need a GC
<bluestorm_> (because of closures, i think)
crathman has joined #ocaml
<flux> uh, you want gc even with simple recursion?
<bluestorm_> (of course mutable state does have an influence on the GC design)
<bluestorm_> hm ?
<flux> let rec foo l = if List.length l < 10 then foo (List.length l::l) else foo [] can run forever with gc; not so without it..
<loufoque> GC is only needed if you are sharing a variable between multiple scopes. Otherwise, you could just put it on the stack. When the scope ends, the variable is freed. It's that simple. It seems there is no way in OCaml to have simple variables on the stack.
<flux> loufoque, the problem is that what if you do infact have a reference outside the scope - then it is probably undefined behavior time, or otherwise you spend (run)time accounting for those..
<flux> I suppose a linear type system would help with that
<bluestorm_> loufoque:
<bluestorm_> with closure you can have variable whose scope is very hard to trace, i think
<loufoque> yes, a closure can potentially outlive the scope it was created in, when it is returned for example.
<loufoque> is there a quick guide to exceptions somewhere, and how to achieve exception-safety in ocaml ?
<loufoque> I can't even find much info in the reference manual
<bluestorm_> hm
<bluestorm_> there are only try .. with and exception declaration
<flux> and the with-statement is a pattern-match construction
<bluestorm_> hm
<bluestorm_> http://caml.inria.fr/pub/docs/oreilly-book/html/book-ora017.html is more verbose than the reference manual
<flux> one thing you can do for handling exceptions:
<flux> type 'a value = Value of 'a | Exception of exn;;
<xavierbot> type 'a value = Value of 'a | Exception of exn
<flux> let valuefy f arg = try Value (f arg) with exn -> Exception exn
<flux> let valuefy f arg = try Value (f arg) with exn -> Exception exn;;
<xavierbot> val valuefy : ('a -> 'b) -> 'a -> 'b value = <fun>
<flux> so that let's you do:
<flux> List.find ((=) 42) [1; 9; 15];;
<xavierbot> Exception: Not_found.
<flux> match valuefy (List.find ((=) 42)) [1; 9; 15] with Value v -> "found it" | Exception Not_found -> "Didn't find it" | e -> raise e;;
<xavierbot> Characters 129-130:
<xavierbot> match valuefy (List.find ((=) 42)) [1; 9; 15] with Value v -> "found it" | Exception Not_found -> "Didn't find it" | e -> raise e;;
<xavierbot> ^
<xavierbot> This expression has type int value but is here used with type exn
<flux> hmph
<flux> match valuefy (List.find ((=) 42)) [1; 9; 15] with Value v -> "found it" | Exception Not_found -> "Didn't find it" | Exception e -> raise e;;
<xavierbot> - : string = "Didn't find it"
<flux> if you find try..with at some cases inconvenient
<flux> (I suppose if you know it can only raise Not_found, you could replace Exception Not_found with _ and drop the last case
seafoodX has quit []
<flux> )
<bluestorm_> let valuemap f = function Value v -> (valuefy f) v | Exception exn -> Exception exn;;
<xavierbot> val valuemap : ('a -> 'b) -> 'a value -> 'b value = <fun>
<bluestorm_> let valueapp valuefied x = match valuefied with Value f -> (valuefy f) v | Exception exn -> Exception exn;;
<xavierbot> Characters 72-73:
<xavierbot> let valueapp valuefied x = match valuefied with Value f -> (valuefy f) v | Exception exn -> Exception exn;;
<xavierbot> ^
<xavierbot> Unbound value v
<bluestorm_> let valueapp valuefied x = match valuefied with Value f -> (valuefy f) x | Exception exn -> Exception exn;;
<xavierbot> val valueapp : ('a -> 'b) value -> 'a -> 'b value = <fun>
<bluestorm_> :]
<bluestorm_> let ( @$ ) x = valueapp x;;
<xavierbot> val ( @$ ) : ('a -> 'b) value -> 'a -> 'b value = <fun>
<bluestorm_> valuefy List.find @$ ((=) 42) @$ [1; 9; 15];;
<xavierbot> Characters 9-18:
<xavierbot> valuefy List.find @$ ((=) 42) @$ [1; 9; 15];;
<xavierbot> ^^^^^^^^^
<xavierbot> This expression has type ('a -> bool) -> ('a list -> 'a) value
<xavierbot> but is here used with type ('b -> 'c) value
<bluestorm_> grr
<bluestorm_> valuefy List.find ((=) 42) @$ [1; 9; 15];;
<xavierbot> - : int value = Exception Not_found
<bluestorm_> hehe
<bluestorm_> (i'm satisfied now, and will stop flooding the chan)
ygrek has joined #ocaml
<loufoque> there is no construct similar to "finally" ?
<flux> loufoque, there are camlp4 extensions that can implement that
<flux> however, a common functional programming idiom is something like:
<flux> let return_value = function Value v -> v | Exception e -> raise e;;
<xavierbot> val return_value : 'a value -> 'a = <fun>
<flux> actually I don't think I'll use that..
<flux> let with_res acquire release f = let res = acquire () in try let v = f res in release res with e -> release res; raise e;;
<xavierbot> Characters 66-75:
<xavierbot> let with_res acquire release f = let res = acquire () in try let v = f res in release res with e -> release res; raise e;;
<xavierbot> ^^^^^^^^^
<xavierbot> Warning Y: unused variable v.
<xavierbot> val with_res : (unit -> 'a) -> ('a -> 'b) -> ('a -> 'c) -> 'b = <fun>
<flux> let with_res acquire release f = let res = acquire () in try let v = f res in release res; v with e -> release res; raise e;;
<xavierbot> val with_res : (unit -> 'a) -> ('a -> 'b) -> ('a -> 'c) -> 'c = <fun>
<flux> once again static typing to the rescue ;)
<flux> (well, simple diagnostics I suppose even without it..)
<flux> then this would work (but won't because xavierbot is limited to no-io):
<flux> with_res (fun () -> open_in "file") close_in (fun file -> read_input file);;
<xavierbot> Characters 21-28:
<xavierbot> with_res (fun () -> open_in "file") close_in (fun file -> read_input file);;
<xavierbot> ^^^^^^^
<xavierbot> This expression is not a function, it cannot be applied
<flux> but without some other framework that can be more clumsy than just using 'finally' :)
<flux> (you'd like to pair resource acquisition and release functions so you won't need to give too many arguments to such functions etc)
jedai has joined #ocaml
Smerdyakov has joined #ocaml
<flux> hmm.. ocaml needs a lambda function syntax that doesn't need surrounding parenthesis in that case..
crabstick_ has joined #ocaml
crabstick has quit [Read error: 104 (Connection reset by peer)]
<aij> flux: in which case?
<aij> if you mean (fun file -> read_input file), then you could just say read_input instead
<flux> aij, well obviously there's a lot more code after that
<flux> aij, something like fun file -> let get_input () = match valuefy read_input file with Value v -> v::get_input () | _ -> [] in get_input ()
<flux> I suppose using any operator in between would fit also..
<aij> so, you want the parser to use type inference to figure out how to parse an expression?
tetsuo_ has joined #ocaml
<Smerdyakov> What was the original example where you needed parentheses but wished you didn't, flux?
G_ has joined #ocaml
Tetsuo has quit [Read error: 104 (Connection reset by peer)]
<flux> well, this works, and I've used this approach earlier in other contexts
<flux> let (@@) a b = a b;;
<xavierbot> val ( @@ ) : ('a -> 'b) -> 'a -> 'b = <fun>
<flux> with_res open_in "/etc/fstab" close_in @@ fun file -> let rec consume () = print_string @@ input_line file ^ "\n"; consume () in consume ()
<flux> aij, I don't think it needs type-level magic. simply a keyword or operator that combines @@ and fun :) (perhaps not -> because that's everywhere already)
G has quit [Connection timed out]
<flux> oh, right, I had already replaced with_res with
<flux> let with_res acquire arg release f = let res = acquire arg in try let v = f res in release res; v with e -> release res; raise e;;
<xavierbot> val with_res : ('a -> 'b) -> 'a -> ('b -> 'c) -> ('b -> 'd) -> 'd = <fun>
<flux> hm, actually I don't know why I want open_in to be evaluated within with_res
<flux> (I don't)
buluca has quit [No route to host]
buluca has joined #ocaml
<bluestorm_> hm
mav has quit [Read error: 110 (Connection timed out)]
mav has joined #ocaml
<aij> flux: ah, so you want @@ to bind less tightly than fun?
<aij> or just to mark the end of a fun?
<mr_hugo> i have this error:
<mr_hugo> fst p_data;;This expression has type (string * string) list but is here used with type 'a * 'b
<mr_hugo> how do i access (string * string) data types ?
<mr_hugo> ah ok
<aij> fst would get you the first string of a (string * string)
<aij> but you have a (string * string) list
<mr_hugo> yes okok, i was returning it inside a string, and i didn't realize it
<mr_hugo> inside a list i mean
<mr_hugo> yes
<mr_hugo> thanx you
<mr_hugo> still trying to grasp Ocaml
ygrek has quit ["Leaving"]
<flux> aij, that example works just fine
<flux> aij, I think any operator would infact do in that particular situation..
<flux> aij, but @ is nice because it is right-associative
<mr_hugo> how do i make several let without using let ?
<mr_hugo> is there any way to set precedence in OCaml ?
<mr_hugo> like '(' in C ?
<flux> mr_hugo, let (a, b, c) = (4, 3, 2) and d = 42 in a + d
<mr_hugo> ( (( ) () ))
<mr_hugo> ahh
<mr_hugo> ok
<flux> mr_hugo, hmm.. parenthesis set precedency in ocaml also
<mr_hugo> i thought they would create a list
<aij> mr_hugo: in SML they are needed around tuples
<mr_hugo> yes tupes
<mr_hugo> ok
<aij> but in ocaml they only affect binding precedence
<aij> I usually still put them around tuples, but only because I first learned SML and other people around here are likely to find it less confusing
ktne has quit [Nick collision from services.]
ktne has joined #ocaml
Cygaal has joined #ocaml
crathman has quit ["ChatZilla 0.9.78.1 [Firefox 2.0.0.6/2007072518]"]
buluca has quit [Read error: 113 (No route to host)]
mr_hugo has quit [Read error: 104 (Connection reset by peer)]
cpst has joined #ocaml
Cygal_ has quit [Success]
rwmjones has joined #ocaml
ktne has quit []
crathman has joined #ocaml
buluca has joined #ocaml
piggybox_ has joined #ocaml
piggybox has quit [Connection timed out]
<danderson> can strings have embedded null characters in objective caml?
<bluestorm_> yes
<danderson> let str = "foo\0bar";;
<bluestorm_> str.[n] <- '\0';
<xavierbot> let str = "foo\0bar";;
<xavierbot> ^^^
<xavierbot> Warning: File "", line 26, characters 14-16: Illegal backslash escape in string or character (0)
<xavierbot> Characters 1-4:
<xavierbot> Parse error:
crathman has quit ["ChatZilla 0.9.78.1 [Firefox 2.0.0.6/2007072518]"]
<danderson> ... really?
<bluestorm_> let a = "aaa";;
<xavierbot> val a : string = "aaa"
<bluestorm_> a.[1] <- '\0';;
<xavierbot> a.[1] <- '\0';;
<xavierbot> ^^^
<xavierbot> Characters 10-13:
<xavierbot> Illegal backslash escape in string or character (0)
<bluestorm_> a;;
<xavierbot> - : string = "aaa"
<bluestorm_> hm
<bluestorm_> strange :p
<bluestorm_> ah
<bluestorm_> a.[1] <- '\000';;
<xavierbot> - : unit = ()
<bluestorm_> a;;
<xavierbot> - : string = "a\000a"
<danderson> aaaah.
<danderson> okay.
<danderson> Thanks
<danderson> (trying to gracefully handle passing an UTF16 string to caml from C)
<danderson> hmm, actually, that's annoying
<danderson> how do I make a caml string from a C string with embedded nulls?
<danderson> the caml C lib has only copy_string, which doesn't take a size argument
<danderson> okay, I think I have it. I'll poke around and see what I can do.
<bluestorm_> hm
<bluestorm_> if you have to handle UTF, there is a special (external) lib, camomile
<bluestorm_> (as i never used it i cannot say more)
<danderson> right
<danderson> the trouble in this case is getting the input to camomile.
<danderson> I have to get it out of the C code (easy) and into ocaml (harder), so that camomile can operate on it
<danderson> but I have the solution.
<bluestorm_> :p
piggybox has joined #ocaml
leo037 has joined #ocaml
G_ has quit [Success]
piggybox_ has quit [Connection timed out]
<loufoque> how good is ocaml unicode support?
<bluestorm_> there is no built-in support
<bluestorm_> but from what i heard camomile is good enough
<bluestorm_> I think that generally, OCaml strings are not a strong point of the language
<bluestorm_> (String is not that fast, and Str isn't thread-safe)
<rwmjones> loufoque, camomile
<bluestorm_> but good external libraries exist
<loufoque> first, I can see that camomile is designed for Unicode 3.2
<rwmjones> & for utf-8, it "just works" provided you don't do anything stupid like calling String.uppercase
<loufoque> the latest version is 5.0
<bluestorm_> rwmjones: is there a way to have the compiler tools to read utf8 in source files ?
<rwmjones> bluestorm_, sure, using \x sequences :-)
<bluestorm_> hm
<bluestorm_> not so user-friendly :]
<bluestorm_> hm
<rwmjones> well, you write your messages in english, and translate them using gettext. The translations come from an external utf-8 file, so no problem.
piggybox_ has joined #ocaml
G_ has joined #ocaml
piggybox has quit [Read error: 110 (Connection timed out)]
piggybox has joined #ocaml
m3ga has joined #ocaml
leo037 has quit ["urpmi dodo"]
piggybox_ has quit [Connection timed out]
tetsuo_ has quit ["Leaving"]
piggybox_ has joined #ocaml
bluestorm_ has quit ["Konversation terminated!"]
seafoodX has joined #ocaml
seafoodX has quit [Client Quit]
Cygaal has quit [Read error: 104 (Connection reset by peer)]
piggybox has quit [Read error: 110 (Connection timed out)]
piggybox has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
piggybox_ has quit [Read error: 110 (Connection timed out)]