Amorphous has quit ["arg... must... shutdown... computer burnin..."]
Amorphous has joined #ocaml
<andreas_>
With the new type I get some strange error messages:
<andreas_>
print_char x.(i).(j);
<andreas_>
This expression has type Util.sequence but is here used with type 'a array
<pango>
correct, a sequence is not an array, it's a sum type
<andreas_>
that is I loose all the Array functionalities
<pango>
that's why you need to "deconstruct" it using pattern matching to access the array (in the case it's an AASeq)
<pango>
see my "match" code example above
<andreas_>
ok, I try
holo has joined #ocaml
<pango>
andreas_: the benefit of this is that you cannot forget to check whether it's an AASeq or a CharSeq before using it (and get errors are runtime)
<andreas_>
well the point is that I am always certain what kind of array x.(i) is, there is no ambiguity
<pango>
then deconstruct it earlier, and pass the array around
<flux__>
you can write a function that does it for you, so print_char (foo x.(i)).(j), where foo would throw an exception if it is something unexpected
<flux__>
I would probably use pattern matching locally, though
<andreas_>
for 95% of the program the array will consist of AASeq, only in the very beginning I need CharSeq
<pango>
then maybe you don't want that sum type in the first place
<andreas_>
Maybe it is better to use two different variables
<andreas_>
exactly
<andreas_>
that would save me a lot of pattern matching
<andreas_>
I think I will create some help variable with type CharSeq, that should do
<pango>
or only use chars in I/O functions
<andreas_>
I don't understand
<pango>
do you really need to build that char array, or could you directly create an aa array ?
<andreas_>
I need it for a computation in another function, so I can't just skip it
<pango>
create two functions, aaarray_of_chararray and chararray_of_aaarray ?
<andreas_>
maybe
<pango>
once you have aa_of_char and char_of_aa, it's just an Array.map away...
taw has joined #ocaml
<taw>
hello
<taw>
is there some standard type for resizable arrays, like STL vector<> ?
<andreas_>
on line "seq.(i) <- Array.fold_left seq_concat "" aln.x_char.(i);" the compiler complains with "This expression has type string -> 'a -> char -> string
<andreas_>
but is here used with type string -> 'a -> string"
<flux__>
btw, those array elements will all contain the same "bla", not different "bla"s
<andreas_>
I have no idea what I am doeing wrong
<andreas_>
it does not matter I overwrite them all
<pango>
beware of "function"
<pango>
seq_concat is a function of 3 arguments, as written
<pango>
a, b, and an anonymous third parameter
<andreas_>
thx I see
<andreas_>
let seq_concat a = function
<andreas_>
:)
<flux__>
andreas_, so yu're aware that let a = Array.make 2 "foo" in a.(0).[0] <- 'z'; a results in [|"zoo"; "zoo"|]?
<flux__>
oh, right
<flux__>
never mind ;)
<andreas_>
it compiles
<flux__>
it probably works then, too ;)
<pango>
if performance is a concern, you could use a Buffer.t instead of catenating strings
<andreas_>
that's the nice thing about ocaml, once it compiles it probably all good
<pango>
let buffer = Buffer.create 5 in
<pango>
Array.iter (fun b -> if b <> '.' then Buffer.add_char buffer b) aln.x_char.(i);
<pango>
seq.(i) <- Buffer.contents buffer
andreas_ has quit []
taw has left #ocaml []
andreas_ has joined #ocaml
<andreas_>
is it possible to do pattern matching on strings?
<andreas_>
let's say I have a string that starts with ">..."
<andreas_>
match line with
<andreas_>
| s when s.[0] = '>'
<love-pingoo>
that's possible
<love-pingoo>
but it isn't a pure pattern anymore.. the side condition after the when can actually be arbitrary and the compiler's coverage check will thus skip that clause
<andreas_>
could I match the line directly agains a regular expresssion?
<love-pingoo>
andreas_: not that I know, unfortunately :(
<love-pingoo>
you can only match constant strings
<love-pingoo>
for chars, you can write intervals
<love-pingoo>
| 'a'..'z' ->
<andreas_>
so I would need several "| s when s.[0] = '>'" lines if I wanted to do distinguish several strings
<love-pingoo>
holo: your float token seems to require a parameter
<love-pingoo>
on line 62 you must provide that parameter
<pango>
holo: all branches of a match must have the same type, and the other branch is "FLOAT" (and not FLOAT something)
<holo>
dylan, becouse i'm learning caml, and camllight is for learning purppose
<holo>
hmm
<love-pingoo>
holo: if you have the choice, choose ocaml, it's as easy to learn, and there is a wider community, and you'll know a general purpose language
<love-pingoo>
holo: btw #close doesn't exist
<pango>
and you cannot do that mistake, because ocaml doesn't allow partially applied constructors ;)
<holo>
love-pingoo, i'll put it there, the close stream. i know, but as this is for school evalution with camlight, i think its safer to use what they use to evaluate
<holo>
sorry for the comments in portuguese :s
<dylan>
heh, I didn't even notice.
<holo>
grr, if i fix that i know i will have another error in other side
<love-pingoo>
holo: if it's for school, then there's nothing to say.. you'll move to ocaml later, and live a long and happy life ;)
<love-pingoo>
I actually didn't know that constructors had that function-like behaviour in camllight.. I'd prefer that in OCaml
ski_ has joined #ocaml
ski has quit [Nick collision from services.]
ski_ is now known as ski
<holo>
weird
<holo>
it has type char and is used with type char stream, but in the option ":" below he doesn't complain with that
<love-pingoo>
holo: your i is a stream, so it's not a char
<love-pingoo>
just as you said
<love-pingoo>
you must explicitely peek the first char of the stream
<love-pingoo>
or whatever
<love-pingoo>
in the second branch it doesn't complain because you're not trying to string_of_char(i)
descender has joined #ocaml
<holo>
thanks love-pingoo!
<holo>
i haven't fixed yet but i know know the reason
<holo>
the secret is to interpret correctly the errors
<holo>
among other stuff :s
<holo>
is there any explicit conversion from stream to other type?
<holo>
if not i have to fix the algorithm ;s
<holo>
|[<'(`.`|`=`|`(`|`)`|`-`|`+`|`/`|`:`|`>`|`<`|`*`) as c;
<holo>
(ident_symbol(string_of_char c)) i >] -> [< 'i ; alex code>]
<holo>
the "c" is being interpreted as a char
<holo>
and is converted to a string
<holo>
"love-pingooyou must explicitely peek the first char of the stream"
<flux__>
am I imagining things, as has there been lately been an influx of ocaml-newcomers to the channel?
<flux__>
I'm not complaining, definitely ;)
<holo>
flux__, just school work for me, maybe some serious work in the future who knows.. but this is hard, i dunno
andreas_ has quit []
<flux__>
(I was thinking of a natural reason, yes, for instance a bunch of people going the same course would join)
andreas_ has joined #ocaml
<holo>
lolol
andreas_ has quit []
<holo>
how do i make from 0 to 9 as integers?
<holo>
i tried 0..9 but its syntax error
<mellum>
there's no special syntax for that
<mellum>
or do you mean a loop?
<holo>
`0`..`9`
<holo>
this is charsl
<holo>
i want integers
<mellum>
Oh. No idea.
<holo>
np
<holo>
:)
<holo>
any one with idea? :x
<flux__>
you could write a function range low high
<love-pingoo>
holo: if your range is not too wide you can write | 0 | 1 | 2 | 3 | 4 -> ...
<pango>
or use guards
<pango>
| x when x >= min && x <= max ->
<holo>
love-pingoo, yeah that's what i did and it worked
<holo>
pango, that's a good idea
TaXules has quit [Remote closed the connection]
TaXules has joined #ocaml
Smerdyakov has joined #ocaml
Tachyon76 has quit ["Leaving"]
descender has quit [zelazny.freenode.net irc.freenode.net]
descender has joined #ocaml
palomer has left #ocaml []
love-pingoo has quit ["Leaving"]
Snark has joined #ocaml
cjeris has joined #ocaml
Schmurtz has joined #ocaml
<cjeris>
If a, b, c : (float, float64_elt, c_layout) Bigarray.Array2.t, and I do a.{i,j} <- b.{i,j} + c.{i,j}, how many intermediate boxed floats are generated?
Submarine has joined #ocaml
<pango>
check asm
Amorphous has quit [zelazny.freenode.net irc.freenode.net]
mellum has quit [zelazny.freenode.net irc.freenode.net]
jgrimes has quit [zelazny.freenode.net irc.freenode.net]
Amorphous has joined #ocaml
mellum has joined #ocaml
jgrimes has joined #ocaml
<cjeris>
can't tell if it's 2 or 3, but at least 2.
<pango>
first case will match an consume the token
<pango>
other case will never be considered
<pango>
actually, the problem is not that the character will be consumed, but that match is "deterministic" : once a branch matches, other branches will never be visited
<holo>
yes! i don't them to revisited
<holo>
pango, first one will be consumed if it matches
<holo>
pango, right?
<pango>
from what I understand from stream docs, yes
<holo>
till now it has been working
<holo>
> .... ......match i with
<holo>
> [<'i>] -> ident_kwd (string_of_char i).
<holo>
This expression has type char stream -> token,