Hw9 menhir

.gitignore

@@ -1,4 +1,4 @@
 *~
-*.cmi
-*.cmx
+*.cm[iox]
 *.o
+

README.md

@@ -2,7 +2,7 @@
 
 Supplementary repository for compiler course.
 
-Prerequisites: ocaml [http://ocaml.org], opam [http://opam.ocaml.org].
+Prerequisites: [ocaml](http://ocaml.org), opam [http://opam.ocaml.org].
 
 Building:
 
@@ -12,3 +12,51 @@ Building:
 * `opam install GT`
 * To build the sources: `make` from the top project directory
 * To test: `test.sh` from `regression` subfolder
+
+
+
+### Про бенчмарки
+
+Было рассмотрено три подхода к созданию синтаксического анализатора:
+
+* LR анализ на основе Menhir
+* Нисходящий с помощью библиотеки Opal
+* Нисходящий с помощью Ostap
+
+#### Сравнение производительности
+
+Сравнивались три реализации:
+
+* [Старый](https://github.com/Kakadu/ostap/tree/master-very-old) Ostap с отключенной обработкой ошибок
+* [Opal](https://github.com/pyrocat101/opal)
+* [Menhir](http://gitlab.inria.fr/fpottier/menhir)
+
+Opal не поддерживает человеческие сообщения об ошибках, поэтому в Ostap те были отключены. В Menhir сообщения об
+ошибках так просто отключить нельзя.
+
+Производительность показана в таблице. Парсеры запускали в течение 1 секунды и вычислялось сколько раз они успешно отработали. В таблице хранится следующая информация:
+
+* Первый столбец --- название парсера
+* Второй столбей --- абсолютная скорость, чем больше, тем лучше
+* Третий --- таблица ускорения одного вида парсинга относительно другого. Для строки L и стобца R в ячейке `[L][R]` будет храниться ускроение, которое дает парсер L относительно R, которое вычисляется как (L-R)/R*100%. В зеркальных элементах таблицы при  таком подсчете будут всегда значения противоположного знака.
+
+В итоге получилось, что LR анализатор (Menhir) работает существенно производительнее нисходящего анализа, по причинам...
+
+#### Сравнение размера кода
+
+Реализации находятся в файлах
+
+* [LamaOpal.ml](src/LamaOpal.ml)
+* [LamaOstapP5.ml](src/LamaOstapP5.ml)
+* [LamaMenhir.mly](src/LamaMenhir.mly) и [LamaLexer.mll](src/LamaLexer.mll)
+
+Ostap использует специальное синтаксическое расширение для написание парсера, поэтому естесственно, что размер реализации на Ostap меньше, чем на Opal. Но и там, и там, можно описывать специализированные парсеры (например, парсер арифметических выражений), использование которых может сделать код более похожим по размеру.
+
+Menhir позволяет параметризовывать правила другими, в том числе "анонимными" правилами, поддерживает специальный синтаксии для операций EBNF. Поэтому размер непосредственно пасрера можно сопоставить по размеру с реализацией на Ostap, за несколькими исключениями.
+
+* Ostap использует специальный парсер для парсинга арифметических выражений, поэтому эта часть на нём компактнее.
+* Menhir использует lexer на основе OCamlLex, в Ostap это реализовано по-другому. Поэтому реализация лексической части на menhir выглядит сущетсвенно длиннее, чем на Ostap.
+
+#### Разбираемый язык
+
+Разновиность Ламы, где мы не используем определение кастомных инфиксных операторов. По идее, если их завести, то menhir будет больно. ДЮ, Вы тут лучше знаете, какие там инфиксы в Ламе и почему именно будет больно.

doc/.gitignore

@@ -0,0 +1,4 @@
+*.log
+*.out
+*.pdf
+

regression/.gitignore

@@ -0,0 +1,2 @@
+*.s
+

src/.gitignore

@@ -0,0 +1,7 @@
+.merlin
+/LamaLexer.ml
+/LamaMenhir.ml
+/LamaMenhir.mli
+/LamaMenhir.conflicts
+/rc.opt
+/*.exe

src/Driver.ml

@@ -1,50 +1,75 @@
-open Ostap
 
-let parse infile =
-  let s = Util.read infile in
-  Util.parse
-    (object
-       inherit Matcher.t s
-       inherit Util.Lexers.decimal s
-       inherit Util.Lexers.string s
-       inherit Util.Lexers.char   s
-       inherit Util.Lexers.ident ["skip"; "if"; "then"; "else"; "elif"; "fi"; "while"; "do"; "od"; "repeat"; "until"; "for"; "fun"; "local"; "return"; "length"] s
-       inherit Util.Lexers.skip [
-	 Matcher.Skip.whitespaces " \t\n";
-	 Matcher.Skip.lineComment "--";
-	 Matcher.Skip.nestedComment "(*" "*)"
-       ] s
-     end
-    )
-    (ostap (!(Language.parse) -EOF))
+
+module ArgInfo = struct
+  type t =
+    { mutable interpret: bool
+    ; mutable stack: bool
+    ; mutable file: string
+    ; mutable menhir: bool
+    ; mutable dparsetree: bool
+    }
+  let empty () = { interpret = false; stack=false; file=""; menhir=false; dparsetree = false }
+  let to_compile { stack; interpret } = not (interpret || stack)
+  let parse_args nfo =
+    Arg.parse
+      [ ("-i", Arg.Unit (fun () -> nfo.interpret <- true), "interpret")
+      ; ("-s", Arg.Unit (fun () -> nfo.stack <- true), "stack")
+      ; ("-m", Arg.Unit (fun () -> nfo.menhir <- true), "use menhir")
+      ; ("-pc", Arg.Unit (fun () -> nfo.menhir <- false), "use ostap (default) ")
+      ; ("-dparsetree", Arg.Unit (fun () -> nfo.dparsetree <- true), "dump parsetree")
+      ]
+      (fun s -> nfo.file <- s )
+      "Usage: rc [-i | -s] <input file.expr>\n"
+
+  let infile { file } = file
+  let is_interpret { interpret } = interpret
+  let dparsetree { dparsetree } = dparsetree
+
+  let parse { menhir; file } =
+    print_endline file;
+    let s = Ostap.Util.read file in
+    if not menhir
+    then Language.run_parser s
+    else RunMenhir.run_parser ~filename:file s
+
+end
 
 let main =
-  try
-    let interpret  = Sys.argv.(1) = "-i"  in
-    let stack      = Sys.argv.(1) = "-s"  in
-    let to_compile = not (interpret || stack) in
-    let infile     = Sys.argv.(if not to_compile then 2 else 1) in
-    match parse infile with
+  (* try *)
+    let args = ArgInfo.empty () in
+    let () = ArgInfo.parse_args args in
+    (* let interpret  = Sys.argv.(1) = "-i"  in *)
+    (* let stack      = Sys.argv.(1) = "-s"  in *)
+    (* let to_compile = not (interpret || stack) in *)
+    (* let infile     = Sys.argv.(if not to_compile then 2 else 1) in *)
+    match ArgInfo.parse args with
     | `Ok prog ->
-      if to_compile
-      then            
-        let basename = Filename.chop_suffix infile ".expr" in
-        ignore @@ X86.build prog basename        
-      else 
-	let rec read acc =
-	  try
-	    let r = read_int () in
-	    Printf.printf "> ";
-	    read (acc @ [r]) 
-          with End_of_file -> acc
-	in
-	let input = read [] in	
-	let output = 
-	  if interpret 
-	  then Language.eval prog input 
-	  else SM.run (SM.compile prog) input
-	in
-	List.iter (fun i -> Printf.printf "%d\n" i) output
+      let () =
+        if ArgInfo.dparsetree args
+        then (
+          Format.printf "%s\n%!" (GT.show GT.list (GT.show Language.Definition.t) @@ fst prog);
+          Format.printf "%s\n%!" (GT.show Language.Stmt.t @@ snd prog);
+        )
+      in
+      if ArgInfo.to_compile args
+      then
+        let basename = Filename.chop_suffix (ArgInfo.infile args) ".expr" in
+        ignore @@ X86.build prog basename
+      else
+        let rec read acc =
+          try
+            let r = read_int () in
+            Printf.printf "> ";
+            read (acc @ [r])
+                with End_of_file -> acc
+        in
+        let input = read [] in
+        let output =
+          if ArgInfo.is_interpret args
+          then Language.eval prog input
+          else SM.run (SM.compile prog) input
+        in
+        List.iter (fun i -> Printf.printf "%d\n" i) output
     | `Fail er -> Printf.eprintf "Syntax error: %s\n" er
-  with Invalid_argument _ ->
-    Printf.printf "Usage: rc [-i | -s] <input file.expr>\n"
+  (* with Invalid_argument _ ->
+    Printf.printf "Usage: rc [-i | -s] <input file.expr>\n" *)

src/GenParser.ml

@@ -0,0 +1,141 @@
+module type P = sig
+  type ('t, 'a) t
+
+  val ( => ) : ('t, 'a) t -> ('a -> 'b) -> ('t, 'b) t
+
+  val map : ('a -> 'b) -> ('t, 'a) t -> ('t, 'b) t
+
+  val altl : ('t, 'a) t list -> ('t, 'a) t
+
+  val alt : ('t, 'a) t -> ('t, 'a) t -> ('t, 'a) t
+
+  val many : ('t, 'a) t -> ('t, 'a list) t
+
+  val empty : ('t, unit) t
+
+  val return : 'a -> ('t, 'a) t
+
+  val ( >>= ) : ('t, 'a) t -> ('a -> ('t, 'b) t) -> ('t, 'b) t
+
+  val ( *> ) : ('t, 'a) t -> ('t, 'b) t -> ('t, 'b) t
+
+  val ( <* ) : ('t, 'a) t -> ('t, 'b) t -> ('t, 'a) t
+
+  val seq : ('t, 'a) t -> ('a -> ('t, 'b) t) -> ('t, 'b) t
+
+  (* val guard : ('a, 'b, 'c) t -> ('b -> bool) -> ('b -> 'c) option -> ('a, 'b, 'c) t *)
+
+  val guard : ('a, 'b) t -> ('b -> bool) -> ('b -> unit) option -> ('a, 'b) t
+
+  val opt : ('a, 'b) t -> ('a, 'b option) t
+
+  val fix : (('a, 'b) t -> ('a, 'b) t) -> ('a, 'b) t
+
+  val token : string -> (char, string) t
+
+  (* almost token but modulo whitespace *)
+  val lexeme : string -> (char, string) t
+
+  val decimal : (char, int) t
+
+  val ident : (char, string) t
+
+  val eof : (char, unit) t
+
+  (* should return a string with leading and ending quotes *)
+  val string : (char, string) t
+
+  val char : (char, char) t
+
+  val debug : string -> ('tok, unit) t
+
+  val spaces : (char, unit) t
+end
+
+module type PExt = sig
+  include P
+
+  (* comma-separated list of >=0 values *)
+  val list0 : (char, 'r) t -> (char, 'r list) t
+
+  (* comma-separated list of >=1 values *)
+  val list : (char, 'r) t -> (char, 'r list) t
+
+  val parens : (char, 'b) t -> (char, 'b) t
+end
+
+module OUtil (P : P) = struct
+  open P
+
+  let left f c x y = f (c x) y
+
+  let right f c x y = c (f x y)
+
+  let expr f ops opnd =
+    let ops =
+      Array.map
+        (fun (assoc, list) ->
+          let g =
+            match assoc with `Lefta | `Nona -> left | `Righta -> right
+          in
+          ( assoc = `Nona,
+            altl (List.map (fun (oper, sema) -> oper => fun _ -> g sema) list)
+          ))
+        ops
+    in
+    let n = Array.length ops in
+    let op i = snd ops.(i) in
+    let nona i = fst ops.(i) in
+    let id x = x in
+    let rec inner l c =
+      (* Printf.printf "inner %d \n%!" l; *)
+      f
+        (alt
+           (seq
+              (guard empty (fun _ -> n = l) None)
+              (fun _ -> map (fun (x as _0) -> c x) opnd))
+           (alt
+              (seq
+                 (guard empty (fun _ -> n > l && not (nona l)) None)
+                 (fun _ ->
+                   seq
+                     (inner (l + 1) id)
+                     (fun (x as _1) ->
+                       map
+                         (fun (b as _0) ->
+                           match b with None -> c x | Some x -> x)
+                         (opt (seq (op l) (fun o -> inner l (o c x)))))))
+              (seq
+                 (guard empty (fun _ -> n > l && nona l) None)
+                 (fun _ ->
+                   seq
+                     (inner (l + 1) id)
+                     (fun (x as _1) ->
+                       map
+                         (fun (b as _0) ->
+                           c (match b with None -> x | Some (o, y) -> o id x y))
+                         (opt
+                            (seq (op l) (fun (_ as _1) ->
+                                 map
+                                   (fun (_ as _0) -> (_1, _0))
+                                   (inner (l + 1) id)))))))))
+    in
+
+    inner 0 id
+end
+
+module Helpers (P : P) : PExt with type ('a, 'b) t = ('a, 'b) P.t = struct
+  include P
+
+  let list0 p =
+    alt
+      ( p >>= fun h ->
+        many (lexeme "," *> p) >>= fun tl -> return (h :: tl) )
+      (empty => fun _ -> [])
+
+  let list p =
+    p >>= fun h ->
+    many (lexeme "," *> p) >>= fun tl -> return (h :: tl)
+
+  let parens p = lexeme "(" *> p <* lexeme ")"
+end