<discocaml>
<julin9340> Right now I have got an `.mll` file and an `.ml` file .
<discocaml>
<julin9340> Oh..
<discocaml>
<sim642> You don't need to run it manually
<discocaml>
<sim642> Same for ocamlyacc
<discocaml>
<deepspacejohn> If you did need to run it manually for some reason (or a similar tool) then you would do it similarly to the example rule in the docs
Serpent7776 has quit [Quit: leaving]
<discocaml>
<julin9340> The ml file that ocamllex produces have lines like
<discocaml>
<julin9340>
<discocaml>
<julin9340> ```
<discocaml>
<julin9340> match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
<discocaml>
<julin9340> | 0 ->
<discocaml>
<julin9340> # 13 "lexer.mll"
<discocaml>
<julin9340> ( token lexbuf )
<discocaml>
<julin9340> # 151 "lexer.ml"
<discocaml>
<julin9340> ```
<discocaml>
<julin9340> Why is it that the `#` don't give errors? Are they comments?
<discocaml>
<contificate> You repeatedly poll the lexer
<discocaml>
<contificate> you usually have a rule `eof { EOF }`, then poll the lexer repeatedly until you get to EOF
Humean has joined #ocaml
<discocaml>
<contificate> from_string is fine, it'll buffer the entire string - it's `Lexer.token` where `lexer.mll` defines the `token `rule that you call several times (with the same lexbuf)
<discocaml>
<contificate> you're doing something strange in the lexer.mll itself
<discocaml>
<contificate> you usually just want to do that collection of tokens into a list outside of the lexer
<discocaml>
<contificate> it's a bad idea to do what you're doing because it will make the lexer not thread safe (as you maintain a global `token list ref`)
Haudegen has quit [Quit: Bin weg.]
wbooze has quit [Quit: Leaving]
wbooze has joined #ocaml
<discocaml>
<julin9340> Yeah I had a bad feeling while doing that. But couldn't think of a way to collect the tokens.
<discocaml>
<contificate> the way I said
<discocaml>
<contificate> ```ocaml
<discocaml>
<contificate> let rec go tokens =
<discocaml>
<contificate> let t = Lexer.token lbuf in
<discocaml>
<contificate> let tokens = t :: tokens in
<discocaml>
<contificate> there's often no need to fully tokenise something prior to parsing
<discocaml>
<contificate> ocamllex happens to line up well with ocamlyacc/menhir, which only really need a single lookahead at each point, and otherwise shift things onto their parsing stacks
<discocaml>
<contificate> ocamllex has some deficiencies that can't easily account for various things you might want, in which case you may do this
<discocaml>
<._null._> You can even write this in the post mll, so that you don't even have to export the raw lexing function
<discocaml>
<contificate> that's need as well
<discocaml>
<contificate> what would really be neat is if ocamllex got what menhir has
<discocaml>
<contificate> in menhir, you can use `%parameter <uid : mty>` to functorise the parser, then you can simply have per-parse state by providing fresh data structures to populate within the mly code
<discocaml>
<contificate> but ocamllex remains rather simplistic, I often note that it still retains commentary, citing the chapter of the dragon book from which the RE->DFA algorithm is taken
<discocaml>
<._null._> When do you need that?
myrkraverk has joined #ocaml
<discocaml>
<contificate> I used it once for populating a table with parser locations or something as a side effect
<discocaml>
<contificate> had to retrofit stuff into a large parser I'd already written for a university project
<discocaml>
<contificate> a bit like injecting some ambient state into each parser
<discocaml>
<._null._> You can also give argument to lexing functions, does it not do the same job ?
<discocaml>
<._null._> arguments*
myrkraverk_ has quit [Ping timeout: 268 seconds]
<discocaml>
<contificate> I forgot about that
<discocaml>
<contificate> yes that would work as well, but then you thread it around
<discocaml>
<contificate> probably alright if all `rule x d` takes `d` as a record or whatever
<discocaml>
<julin9340> Thanks! I was able to finish an executable with the lexer.
<discocaml>
<julin9340> So it ensures that a function is tail recursive and gives error otherwise.
myrkraverk_ has joined #ocaml
myrkraverk has quit [Ping timeout: 248 seconds]
<discocaml>
<julin9340> Using `tailcall` on a function I made gave error.
<discocaml>
<julin9340>
<discocaml>
<julin9340> What makes this non-tail recursive?
<discocaml>
<julin9340>
<discocaml>
<julin9340> ```
<discocaml>
<julin9340> let get_tokens lexbuf =
<discocaml>
<julin9340> let rec go acc =
<discocaml>
<julin9340> match Lexer.lex lexbuf with
<discocaml>
<julin9340> | Token.EOF -> acc
<discocaml>
<julin9340> | tok -> go (tok::acc)
<discocaml>
<julin9340> in (go [@tailcall]) [] |> List.rev
<discocaml>
<julin9340> ```
<discocaml>
<julin9340>
<discocaml>
<julin9340> Recursive calls on `go` doesn't perform any operation, right?
<discocaml>
<julin9340> Only thing left to do upon coming out of the recursion is to return the value.
<discocaml>
<Kali> the last call is equivalent to `List.rev ((go [@tailcall]) [])` which places go in a non-tail position
<discocaml>
<Kali> you don't want the [@tailcall] assertion here anyway, it's supposed to be inside the function to guarantee the *recursive* call is a tail-call
<discocaml>
<Kali> [@tailcall] checks only that the call is in the tail position, not the whole function
<discocaml>
<julin9340> Oh.. I had thought tail recursion was only about the body of a single function... I guess I have got some looking up to do.
<discocaml>
<julin9340> Ah.. That makes sense.
<discocaml>
<edhebi> tailrec is a property of each recursive call, and you can have some tail recursive and some not
<discocaml>
<._null._> More precisely, being a tail call is a property of any function call, and being tail recursive is the special case where the tail calls are the recursive calls
<discocaml>
<._null._> The taill call optimisation happens to any function call, recursivity doesn't change anything for that matter
<discocaml>
<edhebi> fair enough
<discocaml>
<Kali> another hint that it isn't checking the whole function is that, if it somehow was, the attribute would be placed at the end of the function definition and have two @s, like `let rec go = <definition> [@@attribute]` (the number of @s determines what the attribute applies to—1 for expressions, 2 for a binding/definition/declaration, 3 for the rest of the file)
<discocaml>
<Kali> there is a syntax shorthand for the second case which is `let[@attribute] f = ...`
<discocaml>
<contificate> I think it's a neat idea to retain EOF explicitly on the end as well
<discocaml>
<edhebi> also, as far as I understand it, `[@tailcall]` is only a syntactic check right ? Ie it's checking whether the call is in tail position, but is it actually saying anything about whether the optimization happens ?
<discocaml>
<edhebi> also, as far as I understand it, `[@tailcall]` is only a syntactic check right ? Ie it's checking whether the call is in tail position, but is it actually saying anything about whether the expected optimization happens ?
<discocaml>
<Kali> the optimization always happens, tailcall will make the program fail to compile if it isn't in tail position
<discocaml>
<._null._> I'm pretty sure all tail calls are optimised, but I'm also pretty sure the intended semantics is to ensure the call is really tail-call optimised
<discocaml>
<edhebi> ie the compiler guarantees that if tailrec optimization can happen it does ?
<dh`>
"guarantees" is pretty strong but it's certainly expected
<discocaml>
<yawaramin> yes
<discocaml>
<edhebi> how polite
<discocaml>
<aguluman> Welcome
myrkraverk has joined #ocaml
myrkraverk_ has quit [Ping timeout: 260 seconds]
Anarchos has joined #ocaml
chiselfuse has quit [Ping timeout: 264 seconds]
chiselfuse has joined #ocaml
Anarchos has quit [Quit: Vision[]: i've been blurred!]