<palomer>
ok, the repo doesn't have any more bin files
<palomer>
woot!
* palomer
hugs ruby
Mr_Awesome has quit [Read error: 110 (Connection timed out)]
* thelema
can build
<thelema>
uh oh, problem in expression.ml
<thelema>
big nasty type error with objects: The second object type has no method check_types
<rpg_>
i have 3 records let rec1 = { data = "abcd" ; next = rec2 };; let rec2 = {data = "efgh" ; next = rec3 } ;; type rec3 = { data = "finally" ; next = Nil };;
<rpg_>
how would i scan for the record that has next value of Nil
<palomer>
thelema, that sucks
<thelema>
rpg_: well, your types are a bit fuzzy, as well as your declaration
<palomer>
works fine over here
<rpg_>
i know thelema the actual code is proper and it works
<thelema>
palomer: body expression is not a subtype of expression
<thelema>
while cur_record.next != Nil do cur_record := cur_record.next; done
<thelema>
with appropriate ! and let
<rpg_>
hold on le me see
<rpg_>
oh i think i get it
<thelema>
you could also use a recursive function, but the while loop seems plenty straightforward.
<rpg_>
thanks
gerardoj has joined #ocaml
gerardoj is now known as r0oter
<thelema>
palomer: oh, it actually comes from a different level - body_expression body_expression_variant is not a subtype of expression generic_expression_variant
<rpg_>
thelema: how about # let final_record current = if current.next = Nil then current else (final current.next) ;;
<palomer>
but it is!
<rpg_>
err
<palomer>
maybe you need to cast it
<rpg_>
final_current at the end
<palomer>
works fine on my system though
<thelema>
rpg_: let rec and you're good.
<rpg_>
oh yeah
<rpg_>
sorry
<thelema>
congrats, you've re-invented the list.
<rpg_>
lol
<rpg_>
doesnt work :(
<rpg_>
# let rec return_final current = if current.next = Nil then current else (return_final current.next);;
<rpg_>
This expression has type node_ref but is here used with type queue_node
<thelema>
let rec final = function {contents=_; next=Nil} as current-> current | {contents=_; next=Node n} -> final n;;
<thelema>
that syntax should work.
<thelema>
it has to do with current.next not being a node, but a node_ref.
<rpg_>
yeah
<thelema>
which is exactly the error you get.
<rpg_>
yeah
<rpg_>
lol
<rpg_>
hold on le me see
<rpg_>
what is "as"
<thelema>
gives a name to the whole record.
<rpg_>
explain pls
<rpg_>
how do i use it
<thelema>
i.e. if you were matching (1, (2,3)), you could do: | (x,(y,z) as a) as b -> ...
<thelema>
and x=1, y=2, z=3
<r0oter>
hi everyone, does anybody knows how could I delete the second element of a list?
<thelema>
a=(2,3), b=(1,(2,3))
<rpg_>
hmm
<thelema>
otherwise to get a you'd have to do | a -> match a with (x,b) -> match b with (y,z) ->
<rpg_>
This expression has type queue_node ref but is here used with type queue_node
<thelema>
[as] lets you bind parts of patterns to names.
<thelema>
if next is mutable, you don't need to have Node of queue_node ref
<r0oter>
is there something like delete?
<thelema>
but if you really want, do [final !n]
<thelema>
r0oter: yes: let remove_second = function a :: b :: t -> a::t | _ -> failwith "Not enough elements"
<r0oter>
thelema: thanks thats exactly what I was looking for ;)
<thelema>
r0oter: homework?
Palace_Chan has joined #ocaml
<r0oter>
thelema: actually job homework
<thelema>
in ocaml? hope it's a good job.
<r0oter>
thelema: actually my boss want me do some comparisons against perl, I get to choose any functional lang..
<thelema>
you may save some development time using batteries. Or you may lose it compiling all its dependencies
Mr_Awesome has joined #ocaml
<rpg_>
hmm
<r0oter>
thelema: but now that Im going through some documentation, seems really interesting on how code you actually need to code on equivalent programs.
<rpg_>
how do i return the previous elem
<thelema>
rpg_: before the Nul?
<thelema>
r0oter: ocaml does encourage you to thing different from other languages.
<thelema>
you can do imperative programming, but often that's not best.
<rpg_>
let rec final = function {contents=_; next=Nil} as current-> current | {contents=_; next=Node n} -> final n;;
<rpg_>
can i do like
<rpg_>
let rec final = function { contents=_; next=Nil} as current.next -> current etc.
<thelema>
no.
<rpg_>
oh.
<palomer>
make inconsistent assumptions over interface Expression <--what in the??!?
<thelema>
maybe you can skip the unusued fields
<rpg_>
i dont want the Nil one i want the one before
<rpg_>
brb gona contemplate
<thelema>
function {next = Node {next = Nil}} as notlast -> notlast | {next = Node n} -> final !n
<rpg_>
i was thinking something like
<rpg_>
let previous n = match n.next with {contents=_ ; next = Nil } -> n | {contents=_ ; next = Node n} -> previous n;;
<rpg_>
how aboud that
<thelema>
need one more !, but looks good.
<rpg_>
where ?
<thelema>
previous !n
<rpg_>
btw i rechanged my code
<rpg_>
1 sec
<thelema>
also, maybe better to not use n for two different things.
<rpg_>
This pattern matches values of type queue_node but is here used to match values of type node_ref
<thelema>
ah, n.next is a node ref, so you have to take into account | Nil, and put Node before each {}
<rpg_>
oh because it is .next
<rpg_>
i get it
<thelema>
you'll save yourself some hassle if you make the list circular.
<thelema>
so that each node points to the next, and the last points to the first.
<thelema>
then there's no need for node_ref
<rpg_>
yes but the size is unlimited
<rpg_>
i mean
<rpg_>
i want to make the size unlimited
<rpg_>
actually
<rpg_>
u got a good point
<rpg_>
lol
<thelema>
so what's the problem? instead of doing appends, you're inserting into a circle.
<rpg_>
brbr gona rethink this for a sec
<rpg_>
o yeah
<rpg_>
i remeber
<rpg_>
the whole point of Nil was because i couldnt do let node1 = { contents = e1 ; next = node2 } and node2 = { contents = e2 ; next = node1 };;
<rpg_>
it creates a loop
<thelema>
what's the problem?
<thelema>
what's the problem with a loop?
<rpg_>
it scares me
<rpg_>
it printed a long list of lines
<thelema>
the GC will still collect it once it's unreferenced.
<rpg_>
like an infinite loop
<r0oter>
thelema: was wondering when do you use a rec function on ocaml?
<thelema>
you just have to be careful to use your first and last pointers to start and stop your recursion.
<rpg_>
next is a reference
<thelema>
err, back and front
<rpg_>
next should be a reference
<palomer>
let node1 = { contents = e1 ; next = node2 } and node2 = { contents = e2 ; next = node1 };; <-- you can do something similar to this
<thelema>
r0oter: whenever you want that function to call itself. In most languages, functions can call themselves by default, but ocaml requires a keyword to self-reference.
<rpg_>
ok le me rewrite some code brb
<palomer>
thelema, any luck compiling?
<thelema>
Palace_Chan: no. It's late, and I'm gonna go to sleep.
<thelema>
grr...
<thelema>
palomer: ^^^^
<Palace_Chan>
thelema, gnight the lema lol
<thelema>
good night all
<palomer>
night
<r0oter>
thelema: gotcha thx :)
<r0oter>
is it legal to do something like this?
<r0oter>
let f lis = match lis with [] -> [] | head :: tail -> insert head (sort tail);;
r0oter has left #ocaml []
r0oter has joined #ocaml
<rpg_>
ah i think i did it thelema
r0oter has left #ocaml []
<rpg_>
thank you
<rpg_>
for your guidance ;)
r0oter has joined #ocaml
r0oter has left #ocaml []
kennyluck has left #ocaml []
threeve has quit []
Palace_Chan has quit ["Palace goes to sleep"]
alexyk has quit []
jknick has joined #ocaml
Snark has joined #ocaml
rpg__ has joined #ocaml
sporkmonger has quit []
Yoric[DT] has joined #ocaml
<Yoric[DT]>
hi
mishok13 has joined #ocaml
<palomer>
hey Yoric[DT]
<Yoric[DT]>
How do you do?
<palomer>
great!
<palomer>
in the process of releasing my application
<palomer>
wanna try it?
<palomer>
it's really cool!
rpg_ has quit [Read error: 110 (Connection timed out)]
Yoric[DT] has quit [Read error: 60 (Operation timed out)]
Yoric[DT] has joined #ocaml
asabil has joined #ocaml
<Yoric[DT]>
mmhhh....
<Yoric[DT]>
How do I delete a file?
* Yoric[DT]
can't find any function for deleting files.
<Yoric[DT]>
Arf, Unix.unlink.
<gildor>
Sys.remove ?
jknick has quit ["Lost terminal"]
<Yoric[DT]>
That, too :)
<flux>
palomer, so it's like an environment for developing programming languages?
<Yoric[DT]>
thanks
gim has quit [Read error: 60 (Operation timed out)]
glondu` has joined #ocaml
gim has joined #ocaml
glondu has quit [Read error: 104 (Connection reset by peer)]
code17 has joined #ocaml
l_a_m has joined #ocaml
ulfdoz has joined #ocaml
OChameau has joined #ocaml
Kerris0 has joined #ocaml
Kerris01 has joined #ocaml
ulfdoz has quit ["deprecated"]
ulfdoz has joined #ocaml
gene9 has joined #ocaml
gene9 has quit ["leaving"]
Kerris0 has quit [Read error: 110 (Connection timed out)]
ulfdoz has quit [Read error: 110 (Connection timed out)]
Kerris0 has joined #ocaml
Kerris01 has quit [Read error: 110 (Connection timed out)]
ulfdoz has joined #ocaml
gaja has quit ["t"]
Kerris01 has joined #ocaml
Kerris0 has quit [Read error: 110 (Connection timed out)]
mfp has quit [Read error: 104 (Connection reset by peer)]
s4tan has quit [Read error: 104 (Connection reset by peer)]
Kerris01 has quit ["Leaving."]
mfp has joined #ocaml
<Yoric[DT]>
palomer: ping
<mehdid>
Yoric[DT]: the syntax notation "open System, IO, File" is, frankly, horrible :) IMO
<Yoric[DT]>
You think so?
* Yoric[DT]
actually likes it.
<Yoric[DT]>
What would you replace it with?
<mehdid>
well ... it looks like it opens the three modules
<Yoric[DT]>
Well, it does.
<Yoric[DT]>
Objective served :)
<mehdid>
yeah but implicitely IO and File are in system
<mehdid>
am I wrong ?
<Yoric[DT]>
Indeed.
<Yoric[DT]>
[open System, IO, File]
<Yoric[DT]>
is exactly
<Yoric[DT]>
[open System;; open IO;; open File;;]
<mehdid>
oh ... I missed something then :)
<mehdid>
So sorry for the noise
<mehdid>
:p
<Yoric[DT]>
No problem :)
<mehdid>
in you first message, in the caml-list, you said it's : open System.IO;; open System.File;;
<Yoric[DT]>
Fair enough, I should have been clearer.
<Yoric[DT]>
Fair enough, I should have been clearer on the fact that the two examples are not exactly identical.
<mehdid>
:D
<mehdid>
ok now I understand
Jedai has joined #ocaml
Kerris0 has joined #ocaml
|Jedai| has quit [Read error: 110 (Connection timed out)]
damg has joined #ocaml
damg has quit [Remote closed the connection]
code17 has quit ["Leaving."]
code17 has joined #ocaml
code17 has quit [Remote closed the connection]
code17 has joined #ocaml
_zack has joined #ocaml
Kerris0 has quit [Read error: 104 (Connection reset by peer)]
alexyk has joined #ocaml
<thelema>
Yoric[DT]: good job with the thread on caml-list
<flux>
I've actually thought that 'Foo, Bar, Baz' is a very unocamlish way to express a list, but I'm not sure if there's another way
<thelema>
<< Foo, Bar, Baz >> ?
<flux>
(I mean, commas separate elements of tuples in ocaml)
<thelema>
yes.
<thelema>
but with camlp4, anything's possible.
<flux>
well, for example open System IO File might not be that possible?
<flux>
or is there no ambiguity
<thelema>
hmm.. I don't mind the commas
<thelema>
what would it mean to open a tuple?
<flux>
who knows :). open [System; IO; File] would even be worse. so perhaps , is the way to go.
<thelema>
without any separator, it'd be difficult to tell the end of the [open] clause
<Smerdyakov>
thelema, really? SML has no separator. What's the difference?
<flux>
now now, are you backing on your "with camlp4, anything's possible" statement :)
<flux>
smerdyakov, SML can open multiple modules in one open?
<Smerdyakov>
flux, yes.
<thelema>
does SML completely ignore whitespace?
<flux>
I can't think an example of an ambiguity, although it is no proof that there is none
<thelema>
open Batteries let foo = bar
<flux>
let is not a module name
<Smerdyakov>
thelema, I'm not sure what you mean. Just like in OCaml, whitespace outside strings is used only to separate tokens.
<thelema>
I guess the capitalization / keyword issue would take care of that.
<flux>
thelema, how about this: let a b = foo b let c = 42 ?
<thelema>
how about that?
<flux>
thelema, it's the same thing, the number of arguments for foo can be determined by that let isn't a value
<flux>
(well, an expression)
<flux>
afaik there are no top-level expressions that can begin with a capital letter
<thelema>
in my mind, there's some wierd disambiguation going on at the toplevel, and sometimes it breaks down in the face of grouping:
<flux>
it might overlap with some syntax extensions, though
<thelema>
let a b = foo b; let c = 42
<flux>
I think that's just plain incorrect syntax
<thelema>
no, I think it'll compile
<thelema>
err, n/m
<flux>
nope
<thelema>
let a b = foo b; let c = 42 in 5
<flux>
what about that?
* thelema
was thinking c, expecting [let c = 42] to return 42
<flux>
that's correct syntax with the same meaning as let a b = (foo b; 5)
<thelema>
parsing-wise, when you see the let, you don't/can't know whether it's the beginning of a toplevel expression (bad ;) or just part of a complex expression
<flux>
true
<Yoric[DT]>
Possible ambiguity: open List None
<thelema>
Yoric[DT]: good job.
<Yoric[DT]>
Is None a module name or an 'a option?
<Yoric[DT]>
Thanks.
<flux>
yoric[dt], how could it be an option?
<Yoric[DT]>
flux: Well, why not?
<Yoric[DT]>
I can open a module, ignore it and return a value, can't it?
<flux>
yoric[dt], what would it mean?
Jedai has quit [Read error: 104 (Connection reset by peer)]
<flux>
open List 5 is illegal
<Yoric[DT]>
Is it?
<thelema>
open List Some None => open List;; Some None;;
<flux>
(same as open List None is)
Jedai has joined #ocaml
<Yoric[DT]>
My bad.
<flux>
thelema, yes, but open List None doesn't mean open List;; None;;
<thelema>
if the [open] parser magically knew the end of the list of arguments...
<thelema>
anyway, time to go.
<Yoric[DT]>
cheers
<Yoric[DT]>
flux: thing is [open System, IO, File] is readable.
<flux>
I can't disagree with that :)
<Yoric[DT]>
But yes, we could certainly rewrite this [open System IO File]
<flux>
I'm not sure if it's worth the trouble. someone familiar with campl4 (bluestorm, mfp?) might have an idea if it'd cause problems with camlp4 extensions.
<flux>
for example with relational one can (?) write: open Foo TABLE bar bar ..
threeve has joined #ocaml
bla has quit [Read error: 113 (No route to host)]
bla has joined #ocaml
_zack has quit ["Leaving."]
alexyk has quit []
<mfp>
flux: relational is pretty invasive anyway (and nobody uses it), so I wouldn't consider it an argument against open A B C; also, you could always do open A;; TABLE user users ...
<flux>
true
<flux>
but I imagine other extensions could use the same mechanism
<mfp>
hmm
<flux>
but while open A;; surely does fix the issue, I don't think it's neat to require ;;'s. I don't use them :)
<mfp>
the only one that comes to mind is Camlp4MacroParser
<mfp>
open A DEFINE A = 1 oops
<mfp>
but it's a keyword anyway
<mfp>
so that case is OK
<mfp>
however, macros for str_items aren't
<mfp>
or rather, wouldn't
<mfp>
because they don't exist atm. :)
<mfp>
(imagine something like DEFINE Type(M, x) = type x = M.x open Foo Type(t) ... probably convoluted)
<mfp>
*Type(Module, t)
<flux>
but nevertheless, could be surprising
<mfp>
keeping A, B, C is safe for now
<mfp>
the comma could be dropped later (while supporting the old syntax)
<mfp>
re: TABLE user... actually, open Foo\n TABLE user users would work, since TABLE is a keyword, not an a_UIDENT
<mfp>
so open A B C can only conflict with extensions that use a mere a_UIDENT at the top-level, not a keyword