flux has quit [Read error: 131 (Connection reset by peer)]
bebui has quit [Remote closed the connection]
bebui has joined #ocaml
TaXules has quit [Remote closed the connection]
TaXules has joined #ocaml
jbu311 has joined #ocaml
<jbu311>
Would someone kindly help me out? I'm a newb and am trying to create a REALLY simple program but it's giving me errors on the most simple things I believe to be true. The print in this code won't work http://rafb.net/p/OL9ynF22.html
thermoplyae has quit ["daddy's in space"]
<yminsky>
The code doesn't seem to compile (missing a semicolon after the !q
<yminsky>
And once you put that in, it seems to work just as one would expect.
mfp has quit [Read error: 104 (Connection reset by peer)]
mwc has quit ["Leaving"]
jbu311_ has joined #ocaml
jbu311 has quit [Read error: 110 (Connection timed out)]
flux has joined #ocaml
jbu311_ has quit [Client Quit]
bluestorm has joined #ocaml
<ozzloy>
ok, so ocaml has this: type tree = Leaf of int | Node of tree * tree;;
<xavierbot>
Characters 0-2:
<xavierbot>
ok, so ocaml has this: type tree = Leaf of int | Node of tree * tree;;
<xavierbot>
^^
<xavierbot>
Unbound value ok
<xavierbot>
Characters 21-22:
<xavierbot>
Parse error: illegal begin of top_phrase
<ozzloy>
um...
<ozzloy>
now "tree" is a new type, but what do you call "Leaf" and "Node"?
<bluestorm>
:D
<bluestorm>
ozzloy: constructors ?
<bluestorm>
they're not functions
<bluestorm>
for example, (fun x -> Leaf x) is _not_ equivalent to (Leaf)
<bluestorm>
(the former will type int -> tree, the latter will fail with an error)
<bluestorm>
ozzloy: on a side not, it would be more generic to parametrize over the data type : type 'a tree = Leaf of 'a | Node of 'a tree * 'a tree
<bluestorm>
s/not/note/
<bluestorm>
your former example is an "int tree"
<ozzloy>
bluestorm: so they're constructors then? also that's neat with the generic parameterized data type
<bluestorm>
hm
<bluestorm>
i'd have cheked the manual for the exact name but it's down
<bluestorm>
i think "constructor" is correct, but as didn't learn OCaml in english, you're never sure :p
ygrek has joined #ocaml
<ozzloy>
bluestorm: oh? did you learn in french?
<bluestorm>
yes
<ozzloy>
bluestorm: neat. so the concept has a name in french?
<bluestorm>
hm, i guess "constructeur" is used there :p
jlouis_ has joined #ocaml
Tetsuo has joined #ocaml
<ozzloy>
not quite like "constructors" in java though
<ozzloy>
i'm off to bed. thanks bluestorm. goodnight
<bluestorm>
good night :p
rwmjones has joined #ocaml
jlouis has quit [Read error: 110 (Connection timed out)]
grom358 has joined #ocaml
ygrek_ has joined #ocaml
ygrek has quit [Remote closed the connection]
|Catch22| has quit [Read error: 104 (Connection reset by peer)]
ygrek_ has quit [Remote closed the connection]
ygrek_ has joined #ocaml
jderque has joined #ocaml
rwmjones has quit ["Closed connection"]
mfp has joined #ocaml
grom358 has quit ["Leaving"]
ygrek_ has quit [Remote closed the connection]
ygrek has joined #ocaml
marmottine has joined #ocaml
m3ga has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
rwmjones has joined #ocaml
<mfp>
threadring.hs (Control.Concurrent, MVar) 6.5s; threadring.ml (Lwt, custom MVar) 7.85s (2MB minor heap to use as much mem as Haskell)
<mfp>
a Control.Concurrent thread can only be preempted when it allocates. It's almost cooperative multitasking like Lwt.
jderque has quit [Read error: 104 (Connection reset by peer)]
jderque has joined #ocaml
Yoric[DT] has joined #ocaml
<Yoric[DT]>
hi
ita has joined #ocaml
ttamttam has joined #ocaml
seafood_ has quit []
jderque has quit [Read error: 113 (No route to host)]
seafood_ has joined #ocaml
<bla>
mfp, ;)
* Yoric[DT]
is looking for a nice way to prevent some computation from taking place.
<Yoric[DT]>
Or to prevent some data structure parametrized on 'a to ever being instantiated with 'a containing some type t.
<olegfink>
lazy?
<Yoric[DT]>
Sorry ?
<olegfink>
lazy suspends computation of an expression. however, that won't help with structures.
<Yoric[DT]>
Nope, it won't.
<mfp>
olegfink: next time say Lazy.t and avoid the ambiguity ;)
<Yoric[DT]>
:)
<ita>
even if the struture is purely functional
<ita>
?
<Yoric[DT]>
Let me give you a few additional details.
<Yoric[DT]>
I'm trying and find a solution for a colleague working on an extension of OCaml for concurrent programming.
<Yoric[DT]>
In his model, there's a central controller and a number of slave nodes.
<Yoric[DT]>
The controller may distribute computations to nodes but nodes shouldn't be able to do the same thing.
<mfp>
Yoric[DT]: can you consume some 'a t and provide a number of functions 'whatever -> _'a t so that there's no way to create 'a t values where 'a isn't in the allowed types?
<Yoric[DT]>
'a could be *anything*
<Yoric[DT]>
However, these nodes should be able to do anything except calling this "distribute" function.
<Yoric[DT]>
One option would be to simply put "distribute" in its own module and not give this module to the slave nodes. Not very type-safe and all that, but it could work.
<Yoric[DT]>
Another option would be to implement a new type system with effects and use that type system to guarantee that distribute is never invoked on arguments that may contain some distribution effect. A bit overkill, I hope.
<Yoric[DT]>
Right now, I'm trying to find another solution.
<Yoric[DT]>
* computations that are meant to be distributed to slave nodes have type 'a slave, where 'a is the type of the result
<Yoric[DT]>
* computations that are meant to be executed on the master have type 'a master
<mfp>
so you want to prevent ('a slave) slave or such, right?
<Yoric[DT]>
(making sure that these computations have the right type can be enforced either using monadic style or, I believe, with a simple Camlp4 extension)
<Yoric[DT]>
That's the idea.
<Yoric[DT]>
If we can prevent ('a slave) slave, we have won already.
<Yoric[DT]>
The problem being, of course, that ('a slave list) slave isn't better.
<bluestorm>
hm
<bluestorm>
what's the problem with the "module hiding" solution ?
<bluestorm>
you could eg. create two functors, Master and Slave, parametrized by the same common module (wich describe the computations), but with different interfaces
<bluestorm>
so that Slave wouldn't access to the "bad" functions
<bluestorm>
you could even combine the two approach
seafood_ has quit []
<Yoric[DT]>
Well, the idea is to make sure that slaves won't "accidentally" use the master module.
<bluestorm>
make 'a slave a suspension, create a monad algebra 'a slave -> 'a in the module, and hide it from slaves
<bluestorm>
hm
<bluestorm>
i don't really see why you consider type-enforced safety is safer than module-enforced safety
ita has quit [Remote closed the connection]
<Yoric[DT]>
I'm not completely sure how the slaves are distributed to their nodes.
<Yoric[DT]>
So yes, perhaps we can just make sure that the Slave module doesn't appear on each node.
<Yoric[DT]>
In which case this becomes some form of runtime error rather than a type error.
<Yoric[DT]>
...
<Yoric[DT]>
Although there may be a problem if the master node is also a slave node.
|Catch22| has joined #ocaml
<pango>
phantom types? I'm not sure it'd make any difference vs. 'a master / 'a slave solution...
<Yoric[DT]>
Up to this point, I've been trying with phantom types + monads.
<Yoric[DT]>
But I still need some functions 'a slave -> 'a master and 'a master -> 'a .
<Yoric[DT]>
Eventually, I end up with the same problem of hiding one function from the slave.
<Yoric[DT]>
I can manage to turn the problem into a trivial dynamic problem.
<Yoric[DT]>
But it's still dynamic.
<Yoric[DT]>
Basically, if the whole computation has type a 'a master and there is only one function with type 'a master -> 'a, I can ensure that the function is only called once.
<Yoric[DT]>
Well, I've sent these two suggestions.
filp has joined #ocaml
ita has joined #ocaml
jlouis has joined #ocaml
jlouis_ has quit [Read error: 110 (Connection timed out)]
jderque has joined #ocaml
ygrek has quit [Remote closed the connection]
ygrek_ has joined #ocaml
hkBst has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
piggybox has joined #ocaml
<mfp>
anybody knows the differences in native code generation triggered by -thread? So far, I've found no change in the generated .s...
ulfdoz has quit [Read error: 104 (Connection reset by peer)]
ulfdoz has joined #ocaml
hando has joined #ocaml
<hando>
could anyone explain why the following code doesnt work? "let input1 = (read_line()) in print_string input1;"
<bluestorm>
use ";;" instead of ";" ?
<bluestorm>
what you mean by "doesn't work" is unclear actually
<hando>
nope, that didnt work
<bluestorm>
do you have an error ? an unexpected behavior ?
<hando>
bluestorm, i'm feeding it input through stdin, and it should print out every line
<hando>
instead
<hando>
there's no error
<hando>
but it doesn't print out every line
<bluestorm>
hm
<hando>
it just doesnt print out anything
<bluestorm>
a buffering issue maybe
<bluestorm>
first : you have no endline for now
<bluestorm>
use print_endline input1
<hando>
and i know the method works, because when I use read_line() and store everything in an array and iterate the array I can print everything out
<hando>
what's the difference in ocaml with print_string and print_endline?
<bluestorm>
print_endline adds a new line
<hando>
bluestorm, print_endline worked
<bluestorm>
and flush the output
<hando>
why would endline work and not print_string?
<bluestorm>
because of the flushing
<bluestorm>
input/output is buffered
<hando>
ah
<hando>
thanks a bunch
<bluestorm>
btw
<bluestorm>
the additional parenthesis around read_line() were unnecessary
<hando>
are they? it gave me an error without them
<hando>
and then i put them in and it worked
<bluestorm>
hm
<bluestorm>
that was not in that very piece of code
<hando>
you're probably right
<bluestorm>
print_endline read_line () won't work, you need print_endline (read_line ())
<bluestorm>
because otherwise, the "print_endline" function is given two parameters, "read_line" and "()"
<hando>
now i'm trying to do "let q = ref [] in let input 1 = read_line() in if List.mem input1 !q then q:= input1 :: !q;"
<hando>
i assume it's again a buffering problem
<hando>
how do I gte around it this time, since i'm not trying to print
<bluestorm>
hm
<hando>
the error is again that it's not printing anything when I print q
<hando>
there are no errors
<bluestorm>
i assume you mean "if not (List.mem input1 !q) then .." ?
<hando>
bluestorm, could you explain when semicolons are needed? I think that's one of my big problems...i'm not sure when to use a semicolon or a double semi-colon...and the manuals/tutorials I've looked at don't even show uses of semicolons...so i'm very confused
<hando>
and thanks for all your help so far
<Smerdyakov>
Double semicolons are only signals to the toplevel.
<Smerdyakov>
Only use singles in files.
<bluestorm>
hando:
<Smerdyakov>
Double semicolons have one extra role to play in files, but IMO programs that need this role are flawed.
<hando>
ah
<bluestorm>
you putted if not List.mem input1 !q
<bluestorm>
not if not (List.mem input1 !q)
<Smerdyakov>
So, I recommend thinking of double semicolon as a signal to the toplevel to process a (syntactically self-contained) batch of code.
<bluestorm>
the former gives List.mem, input1, and !q, as parameters to the "not" function
<hando>
bluestorm, isnt !q the way to dereference the list?
<bluestorm>
yes it is
<bluestorm>
but i'm speaking about your parenthesis problem
<hando>
oh
<hando>
I see what you mean
<bluestorm>
if not foo bar is not correct
<hando>
so it should be if not (List.mem input1 !q) ?
<bluestorm>
yes it is
<hando>
so it should be if not (List.mem input1 !q) ?
<hando>
oops
<hando>
sorry
<bluestorm>
do you use the toplevel ?
<bluestorm>
in the toplevel, the error location is underlined
<hando>
bluestorm, that worked
<hando>
thanks
<bluestorm>
so it's easy to spot the problem
<hando>
No, I'm not using the toplevel
<hando>
the tutorials have been good but I havent seen explanation of when to use single semicolons
<Smerdyakov>
If you use Emacs and C-c C-c, followed by C-x `, the cursor moves to error locations.
<bluestorm>
(expr1; expr2) is an expression, that evaluates expr1, then expr2, and return expr2's value
<bluestorm>
that's all
<bluestorm>
let id = expr1 in expr2 is an expression as well
<bluestorm>
the rest is a question of priorities
jlouis_ has joined #ocaml
<hando>
so when I say if not ... then q := input1 :: !q; why do I need that semicolon after the q? It's an expression but it's not the last expression
<hando>
i thought you only need a semicolon to separate expressions, and that you dont need them after the last one
<bluestorm>
the expression being ;-ed is (if not ... then q := input1 :: !q)
<bluestorm>
yes, you need ; only to separate expression
<hando>
ah
<hando>
thanks
<bluestorm>
for convenience you may add an optional ; at the end of the expression, before a "block-closing" keyword like "done"
<bluestorm>
btw, is it intentional to read two lines at a time ?
<bluestorm>
with the exception mechanism, you may miss the last line
<bluestorm>
(if it's an odd one)
<hando>
yes, its intentional, because the lines come as pairs
<hando>
pairs of lines
<bluestorm>
ok
<hando>
Yeah, I've thought about that exception mechanism...
<hando>
I'm wondering if it'll screw up if I have no new line at the end
<bluestorm>
hm
<bluestorm>
seems so
<bluestorm>
but you forget newlines nowadays ? :-'
<bluestorm>
s/you/who/, actually
<bluestorm>
you may use finer-grained input functions
<hando>
well
<hando>
the input that i'm receiving, may or may not have newlines at the end
<hando>
it's strange why that would be, but it is the case
<bluestorm>
can't you add the newline yourself ?
<hando>
lol hmm
<bluestorm>
eg. if you're piping an output into your program, it should be quite easy to wrap that in a shell command that adds a newline at the end
<hando>
oh i'm not piping
<hando>
but hmm
mwc has joined #ocaml
jlouis has quit [Read error: 110 (Connection timed out)]
<hando>
does anyone know how to read all lines an input file if the last line doesn't have a newline on it?
^authentic has joined #ocaml
Yorick has joined #ocaml
<bluestorm>
hando:
<bluestorm>
you could read char-by-char
<hando>
i suppose I could
<bluestorm>
using (input_char stdin)
<hando>
could I use the pipe command for io to create a new file and then add the newline to the end of the output file? (I assume that I don't have write privileges on the input file)
<hando>
trying to look for an easier way
<hando>
like a 1 or 2 line addition
<bluestorm>
hm
<bluestorm>
i guess a System.command "cat yourinputfile > /tmp/foo" would do the job
<hando>
does everyone have privileges to /tmp/foo?
<pango>
I don't know if it helps, but if you need the sorted list lines without duplicates, using a Set look more appropriate than using a list
Cosmos95 has quit []
<hando>
it helps me, but as someone who has examples of code with list operations, I'm probably going to stick with lists
<hando>
but yeah, I should be using sets
<flux>
hando, I suppose System.command "umask 077; cat .. " would fix the permissions
<hando>
hrm
<hando>
is there just no way to get the io to recognize that last line (the line without the \n in it)?
<pango>
you can check with a small program that missing last newline is correctly handled by read_line
<hando>
pango, i've already checked
<hando>
it doesnt work
<flux>
hm
<flux>
input_line works fine for me for files without the last \n
<flux>
is the problem something different?
<hando>
someone used a hex editor (because apparently all text editors automatically add the new line?) and removed a \n at the end of the text file
<mwc>
hando
<hando>
yeS?
<mwc>
you could read chars, and if you don't detect a \n immediately before EOF, emit the \n
<jlouis_>
this doesn't really sound like a hard problem to fix or work around ;)
<hando>
sigh, that sounds like the best bet at the moment
<hando>
jlouis_, this is my first ocaml program
Anarchos has joined #ocaml
<hando>
jlouis_ i'm finding the most simple things are difficult to do
<Anarchos>
fastworld is not working for me : it tells that Printf.sprintf doesn't exist
<mwc>
hold on
<mwc>
val input_line : in_channel -> string
<mwc>
Read characters from the given input channel, until a newline character is encountered. Return the string of all characters read, without the newline character at the end. Raise End_of_file if the end of the file is reached at the beginning of line.
authentic has quit [Read error: 110 (Connection timed out)]
^authentic is now known as authentic
<hando>
would it look something like "try while true do let input1 = IO.input_line() in ... with _ -> begin ... end"
<flux>
hando, what's your current problem with the program?
<hando>
flux, the problem is if my last line is "B \nEOF" it works correctly
<hando>
flux, but if the last line is "B EOF" it doesn't
<hando>
flux, it just skips the last line
<pango>
hando: reading from files with no last newline works for me
<mfp>
hando: platform?
<mfp>
since there's so many ppl around... <mfp> anybody knows the differences in native code generation triggered by -thread? So far, I've found no change in the generated .s...
<flux>
let test () = let o = open_out "test.txt" in output_string o "hello\nworld"; close_out o; let i = open_in "test.txt" in while true do let s = input_line i in Printf.printf "got string: %s\n" s done;;
<xavierbot>
Characters 23-31:
<xavierbot>
let test () = let o = open_out "test.txt" in output_string o "hello\nworld"; close_out o; let i = open_in "test.txt" in while true do let s = input_line i in Printf.printf "got string: %s\n" s done;;
<xavierbot>
^^^^^^^^
<xavierbot>
This expression is not a function, it cannot be applied
<bluestorm>
mfp:
<bluestorm>
-thread Generate code that supports the system threads library
<bluestorm>
hm
<flux>
when I execute that function, I get output "hello" "world"
<pango>
I used echo -n to create a file with missing last newline
<hando>
mfp, it's an assignment and we're not told the platform
<hando>
mfp, just says "platform independent code should be written"
* hando
shoots self
<mfp>
bluestorm: what I'm looking for is differences in the generated assembly; I hoped to find some obvious change in e.g. allocation (but it turns out those are already safepoints) or something
<flux>
bluestorm, it doesn't exactly say what's the difference in compiling with -thread and without..
<flux>
mfp, it has been my belief that it may simply choose a different set of libraries to compile against
<flux>
(replacing the standard libraries with other versions)
<flux>
but I really don't know. perhaps you could take a look at the compiler source?
<flux>
if it has conditionals based on that switch, they should be easy to find without much understanding of the code
<mfp>
yeah looks like I'll have to
<pango>
flux: those days I think even that is minimal, standard libs are thread-safe
<mfp>
since I cannot see anything different in a number of toy progs
<pango>
but yes, there used to be a specifically thread-safe version of Unix, for example
<mfp>
hmm the refman says "Module Thread: lightweight threads" _lightweight_ ? (only with vmthread)
<pango>
mmmh there's still a threadUnix module in threads/ subdir
<flux>
it appears to me it that the compiler itself doesn't use the use_threads flag
<flux>
but I suppose it could be deeper than where I'm looking..
<mfp>
pango: the manual says it's deprecated
<pango>
mfp: definitely, but I'm surprized it didn't disappear altogether
<mfp>
I was wondering how hard it would be to have actual parallelism with the current stop-the-world GC, using multiple nurseries within the minor heap
<Yorick>
mfp: Quite hard with the current design, I'm afraid.
<mfp>
AFAIK that's the (limited) support for parallelism GHC has
<flux>
mfp, you mean with a stop-the-world so that each thread would stop?
<mfp>
sync on allocation, stop them all at once before the GC kicks in
Anarchos has quit ["Vision[0.8.5-0418]: i've been blurred!"]
<flux>
syncin on allocation? wouldn't that make it pointlessly slow?
<mfp>
each thread would have its own heap and limit pointer
<Yoric[DT]>
Yorick: I resent your nickname :)
<mfp>
flux: multiple nurseries
<Yoric[DT]>
What exactly is the nursery ?
<flux>
I thin it's the same as minor heap?
<mfp>
using a larger minor heap, then each thread allocates in say 64KB chunks
<flux>
I must say I'm not that up to speed on gc techniques; I haven't implemented any
<mfp>
then allocates blocks within its current chunk
<Yorick>
Yoric[DT]: Sorry. I've had it for maybe 15 years, so it's an old habit.
<jlouis_>
Usually the nursery is the place where objects are created. Upon first GC, you escavate the objects to the minor heap
<jlouis_>
if they survive a couple of collections in the minor heap, then its off to the tenured/old heap
<Yoric[DT]>
Yorick: I've had it for only 10 years but I still resent you :)
<jlouis_>
'a couple' is usually 3-4
<Yoric[DT]>
jlouis_: does this involve moving memory contents or just toying with pointers ?
<jlouis_>
it depends, but usually it involves moving memory
<jlouis_>
it works together with the 2-space minor heap
<mfp>
the current GC isn't a regular two-space anyway
<jlouis_>
note, i know very little about the Ocaml internals
<Yorick>
There are tricks that could be used for having multiple concurrent minor heaps sharing a major heap, if mutation is rare. I recall some fun papers about this...
<jlouis_>
the JVM actually does something like that for one of its (many) garbage collectors
<flux>
didn't ocaml (camllight?) use to have a parallel gc?
<flux>
so camllight actually scales to two cpus, or is that gone?
<jlouis_>
parallel GC is a bitch
<mfp>
.oO(caml_modify worries me)
<pango>
the problem is keeping the fast path _fast_, because of ML languages insane rate of allocation
<Yorick>
pango: Ah yes, it was the articles by Damien Doligez that I was thinking about. Thank you.
<mfp>
a concurrent GC is much harder than what I had in mind
<mfp>
halting all mutators when the major GC runs is much easier
<jlouis_>
I am pondering on going the purely functional way. Then its hella' easy
<flux>
I suppose that even if the gc was stop-the-world it would still allow scaling to, say, two hardware threads
<mfp>
s/major/minor/
<Yorick>
mfp: Not even that is easy if it is performance you are after
<flux>
perhaps even four, but at some point so much gc is being done that the time you spend stopped removes the advantage
<jlouis_>
mfp: you want the major collector to be something not-stop-and-go
<flux>
looking at the number of cores we may soon have may lead to think that there's no point writing code that complicates code but won't scale to more than four cpu's
<Yorick>
flux: There are allocators scaling slightly better than that (for JVMs) but they are probably too slow for the allocation rates of ML.
<jlouis_>
Yorick: you don't know how Java 5 EE code allocates then ;)
<jlouis_>
Since you have this grande stack of crap, it tends to be fairly aggressive allocating data. But I think ML beats it though
<mfp>
hmm this means GHC's stuff won't scale past 2-4 threads?
<Yorick>
jlouis_: Right, I don't. I was rather thinking about the high-end JVMs touted by bea and ibm.
<mfp>
oh but no mutations => easier
<jlouis_>
mfp: yup
<jlouis_>
but since they are purely functional, they have an option to redo parts of the backend
<flux>
but how about the erlang way of doing threading? I understand Xavier has suggested going that way?
<flux>
and then there is the CoThread library
<mfp>
and JoCaml
<jlouis_>
flux: in erlang, each process is isolated from the others so it has its own heap
<Yorick>
flux: Erlang copies data being passed (which is not necessarily a bad idea)
<bluestorm>
flux:
<bluestorm>
the suggestion was about message-passing
<Yoric[DT]>
same for JoCaml
<pango>
yup JoCaml is nice... too bad it's a different compiler, though :/
<Yorick>
Right. I do find the idea of shared immutable, local mutable state appealing.
<bluestorm>
i'm not sure the "green threads / process / OS threads" debate is related
<flux>
copying the messages might be good when you actually have multiple cpu's: perhaps even numa
<jlouis_>
data is moved via msg-passing by copying yes, but note that binaries (byte-vectors) are ref-counted and shared amongst the processes
<jlouis_>
since one can't update a binary
<mfp>
the thing is that in JoCaml you have to create the processes "externally" or use fork + pass parameters to specify which channel is to be spawn
<Yorick>
It should not be _that_ difficult to adapt ocaml for multiple threads with independent runtimes in the same memory space.
<flux>
how does jocaml make the magic work then?
<Yorick>
flux: fork, and pass marshalled data.
<Yorick>
flux: No shared mutable state.
<flux>
off to sauna now, will resume later ->
<mfp>
or no fork, nor parallelism (and still no shared state)
hando has quit []
<mfp>
if camlp4 worked with JoCaml, it'd be fairly easy to autogenerate the code to fork + spawn appropriate channel
mwc has quit ["Leaving"]
<mfp>
turn each def foo(...) & ... into def foo(...) & ... register_in_global_table "__whatever_Module_foo" (fun argv -> spawn foo(...)) and then some spawn_remote foo(...) that gets translated to fork + invoke channel creation func + register in Ns etc.
<flux>
what does JoCaml do that cannot be done with a library?
<flux>
it's definitely different from normal message passing model..
<mfp>
it's got the type system & convenient join patterns
<Yorick>
In a way it's more general than plain message passing.
<mfp>
mostly the multiple join patterns I guess?
<mfp>
also, synchronous channels
<flux>
so it's got extended type system for concurrency, with pattern matching for it?
<flux>
(something not easily implemented with a preprocessor and a library ;))
<mfp>
somebody can do wait() and will only get the answer then async_task(...) and some_other(...) have been spawn
<mfp>
*when
<mfp>
you can basically encode the state in several async channels and synchronize easily with the join patterns
<Yorick>
It's neat but takes a little while to get used to.
<Yorick>
but you can still get deadlocks, right?
<mfp>
yes
<flux>
it took a little while to get used to the Event-module already.. infact never go that used to it so I wrote an asynchronous version of it.
postalchris has joined #ocaml
<mfp>
for example your state is maintained in two channels, and you do def statea(x) & stateb(y) & somecond() & someother () = spawn othercond(...) & statea(foo x)
<mfp>
since stateb() is consumed and not spawned again, that pattern cannot be matched again => deadlock
<Yorick>
mfp: It is perhaps unavoidable, unless it's acceptable to make the notation less expressive.
<mfp>
but once I began to see such async channels as parts of the state, it became easier to look for such errors systematically
<mfp>
that error can also be avoided by doing def state({a = a; b = b; ...}) & (i.e., state held in a single process), but that limits concurrency
<mfp>
because in the above example it'd be possible to have another clause or stateb(b) & foo() = .... which wouldn't block if there are more stateb processes, even if there's only one statea
<mfp>
at any rate, synchronization patterns are *much* easier to express than with shared mutable state, and debugging should be considerably simpler too
<Yorick>
I suspect the most common case is the simple dataflow parallism (x = spawn y)
<Yorick>
which is trivially free from deadlocks
ttamttam has left #ocaml []
<mfp>
deadlocks caused by resource consumption are avoided too
<bla>
flux, Yorick you haven't done chameneos redux for ocaml?
<lkj>
i have an array of string tuples, is there an easy way to print them out in ocaml?
<mfp>
no need to acquire in a fixed order, the join patterns will take care for you
<Yorick>
bla: No, sorry
<bla>
Yorick, n/p. I'd like to do it and just asking if it's not already done.
<mfp>
Array.iter (fun (a, b) -> print_string a; print_string b) ?
<bla>
(With array as last argument)
<lkj>
mfp, thanks
<mfp>
"point-less" hah ;-)
<Yorick>
oh dear
<Yorick>
If there is ever a case for ad-hoc polymorphism in ocaml, it's for printing out values when debugging
<mfp>
is there some long-term plan for ad-hoc polymorphism?
<Yorick>
mfp: not that I know of
<lkj>
mfp, I have : edges := [(x, y)] @ !edges; Array.iter (fun (a, b) -> print_string a; print_string b) edges; and it says maybe i forgot a semicolon...any ideas?
<Yorick>
well, there is gcaml
<mfp>
isn't it dead?
<mfp>
lkj: that's not an array, and you can cons with ::
<Yorick>
lkj: I don't see it right away, but isn't the first expression just a cons?
<Yorick>
ah yes
<lkj>
i want to add it to the end of the list
<lkj>
err
kelaouch1 has quit ["leaving"]
<lkj>
should i be doing it !edges @ [(x,y)]?
<lkj>
looks like it
<lkj>
ok
<mfp>
lkj: normally you add it to the front and reverse (to avoid O(n^2))
<Yorick>
lkj: Maybe it is a queue you need.
thermoplyae has joined #ocaml
<lkj>
would a list work? I assume I can just do: let edges = ref [] in edges := [(input1, input2)] :: !edges; ..or do I need to create a type of (x, y) record first?
<lkj>
<- confused by ocaml
<Yorick>
lkj: It is much faster to add things to the beginning of a list, so do that if you can (and reverse it later if you need to).
<lkj>
ok
filp has quit ["Bye"]
<olegfink>
:: is 'a -> 'a list -> 'a list, so you probably want (input1, input2) :: !edges rather than [(input1, input2)] :: !edges
<lkj>
olegfink, ya, you're right, still doesn't let me pass though
<lkj>
is there anywhere online that has lots of examples?
<Yorick>
maybe someone should write a typeless ocaml, for those who want their errors at runtime...
<flux>
yorick, should be a simple library?
<flux>
I'm at 3/5 of the JoCaml introduction, but it yet hasn't explained to me why processes always seem to return zero
<flux>
what's the idea in that?
<flux>
hm, actually now that I said it I see an example with a for-loop (returning unit), so maybe it's just a style issue :-o
<flux>
it's not immediately obvious for me, from the examples, how joint calculus is better than message passing; it does allow encoding succinctly many kinds of primitives, but I'm not sure if they are as easy to understand afterwards. perhaps writing actual code with jocaml would help.
<Yorick>
flux: 0 is the null process - perhaps that is the source of confusion?
<flux>
yorick, perhaps indeed
<flux>
well, rewriting the stack example by using the Event-module does lead to much more complicated code
<flux>
I was thinking of writing it here on irc as a one-liner, but it's not quite as short as I'd like :)
<flux>
let stack = let chan = Event.new_channel () in let rec thread els = match Event.sync (Event.receive chan) with `Push el -> thread (el::els) | `Pop chan -> Event.sync (Event.write chan (List.hd els)); thread (List.tl els) in Thread.create thread; channel
<flux>
and that's not even taking into account the case when the stack is empty
<flux>
and it also blocks when sending the response back, because Event is synchronous message passing
<olegfink>
lkj: also, if you are using a list, you should use List.iter.
<bla>
Uhm. I've checked emacs reference card but can't find basic shortcut for selecting parts of texts and copying/cutting/pasting it.
<flux>
bla, that's one lousy reference card then
<flux>
ctrl-space starts marking an area, control-w cuts stuff (alt-w copies), ctrl-y pastes; if you have older cut stuff, alt-y rotates those after ctrl-y
<olegfink>
so your example becomes let edges = ref [] in edges := (input1, input2) :: !edges; List.iter (fun (a,b) -> print_string a; print_string b) !edges
<bla>
Where it even has shortcuts for 'swaping words, lines...' But not such as pasting. ;D
<flux>
ctrl-k removes from cursor to the end of the line; if the next character is eol, remove that
<flux>
bla, perhaps that's a reference card for someone who knows the basics..
<bla>
flux, thanks then.
<bla>
flux, possibly. I was looking for something basic cause I'm generally vim user.
<bla>
flux, I want to learn emacs a bit. But i doubt I will stop writting ':wq' into program each time I'm trying to save something.
<olegfink>
never understood all that escape-meta-alt-control-shift stuff
<flux>
the most useful binding I've lately learned (accidentally) has been ctrl-meta-space
<flux>
it marks marks the next logical block, repeated presses will mark more; especially useful for moving whole expressions
<Yorick>
bla: Emacs calls its cut and copy commands "kill", which may be a little confusing.
<flux>
and paste is yank
<flux>
(hence 'y')
<flux>
I'm not actually that good at reciting (x)emacs keybindings; I can use them but it may be difficult to say which they are :)
<Yorick>
bla: But spend some time with Emacs and the basic commands - it is very rewarding.
<bla>
I'll try. If I won't get over irittated there might be something out of this relationship.
<bla>
tuareg mode is nice.
<bla>
And I want to learn LISP a bit.
<flux>
bla, I suppose you've found C-c C-t?
<bla>
Coding LISP in VIM seems just inappropriate.
<flux>
I hear Slime is great for lisp development in emacs
<flux>
(I haven't done any)
* Yorick
never understood what would be appropriate for coding in VIM
<bla>
Ah, I guess just anything. ;)
<bla>
But let's don't start a editor war.
<Yorick>
Of course not. There's an emacs-like editor written in ocaml, by the way.
<flux>
yorick, url?
<bluestorm>
hm
<flux>
the greatest downside of emacs-like editor clones is usually that they aren't emacs enough..
<bluestorm>
the dead one
<bluestorm>
or the other dead one ?
<flux>
besides, I've got tons of configuration files lying around, porting them would be a big task
<lkj>
would someone kindly look at my code? It's just a few lines. I'm having with my printing of tuples http://paste.uni.cc/18249
<bluestorm>
(or "compare", without ( ), of course)
<lkj>
thanks guys
<Yorick>
I actually suffer more from brackets than semicolons
<Yorick>
all sufficiently complex ocaml expressions turn into lisp
Tetsuo has quit ["Leaving"]
<bla>
I still prefer (fun a -> a + 2) from #'(lambda (a) (+ a 2))
<bla>
I was yesterday horrified to see how it's done in lisp.
<Yorick>
bla: Well, in scheme you don't have the #' - but I agree.
<bla>
Yeah, sure. There's one namespace.
<bla>
But scheme is rarely seen outside educational purposes as I was told. ;)
<Yorick>
bla: But smalltalk beats them all in concise notation for anonymous functions
<bla>
Haven't learned it still.
<bla>
Haskell probably is also conscise.
piggybox_ has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
ygrek_ has quit [Remote closed the connection]
<Yorick>
Now if someone could tell me why I need to write (Point(a,b)) instead of just Point(a,b), then I'd be happy
<thermoplyae>
function application binds tightest, so f Point (a, b) is parsed as (f Point)(a, b)
<bluestorm>
in revised syntax you can write (Point a b), if that helps
<Yorick>
thermoplyae: I know the reason but am not really happy with it (is anyone?)
<thermoplyae>
it would be nice if constructors got higher precedence, imo, but what are you going to do?
<thermoplyae>
use revised syntax, apparently :)
<Yorick>
that's what I meant - the syntax should take more advantage of that constructors have lexically distinct tokens.
<thermoplyae>
especially since constructors can't be partially applied
<Yorick>
(or the hackish solution to make whitespace after constructors significant, but I suppose that would be worse)
<Yorick>
thermoplyae: Right! We want to get something for the price we pay :)
<bluestorm>
hm
<bluestorm>
you can use a syntax extension (eg. mine :-' ) to generate constructor functions
<Yorick>
I have yet to find anyone who really loves the revised syntax, even if most people seem to agree it's cleaner. Maybe we need a revised² syntax?
<thermoplyae>
i'm less interested in the partial application and more in the association :)
<thermoplyae>
it's possible that this can be accomplished with camlp4, i don't know a thing about it
<lkj>
why is it that a lot of the ocaml examples I'm seeing are done with recursion/folding? ...out of curiousity
<lkj>
is it just a common style?
<bluestorm>
yes, functional style
<lkj>
but ocaml has all the means to do imperative coding, right?
<bluestorm>
recursion is nice because most of the state transition you've got in imperative style are translated into pure computations
<Yorick>
lkj: Don't worry - you are allowed to write ocaml any way you like.
<bluestorm>
less mutable states -> less bugs
<lkj>
Yorick, haha I just want to get my homework assignment done, so I guess I'm sticking with as little recursion as I can get away with
<bluestorm>
folding is nice too, because it factorize away the usual burden of 60% of the recursions
<Yorick>
and they make such good job interview questions
<bluestorm>
:D
<bluestorm>
Yorick: i've seen people that really like the revised syntax
<bluestorm>
the nice bits are nice, and it seems you can get used to the ugly ones
piggybox has quit [Connection timed out]
<thermoplyae>
sounds like the current syntax :)
<pango>
lol
<bluestorm>
right
<Yorick>
bluestorm: I like it too, but most people seem to think it's not a sufficiently big improvement to be worth it - and it introduces some new ugly parts.
<bluestorm>
thermoplyae: what are the nice bits of the classical one ?
<thermoplyae>
i haven't looked at the revised syntax to know the difference
<thermoplyae>
i know that there's something up with lists in the new one?
<bluestorm>
the list part is really ugly :D
<bluestorm>
the good parts are the curryfication at the types, constructors and functors level
<bluestorm>
and *maybe* the additionnal brackets around disjoint sums (i mean | , in type declarations or pattern matching)
<bluestorm>
hm
<Yorick>
Being able to pattern-match multiple (curried) function arguments without first putting them in a tuple would be nice
<bluestorm>
and the "value" keyword is not a bad idea
<bluestorm>
as in caml light ?
<bluestorm>
hm thermoplyae, and the "where" keyword, even if its use is artifically reduced
<thermoplyae>
curryfication would be nice
<mbishop>
if only SML would just add a little more sugar...
<thermoplyae>
i don't know what the where keyword does
<bluestorm>
hm
<bluestorm>
it's a reverse-order let-declaration
<bluestorm>
let foo a = a + b where b = ....
<bluestorm>
i've seen it used a lot in Haskell
<bluestorm>
and imho it's really nice
<thermoplyae>
oh, alright
<thermoplyae>
that is nice, and i did like it in haskell
<bluestorm>
you can have it in caml light
<bluestorm>
it's a shame it was removed since :p
<pango>
bluestorm: problem with where is that it obfuscates evaluation order
<bluestorm>
hm
<pango>
not a problem in a lazy language, but ocaml is eager
jderque has quit [Read error: 113 (No route to host)]
<bluestorm>
i think it's up to the programmer to use "let ... in" if there is a non-neglectible side-effect
<Yorick>
I wonder if some kind of "named let" a la Scheme would be a good idea
<lkj>
bla: thanks, i cant pm, but i see your point
<bluestorm>
named let ?
<Yorick>
A more readable way to write (tail-recursive) loops
<bluestorm>
do you have an example ?
<Yorick>
(let loop ((i 0) (x 0)) ... (loop (+ i 1) (+ x a)))
Yoric[DT] has quit ["Ex-Chat"]
<Yorick>
It's just a sugar for declaring a function and calling it, but with the initial values near the top instead of the bottom.
<bluestorm>
Yorick: i'm not sure you have to design loop to be usable with multi-parameter recursive functions
<bluestorm>
you may allow only one parameter, as the user may use a tuple, still
<lkj>
http://rafb.net/p/h8nf1U32.html I have a VERY simple string matching function (5 lines long) if anyone could take a look at it, I'd really appreciate it. The problem is described in the link
<bluestorm>
(eg. he can write loop myloop (x, sum) = (a, 0) in .... if he wants to)
<Yorick>
Maybe, but more than one parameter is the common case I'd say. One for looping over and one to accumulate the result, for instance.
<bluestorm>
lkj:
<bluestorm>
"string a" ?
<bluestorm>
you can't put function application inside a pattern matching
<bluestorm>
match foo with (1 + 2) -> ... won't work
<lkj>
hm?
<bluestorm>
as it is not an equality test, it's a binding
<bluestorm>
wich is totally different
<lkj>
(string sa, string sb) is matching t with a structure format, isnt it?
<lkj>
i'm just making sure t is a tuple of strings
<bluestorm>
hm
<bluestorm>
you don't force typing that way
<bluestorm>
match t with (sa, sb) -> ...
<bluestorm>
will work if t types string * string
<bluestorm>
you can even do
AxleLonghorn has joined #ocaml
<bluestorm>
let sa, sb = t in ...
<mbishop>
also you don't even need to match sa if you don't care
<mbishop>
match t with (_, sb) ->
<lkj>
yeah
<bluestorm>
let mem_match e (_, sb) = e = sb
<bluestorm>
:-'
<pango>
or let mem_match e (sa, sb) = using let to do the pattern matching
AxleLonghorn has quit [Client Quit]
<Yorick>
one thing the revised syntax does do right: the mandatory brackets around tuples!
<bluestorm>
obviously, "5 lines long" usually means "too much" :p
<bluestorm>
Yorick: i don't like that, but it's a matter of taste mostly
<bluestorm>
i actually like to write let a, b = ...
<bluestorm>
of course it's not a big thing, and i'm ready to change that :p
postalchris has quit [Read error: 110 (Connection timed out)]
<Yorick>
bluestorm: I parse "let a, b = c in ..." as "(let a), (b = c in ...)"
<Yorick>
bluestorm: pretty nice. I was worried a bit about the colon colliding with type ascription
<bluestorm>
the fact is that i haven't managed to find any good example
<Yorick>
but it is clearly readable
<bluestorm>
i agree colon is not a very good choice
<bluestorm>
conflicts with type ascription + labels
<Yorick>
so sad that we only have ascii to work with, for now
<bluestorm>
moreover, in the actual state, i only accept identifiers to the left of :
<bluestorm>
while the natural choice would be to accept any pattern
<bluestorm>
(but then you need stronger delimiters)
<bluestorm>
hm
<Yorick>
yes
<bluestorm>
feel free to participate to the "Unicode identifiers ?" discussion :p
hkBst has quit ["Konversation terminated!"]
seafood_ has joined #ocaml
<Yorick>
Oh, I'm definitely in favour of unicode identifiers. The work is just in determining which ones should be allowed for what.
<Yorick>
(and, of course, convincing Xavier to deprecate his latin-1-accent-removal hack :-)
* bla
starts to like Emacs.
<bla>
(It has nicer color themes than Vim)
<pango>
reminds me of APL, the use of special symbols seems to have made it a PITA to share, print, etc.
Morphous has quit [Read error: 110 (Connection timed out)]
<pango>
hopefully unicode would have made it less of a PITA, but still, it's a bit frightening
<Yorick>
pango: I know, but that is partly because it was developed in an EBCDIC/ASCII world
<Yorick>
pango: It's just so silly that we are designing notation from what people in 1955 had on their typewriters
<pango>
it could also be a case of 'worse is better'
<Yorick>
It could, but a catchy slogan proves nothing. Sometimes better really is better.
<bluestorm>
hm
<bluestorm>
i think the precedence/associativity rule of ocaml infix operators is quite clever
<bluestorm>
and it would benefit a lot from some more possible characters
<pango>
my guess is that theoricians will put greek letters (and more) to good use, but that will be yet another reason for others not to put their hands in their code ;)
<bluestorm>
(as i'm often confronted with, say, the lack of rigt-precedence first infix character)
Torment has joined #ocaml
<bluestorm>
pango: wouldn't you like a f ⁰ g operator for function composition ?
<Yorick>
Also, there is a good case for helping non-English speaking (and non-latin-using) to learn programming
<pango>
bluestorm: I'm not sure
<bluestorm>
actually i'm not either
<bluestorm>
if think the F# idea of <| is better
<pango>
if they ever become professional programmers, they'll have to use english identifiers and english comments
<Yorick>
bluestorm: I definitely would prefer a good set of clear operators to kludges like & and $ which are quite unsuitable to formal notation
<pango>
so yet, it is a help for beginners and amateurs
<Yorick>
pango: Maybe, but they must start somewhere.
<bluestorm>
Yorick: "formal notation" ?
<bluestorm>
you mean you can't handwrite your code easily ?
<Yorick>
bluestorm: no, I just meant programming.
<bluestorm>
how is $ unsuitable for programming ?
<pango>
I'm half playing devil's advocate here, I'm not against the idea upfront, it's just that I'm far from enthusiastic
<Yorick>
It's just not a good symbol. It is typographically too close to letters and digits.
<Yorick>
Typography matters in syntax. Consider the ocaml object#method notation, and how much more readable object.method is.
<bluestorm>
hum Yorick
<bluestorm>
actually "loop" is quite useless once you've got the "where" keyword back
<bluestorm>
value foo = range 10 where rec range k = if k < 0 then [] else [k :: range (k - 1)];
<bluestorm>
it's concise too, has similar spatial properties, and more idiomatic
<Yorick>
Yes, at least mostly.
<Yorick>
There is still not the close association with the parameters and initial values.
<Yorick>
But you are right. Perhaps a dedicated loop construct would be better.
<Yorick>
Tail-recursive loops are rather like GOTO-based loops in Fortran or Basic.
<Smerdyakov>
You shouldn't be writing loops or recursive functions manually.
<Smerdyakov>
Use higher-order functions instead.
<Yorick>
Of course, but that is not always possible.
<Yorick>
(and not always desirable)
<ikatz>
on the subject of while loops... general ocaml question:
<ikatz>
can you process a priority queue without using a while loop and a queue reference?
<ikatz>
or to put it another way, i have to process a priority queue and the only way i can think of doing it is by while-looping until the queue (passed by reference) is empty
<bluestorm>
hm
<Yorick>
ikatz: you could use a tail-recursive loop, but that is mostly the same thing
Jedai has quit [Read error: 110 (Connection timed out)]
<Yorick>
ikatz: Or change queue representation - perhaps a functional queue.
<bluestorm>
if your queue is functionally implemented, the tail-recursion versy seems to be more natural
<ikatz>
well this is for a search problem... so the queue represents my "search frontier"
<bluestorm>
Yorick: i guess he use a functional repr., orelse he wouldn't bother with a reference
<ikatz>
i keep expanding the node at the front of the queue and merging the results back into the queue
<bluestorm>
bread first search ?
<bluestorm>
...
<ikatz>
in this case...
<bluestorm>
breadth
<ikatz>
it will be A* eventually
<Yorick>
ikatz: A* search?
<bluestorm>
that's mostly the same thing :-'
<ikatz>
yep
<Yorick>
I wrote an A* search with queues as simple lists, and tail-recursive loops to process
<bluestorm>
hm
<bluestorm>
lists with a linear search overhead ?
<bluestorm>
doesn't sound that great
<bluestorm>
there is a functional heap impl. in the manual
<ikatz>
the problem i'm seeing is that if i used a fold-type operation instead of a while loop, the queue would get messed up during the recursion
<Yorick>
bluestorm: Depends on the insertion pattern. There is a whole literature on how to implement priority queues in different circumstances.
<ikatz>
what is the name of the module for the "functional heap"?
<Yorick>
I wouldn't bother with anything fancier than a list unless there were performance problems
<ikatz>
same problem though...
postalchris has joined #ocaml
<ikatz>
if i fold the list, then add to the list within my folded function, won't it mess me up?
jbu311 has quit []
<bluestorm>
ikatz: actually
<ita>
for or against the """ delimiter for strings ?
<bluestorm>
it's in the *manual*, but not in the standard lib :p