New Dune demos.

demos/calc-param-dune/.gitignore

+calc.exe
+_build
+.merlin

demos/calc-param-dune/Makefile

+.PHONY: all clean test
+
+DUNE       := jbuilder
+EXECUTABLE := calc.exe
+
+all:
+	@ if command -v $(DUNE) > /dev/null ; then \
+	  $(DUNE) build $(EXECUTABLE) ; \
+	else \
+	  echo "Error: $(DUNE) is required." ; \
+	fi
+
+clean:
+	rm -rf `cat .gitignore`
+	rm -f *~
+
+test: all
+	@echo "The following command should print 42.0:"
+	echo "(1 + 2 * 10) * 2" | ./_build/default/$(EXECUTABLE)

demos/calc-param-dune/README

+This demo is identical to the "calc-param" demo,
+but uses dune (a.k.a. jbuilder)
+instead of ocamlbuild.

demos/calc-param-dune/calc.ml

+(* Let's do floating-point evaluation, for a change. *)
+
+module FloatSemantics = struct
+
+  type number =
+      float
+
+  let inject =
+    float_of_int
+
+  let ( + ) = ( +. )
+  let ( - ) = ( -. )
+  let ( * ) = ( *. )
+  let ( / ) = ( /. )
+  let (~- ) = (~-. )
+
+end
+
+(* Let us now specialize our parameterized parser. *)
+
+module FloatParser =
+  Parser.Make(FloatSemantics)
+
+(* The rest is as usual. *)
+
+let process (line : string) =
+  let linebuf = Lexing.from_string line in
+  try
+    (* Run the parser on this line of input. *)
+    Printf.printf "%f\n%!" (FloatParser.main Lexer.token linebuf)
+  with
+  | Lexer.Error msg ->
+      Printf.fprintf stderr "%s%!" msg
+  | FloatParser.Error ->
+      Printf.fprintf stderr "At offset %d: syntax error.\n%!" (Lexing.lexeme_start linebuf)
+
+let process (optional_line : string option) =
+  match optional_line with
+  | None ->
+      ()
+  | Some line ->
+      process line
+
+let rec repeat channel =
+  (* Attempt to read one line. *)
+  let optional_line, continue = Lexer.line channel in
+  process optional_line;
+  if continue then
+    repeat channel
+  
+let () =
+  repeat (Lexing.from_channel stdin)
+

demos/calc-param-dune/jbuild

+(jbuild_version 1)
+
+(ocamllex (lexer))
+
+; Compile tokens.mly into a definition of the type [token].
+(menhir (
+  (modules (tokens))
+  (flags ("--only-tokens"))
+))
+
+; Compile parser.mly into a (parameterized) parser.
+; We need tokens.mly too, because it contains the token definitions.
+; The resulting OCaml files should be named parser.{ml,mli}
+; and should *not* contain a definition of the [token] type.
+(menhir (
+  (modules (tokens parser))
+  (merge_into parser)
+  (flags ("--external-tokens" "Tokens"))
+))
+
+(executable
+  ((name calc))
+)

demos/calc-param-dune/lexer.mll

+{
+  open Tokens
+
+  exception Error of string
+
+}
+
+(* This rule looks for a single line, terminated with '\n' or eof.
+   It returns a pair of an optional string (the line that was found)
+   and a Boolean flag (false if eof was reached). *)
+
+rule line = parse
+| ([^'\n']* '\n') as line
+    (* Normal case: one line, no eof. *)
+    { Some line, true }
+| eof
+    (* Normal case: no data, eof. *)
+    { None, false }
+| ([^'\n']+ as line) eof
+    (* Special case: some data but missing '\n', then eof.
+       Consider this as the last line, and add the missing '\n'. *)
+    { Some (line ^ "\n"), false }
+
+(* This rule analyzes a single line and turns it into a stream of
+   tokens. *)
+
+and token = parse
+| [' ' '\t']
+    { token lexbuf }
+| '\n'
+    { EOL }
+| ['0'-'9']+ as i
+    { INT (int_of_string i) }
+| '+'
+    { PLUS }
+| '-'
+    { MINUS }
+| '*'
+    { TIMES }
+| '/'
+    { DIV }
+| '('
+    { LPAREN }
+| ')'
+    { RPAREN }
+| _
+    { raise (Error (Printf.sprintf "At offset %d: unexpected character.\n" (Lexing.lexeme_start lexbuf))) }
+

demos/calc-param-dune/parser.mly

+(* These are the functions that we need in order to write our semantic
+   actions. *)
+
+%parameter<Semantics : sig
+  type number
+  val inject: int -> number
+  val ( + ): number -> number -> number
+  val ( - ): number -> number -> number
+  val ( * ): number -> number -> number
+  val ( / ): number -> number -> number
+  val ( ~-): number -> number
+end>
+
+(* The parser no longer returns an integer; instead, it returns an
+   abstract number. *)
+
+%start <Semantics.number> main
+
+(* Let us open the [Semantics] module, so as to make all of its
+   operations available in the semantic actions. *)
+
+%{
+
+  open Semantics
+
+%}
+
+%%
+
+main:
+| e = expr EOL
+    { e }
+
+expr:
+| i = INT
+    { inject i }
+| LPAREN e = expr RPAREN
+    { e }
+| e1 = expr PLUS e2 = expr
+    { e1 + e2 }
+| e1 = expr MINUS e2 = expr
+    { e1 - e2 }
+| e1 = expr TIMES e2 = expr
+    { e1 * e2 }
+| e1 = expr DIV e2 = expr
+    { e1 / e2 }
+| MINUS e = expr %prec UMINUS
+    { - e }
+

demos/calc-param-dune/tokens.mly

+(* We want the tokens to be independent of the [Semantics] parameter,
+   so we declare them here, in a separate file, as opposed to within
+   [parser.mly]. *)
+
+%token <int> INT
+%token PLUS MINUS TIMES DIV
+%token LPAREN RPAREN
+%token EOL
+
+%left PLUS MINUS        /* lowest precedence */
+%left TIMES DIV         /* medium precedence */
+%nonassoc UMINUS        /* highest precedence */
+
+%%
+

demos/calc-two-dune/.gitignore

+calc.exe
+_build
+.merlin

demos/calc-two-dune/Makefile

+.PHONY: all clean test
+
+DUNE       := jbuilder
+EXECUTABLE := calc.exe
+
+all:
+	@ if command -v $(DUNE) > /dev/null ; then \
+	  $(DUNE) build $(EXECUTABLE) ; \
+	else \
+	  echo "Error: $(DUNE) is required." ; \
+	fi
+
+clean:
+	rm -rf `cat .gitignore`
+	rm -f *~
+
+test: all
+	@echo "The following command should print 42:"
+	echo "(1 + 2 * 10) * 2" | ./_build/default/$(EXECUTABLE) --algebraic
+	@echo "The following command should print 42:"
+	echo " 1 2 10 * + 2 *"  | ./_build/default/$(EXECUTABLE) --reverse

demos/calc-two-dune/README

+This demo is identical to the "calc-two" demo,
+but uses dune (a.k.a. jbuilder)
+instead of ocamlbuild.

demos/calc-two-dune/algebraic.mly

+(* This partial grammar specification defines the syntax of expressions
+   in algebraic notation. *)
+
+%left PLUS MINUS        /* lowest precedence */
+%left TIMES DIV         /* medium precedence */
+%nonassoc UMINUS        /* highest precedence */
+
+%%
+
+%public expr:
+| i = INT
+    { i }
+| LPAREN e = expr RPAREN
+    { e }
+| e1 = expr PLUS e2 = expr
+    { e1 + e2 }
+| e1 = expr MINUS e2 = expr
+    { e1 - e2 }
+| e1 = expr TIMES e2 = expr
+    { e1 * e2 }
+| e1 = expr DIV e2 = expr
+    { e1 / e2 }
+| MINUS e = expr %prec UMINUS
+    { - e }
+

demos/calc-two-dune/algebraic.mlypack

+Tokens Algebraic Common

demos/calc-two-dune/calc.ml

+let algebraic =
+  ref true
+
+let () =
+  Arg.parse [
+    "--algebraic", Arg.Set algebraic, " Use algebraic (that is, infix) notation";
+    "--reverse", Arg.Clear algebraic, " Use reverse Polish (that is, postfix) notation";
+  ] (fun _ -> ()) (Printf.sprintf "Usage: %s <options>" Sys.argv.(0))
+
+let main =
+  if !algebraic then
+    Algebraic.main
+  else
+    Reverse.main
+
+let process (line : string) =
+  let linebuf = Lexing.from_string line in
+  try
+    (* Run the parser on this line of input. *)
+    Printf.printf "%d\n%!" (main Lexer.token linebuf)
+  with
+  | Lexer.Error msg ->
+      Printf.fprintf stderr "%s%!" msg
+  | Algebraic.Error
+  | Reverse.Error ->
+      Printf.fprintf stderr "At offset %d: syntax error.\n%!" (Lexing.lexeme_start linebuf)
+
+let process (optional_line : string option) =
+  match optional_line with
+  | None ->
+      ()
+  | Some line ->
+      process line
+
+let rec repeat channel =
+  (* Attempt to read one line. *)
+  let optional_line, continue = Lexer.line channel in
+  process optional_line;
+  if continue then
+    repeat channel
+  
+let () =
+  repeat (Lexing.from_channel stdin)
+

demos/calc-two-dune/common.mly

+(* This partial grammar specification defines the grammar's entry
+   point to be an expression, followed with an end-of-line token. *)
+
+%start <int> main
+
+%%
+
+main:
+| e = expr EOL
+    { e }
+

demos/calc-two-dune/jbuild

+(jbuild_version 1)
+
+(ocamllex (lexer))
+
+; Compile tokens.mly into a definition of the type [token].
+(menhir (
+  (modules (tokens))
+  (flags ("--only-tokens"))
+))
+
+; Compile reverse.mly into a parser.
+(menhir (
+  (modules (tokens reverse common))
+  (merge_into reverse)
+  (flags (
+     "--external-tokens" "Tokens"
+     "--unused-token" "LPAREN"
+     "--unused-token" "RPAREN"
+  ))
+))
+
+; Compile algebraic.mly into a parser.
+(menhir (
+  (modules (tokens algebraic common))
+  (merge_into algebraic)
+  (flags ("--external-tokens" "Tokens"))
+))
+
+(executable
+  ((name calc))
+)

demos/calc-two-dune/lexer.mll

+{
+  open Tokens
+
+  exception Error of string
+
+}
+
+(* This rule looks for a single line, terminated with '\n' or eof.
+   It returns a pair of an optional string (the line that was found)
+   and a Boolean flag (false if eof was reached). *)
+
+rule line = parse
+| ([^'\n']* '\n') as line
+    (* Normal case: one line, no eof. *)
+    { Some line, true }
+| eof
+    (* Normal case: no data, eof. *)
+    { None, false }
+| ([^'\n']+ as line) eof
+    (* Special case: some data but missing '\n', then eof.
+       Consider this as the last line, and add the missing '\n'. *)
+    { Some (line ^ "\n"), false }
+
+(* This rule analyzes a single line and turns it into a stream of
+   tokens. *)
+
+and token = parse
+| [' ' '\t']
+    { token lexbuf }
+| '\n'
+    { EOL }
+| ['0'-'9']+ as i
+    { INT (int_of_string i) }
+| '+'
+    { PLUS }
+| '-'
+    { MINUS }
+| '*'
+    { TIMES }
+| '/'
+    { DIV }
+| '('
+    { LPAREN }
+| ')'
+    { RPAREN }
+| _
+    { raise (Error (Printf.sprintf "At offset %d: unexpected character.\n" (Lexing.lexeme_start lexbuf))) }
+

demos/calc-two-dune/reverse.mly

+(* This partial grammar specification defines the syntax of
+   expressions in reverse Polish notation. Parentheses are
+   meaningless, and unary minus is not supported (some other symbol
+   than MINUS would be required in order to avoid an ambiguity). *)
+
+%%
+
+%public expr:
+| i = INT
+    { i }
+| e1 = expr e2 = expr PLUS
+    { e1 + e2 }
+| e1 = expr e2 = expr MINUS
+    { e1 - e2 }
+| e1 = expr e2 = expr TIMES
+    { e1 * e2 }
+| e1 = expr e2 = expr DIV
+    { e1 / e2 }
+

demos/calc-two-dune/reverse.mlypack

+Tokens Reverse Common

demos/calc-two-dune/tokens.mly

+(* This partial grammar specification defines the set of tokens. *)
+
+%token <int> INT
+%token PLUS MINUS TIMES DIV
+%token LPAREN RPAREN
+%token EOL
+
+%%
+

demos/calc-two-dune/tokens.mlypack

+Tokens

demos/generate-printers-dune/.gitignore

+.merlin
+_build
+menhir-generate-printers

demos/generate-printers-dune/Makefile

+.PHONY: all test clean
+
+# The Menhir executable in the PATH and the library MenhirSdk
+# should agree on their version number, or this test will fail
+# complaining that magic strings do not match.
+MENHIR     := menhir
+DUNE       := jbuilder
+MAIN       := generate
+EXECUTABLE := menhir-generate-printers
+
+all:
+	$(DUNE) build $(MAIN).exe
+	cp -f _build/default/$(MAIN).exe $(EXECUTABLE)
+
+TEST       := ../../test/good/parser_raw
+
+test: all
+	rm -f $(TEST).cmly
+	$(MENHIR) --cmly $(TEST).mly
+	./$(EXECUTABLE) $(TEST).cmly
+
+clean:
+	rm -f *~ .*~
+	$(DUNE) clean
+	rm -f $(EXECUTABLE)

demos/generate-printers-dune/README.md

+This tool, `menhir-generate-printers`, reads a `.cmly` file and produces code
+for three functions, namely `print_symbol`, `print_value`, and `print_token`.
+
+```
+val print_symbol: MenhirInterpreter.xsymbol -> string
+```
+
+By default, `print_symbol` prints the internal name of a (terminal or
+nonterminal) symbol. This can however be changed by attaching a `[@name]`
+attribute with this symbol. The attribute payload should be an OCaml
+expression of type `string`.
+
+```
+val print_value: 'a MenhirInterpreter.symbol -> 'a -> string
+val print_token: token -> string
+```
+
+By default, `print_value` and `print_token` ignore the semantic value and
+print just the name of the symbol, like `print_symbol`. This can however be
+changed by attaching a `[@printer]` attribute with this symbol. The attribute
+payload should be an OCaml expression of type `_ -> string`, where `_` stands
+for an appropriate type of semantic values.

demos/generate-printers-dune/generate.ml

+open Printf
+open MenhirSdk
+
+(* ------------------------------------------------------------------------ *)
+
+(* We expect one command line argument: the name of a .cmly file. *)
+
+let filename =
+  if Array.length Sys.argv = 2
+  && Filename.check_suffix Sys.argv.(1) ".cmly" then
+    Sys.argv.(1)
+  else begin
+    eprintf "Usage: %s <parser.cmly>\n" Sys.argv.(0);
+    exit 1
+  end
+
+(* ------------------------------------------------------------------------ *)
+
+(* Read this file. This gives rise to a module whose signature is
+   [Cmly_api.GRAMMAR]. We include it, so we can use it without even
+   naming it. *)
+
+include Cmly_read.Read (struct
+  let filename = filename
+end)
+
+(* ------------------------------------------------------------------------ *)
+
+(* All names which refer to Menhir's inspection API are qualified with this
+   module name. We do not [open] this module because that might hide some
+    names exploited by the user within attributes. *)
+
+let menhir =
+  "MenhirInterpreter"
+
+(* ------------------------------------------------------------------------ *)
+
+(* The header consists of an [open] directive, followed with content taken
+   from [@header] attributes. *)
+
+let module_name =
+  filename
+    |> Filename.basename
+    |> Filename.chop_extension
+    |> String.capitalize_ascii
+
+let header () =
+  printf "open %s\n\n" module_name;
+  List.iter (fun attr ->
+    if Attribute.has_label "header" attr then
+      printf "%s\n" (Attribute.payload attr)
+  ) Grammar.attributes
+
+(* ------------------------------------------------------------------------ *)
+
+(* [name default attrs] returns the payload of an [@name] attribute found in
+   [attrs], if there is one, and the literal string [default] otherwise. *)
+
+let name default attrs =
+  try
+    let attr = List.find (Attribute.has_label "name") attrs in
+    Attribute.payload attr
+  with Not_found ->
+    sprintf "%S" default
+
+(* [print_symbol()] generates code for a [print_symbol] function, which
+   converts a symbol to a string. The type of a symbol is [xsymbol];
+   see the documentation of Menhir's inspection API. *)
+
+let print_symbol () =
+  printf "let print_symbol = function\n";
+  Terminal.iter (fun t ->
+    match Terminal.kind t with
+    | `REGULAR | `ERROR ->
+        printf "  | %s.X (%s.T %s.T_%s) -> %s\n"
+          menhir menhir menhir
+          (Terminal.name t)
+          (name (Terminal.name t) (Terminal.attributes t))
+    | `PSEUDO | `EOF ->
+         ()
+  );
+  Nonterminal.iter (fun n ->
+    match Nonterminal.kind n with
+    | `REGULAR ->
+        printf "  | %s.X (%s.N %s.N_%s) -> %s\n"
+          menhir menhir menhir
+          (Nonterminal.name n)
+          (name (Nonterminal.name n) (Nonterminal.attributes n))
+    | `START ->
+        ()
+  );
+  printf "\n"
+
+(* ------------------------------------------------------------------------ *)
+
+(* [printer default attrs] returns the payload of a [@printer] attribute
+   found in [attrs], within parentheses, if there is one. Otherwise, it
+   returns a function that ignores its argument and always returns the
+   literal string [name default attrs]. *)
+
+let printer default attrs =
+  try