<julm>
apparently it's different from the Longident.t defined in ocaml/parsing/longident.ml
Lomono has joined #ocaml
<julm>
ahah
<julm>
it's for [with_constr]
<julm>
[type_longident_and_parameters] is used when parsing something like what is in {} here: [module M (F: F) (G: G with type {GG.t} = F.t = struct .. end]
<julm>
[type_ident_and_parameters] used when we declare a type
<julm>
(arf, I forgot a closing parenthesis at the end of the G module)
matrim has left #ocaml []
Associat0r has joined #ocaml
<thelema>
The neat thing about optimising divisions away is that they're so expensive (on the order of 100-200 clock cycles on modern x86) that even branches are pretty much guaranteed to be an improvement, even in the worst case <- true?
<thelema>
(about expensiveness)
Ched has quit [Read error: 110 (Connection timed out)]
ched_ has joined #ocaml
<thelema>
Wow, Dec Alpha didn't have hardware N-bit/ N-bit divide?
<julm>
strangely, [type_longident] is very different in the revised syntax (I mean it seems to handle completely a Longident.t, whereas in the old syntax, it appears to only handle functor applications (the parenthesis), but camlp4 in old syntax parses well the GG.t example, so my understanding is quite limited)
alexyk has quit []
alexyk has joined #ocaml
<palomer>
hah
<palomer>
I've been grepping from ocaml/Camlp4 all this time
<palomer>
no wonder I couldn't find anything
seafood has quit []
<palomer>
err, camlp4/Camlp4
Yoric[DT] has quit ["Ex-Chat"]
julm has quit [Read error: 110 (Connection timed out)]
julm has joined #ocaml
travisbrady has joined #ocaml
Alpounet has quit ["Quitte"]
Lomono has quit ["Don't even think about saying Candlejack or else you wi"]
<sporkmonger>
if i wanted to look at some example code written with ocamlyacc that works with an AST rather than doing immediate execution (ie, calculator examples) where would you suggest i go?
<sporkmonger>
i'm mostly having type issues right now... something somewhere thinks all the parsed values are ints instead of Ast.expr
<sporkmonger>
i'm kinda suspecting a mistake in my lexer
<julm>
sporkmonger: perhaps have a look at how things are done in ocaml/parsing/parser.mly
<julm>
sporkmonger: the Jabber bot Sulci seems too have a calculator in ocamlyacc : sulci/pcalc.mly
<sporkmonger>
well, if the calculator doesn't dump to an AST that won't help
<julm>
seems to be immediate execution
Lomono has joined #ocaml
<sporkmonger>
yeah
<sporkmonger>
that's kinda the problem
<sporkmonger>
everything simple enough to understand is immediate execution
BiDOrD has quit [Read error: 110 (Connection timed out)]
BiDOrD has joined #ocaml
Associat0r has quit []
Camarade_Tux has joined #ocaml
seafood has joined #ocaml
mpwd has joined #ocaml
sporkmonger has quit []
alexyk has quit []
<flux>
just return a data structure describing what the parser has just seen and that is it?-)
rAphael_ has joined #ocaml
travisbrady_ has joined #ocaml
travisbrady has quit [Read error: 104 (Connection reset by peer)]
duper` has joined #ocaml
seafood has quit []
schme has joined #ocaml
jeddhaberstro has quit []
ikaros has joined #ocaml
svenl has quit [Remote closed the connection]
svenl has joined #ocaml
jeanbon has joined #ocaml
schme has quit [Read error: 60 (Operation timed out)]
Alpounet has joined #ocaml
hkBst has joined #ocaml
Snark has joined #ocaml
jeanbon has quit ["EOF"]
monadic_kid has joined #ocaml
monadic_kid has quit ["Leaving"]
Yoric[DT] has joined #ocaml
animist_ has joined #ocaml
animist has quit [Read error: 104 (Connection reset by peer)]
ikaros has quit ["Leave the magic to Houdini"]
Associ8or has joined #ocaml
schme has joined #ocaml
animist_ is now known as animist
mpwd has quit []
seafood has joined #ocaml
Yoric[DT] has quit [Read error: 104 (Connection reset by peer)]
Lockless has joined #ocaml
mpwd has joined #ocaml
matt__ has joined #ocaml
zerny has joined #ocaml
sfmatt has quit [Read error: 110 (Connection timed out)]
schmx has joined #ocaml
schme has quit [Read error: 110 (Connection timed out)]
Camarade_Tux has quit ["Leaving"]
Jedai has joined #ocaml
schmx is now known as schme
seafood has quit []
Snark has quit ["Ex-Chat"]
youscef has joined #ocaml
alexyk has joined #ocaml
romildo has joined #ocaml
<romildo>
Hi.
<schme>
hello
<romildo>
autoconf gives error messages when run in lablgtk-2.12.0 sources:
<sporkmonger>
why is the type system so insistent that the output of the parser is of type int and not type Ast.expr?
<sporkmonger>
(note that I'm still a noob, so this may be obvious to everyone else while I remain oblivious)
<sporkmonger>
i am vaguely aware that lines 29 and 30 of grammar.mly are probably wrong, but i'm not sure how to get my hands on the int and float respectively
<kattla>
line 20: %type <int> main
* thelema
takes a look
<flux>
hey, that's a fun idea, pastebin with git clone capability
<kattla>
and main: expr EOL { $1 }
<flux>
does it support pushin too?
<kattla>
sporkmonger: expr is used as an int in the definition of main
<thelema>
kattla has the right answer
<sporkmonger>
ahhhh
<sporkmonger>
yeah
<sporkmonger>
hot, and with that one-line change, it suddenly all works
<sporkmonger>
awesome
<thelema>
flux: I think so.
<sporkmonger>
flux: i think you can push, but i've never tried it
<thelema>
the owner gets a "owner clone URL" and I bet you can push to it
<sporkmonger>
flux: i've now tried it, and yes, you can push
<sporkmonger>
right, and anyone can "fork" a gist, which would give them an "owner clone URL" for their fork
<sporkmonger>
the Github guys are constantly coming up with awesome ideas
<sporkmonger>
they're also pretty cool IRL
<flux>
sporkmonger, I was about to, but you were faster with the fix :)
<sporkmonger>
hehe
<yziquel>
stumbled on Thread 24 killed on uncaught exception Invalid_argument("Thread.kill: not implemented")
<yziquel>
any workaround?
<sporkmonger>
i am still a little confused though, because i was fully expecting line 29 to still cause problems even after the fix
<thelema>
L29 of which file?
<sporkmonger>
grammar.mly
<sporkmonger>
why is $1 of type int there?
<sporkmonger>
seems to me like maybe it should be of type token
<sporkmonger>
specifically, INT(int)
<thelema>
yes, the token INT has attached a value of type int
<thelema>
thus $1 has type int
<flux>
sporkmonger, oh, I need to first have an account
<flux>
right?
zerny has quit [Read error: 110 (Connection timed out)]
<sporkmonger>
flux: i think so?
<thelema>
flux: yes.
<flux>
thelema, it'd be cooler if it didn't have such a requirement :)
<sporkmonger>
github uses your public key to identify you, and in order to do that, it needs to know what that public key is
<sporkmonger>
ie, you need an account
<thelema>
flux: how are you supposed to authenticate to push w/o an account?
<flux>
thelema, just accept anyone?
<sporkmonger>
^ what he said :-)
<flux>
..for public pastes
<flux>
I mean, how likely is vandalism anyway
<thelema>
flux: I guess the URL could be the pass, it's kinda random
<thelema>
like drop.io's URLs
<thelema>
But they want users. Your forks get associated with you - they're mini repositories
<sporkmonger>
so if the grammar rule is "expr SEMI" what would the type of $2 be, since it doesn't have an attached value?
<flux>
yziquel, Thread.kill in general (in any language) is not a good idea. perhaps you can use a process?
<flux>
thelema, well, for example in this case had I wanted to push my solution in (more convenient than editing the paste on the page), I would not have created an account to do that :)
<sporkmonger>
the real value of github is that it's a little bit like Facebook for code, only... without any of the people you hated from highschool
<flux>
well, ocamlforge can take that feature and enhance it!
<thelema>
well, github takes the idea of ownership of repos and applies it to gists
<sporkmonger>
for example, i know anything Ryan Tomayko makes, i'm going to be interested in, so i follow his activity on github, and anytime he pushes code or creates a new project or the like, github lets me know
<yziquel>
flu: Nope. The thread I want to kill is doing a Thread.delay, and can only be killed during the Thread.delay. The idea is to replace the killed thread by another thread with a shorter Thread.delay.
<yziquel>
flux: this is to implement a scheduler with only one thread waiting...
<sporkmonger>
plus, github make forking so drop-dead-easy that pretty much everyone does it
<flux>
yziquel, replace Thread.delay with something of your own
<flux>
yziquel, is that possible?
<yziquel>
flux: I do not see how.
<flux>
yziquel, I mean, it is your code that calls Thread.delay
<sporkmonger>
and because github has a graph of all the forks, the parent project can see what happened in the child forks and can automatically apply their changesets as patches
<flux>
yziquel, you can have a version of Thread.delay that for example uses Unix.select to detect the kill situation and raises an exception in that case
<flux>
..hoping nobody catches that silently :P
<sporkmonger>
it's kinda neat, they have this page where you get every change for every child fork, and the patches that would apply cleanly are listed in green, and the ones that one show up in red
<thelema>
flux: instead of others pushing into your branch, they push into their own forks, and you have the choice of bringing their code into your repo
<yziquel>
flux: so I need to have one thread that simultaneously is in a Thread.delay, and that waits on a select.
<yziquel>
flux: the problem is the "simultaneously"
<yziquel>
flux: is that possible?
<flux>
yziquel, hmm, I don't get it why you need to be in a certain function. surely for example Unix.select satisfies the need of delaying computation also?
<yziquel>
flux: but when does the Unix.select gets raised? and how? By another thread that is in Thread.delay?
<flux>
yziquel, I thought you'd have some other thread that was in the position to call Thread.kill?
<yziquel>
flux: the point is to have only one tread waiting. Not as many threads as there are requests for scheduled tasks.
<flux>
yziquel, regarding your original problem: replace val mutable delayed_thread : Thread.t option = None
<yziquel>
flux: when a schduling request happens, if the next event is in a closer timeframe than the one being waited for by Thread.delay, then the thread gets killed.
<flux>
with val mutable delayed_thread : (Thread.t * Unix.file_descr) option = None
<flux>
and the assignment with something like let (read_stop, write_stop) = Unix.pipe () in .. delayed_thread <- Some (read_stop, ..)
<yziquel>
flux: But I need another thread to raise the Unix.select...
<yziquel>
flux: and this thread will be in a Thread.delay...
<yziquel>
flux: this is simply moving the problem around...
<flux>
and Thread.delay with (if Unix.select [read_stop] [] [] delay <> ([], [], []) then failwith "KILLED") ?
<yziquel>
ah! ok! the delay is in the Unix.select...
<flux>
you need to take care of closing both the fd's too
<yziquel>
flux: urgh. not really the kind of trade-off i fancy...
<flux>
yziquel, not a biggie, you can pass a closure for doing just that with the delayed_thread value
<flux>
anyway, that seems like an awfully complicated way of scheduling functions. the task is to run functions like cron, at certain predeterminde times, including the case of adding new functions when running the scheduler?
<yziquel>
flux: yes, and later on, to modify the dates, to make one depend on another, and to make them persistent in a database.
<flux>
although it is indeed complicated by the fact that there's no delayed wait in the Event-module - a big missing feature! - so that needs to be emulated
<flux>
I would just have one thread that provided the timed waits via the Event-module and one thread that did the scheduling
olivierp has joined #ocaml
<yziquel>
flux: yes, indeed. that feature is missing.
<olivierp>
hi, does anyone know if there's a way to write join patterns with several instances of the same channel in JoCaml? eg. def elf(id1) & elf(id2) & elf(id3) = elvesReady([id1;id2;id3]) ;; Except that doesn't work (says name elf is bound more than once in the pattern)
BiDOrD has quit []
Snark has joined #ocaml
elehack has joined #ocaml
Yoric[DT] has joined #ocaml
<mfp>
olivierp: can you express directly with def elves(id1::id2::id3::tl) = elves(tl) & elvesReader(id1, id2, id3)
<mfp>
?
<mfp>
*elvesReady
* Yoric[DT]
wonders if he has just stepped into #tolkienfp.
<olivierp>
mfp: well there are more than 3 elves total, and i want the pattern to fire when 3 become available
<flux>
yziquel, once you add the method add you're set :)
jeanbon has joined #ocaml
alexyk has quit []
olivierp has quit []
elehack has quit ["Leaving"]
alexyk has joined #ocaml
Amorphous has quit [Read error: 110 (Connection timed out)]
alexyk has quit []
Amorphous has joined #ocaml
slash_ has joined #ocaml
olivierp has joined #ocaml
<olivierp>
silly beginner's question: how do you define 2 functions that call each other?
<thelema>
let rec f1 = blah f2 blah
<thelema>
and f2 = blah f1 blah
<olivierp>
thanks !
<thelema>
n/p
<olivierp>
hmm, in my case one of these is a def (this in JoCaml)
Ched has joined #ocaml
<olivierp>
... and def ... gives me a syntax error
Snark has quit ["Ex-Chat"]
<olivierp>
maybe i just need to pass the channel as a parameter to the function
bohanlon has quit [Read error: 60 (Operation timed out)]
bohanlon has joined #ocaml
elehack has joined #ocaml
ulfdoz has joined #ocaml
<animist>
hi all, I have a question about unix library behaviour under linux
<flux>
go ahead, hit us!
<animist>
assume a simple program: let _ = ignore (Unix.select [Unix.stdin] [] [] (-1.0))
<flux>
assuming..
<animist>
if i compile it natively and interrupt on blocking select, I receive error code 130
<flux>
what kind of interrupt?
<animist>
classical ctrl-c signal
<flux>
hm, doesn't do that for me
<animist>
why error code is not EINTR?
<flux>
oh, so you've disabled something to even expect that?
<flux>
you ignore sigterm?
<flux>
hm, sigintr even
<animist>
ctrl-c stands for SIGINTR
travisbrady has joined #ocaml
travisbrady_ has quit [Read error: 104 (Connection reset by peer)]
<flux>
expected behavior would be that kernel sends the process SIGINTR and it, due to using the default signal handler, exits
<flux>
not select returning with EINTR
<flux>
unless you've disabled the signal
<flux>
in any case, I can't repeat what you're experiencing
<flux>
I've got let _ = ignore (Unix.select [Unix.stdin] [] [] (-1.0)) in foo.ml, ocamlopt unix.cmxa foo.ml; ./a.out (hits ctrl-c) and I'm back to prompt
<animist>
what's your $ echo
<flux>
$ echo?
<flux>
ah, you mean $?
<animist>
what's your output of $ echo $?
<animist>
after signal sent to the program?
Associ8or has quit [Read error: 104 (Connection reset by peer)]
<flux>
it's 130 for both ocamlc and ocamlopt
<flux>
which I suppose mean SIGINT + killed
<animist>
yep. 130 stands for EOWNERDEAD, someone in unix library doesn't release a mutex
<flux>
I don't think so
<flux>
return values are encoded in the case a process is killed with a signal
<flux>
one bit means that it was killed with a signal, and then the signal value itself is in the return code
olivierp has quit []
<flux>
btw, I'm betting you can repeat that with cat
<animist>
so ocaml programs have their own notations of exit codes?
<flux>
cat (hit ctrl-c) echo $? -> 130
<flux>
no, that's standard unix behavior
<animist>
oh
<flux>
in C you're supposed to use a set of macros to extract out that information
Yoric[DT] has quit [Read error: 110 (Connection timed out)]
<flux>
I guess ocaml provides a similar set of data structures for the return values of Unix.waitpid
<flux>
(well, I know it does, but I don't remember the exact names)
<animist>
now the issue is clear. thank you for the assistance :)
<flux>
btw, you can try this too: cat (hit ctrl-\) echo $?
<flux>
it will output 131
<flux>
incidentally SIGQUIT is signal number 3 while SIGINT is signal number 2, that is, one bigger..
<yziquel>
flux: could not avoid a mutex for atomicity between the Unix.pipe and the Event.channel... too bad.
Associat0r has joined #ocaml
olivierp has joined #ocaml
Camarade_Tux has joined #ocaml
Camarade_Tux has quit ["Leaving"]
Ched has quit [Remote closed the connection]
Camarade_Tux has joined #ocaml
Camarade_Tux_ has joined #ocaml
Ched has joined #ocaml
<palomer>
hrmph
<palomer>
what's the quotation for a type declaration in camlp4? I'm trying to do <:str_item< type $type_name$ = $constructors$ >>
<palomer>
?
Camarade_Tux_ has quit ["Leaving"]
thelema has quit [Read error: 60 (Operation timed out)]
<palomer>
well, seems to work now
<palomer>
(for some odd reason)
rAphael_ has quit ["leaving"]
<palomer>
how do you define recursive types in revised syntax?
<palomer>
I have a list of constructor arguments and a list of constructor names and a list of type names and I'd like to combine them to define a set of recursive types
hkBst has quit [Read error: 104 (Connection reset by peer)]
alexyk has quit []
schme has quit ["leaving"]
Alpounet has quit ["Quitte"]
<palomer>
urgh, I'll have to use Ast.TyCdl
<olivierp>
another JoCaml question: if I'm using (algebraic) pattern matching in a join pattern, how come I get Match_failure errors? should the join patterns not just block until the (argument) pattern matches?
<mfp>
yziquel: you can also turn a set of libs into a cmxs with ocamlfind ocamlopt -package num,cryptokit,sqlite3 -shared -o runtime.cmxs nums.cmxa cryptokit.cmxa sqlite3.cmxa -linkall
<mfp>
that creates a cmxs with the code from all the specified libs
<mfp>
but it could deadlock if you have 2 processes stuch in want_2nd or want_3rd
<olivierp>
oh right
<olivierp>
so, no
<mfp>
jocaml-list should know why processes cannot be repeated in a pattern
<olivierp>
i know why, i think - that's because you can write "reply x to chan"
<olivierp>
so if you have several chans
<olivierp>
you wouldn't know which you're talking about
<olivierp>
of course that makes chan a sync channel, so it could possibly be allowed for async channels
<olivierp>
but maybe that kills type inference
alexyk has quit []
<olivierp>
while we're at it, do you have any idea how we could give priority to reindeer over elves? the problems asks for it normally, but in this variant with several santas, and the fact that jocaml gives no guarantee about which pattern fires when there's ambiguity, i don't see a solution
<mfp>
nothing comes to mind
<yziquel>
what does "ocamlfind: When using -syntax, the META variable 'preprocessor' must be set" mean?
<palomer>
ah, righto...
<palomer>
is your -package ... set?
<palomer>
if so, does the META in your package have a archive(syntax,preprocessor) ?