<thelema>
Palace_Chan: if you like, you can omit the ''' if you won't ever refer to the previous binding.
<thelema>
i.e. let cxt = rev_is_of_ast ctx guard in ...
<Palace_Chan>
lol yea, once it became ''' it looks a litle annoyingg
<thelema>
let cxt = rev_il_of_ast cxt t in ...
<Palace_Chan>
thing is, those match statements, since i have two in there the type checker is blasting me away
<thelema>
but the parentheses balance for me.
<Palace_Chan>
they balance, which is the weird part
<thelema>
what editor do you use?
<thelema>
If you use one with indenting, that's helped me solve your problem.
<thelema>
Your last match | None -> faileith "chibiusa if2
<thelema>
(ignore all the typos)
<thelema>
as written, that goes with the "match l with | CImm i ->" matching
<thelema>
do you have a type that's [CImm of int | None]?
<Palace_Chan>
emacs with tuareg, yea i have terrible indenting there...yeah i want match #1 to be None failwith Some -> the let thinsg and then a match #2 Cimm do something or None failwith
<Palace_Chan>
i have a CImm of int32 type
<Palace_Chan>
hmm wait i see what you mean
<Palace_Chan>
i guess my last None has to be _
<Palace_Chan>
because CImm constructor is not an option type and has no None either
<Palace_Chan>
i mean..the match for it
<thelema>
if your type has one variant: CImm of int32, then you might want to use a let to get at i: let (CImm i) = l in (I think)
<thelema>
but if that's the case, you probably really want a private type.
<Palace_Chan>
im doing a match on l which is of a type defined: type operand | CImm of int32 | Svar of svar
<Palace_Chan>
adding the _ seemed to do the trick...well at least compilation is reporting another type error now lol
<thelema>
you should match both CImm and Svar, if those are the two possibilities.
<thelema>
using | _ in your match may hide errors in the future.
<Palace_Chan>
yea ur right, might as well failwith Svar than _
<Palace_Chan>
wow the type checker loves to shrivel me up and toss me into the recycle bin.... only error reported for this line: { cxt''' with cg_retloc = (if ((Int32.compare i 0l) != 0) then rt else rf)
<Palace_Chan>
is "this expression is not a function and cannot be applied"
<Palace_Chan>
Int32.compare is the only function there..and it is a function
<thelema>
you have (x) y somehow.
<Palace_Chan>
(x) y somehow ?
<thelema>
cxt with cg_retloc = if Int32.compare i 0l != 0 then rt else rf}
<thelema>
yes, two expressions separated by a space.
<thelema>
ocaml tries to use the first expression as a function and apply it to the second.
<Palace_Chan>
which are my two expressions separated by a space ?
<thelema>
you don't need any () in your expression above, only the {} around it.
<thelema>
I don't see where.
<thelema>
I don't see which two.
<Palace_Chan>
hmm, although sometimes...particularly with the Some keyword i get errors when i dont use parens
rstites has joined #ocaml
<thelema>
Variant names bind pretty loosely, and associate left, which often isn't what's wanted.
<Palace_Chan>
ugh still getting that "expression not a function cannot be applied", took out parens at least: { cxt''' with cg_retloc = if Int32.compare i 0l != 0 then rt else rf
<Palace_Chan>
cg_insns = [] }
<Palace_Chan>
maybe a semicolen after rf ?
<thelema>
no. Maybe Int32.zero instead of 0l?
<thelema>
or how about [i <> Int32.zero]
<Palace_Chan>
ohhh fancy..why in braces ?
<thelema>
[] just IRC bracketing to indicate code.
<thelema>
(used in ocamldoc)
<Palace_Chan>
hmm nah same error...sometimes it takes me hours to find these errors
<thelema>
oops - you do need something after rf.
<thelema>
and it's a ; that separates record extensions.
<thelema>
{ expr with field = expr { ; field = expr } }
<Palace_Chan>
ahhh
<thelema>
your first paste had a } after rf.
<thelema>
so I assumed that was the end of it.
<Palace_Chan>
nice! i got another syntax error now which means that one is gone
<Palace_Chan>
thanks, you're good at ocaml
<Palace_Chan>
it's type sys. still messes me up
<thelema>
it takes a while to get used to the error messages produced by type inference.
<thelema>
and the parser gives poor feedback on syntax errors.
<Palace_Chan>
oh wow it compiled...lol with ocaml getting my code to actually compile is soooo hard
<thelema>
On my todo list (down towards the bottom) is to rewrite the ocaml parser to increase the usefulness of error messages.
<thelema>
Palace_Chan: I remember people saying the exact same thing about Ada.
<Palace_Chan>
is Ada functional or what ?
<thelema>
no, it's very pascal-ish. Imperative to the extreme.
<thelema>
but it has a reasonably expressive type system and is very strongly typed, so a lot of errors get caught in the process of compilation.
<Palace_Chan>
imperative to the extreme ? how much so ?
<thelema>
The normal style of programming involves almost all statements, especially assignment statements.
<thelema>
I guess it'd be possible to program in a functional style with it, but since there's no type inference, one'd have to give full interfaces for every little function.
<christo_1>
why is this code giving me an error at the for loop
<christo_1>
did i declare something incorrectly?
<thelema>
your error is at line 10: x=0
<Palace_Chan>
thelema, lol the error messages of the ocaml parser make segfault feel like your buddy
<thelema>
ocaml doesn't do assignment this way. (nor does it declare "variables" this way.
<thelema>
Palace_Chan: I'd take the ocaml error messages anyday.
rstites has quit [Remote closed the connection]
<thelema>
try something like "let x = ref 0 in ... incr x;"
<Palace_Chan>
haha true, guess im just overly sensitive right now because im not used to it yet
<thelema>
Palace_Chan: it's like learning french - you just have to start thinking backwards. :)
<christo_1>
thelema: thats odd, it highlighted the for
<thelema>
christo_1: yup, that's the first bit that's out of place. x=0 is a valid expression comparing x with 0, but the for can't go next to that because (x=0) isn't a function
<christo_1>
okay i forgot the let
<christo_1>
used to C
<thelema>
and you're forgetting that ocaml let bindings aren't mutable -- you can't just change their values.
<christo_1>
thelema: would you suggest learning lisp?
<christo_1>
i mean ive looked at scheme and haskell but
<thelema>
OCaml will suffice for now.
<christo_1>
thelema: cmon
<thelema>
I haven't learned it well enough to really say. I've just done a little hacking in emacs lisp.
<christo_1>
supposedly crash bandicoot was written in lisp and allegro
<rstites>
I'm at PSU in Portland and I'm using Ocaml for my dissertation.
<thelema>
rstites: ah, okay.
<thelema>
topic?
<ozy`>
<christo_1> i mean ive looked at scheme and haskell but <== haskell is not exactly anything like lisp whatsoever... instead, it's more ML-like than any ML out there
<christo_1>
well schemes the new dialect sort of right
<ozy`>
wasn't scheme designed in the 70s?
<ozy`>
it's a fairly normal lisp
<ozy`>
not exactly terse, but clear and fairly expressive as lisps go
<ozy`>
(common lisp can be a huge mess at times... elisp is even worse)
<christo_1>
so u suggest scheme
<christo_1>
i waslearning it
<christo_1>
from the wizard book
<ozy`>
I would actually suggest clojure, if you're looking for something a little closer to ML or Haskell
<ozy`>
it's probably the most expressive lisp out there right now
<christo_1>
isnt it based on the JVM or something
<ozy`>
yes, it is
<ozy`>
and it's still in development
<ozy`>
you might compare it to arc, except that it has actual support and isn't abandoned
<ozy`>
if you've never used any lisp dialect I guess you might as well try scheme or CL for now, since they're the dialects with the best tutorials
<christo_1>
yeh following that and the wizard book
<christo_1>
i guess thats SICP
<ozy`>
(I somehow missed when you said that earlier)
christo_1 has quit ["sleep"]
johnnowak has joined #ocaml
ygrek has joined #ocaml
Submarine has joined #ocaml
ygrek has quit [Remote closed the connection]
Camarade_Tux has joined #ocaml
<Palace_Chan>
i have a record with a hashtbl field...i want to return a copy of that record with that field's hashtable modified...but the modify functions for a hashtbl dont return the hashtbl so how can i do this ?
<Palace_Chan>
{ cxt' with cg_bindings = Hashtbl.replace cxt'.cg_bindings...
<Palace_Chan>
wont work because the right hand side returns unit, not the new hashtbl
<Palace_Chan>
maybe, have a let k = hashtbl.copy in
<Palace_Chan>
then, modify k
<flux>
palace_chan, you want to create a copy of the hash table with one value modified?
<Palace_Chan>
and set it equal to k
<Palace_Chan>
yes
<Camarade_Tux>
Palace_Chan, hashtables are modified in place so you'll need to copy it I think
<Palace_Chan>
right, so make a copy with a let in above...modify the copy, then set my record field equal to the modified copy
<Camarade_Tux>
and hi everybody :)
<flux>
palace_chan, well, you can do it that way, but if you were to use a tree (Map), you wouldn't need to make a copy, as it work functionally
<Camarade_Tux>
Palace_Chan, agree with flux, if you want to return a copy, hashtable is not the best thing (especially if it becomes quite large)
<Palace_Chan>
hmm guess ill stick to that way for now...mr. type checker has been DESTROYING me enough today....
<Palace_Chan>
right, but im working with a file which has them
ygrek has joined #ocaml
<Camarade_Tux>
Palace_Chan, I'm sure there's a possible way but as far as I'm concerned, I need to really wake up first (or at least get up ;p )
<Palace_Chan>
Camarade_Tux, lol, i know what you mean - i've got to finish this thing tonight and it's killin me
<Camarade_Tux>
Palace_Chan, you could watch memory usage while making a big hashtable and then copying it && modifying it
<Camarade_Tux>
I don't think you will get any sharing between the two but ocaml always surprises me so who knows ? (ok, Xavier ;p )
<Camarade_Tux>
but otherwise, if you have to deal with hashtables, your approach is probably not the correct one
<Camarade_Tux>
btw, if you try copying the hashtable, store nothing ("", None, 0, ...) in the hashtables, just add a *lot* of keys (maybe integers, from 0 to max_int or similar)
pattern has quit [Excess Flood]
pattern has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
mishok13 has joined #ocaml
pantsd has quit [Remote closed the connection]
ygrek has quit [Remote closed the connection]
mattam has joined #ocaml
filp has joined #ocaml
Camarade_Tux has quit []
GustNG has joined #ocaml
Submarine has quit [Read error: 110 (Connection timed out)]
Submarine has joined #ocaml
GustNG has quit ["Leaving."]
maxote has quit [Read error: 110 (Connection timed out)]
rby has quit [Read error: 104 (Connection reset by peer)]
maxote has joined #ocaml
mattam has quit [Remote closed the connection]
Submarine has quit [Read error: 110 (Connection timed out)]
rby has joined #ocaml
johnnowak has quit []
kig__ is now known as kig
johnnowak has joined #ocaml
marmotine has joined #ocaml
ertai[NP] has quit ["leaving"]
ertai has joined #ocaml
ertai is now known as ertai[NP]
johnnowak has quit []
<Palace_Chan>
id like to build a list by traversing a given list, and every time i see a particular type of element...generating a record with contents a list of all the subsequent elements in that list till the next special one and adding that to my output list....no idea how i could approach it
<flux>
build two recursive functions.
<flux>
which both consume list elements
<flux>
the first finds the element matching condition a, the second find the element matching condition b, but while doing that, constructs the result list
<Palace_Chan>
flux, hmmm so if i have special elements a, b, c, d would those still work ?
Associat0r has joined #ocaml
<flux>
palace_chan, perhaps fun a will detect all those cases. I don't know if the end condition is the same for all those.
<Palace_Chan>
flux, thanks, ill give it a go....after a nap though (its 6 in the morning)
seafood has joined #ocaml
<guyzmo>
hi, how can I print n times a string ? (like " "*12 in python)
<rwmjones>
guyzmo, I was fairly sure I'd written a function specifically to do that once, but I cannot find it now. Anyway, I don't think there is one, so you'd have to write your own loop ...
<rwmjones>
ok the function I wrote was a bit different from that ...
<rwmjones>
(* Pad a string to the full width with spaces. If too long, truncate. *)
<rwmjones>
let pad width str =
<rwmjones>
let n = String.length str in
<rwmjones>
if n = width then str
<rwmjones>
else if n > width then String.sub str 0 width
<rwmjones>
else (* if n < width then *) str ^ String.make (width-n) ' '
<rwmjones>
guyzmo, if it's specifically a single character, then you can use String.make 12 ' '
<guyzmo>
I found String.make that works for me
<guyzmo>
:)
<guyzmo>
but thanks
Demitar has quit [Read error: 110 (Connection timed out)]
Palace_Chan has quit ["Palace goes to sleep"]
<petchema>
let pad = Printf.sprintf "%-*s"
<petchema>
ah, it doesn't truncate
<rwmjones>
ah but my code is longer :-)
Demitar has joined #ocaml
longh has joined #ocaml
Yoric[DT] has joined #ocaml
petchema has quit [Remote closed the connection]
<Yoric[DT]>
hi
<Yoric[DT]>
rwmjones: ping
<rwmjones>
Yoric[DT], morning
<Yoric[DT]>
How do you do?
<rwmjones>
busy
<Yoric[DT]>
:/
<Yoric[DT]>
I'm currently writing some documentation for Batteries and I have a small question regarding Fedora.
<Yoric[DT]>
These days, what is the name of the official package manager?
<thelema>
ocamlfind: When using -syntax, the META variable 'preprocessor' must be set
<thelema>
Command exited with code 2.
<thelema>
make: *** [byte] Error 10
<Yoric[DT]>
:/
<Yoric[DT]>
I'm not quite sure what causes that error message.
<Yoric[DT]>
mmmm....
<Yoric[DT]>
That's not the correct command-line.
<Yoric[DT]>
Let me check.
<Yoric[DT]>
Is that with the latest commit?
<thelema>
no, right before it.
* thelema
updates
<thelema>
did you independently come up with the reinstall make target?
<thelema>
is make doc still 15 minutes slow?
ppsmimou has quit ["Leaving"]
mattam has quit [Read error: 60 (Operation timed out)]
ppsmimou has joined #ocaml
* thelema
goes
<Yoric[DT]>
thelema: what do you mean independently?
<Yoric[DT]>
Did you do it, too?
<Yoric[DT]>
And make doc is a bit faster but still slow.
<thelema>
yes. almost the exact same.
<Yoric[DT]>
I've vaguely traced the problem, it seems to be ocamldoc's fault.
<Yoric[DT]>
Most of the time is spent by ocamldoc doing ocamldoc stuff.
mattam has joined #ocaml
<thelema>
ok. We'll work on that later.
<Yoric[DT]>
Yep.
* Yoric[DT]
hopes we won't have to rewrite ocamldoc.
<thelema>
I'll put in more work on batteries tonight (not going to aikido). Keep an eye out for some new code.
<thelema>
'later
<Yoric[DT]>
'later
* Yoric[DT]
would like to resume doing Aikido but can't find a nice club.
* ertai[NP]
would also like to resume Aikido, funny
<Yoric[DT]>
ertai[NP]: well, if you find a decent place to train, be sure to tell us :)
<flux>
do brackets in the nick indicate a former Aikido hobby?
<ertai[NP]>
flux: I don't think so
<ertai[NP]>
flux: I found the idea of putting initials near the nick is easier for people to link nicks to realnames
<flux>
I always thought the ircname-field is for that purpose..
<Yoric[DT]>
flux: you weird person.
<Yoric[DT]>
thelema: at some point, could you upload your list test protocol + results to the tracker?
<flux>
silly of me, I know
<ertai[NP]>
flux: silly question but how to fetch irc-name of others?
<flux>
ertai[np], /whois ertai[np]
<flux>
it's also displayed on /who
<ertai[NP]>
flux: thanks
<flux>
np
<flux>
;)
<ertai[NP]>
you convinced me
ertai[NP] has quit ["leaving"]
ertai has joined #ocaml
longh has quit [Read error: 104 (Connection reset by peer)]
ozy` has quit ["Shop for a whopper"]
<Yoric[DT]>
ertai: you know that you don't need to leave irc to change your nickname, don't you?
<ertai>
Yoric[DT]: yes but to change the Real Name field, I had to
<Yoric[DT]>
possibly
<flux>
ooh
<Yoric[DT]>
Ok, I think I've finished writing the presentation of Batteries.
<Yoric[DT]>
Now, back to actual documentation.
hkBst has quit [Read error: 104 (Connection reset by peer)]
mbishop_ has joined #ocaml
mishok13 has quit [Read error: 110 (Connection timed out)]
mbishop has quit [Read error: 113 (No route to host)]
pango has quit [Remote closed the connection]
longh has joined #ocaml
ozy` has joined #ocaml
pango has joined #ocaml
rby has quit [Read error: 104 (Connection reset by peer)]
Camarade_Tux has joined #ocaml
Camarade_Tux has quit []
Snark_ is now known as Snark
Camarade_Tux has joined #ocaml
filp has quit ["Bye"]
mishok13 has joined #ocaml
jlouis has quit ["Leaving"]
Palace_Chan has joined #ocaml
<Palace_Chan>
i keep gettin a syntax error in line 23 of this code...since it's not a type error im thinking i must have some misuse of the let in, or {} or matches....
<Camarade_Tux>
Palace_Chan, let a = ... in let b = ... in let c = ...
<Camarade_Tux>
you need let cxt'''' = {} in cxt''''
<Camarade_Tux>
you're missing the : in cxt''''
<Camarade_Tux>
but if you just want to return cxt'''' (you want to return it, right ?), you can just rip off "let cxt''''"
<Camarade_Tux>
(with the equal sign of course)
<Palace_Chan>
Camarade_Tux, let me try that
<grirgz>
j'y etait presque =)
<Camarade_Tux>
grirgz, mouhahah ! ;p
<Camarade_Tux>
grirgz, I've too been surprised with the weird way to write the record ;)
<Palace_Chan>
Camarade_Tux, thanks it worke
<Palace_Chan>
d
<Camarade_Tux>
Palace_Chan, yw
itewsh has quit [Read error: 60 (Operation timed out)]
mbishop_ has quit [Remote closed the connection]
itewsh has joined #ocaml
mishok13 has quit [Read error: 110 (Connection timed out)]
Palace_Chan has quit ["Leaving"]
mbishop has joined #ocaml
itewsh has quit [Read error: 110 (Connection timed out)]
itewsh has joined #ocaml
mishok13 has joined #ocaml
marmotine has quit [Read error: 113 (No route to host)]
marmotine has joined #ocaml
itewsh has quit [Read error: 110 (Connection timed out)]
itewsh has joined #ocaml
ygrek has joined #ocaml
Linktim has joined #ocaml
middayc has left #ocaml []
Linktim_ has joined #ocaml
itewsh has quit ["KTHXBYE"]
azi` has joined #ocaml
<azi`>
anyone happens to see what's illegal with the syntax in the if statement : | Dva (x, y) -> x' = zdruzi x y' = zdruzi y if (compare x' y' == 0) then Ena(x') else Dva(x',y')
Linktim has quit [Read error: 110 (Connection timed out)]
<Camarade_Tux>
azi`, you should read how to use the "let" construct ;p
<ozy`>
whoa
<ozy`>
azi`: dude we're like bizarro-doppelgängers or something
<azi`>
i see what's the issue sorry
<azi`>
bizarro-doppelg?ngers?
* ozy`
points to their nicks
<azi`>
now i get a sysntax error indicated at the second "let"
<azi`>
| Dva (x, y) -> let x' = zdruzi x let y' = zdruzi y if (compare x' y' = 0) then Ena(x') else Dva(x',y')
<azi`>
| Ena x -> zdruzi x ;;;;
<azi`>
Syntax error
mattam has quit [Remote closed the connection]
<Camarade_Tux>
let x' = zdruzi *in* let y' = zdrusi y *in* if
<Camarade_Tux>
of course, don't write the '*'s
Linktim has joined #ocaml
middayc_ has joined #ocaml
middayc_ has left #ocaml []
rwmjones_ has joined #ocaml
<azi`>
yeah, i've figured it out thanks
nyingen has joined #ocaml
<nyingen>
so, I compiled my library of C bindings, and would like to test it. However, invoking the external functions in the ocaml top-level results in message "external function foo not found"
Linktim_ has quit [Read error: 110 (Connection timed out)]
<nyingen>
I understand this is because the ocaml top-level is not linked against my foolib?
<Camarade_Tux>
nyingen, how did you compile ?
<Camarade_Tux>
nyingen, does not need to
<nyingen>
oh, ok
<Camarade_Tux>
you only need to make the .cma appropriately ?
<nyingen>
Camarade_Tux: I'm actually adding onto someone else's bindings, and they have a Makefile. I can paste the relevant rules if you want to see them :)
<Camarade_Tux>
use a nopaste service ;)
<nyingen>
what's a nopaste service?
<Camarade_Tux>
a service where you put your paste and which give you a link to it, therefore you don't flood the channel with thousands of lines, just one url ;)
<nyingen>
oh, right
<nyingen>
pastbin.org or somesuch?
<Camarade_Tux>
exactly
<nyingen>
ok
<Camarade_Tux>
btw, we need an ocaml official one, and the corresponding pastebot, paste.lisp.org shouldn't be allowed to be the only one ;p
Linktim has quit [Read error: 110 (Connection timed out)]
<nyingen>
Camarade_Tux: so the -ldb is not needed for ocamlmklib?
<Camarade_Tux>
nyingen, my needs were different, I had the .o files so I used them (no real reason except it was one step-less, namely creating the archive file), but *you* should need it
<nyingen>
I see
<Camarade_Tux>
nyingen, chances are you'll try a few combinations before getting a working one ;)
<nyingen>
yeah, I'm reading the docs for ocamlmklib now
<nyingen>
the ocaml FFI isn't as bad as I thought it would be, until I got to the compilation phase :)
<Camarade_Tux>
nyingen, completely agree, but I'm not sure it's ocaml's fault
<Camarade_Tux>
and I think that's because we're completely unused to runtime errors such as function X is not available
<nyingen>
yeah. interfacing with libraries is always a minefield
<Camarade_Tux>
florent monnier's tutorial is great, his compilation makefile is maybe not the best though
<Camarade_Tux>
by removing his last step, I resolved a problem of external functions not being available, just by *removing* the step
<nyingen>
yeah, that tutorial was really helpful
<hcarty>
Camarade_Tux and nyingen: I have found OCamlMakefile /very/ helpful when starting a C library binding. It has a nice set of features to handle most of the details.
ygrek has quit [Remote closed the connection]
<Camarade_Tux>
hcarty, I think we always start thinking "it will be easy, just compile and that'll be ok", but then...
<Camarade_Tux>
I'll see OCamlMakefile, I've just never used it
Amorphous has quit [Read error: 110 (Connection timed out)]
<hcarty>
Camarade_Tux: It doesn't really make the binding generation itself easier, but the Makefile is greatly simplified
<Camarade_Tux>
hcarty, how do you use it ? you "include" it in your makefile and then can benefit from automatic rules ?
<hcarty>
4 or 5 lines are often enough
<hcarty>
Yes
<hcarty>
I can paste an example, and I think there are some examples online
<Camarade_Tux>
I've got a few sources using ocamlmakefiles so that should be alright, thanks :)
<Camarade_Tux>
calc/Makefile is indeed impressive :)
jlouis has joined #ocaml
<Yoric[DT]>
thelema: ping
* Yoric[DT]
fears he should take a good hard look at OCamlMakefile some day to produce something for using Batteries.
<Yoric[DT]>
At the moment, the only tried method of using Batteries is OCamlBuild.
<nyingen>
hcarty: neat
<nyingen>
OCamlMakefile itself is terrifying :)
<nyingen>
I heard a joke once about make: "there's really only one hand-written makefile, all others are the result of copying and modifying that one"
<Yoric[DT]>
:)
<Yoric[DT]>
Well, for the moment, I'll just wait and hope that someone submits a OCamlMakefile for Batteries.
<Yoric[DT]>
Has anyone every had problems with OCamlDoc not rendering @author ?
<Yoric[DT]>
Mmmhh....
<Yoric[DT]>
Might actually be a bug in ocamldoc -dump.
Snark has quit ["Ex-Chat"]
itewsh has quit [Read error: 110 (Connection timed out)]
itewsh has joined #ocaml
itewsh has quit [Remote closed the connection]
<Yoric[DT]>
Well, I won't spend the night hunting ocamldoc bugs.
jdev has quit [Read error: 104 (Connection reset by peer)]
<Yoric[DT]>
thelema: here, yet?
DroneZilla has joined #ocaml
<azi`>
hm how can i express a type `foo' holding an [int*int] or an in [int*int] appended to `foo' ?
<Yoric[DT]>
What do you mean by "append"?
<Yoric[DT]>
Maybe [type foo = A of int * int | B of int * int * foo]?
<Camarade_Tux>
Yoric[DT], I think he's rather looking for (3, 4) ;)
* Yoric[DT]
still doesn't understand the question.
<Yoric[DT]>
Camarade_Tux: I have the feeling that Batteries is not coming out today.
* Yoric[DT]
is waiting for thelema to get back to irc.
* Camarade_Tux
doesn't understand either
<Camarade_Tux>
Yoric[DT], we're still friday, you said week-end ;p
<Yoric[DT]>
:)
<Camarade_Tux>
btw, did you manage to add "open X" at the beginning of a file ?
<Yoric[DT]>
Yep.
<Yoric[DT]>
Well, I'm just waiting for him to drop an example in directory examples :)
<Camarade_Tux>
great, great, great ! thanks :)
<Yoric[DT]>
In the mean-time, I'm polishing the code and fighting ocamldoc.
<Yoric[DT]>
And finding a number of bugs here and there.
<Yoric[DT]>
I hope people will test that alpha release.
<Camarade_Tux>
as far as I'm concerned I'm not doing anything, I can't concentrate, plus I'm tired of trying to find and counter what stupid things the "user" could do =/
<Camarade_Tux>
Yoric[DT], I'm pretty sure they will
<Yoric[DT]>
What user is that?
<Camarade_Tux>
well, maybe you :p
<Yoric[DT]>
:)
<Camarade_Tux>
it's for my livecd project, it automates absolutely everything but that also means the script is quite heavy
DroneZilla has quit []
itewsh has joined #ocaml
<Camarade_Tux>
now, godi in a chroot but only after checking ocaml is not meant to be installed in /usr
rwmjones_ has quit ["Closed connection"]
Palace_Chan has joined #ocaml
<Palace_Chan>
if i call the following function (only 3 lines so ill cp it here) and give it c as an argument..does it modify c ? (i.e. is it by reference?) and, does it return tmp properly ? or does tmp go out of scope or something ?
<Camarade_Tux>
Palace_Chan, according to your indentation you forgot one let at the very beginning
<Camarade_Tux>
also, you probably don't need to "match ... with" accumtup, just write
<Camarade_Tux>
let blocklist, insnlis, link = accumptup in
<Camarade_Tux>
also, when matching, you don't need to put parens around what you return
<Palace_Chan>
Camarade_Tux, yea i changed that, also in another match near the beginning.....cuz im at war with the type checker now
<Camarade_Tux>
you can however put some around the {...}::blocklist though in the first match case, that'd be a better candidate
<Camarade_Tux>
also, what does ocaml say ?
<Palace_Chan>
gives a huuuge type error now, let me pastebin the ting with some of the changes you suggested
<Camarade_Tux>
in List.fold_left also, you can probably remove one paren : (Ext (Cf...)) should simply be Ext (Cf...)
<Camarade_Tux>
Palace_Chan, compiling with -rectypes ? :d
<Palace_Chan>
Camarade_Tux, what is -rectypes ? in here: http://pastebin.com/d622c2a9a the error reported at line 5 is: This expression has type cgext Cfil.Il.insn list but is here used with type
<Palace_Chan>
unit Cfil.Il.insn list
<Camarade_Tux>
Palace_Chan, you'd better only annotate when ocaml cannot find your type for example because it lacks informations, not when it's not the one expected
<Camarade_Tux>
as for rectypes, it lets you have recursive types which are used in trees for instance and it has the power to make type-checker message really long
<Palace_Chan>
Camarade_Tux, yea we didnt have that before, but we didnt get what the compiler was saying so we added them to see if that would change something
<Camarade_Tux>
Palace_Chan, what you see is ocaml accepting what you tell him but being unable to go over line 5, your problem certainly lies between the first and fourth line
<Camarade_Tux>
line 5 is just the line the ocaml typechecker can't manage anymore, the line it encounters a pure contradiction
<Palace_Chan>
there doesnt seem to be a whole lot before that except the definition....could we benefit from commenting out line 5 onwards and plugging in a failwith ?
<Camarade_Tux>
not really, I'm nearly sure you have a problem in your algorithm (the way it's written, so maybe just a typo or something forgotten)
<Camarade_Tux>
if you don't see it just go outside and take a walk, rest a bit and come back to it
<Palace_Chan>
yea, ill get back to this for a minute now
<Yoric[DT]>
Well, in the absence of thelema, I guess Batteries is postponed to tomorrow or Sunday.
<Camarade_Tux>
Yoric[DT], I don't know if it changes much : the ocaml mailing-list has always been much more quiet on week-ends anyway
<Camarade_Tux>
ie don't worry :)
<Camarade_Tux>
haha, I was going through my scripts, I've found an useless line ;)
<Camarade_Tux>
( cd $TMP/camomile-0.7.1
<Camarade_Tux>
./configure --prefix=$TMP/ocaml/$OCAML_PREFIX && $MAKE_CMD all opt install )
<Camarade_Tux>
:p
* thelema
returns
* thelema
pulls the latest SVN
<thelema>
Yoric[DT]: gone yet?
<Yoric[DT]>
Not completely.
<Yoric[DT]>
Camarade_Tux: noted :)
<Yoric[DT]>
thelema: going soon, though.
<thelema>
yes, it's late there.
<Yoric[DT]>
I'll make the release during the week-end.
<Yoric[DT]>
It's 1 am.
<thelema>
what needs to be done to release?
<Yoric[DT]>
First, I'm waiting for your examples :)
<Yoric[DT]>
Then I'm tweaking the documentation.
<thelema>
examples of ropes? OK.
<Yoric[DT]>
After that, it's just a matter of committing, checking out under a different name, testing that make * works, tar.gzipping and uploading.
<Yoric[DT]>
That'll be done tomorrow.
<thelema>
no problem. I'll try to find any showstoppers before then.
<Yoric[DT]>
ok
<Yoric[DT]>
If you have any tests to add for ropes, feel free to.
<Yoric[DT]>
The test directory will need to be reworked at some point, though.
<thelema>
my benchmarks are under the test directory.
<Yoric[DT]>
Could you post benchmarks and results to the tracker, too?
<thelema>
I have graphs, but they're not very exciting.
<Yoric[DT]>
Anyway, I'll have to call it a night.
<thelema>
good night.
<Yoric[DT]>
See you during the week-end.
<thelema>
I'll be around as much as I can.
<Yoric[DT]>
I'll be more present on Monday, though.
Yoric[DT] has quit ["Ex-Chat"]
longh has quit [Read error: 104 (Connection reset by peer)]
<Palace_Chan>
let string_of_insn pr_ext = function
<Palace_Chan>
| case something -> bla | case another > bla.......is pr_ext the parameter to the function called string_of_insn here ? and why does it say = function ? is our return type a function ?
<thelema>
doing that makes a function with two parameters - one called pr_ext and another that gets matched by your cases.
<Camarade_Tux>
Palace_Chan, you could name the second name and then use "match foo with | case something -> ... | case another -> ..."
<Palace_Chan>
so then string_of_insn is a function with paramter pr_ext, and another paramter depending on what pr_ext is ?
<thelema>
the second parameter doesn't depend.
<thelema>
if you only give one parameter, it returns a function that takes the second parameter.