gene9 changed the topic of #ocaml to: www.ocaml.org | http://caml.inria.fr/oreilly-book/ | http://www.bagley.org/~doug/shootout/ | http://icfp2002.cs.brown.edu/ | Ocaml kicks ass (c) Dybbuk | please, write Makefile.[am|in]
<taw> i have a question
<taw> i wrote this code but i don't know if i'm duplicating something that already exists or not:
<taw> type autohash = { autohash_last: int ref; autohash_h:(string,int)Hashtbl.t; };;
<taw> let autohash_get ah s =
<taw> try Hashtbl.find ah.autohash_h s
<taw> with Not_found -> (
<taw> ah.autohash_last := 1 + !(ah.autohash_last);
<taw> Hashtbl.add ah.autohash_h s !(ah.autohash_last);
<taw> !(ah.autohash_last);
<taw> );;
<taw> let ah = {autohash_last = ref (-1); autohash_h = Hashtbl.create 16; };;
<taw> print_int (autohash_get ah "foo"); print_newline();
<taw> print_int (autohash_get ah "bar"); print_newline();
<taw> print_int (autohash_get ah "foo"); print_newline();
<taw> results are:
<taw> 01
<taw> ^D^D
<taw> results are:
<taw> 0
<taw> 1
<taw> 0
mrvn has quit [Ping timeout: 14400 seconds]
taw has left #ocaml []
bobov has quit [Read error: 104 (Connection reset by peer)]
tsaib_afk is now known as tsaib
gene9 has joined #ocaml
gene9 has quit [Read error: 60 (Operation timed out)]
gl has quit [Read error: 113 (No route to host)]
gl has joined #ocaml
mrvn has joined #ocaml
<mrvn> moin
mrvn_ has joined #ocaml
mrvn has quit [Killed (NickServ (Ghost: mrvn_!~mrvn@p50834F30.dip.t-dialin.net))]
mrvn_ is now known as mrvn
gene9 has joined #ocaml
gene9 has quit [Client Quit]
yangsx has joined #ocaml
yangsx has quit ["Client Exiting"]
<mrvn> I have another probably realy easy problem here:
<mrvn> File "packageParser.mly", line 18, characters 25-46:
<mrvn> Unbound value PacketType.newPackage
<mrvn> But in packageType.ml:
<mrvn> let newPackage = ref (fun () -> new package)
<mrvn> WHat am I missing?
tsaib has quit [Read error: 104 (Connection reset by peer)]
<smkl> PacketType vs. packageType
<mr_bubbs> tricky subject matter
<mrvn> found it some time ago. thx
<mrvn> cut&waste is tricky busyness
ott has joined #ocaml
<ott> re all
<mrvn> But good that someone woke up. I have anotherproblem:
<mrvn> ocamlc -c packageParser.ml
<mrvn> File "packageParser.ml", line 477, characters 26-27:
<mrvn> Syntax error
<mrvn> (fun parser_env ->
<mrvn> let _1 =
<mrvn> (peek_val parser_env 1 : 'Text)
<mrvn> in
<mrvn> Obj.repr((
<mrvn> fun s ->
<mrvn> PackageType.Unknown _1 s )
<mrvn> : 'Field))
<mrvn> The line with Unknown is 477
<mrvn> If I delete "s" in line 477 I get:
<mrvn> File "packageParser.ml", line 477, characters 3-25:
<mrvn> The constructor PackageType.Unknown expects 0 argument(s),
<mrvn> But its "Unknown of string * string" so it clearly needs 2 arguments
gl has quit [No route to host]
<mrvn> Ok, I got the 0 argument error fixed.
<mrvn> But still the syntax error
<mrvn> Args, got the syntax error too. It must be Unknown(_1,s) because its a Constructor.
ott has left #ocaml []
malc has joined #ocaml
malcy has joined #ocaml
malc has quit [Read error: 110 (Connection timed out)]
<mr_bubbs> is there nothing that will split a string, based on a separator character, into a string list?
<malcy> # Str.split (Str.regexp ";") "1;2;3";;
<malcy> - : string list = ["1"; "2"; "3"]
<mr_bubbs> okay
<mr_bubbs> Str is a bummer
<mr_bubbs> but I guess it IS something
<mr_bubbs> I will write my own then
<malcy> let split s =
<malcy> (* - Wed Jun 27 16:14:55 2001 by malcy - Stolen from CDK (with minor modifications) *)
<malcy> let len = String.length s in
<malcy> let rec index_from pos =
<malcy> if pos = len then raise Not_found else
<malcy> match s.[pos] with
<malcy> | ' ' | '\t' -> pos
<malcy> | _ -> index_from (succ pos)
<malcy> and iter pos =
<malcy> try
<malcy> if pos = len then [] else
<malcy> let pos2 = index_from pos in
<malcy> (String.sub s pos (pos2 - pos)) :: (iter (pos2 + 1))
<malcy> with _ -> [String.sub s pos (len - pos)]
<malcy> in
<malcy> iter 0
gl has joined #ocaml