Build pour le 1er TP

.gitignore

+tests/**/*.ast
+tests/**/*.cfg
+tests/**/*.cfg0
+tests/**/*.cfg1
+tests/**/*.cfg2
+tests/**/*.e.dump
+tests/**/*.e.html
+tests/**/*.exe
+tests/**/*.lex
+tests/**/*.linear
+tests/**/*.linear1
+tests/**/*.ltl
+tests/**/*.rtl
+tests/**/*.s
+tests/**/*.svg
+tests/results.html
+tests/__pycache__
+src/_build
+alpaga/_build
+grammar.html
+src/generated_parser.ml
+**/*.native
+alpaga/ml_parser_generator
+alpaga/alpaga
+alpaga/ml_parser_generator.native
+tykernel/*.ast
+tykernel/*.cfg
+tykernel/*.cfg0
+tykernel/*.cfg1
+tykernel/*.cfg2
+tykernel/*.e.dump
+tykernel/*.e.html
+tykernel/*.exe
+tykernel/*.lex
+tykernel/*.linear
+tykernel/*.linear1
+tykernel/*.ltl
+tykernel/*.rtl
+tykernel/*.s
+tykernel/*.svg
+skeleton
+sujet/_minted-tp
+sujet/*.aux
+sujet/*.fdb_latexmk
+sujet/*.fls
+sujet/*.log
+sujet/*.out
+sujet/*.pdf
+sujet/*.synctex.gz

INSTALL.md

+# Install with opam
+1. Install opam (Ocaml PAckage Manager)
+    - https://opam.ocaml.org/doc/Install.html
+2. Get sufficient version of ocaml
+    > opam switch create 4.08.0 (or higher)
+3. Install packages with opam 
+    > opam install package-name
+    - stdlib-shims
+    - ocamlbuild
+    - ocamlfind
+    - menhir
+    - lwt
+    - logs
+    - batteries
+    - yojson
+    - websocket
+    - websocket-lwt-unix
+4. Build the project
+    > make

Makefile

+all: main.native
+
+.PHONY: main.native
+main.native:
+	make -C alpaga
+	./alpaga/alpaga \
+			-g expr_grammar_action.g \
+			-pml src/generated_parser.ml \
+			-t grammar.html
+	./configure
+	make -C src
+	cp src/main.native main.native
+
+
+clean:
+	make -C alpaga clean
+	rm -f src/generated_parser.ml
+	rm -f grammar.html
+	make -C src clean
+	rm -f main.native
+	make -C tests clean
+
+test: main.native
+	make -C tests

alpaga/.merlin

+S .
+B _build
+PKG batteries
\ No newline at end of file

alpaga/Makefile

+OCB=ocamlbuild -use-ocamlfind -cflag -g
+
+SRC=ml_parser_generator.ml \
+	grammar_parser.ml \
+	ll_parser.ml \
+	list_utils.ml	\
+	grammar.ml \
+	grammar_lexer.mll \
+	grammar_parser_yacc.mly
+
+TG = alpaga
+
+all: $(TG)
+
+$(TG): ml_parser_generator.native
+	cp ml_parser_generator.native $(TG)
+
+ml_parser_generator.native: $(SRC)
+	$(OCB) ml_parser_generator.native
+
+clean:
+	rm -f ml_parser_generator.native $(TG)
+	rm -rf _build

alpaga/README.md

+# ALPAGA (An Ll(1) PArser GenerAtor)
+
+ALPAGA est un générateur d'analyseurs syntaxiques LL(1).
+
+Le format d'entrée (simple) est le suivant :
+
+Premièrement, on définit les terminaux du langage :
+
+'''
+tokens SYM_EOF SYM_IF SYM_IDENTIFIER<string> SYM_INTEGER<int> SYM_PLUS SYM_MINUS
+tokens SYM_ASTERISK SYM_DIV
+'''
+
+Les "SYM_XXX" correspondent aux symboles définis dans src/symbols.ml
+
+Lorsqu'un symbole n'est pas constant (i.e. est paramétré par une chaîne de
+caractères ou un entier, n indique son type entre chevrons < et >.
+
+Ensuite, on définit les non-terminaux du langage :
+
+'''
+non-terminals S EXPR TERM FACTOR
+non-terminals EXPRS TERMS
+'''
+
+Puis le non-terminal distingué qui sert d'axiome à la grammaire :
+
+'''
+axiom S
+'''
+
+Ensuite le mot clé 'rules' indique le début des règles de la grammaire
+
+'''rules'''
+
+Une règle est simplement de la forme 'N -> SYM_TRUC AUTRE_NON_TERMINAL SYM_MACHIN'
+
+Par exemple,
+
+'''
+S -> EXPR SYM_EOF
+EXPR ->  TERM EXPRS
+EXPRS -> SYM_PLUS TERM EXPRS
+EXPRS -> SYM_MINUS TERM EXPRS
+EXPRS ->
+'''
+
+La dernière ligne de cette grammaire indique une règle qui produit le mot vide
+(Epsilon) pour le non-terminal EXPRS.
+
+Vous pouvez lancer ALPAGA avec la commande suivante :
+
+'''
+./ml_parser_generator -g <votre_fichier_de_grammaire.g> -t <table.html>
+'''
+
+Cela va analyser votre grammaire et produire un fichier HTML, que vous pouvez
+ouvrir avec un navigateur web, et qui contient les tables Null, First et Follow
+relatives à votre grammaire.
+
+Ce fichier contient aussi la table de prédiction LL(1) avec dans chaque case
+(NT, t) la règle à appliquer lorsque l'analyseur doit reconnaître le
+non-terminal NT, et a le lexème t en entrée.
+
+Si la case est vide, il s'agit d'une erreur de syntaxe : on ne s'attendait pas à
+voir ce lexème-ci dans cet état.
+
+Si la case contient plusieurs règles, c'est un conflit : votre grammaire est
+ambigüe. Sans doute avez-vous utilisé de la récursivité à gauche ?
+
+Dans la case (NT,t), une règle affichée en bleu signifie que cette règle est
+présente car t appartient à First(NT), tandis qu'une règle affichée en rouge
+signifie que NT est Nullable et que t appartient à Follow(NT).
+
+
+## Actions dans la grammaire
+
+Maintenant que vous avez une grammaire sans conflits, il est temps de générer un
+arbre de syntaxe abstraite. Pour ce faire, vous avez deux choses à faire :
+
+- sur les lignes avant le mot-clé 'rules', insérez un bloc de code entre
+  accolades, qui sera copié au début du code source généré pour l'analyseur
+  syntaxique. (en fait dans le squelette qui vous est fourni, ce bloc de code
+  est déjà présent, et vous n'avez qu'à le remplir.)
+  
+- après chaque règle 'X -> w1 w2 ... wn', ajoutez du code entre accolades qui
+  construit le sous-arbre correspondant à la dérivation effectuée par cette
+  règle. On appelle ce code une **action**.
+  
+  Le code que vous écrivez correspond donc à la construction d'un terme OCaml.
+  
+  Par exemple, le morceau suivant vous est fourni :
+  '''
+  S -> GLOBDEF SYM_EOF {  Node (Tlistglobdef, [$1]) }
+  IDENTIFIER -> SYM_IDENTIFIER {  StringLeaf ($1) }
+  INTEGER -> SYM_INTEGER { IntLeaf ($1) }
+  GLOBDEF -> IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS INSTR {
+      let fargs = $3 in
+      let instr = $5 in
+      Node (Tfundef, [$1; Node (Tfunargs, fargs) ; instr ])
+  }
+  '''
+  
+  Pour une règle X -> w1 w2 ... wn, les variables $i correspondent aux actions
+  générées par le symbole wi. Par exemple, dans l'action de la première règle,
+  la variable $1 correspond à l'arbre rendu par le non-terminal GLOBDEF.
+  
+  Les définitions des arbres et nœuds sont trouvées dans le fichier src/ast.ml.
+  
+  Ces actions vont servir à générer le parser, ce qui se fera avec la commande :
+  
+  '''
+./ml_parser_generator -g <votre_fichier_de_grammaire.g> -t <table.html> -pml <generated_parser.ml>
+  '''
+  
+  ce qui créera le fichier <generated_parser.ml> à l'endroit où vous l'avez
+  indiqué.
+  
+  En fait, les différents Makefile de ce projet font que vous n'aurez
+  normalement pas à écrire cette commande à la main : un simple 'make test' à la
+  racine de ce projet devrait faire tout ce dont vous avez besoin.

alpaga/_tags

+<.>: include
+true: package(str, batteries)
+true: use_menhir

alpaga/grammar.ml

+open List_utils
+
+type tokent = string
+type nonterm = string
+
+type action = string option
+
+type rule = { rule_nt: nonterm;
+              rule_prods: string list;
+              rule_action: action
+            }
+
+type grammar = { tokens: (tokent * string option) list;
+                 nonterms: nonterm list;
+                 rules: rule list;
+                 mlcode: string option;
+                 axiom: nonterm option
+               }
+
+
+let dump_grammar oc (toks, nts, rules) =
+  Printf.fprintf oc "tokens";
+  List.iter (fun n -> Printf.fprintf oc " %s" n) toks;
+  Printf.fprintf oc "\nnon-terminals ";
+  List.iter (fun n -> Printf.fprintf oc " %s" n) nts;
+  Printf.fprintf oc "\nrules\n";
+  List.iter (fun (n,lt,a) -> Printf.fprintf oc "%s ->%s\n" n (print_seq (fun x -> x) lt)) rules
+

alpaga/grammar_lexer.mll

+{
+open Grammar_parser_yacc
+}
+
+let digit = ['0'-'9']
+let letter = ['a'-'z' 'A'-'Z']
+let id = letter (digit|letter|'_')*
+
+rule token = parse
+  | [' ' '\t'] { token lexbuf }
+  | "//" { comment lexbuf }
+  | '\n' { Lexing.new_line lexbuf; EOL }
+  | '{' { action 0 "" lexbuf }
+  | "->" { ARROW }
+  | ">" { GT }
+  | "<" { LT }
+  | "axiom" { AXIOM }
+  | "tokens" { TOK }
+  | "non-terminals" { NT }
+  | "rules" { RULES }
+  | id as s { IDENTIFIER s }
+  | eof { EOF }
+  | _ as x { failwith (Printf.sprintf "unexpected char '%c'\n" x)}
+and action level s = parse
+  | '}' { if level = 0 then CODE s else action (level-1) (s ^ "}") lexbuf }
+  | '{' { action (level + 1) (s ^ "{") lexbuf }
+  | _ as x { if x == '\n' then Lexing.new_line lexbuf;
+             action level (Printf.sprintf "%s%c" s x) lexbuf }
+and comment = parse
+  | '\n' { Lexing.new_line lexbuf; token lexbuf }
+  | _ { comment lexbuf }

alpaga/grammar_parser.ml

+open Str
+open List_utils
+open Lexing
+open Grammar_lexer
+open Grammar_parser_yacc
+open Grammar
+
+let print_position outx lexbuf =
+  let pos = lexbuf.lex_curr_p in
+  Printf.fprintf outx "%s:%d:%d" pos.pos_fname
+    pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)
+
+let parse_with_error lexbuf =
+  try main token lexbuf with
+  | Error ->
+    Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf;
+    exit (-1)
+
+let parse_grammar file : grammar * nonterm =
+  let ic = open_in file in
+  let lexbuf = Lexing.from_channel ic in
+  lexbuf.Lexing.lex_curr_p <- {lexbuf.Lexing.lex_curr_p with pos_fname = file};
+  let gram : grammar = parse_with_error lexbuf in
+  let (undefined_strings, used_strings) : string list * string list =
+    List.fold_left (fun (undef, used) rule ->
+        List.fold_left
+          (fun (undef, used) prod ->
+             let undef =
+               if not (List.mem prod (List.map fst gram.tokens) || List.mem prod gram.nonterms || List.mem prod undef)
+               then prod::undef
+               else undef in
+             let used =
+               if List.mem prod used then used else prod::used in
+             (undef, used)
+          )
+          (undef, used) (rule.rule_prods)
+      ) ([],[]) (gram.rules) in
+
+  (* Error if undefined tokens or non-terminals are encountered *)
+  if undefined_strings <> []
+  then (Printf.printf "Undefined tokens or non-terminals: %a\n" print_list undefined_strings;
+       failwith "Undefined tokens or non-terminals");
+
+  match gram.axiom with
+  | None -> failwith "No axiom was defined for the grammar.\n Aborting."
+  | Some axiom ->
+
+    (* Warn if some non terminals are never seen on the right hand side of a rule. *)
+    let unused_nts = List.filter (fun nt -> not (List.mem nt used_strings) && Some nt <> gram.axiom) gram.nonterms in
+    if unused_nts <> [] then Printf.printf "The following non-terminals are declared but never appear on the right hand-side of a rule:\n%a\n" print_list unused_nts;
+
+    (* Warn if some tokens are never seen on the right hand side of a rule. *)
+    let unused_toks = (List.filter_map (fun (t,_) -> if not (List.mem t used_strings) then Some t else None) gram.tokens) in
+    if unused_toks <> [] then Printf.printf "The following tokens are declared but never appear on the right hand-side of a rule:\n%a\n" print_list unused_toks;
+
+    let h : (nonterm , rule list) Hashtbl.t =
+      Hashtbl.create (List.length gram.nonterms) in
+    List.iter ( fun r ->
+        match Hashtbl.find_opt h r.rule_nt with
+        | None -> Hashtbl.add h r.rule_nt [r]
+        | Some lp -> Hashtbl.replace h r.rule_nt (lp@[r]) ) (gram.rules);
+    let rules = List.concat (List.map (fun n -> hashget_def h n []) gram.nonterms) in
+    { gram with rules = rules }, axiom

alpaga/grammar_parser_yacc.mly

+%{
+
+    open Grammar
+
+    %}
+
+%token EOF EOL TOK NT RULES ARROW AXIOM LT GT
+%token<string> IDENTIFIER
+%token<string> CODE
+
+%start main
+%type <Grammar.grammar> main
+
+%%
+
+  main:
+    | AXIOM IDENTIFIER EOL main { let r = $4 in {r with axiom = Some $2 }}
+    | TOK list_tokens EOL main { let r = $4 in {r with tokens = r.tokens @ $2} }
+    | NT list_ident EOL main { let r = $4 in {r with nonterms = r.nonterms @ $2} }
+    | CODE main { let r = $2 in { r with mlcode = Some ($1) }}
+    | RULES EOL rules EOF { { tokens = []; nonterms = []; axiom = None;
+                              rules = $3; mlcode = None } }
+    | EOL main { $2 }
+    ;
+
+      typed_tokens:
+        | IDENTIFIER LT IDENTIFIER GT { ($1, Some $3) }
+        | IDENTIFIER { ($1, None)}
+    ;
+
+
+      list_tokens:
+        | typed_tokens list_tokens { $1 :: $2}
+        | { [] }
+    ;
+
+
+  list_ident:
+    | IDENTIFIER list_ident { $1 :: $2}
+    | { [] }
+    ;
+
+  rules:
+    | rule rules { $1 :: $2 }
+    | EOL rules {$2}
+    | {[]}
+    ;
+
+  rule:
+    | IDENTIFIER ARROW list_ident EOL {
+          { rule_nt = $1; rule_prods = $3; rule_action = None } }
+    | IDENTIFIER ARROW list_ident EOL? CODE EOL {
+          { rule_nt = $1; rule_prods = $3; rule_action = Some $5 } }
+    ;
+
+%%

alpaga/list_utils.ml

+open List
+
+(* Affiche une liste de string. *)
+let print_list oc l =
+  List.iter (fun s -> Printf.fprintf oc "%s " s) l
+
+
+let rec print_seq p = function
+  | [] -> ""
+  | a::r -> " " ^ p a ^ print_seq p r
+
+let hashget_def t k d =
+  match Hashtbl.find_opt t k with
+  | None -> d
+  | Some b -> b
+
+(* Teste si toutes les valeurs de [l1] sont dans [l2].
+   (Relation "sous-ensemble") *)
+let incl l1 l2 =
+  for_all (fun x -> mem x l2) l1
+
+(* Relation "même ensemble". *)
+let same_list l1 l2 = incl l1 l2 && incl l2 l1
+
+(* L'ensemble des éléments de [l1] qui ne sont pas dans [l2]. *)
+let diff l1 l2 =
+  filter (fun x -> not (mem x l2)) l1
+
+(* Enlève les doublons dans une liste. *)
+let rec cleardup l =
+  match l with
+    [] -> []
+  | a::r -> if mem a r then cleardup r else a::cleardup r
+
+let inter l1 l2 =
+  filter (fun x -> mem x l2) l1
+
+let disjoint l1 l2 =
+  inter l1 l2 = []
+
+let rec filter_map f l =
+  match l with
+    [] -> []
+  | a::r ->
+    match f a with
+    | Some fa -> fa :: filter_map f r
+    | _ -> filter_map f r
+
+let filter_mapi f l =
+  filter_map (fun (i,e) -> f i e)
+    (List.mapi (fun i e -> (i,e)) l)

alpaga/ll_parser.ml

+open Batteries
+open List_utils
+open List
+open Grammar
+
+
+let iter_until_fixpoint (f : unit -> bool) name =
+  let rec aux i =
+    if f ()
+    then aux (i+1)
+    else Printf.printf "Finished %s after %d steps.\n" name i in
+  aux 1
+
+let id x = x
+
+let apply_on_all f l = List.exists id (List.map f l)
+
+let nullt : (string, bool) Hashtbl.t = Hashtbl.create 20
+let firstt : (string, string Set.t) Hashtbl.t = Hashtbl.create 20
+let followt : (string, string Set.t) Hashtbl.t = Hashtbl.create 20
+
+let nullable k = hashget_def nullt k false
+let first n = hashget_def firstt n Set.empty
+let follow n = hashget_def followt n Set.empty
+
+let null_nt (toks,nts,rules) (n: string)  : bool =
+  if hashget_def nullt n false then false
+  else
+    begin
+      let r = List.filter (fun {rule_nt = x; _} -> x = n) rules in
+      let r = List.map (fun {rule_prods = x} -> x) r in
+      let can_be_null = List.exists (List.for_all nullable) r in
+      Hashtbl.replace nullt n can_be_null; can_be_null
+    end
+
+let null_all_nt (toks,nts,rules) () : bool = apply_on_all (null_nt (toks,nts,rules)) nts
+
+let iter_nullnt (toks,nts,rules) () = iter_until_fixpoint (null_all_nt (toks,nts,rules)) "nullnt"
+
+let rec first_prod (toks,nts,rules) (p: string list) : string Set.t =
+  match p with
+  | [] -> Set.empty
+  | s::r ->
+    if List.mem s toks then Set.singleton s
+    else begin Set.union (first s) (if nullable s then first_prod (toks,nts,rules) r else Set.empty) end
+
+let first_nt (toks,nts,rules) (n: string) : bool =
+  let old = first n in
+  let r = List.filter (fun {rule_nt = x} -> x = n) rules in
+  let r = List.map (fun {rule_prods = x} -> x) r in
+  let f = List.fold_left Set.union Set.empty (List.map (first_prod (toks,nts,rules)) r) in
+  Hashtbl.replace firstt n f; not (Set.equal old f)
+
+let iter_first (toks,nts,rules) () =
+  iter_until_fixpoint (fun () -> apply_on_all (first_nt (toks,nts,rules)) nts) "firstt"
+
+let rec cut_prod (x: string) (l: string list) : string list =
+  match l with
+    [] -> []
+  | a::r -> if a = x then r else cut_prod x r
+
+let null_prodlist (toks,nts,rules)(pl: string list) =
+  List.for_all (fun p ->
+      if List.mem p toks then false
+      else nullable p) pl
+
+let follow_nt (toks,nts,rules) (n: string) : bool =
+  let old = follow n in
+  let l = List.filter (fun { rule_prods = x} -> List.mem n x) rules in
+  let l = List.map (fun {rule_nt = fx; rule_prods = sx} -> (fx, cut_prod n sx)) l in
+  let l = List.map (fun x -> Set.union (if null_prodlist (toks,nts,rules) (snd x)
+                              then follow (fst x)
+                              else Set.empty) (first_prod (toks,nts,rules) (snd x))) l in
+  let l = List.fold_left Set.union Set.empty l in
+  Hashtbl.add followt n l; old <> l
+
+let follow_all_nt (toks,nts,rules) () = apply_on_all (follow_nt (toks,nts,rules)) nts
+
+let iter_follownt (toks,nts,rules) () =
+  iter_until_fixpoint (follow_all_nt (toks,nts,rules)) "follownt"
+
+type lltype = First of int | Follow of int
+
+let lltable : (string * string, lltype list) Hashtbl.t = Hashtbl.create 20
+
+let add_into_table x t p =
+  Hashtbl.add lltable (x,t) (cleardup (hashget_def lltable (x,t) [] @ [p]))
+
+
+let fill_lltable (toks,nts,rules) () =
+  List.iteri (fun i {rule_nt = x; rule_prods = gamma} ->
+      List.iter (fun t -> add_into_table x t (First (i+1))) (Set.to_list (first_prod (toks,nts,rules) gamma));
+      if null_prodlist (toks,nts,rules) gamma
+      then
+        List.iter (fun t -> add_into_table x t (Follow (i+1))) (Set.to_list (follow x))
+    ) rules
+
+let string_of_lltype = function
+  | First i -> Printf.sprintf "<a style='color:blue;' href=\"#rule-%d\">%d</a>" i i
+  | Follow i -> Printf.sprintf "<a style='color:red;' href=\"#rule-%d\">%d</a>" i i
+
+
+let print_table (toks,nts,rules) oc () =
+  Format.fprintf oc "<!DOCTYPE html>" ;
+  Format.fprintf oc "<html><head><link rel='stylesheet' type='text/css' href='style.css'/></head>\n";
+  Format.fprintf oc "<body><table><tr><th></th>" ;
+  List.iter (fun t ->
+      Format.fprintf oc " <th class='bigth'><div class='verticalText'>%s</div></th> " t
+    ) toks;
+  Format.fprintf oc "</tr>\n";
+  List.iteri
+    (fun i x ->
+       Format.fprintf oc "<tr><td style='text-align:center;'>%s</td> " x;
+       List.iter (fun t ->
+           let rs = (hashget_def lltable (x,t) []) in
+           Format.fprintf oc " <td style='text-align:center;%s'>%s</td> "
+             (if List.length rs > 1 then "background: rgba(255, 99, 71, 0.5);" else "")
+             (print_seq string_of_lltype rs)
+         ) toks;
+    )
+    nts;
+  Format.fprintf oc "</table></body></html>\n"
+
+let str_replace s s1 s2 =
+  Str.global_replace (Str.regexp (Str.quote s1)) s2 s
+
+
+let print_grammar (toks,nts,rules) oc () =
+  let counter = ref 1 in
+  Format.fprintf oc "<table>" ;
+  List.iter (fun nt  ->
+      let rules : (string list * string) list =
+        filter_map (fun {rule_nt; rule_prods; rule_action} ->
+            if rule_nt = nt
+            then Some (rule_prods, match rule_action with Some a -> a | None -> "")
+            else None) rules
+      in
+      let first_rule = ref true in
+      List.iter (fun (rule,act) ->
+          Format.fprintf oc " <tr id='rule-%d' style='%s;'><td class='left'>(%d)</td> <td class='left'> %s </td class='left'> <td class='left'> -> </td> <td class='left'> %s</td><td class='left'><pre>%s</pre></td></tr>\n"
+            !counter
+            (if !first_rule then "border-top: solid 1px" else "border: none")
+            !counter
+            (if !first_rule then Format.sprintf "<span id='nt-%s'>%s</span>" nt nt else "")
+            (if rule = [] then "&epsilon;" else print_seq (fun x -> if List.mem x toks then x else Format.sprintf "<a href='#nt-%s' style='color: black;'>%s</a>" x x) rule)
+            act ;
+          first_rule := false;
+          counter:=!counter+1
+        ) rules ;
+      Format.fprintf oc "\n"
+
+  ) nts;
+  Format.fprintf oc "</table>\n"
+
+
+let print_null (toks,nts,rules) oc () =
+  Format.fprintf oc "<br><table><tr><th>Non-terminal</th><th>Nullable</th></tr>\n" ;
+  List.iteri (fun i x  ->
+      Format.fprintf oc "<tr><td> %s</td><td>  %s</td></tr> \n"
+        x
+        (if nullable x then "true" else "false")
+    ) nts;
+  Format.fprintf oc "</table>\n<br>"
+
+
+let print_first (toks,nts,rules) oc () =
+  Format.fprintf oc "<br><table><tr><th>Non-terminal</th><th>First</th></tr>\n" ;
+  List.iteri (fun i x  ->
+      Format.fprintf oc " <tr><td>%s</td><td>%s</td></tr> \n"
+        x
+        (print_seq (fun y -> y) (Set.to_list (first x)))
+    ) nts;
+  Format.fprintf oc "</table>\n"
+
+
+let print_follow (toks,nts,rules) oc () =
+  Format.fprintf oc "<table><tr><th> Non-terminal</th><th> Follow</th></tr>\n" ;
+  List.iteri (fun i x  ->
+      Format.fprintf oc "<tr><td> %s </td><td> %s</td></tr> \n"
+        x
+        (print_seq (fun y -> y) (Set.to_list (follow x)))
+    ) nts;
+  Format.fprintf oc "</table>\n"
+
+
+
+
+let print_html (toks,nts,rules) oc () =
+  Format.fprintf oc "<!DOCTYPE html>" ;
+  Format.fprintf oc "<html><head>\
+ <style type=\"text/css\">\
+ .bigth\
+ {\
+     text-align: center;\
+     vertical-align: bottom;\
+     height: 250px;\
+     padding-bottom: 3px;\
+     padding-left: 5px;\
+     padding-right: 5px;\
+ }\
+ table {\
+     display: inline-table;\
+     margin: 1em;\
+     border: solid 1px;\
+     border-width: 1px;\
+     border-collapse: collapse;\
+ }\
+ table th, table td {\
+     border: solid 1px;\
+     border-collapse: collapse;\
+ }\
+ .verticalText\
+ {\
+     text-align: center;\
+     vertical-align: middle;\
+     width: 20px;\
+     margin: 0px;\
+     padding: 0px;\
+     padding-left: 3px;\
+     padding-right: 3px;\
+     padding-top: 10px;\
+     white-space: nowrap;\
+     -webkit-transform: rotate(-90deg);\
+     -moz-transform: rotate(-90deg);\
+ }\
+ .left{\
+     text-align: left;\
+     border:none;\
+ }\
+     </style>\
+ </head>\n";
+  Format.fprintf oc "<body>\n" ;
+  Format.fprintf oc "<h1>Grammaire</h1>\n";
+  print_grammar (toks,nts,rules) oc ();
+  Format.fprintf oc "<h1>Table Null</h1>\n";
+  print_null (toks,nts,rules) oc ();
+  Format.fprintf oc "<h1>Table First</h1>\n";
+  print_first (toks,nts,rules) oc ();
+  Format.fprintf oc "<h1>Table Follow</h1>\n";
+  print_follow (toks,nts,rules) oc ();
+  Format.fprintf oc "<h1>Table LL</h1>\n";
+  print_table (toks, nts, rules) oc ();
+  Format.fprintf oc "</body>\n</html>\n"
+
+

alpaga/ml_parser_generator.ml

+open Grammar_parser
+open Batteries
+open Ll_parser
+open List_utils
+open Grammar
+
+
+let int_of_lltype = function
+  | First i
+  | Follow i -> i
+
+let nth_rule (toks,nts,rules) a =
+  (List.nth rules (int_of_lltype a - 1))
+
+let rec make_list l =
+  match l with
+    [] -> "[]"
+  | i::r -> Printf.sprintf "$%d :: %s" (i+1) (make_list r)
+
+(* Return the list of elements of the rule. *)
+let default_action (pl: string list) : string =
+  make_list (List.mapi (fun i e -> i) pl)
+
+let resolve_vars s =
+  Str.global_replace (Str.regexp "\\$\\([0-9]+\\)") "p\\1" s
+
+let make_nt (table: string*string -> lltype list) (toks,nts,rules) oc n () =
+  Printf.fprintf oc "and parse_%s tokens () =\n" n;
+  Printf.fprintf oc " begin match tokens with\n";
+  List.iteri
+    (fun i t ->
+       let rules = List.map (fun a -> nth_rule (toks,nts,rules) a) (table (n,t)) in
+       match rules with
+         [] -> ()
+       | {rule_prods = pl; rule_action = act}::_ ->
+         Printf.fprintf oc " | (symbol, _) :: _ when is_%s symbol -> begin\n" t;
+         List.iteri
+           (fun i t ->
+              if List.mem t toks
+              then Printf.fprintf oc "    eat_%s tokens >>= fun (p%d, tokens) ->\n" t (i + 1)
+              else Printf.fprintf oc "    parse_%s tokens ()  >>= fun (p%d, tokens) ->\n" t (i+1))
+           pl;
+         Printf.fprintf oc "\n" ;
+         Printf.fprintf oc " let res =\n" ;
+         (match act with
+          | Some act -> Printf.fprintf oc "    %s\n" (resolve_vars act)
+          | _ ->
+            Printf.fprintf oc "    %s\n" (resolve_vars (default_action pl))
+         );
+         Printf.fprintf oc " in OK (res, tokens)\n" ;
+         Printf.fprintf oc "end\n";
+    )
+    toks;
+  let expected = List.filter (fun t -> List.length (table (n,t)) > 0) toks in
+  Printf.fprintf oc "  | tokens -> \n";
+  Printf.fprintf oc " let got,lexpos = match tokens with [] -> \"EOF\",None | (symbol, lexpos) :: _ -> (string_of_symbol symbol, lexpos) in Error (\n";
+  Printf.fprintf oc "      (match lexpos with \n";
+  Printf.fprintf oc "      | Some lexpos -> Printf.sprintf \"At %%s, error while parsing %s\\n\" (string_of_position lexpos) \n" n;
+  Printf.fprintf oc "      | None -> Printf.sprintf \"Error while parsing %s\\n\" )^\n" n;
+  Printf.fprintf oc "  Printf.sprintf \"Expected one of \"^\n";
+  begin
+    match expected with
+      [] -> Printf.fprintf oc "Printf.sprintf \"{}\" ^\n"
+    | a::r -> 
+      List.iteri (fun i t ->
+          Printf.fprintf oc "Printf.sprintf \"%s %%s\" (string_of_symbol default_%s)^\n" (if i = 0 then "{" else ",") t;
+        ) (a::r);
+      Printf.fprintf oc "Printf.sprintf \"}\" ^ \n"
+  end;
+  Printf.fprintf oc "  Printf.sprintf \" but got '%%s' instead.\\n\" got\n";
+  Printf.fprintf oc "  )";
+  Printf.fprintf oc "\n  end\n\n"
+
+let make_parser  (table: string*string -> lltype list)
+    (toks,nts,rules,mlcode)
+    (typ: (tokent * string) list)
+    oc () =
+  Stdlib.Option.iter (fun mlcode -> Printf.fprintf oc "\n\n%s\n\n" mlcode) mlcode;
+  List.iter (fun t ->
+      begin match List.assoc_opt t typ with
+        | Some ty ->
+          begin
+            Printf.fprintf oc "let is_%s = function \n" t;
+            Printf.fprintf oc " | %s _ -> true\n" t;
+            Printf.fprintf oc " | _ -> false\n";
+
+            Printf.fprintf oc "let default_%s = %s %s\n" t t
+                       (match ty with
+                          "string" -> "\"\""
+                        | "int" -> "0"
+                        | "bool" -> "false"
+                        | _ -> failwith (Printf.sprintf "Don't know how to generate a default value of type %s" ty)
+                )
+          end
+        | None -> begin
+            Printf.fprintf oc "let is_%s = function \n" t;
+            Printf.fprintf oc " | %s -> true\n" t;
+            Printf.fprintf oc " | _ -> false\n";
+            Printf.fprintf oc "let default_%s = %s\n" t t
+          end
+      end;
+    ) toks;
+  List.iter (fun t ->
+      Printf.fprintf oc "let eat_%s = function \n" t;
+      begin match List.assoc_opt t typ with
+        | Some _ -> Printf.fprintf oc "| (%s(x),_) :: rtokens -> OK (x, rtokens)\n" t
+        | None -> Printf.fprintf oc "| (%s,_) :: rtokens -> OK ((), rtokens)\n" t
+      end;
+      Printf.fprintf oc "|   (x,Some pos) :: _ -> Error (Printf.sprintf \"At position %%s, expected %%s, got %%s.\\n\"";
+      Printf.fprintf oc "    (string_of_position pos)";
+      Printf.fprintf oc "    (string_of_symbol default_%s)" t;
+      Printf.fprintf oc "    (string_of_symbol x))";
+      Printf.fprintf oc "    | (x,None) :: _ -> Error (Printf.sprintf \"Expected %%s, got %%s.\\n\"";
+      Printf.fprintf oc "    (string_of_symbol default_%s)" t;
+      Printf.fprintf oc "    (string_of_symbol x))";
+      Printf.fprintf oc "    | _ -> Error  (Printf.sprintf \"Expected %%s, got EOF.\\n\" (string_of_symbol default_%s))\n" t;
+
+    ) toks;
+  Printf.fprintf oc "let rec ____unused = () \n";
+  List.iter (fun n -> make_nt table (toks,nts,rules) oc n ()) nts
+
+let nts_ordered start (toks,nts,rules) =
+  let nts =
+    let rec aux acc nt =
+      if List.mem nt acc then acc
+      else let acc = nt::acc in
+        let rules : (string list * string) list =
+          filter_map (fun {rule_nt; rule_prods; rule_action} ->
+              if rule_nt = nt
+              then Some (rule_prods, match rule_action with Some a -> a | None -> "")
+              else None) rules
+        in
+        List.fold_left (fun acc (rule,act) ->
+            List.fold_left (fun acc tokornt ->
+                if List.mem tokornt toks then acc else aux acc tokornt
+              ) acc rule
+          ) acc rules
+    in List.rev (aux [] start)
+  in
+  let rules =
+    List.concat (List.map (fun nt -> List.filter (fun r -> r.rule_nt = nt) rules) nts)
+  in (nts,rules)
+
+let _ =
+  let grammar_file = ref None in
+  let table_file = ref None in
+  let parser_ml_file = ref None in
+
+  Arg.parse
+    [("-g", Arg.String (fun s -> grammar_file := Some s), "Input grammar file (.g)");
+     ("-t", Arg.String (fun s -> table_file := Some s), "Where to output tables (.html)");
+     ("-pml", Arg.String (fun s -> parser_ml_file := Some s), "Where to output the parser code (.ml)");
+    ] print_endline "Usage: ";
+  match !grammar_file with
+  | None -> failwith "Please specify a grammar file using '-g <grammar.g>'"
+  | Some gramfile ->
+    let gram, axiom = parse_grammar gramfile in
+    let (toks, nts, rules, mlcode) =
+      (gram.tokens, gram.nonterms, gram.rules, gram.mlcode) in
+    let toks = List.map fst gram.tokens in
+    let (nts, rules) = nts_ordered axiom (toks,nts,rules) in
+    iter_nullnt (toks, nts, rules) ();
+    iter_first (toks, nts, rules) ();
+    iter_follownt (toks, nts, rules) ();
+    fill_lltable (toks, nts, rules) ();
+    (match !table_file with
+     | Some tfile -> let oc = open_out tfile in
+       print_html (toks, nts, rules) (Format.formatter_of_out_channel oc) ();
+       close_out oc
+     | None -> ());
+    (match !parser_ml_file with
+     | None -> Printf.fprintf stderr "Please specify where I should write the generated parser code using '-pml <generated_parser.ml>'"
+     | Some mlfile ->
+       let oc = open_out mlfile in
+       make_parser (fun (n,t) -> hashget_def lltable (n,t) [])
+         (toks, nts, rules, mlcode)
+         (List.filter_map (fun (t,o) ->
+              match o with
+              | None -> None
+              | Some typ -> Some (t,typ)
+            ) gram.tokens)
+         oc ();
+       close_out oc
+    )

configure

+#!/bin/bash
+
+RUNTIME=$(pwd)/runtime
+
+echo "let runtime_dir = \"${RUNTIME}\"" > src/config.ml
+echo "let qemu_path = \"/usr/local/bin/qemu-riscv\"" >> src/config.ml

expr_grammar_action.g

+tokens SYM_EOF SYM_IDENTIFIER<string> SYM_INTEGER<int> SYM_PLUS SYM_MINUS SYM_ASTERISK SYM_DIV SYM_MOD
+tokens SYM_LPARENTHESIS SYM_RPARENTHESIS SYM_LBRACE SYM_RBRACE
+tokens SYM_ASSIGN SYM_SEMICOLON SYM_RETURN SYM_IF SYM_WHILE SYM_ELSE SYM_COMMA SYM_PRINT
+tokens SYM_EQUALITY SYM_NOTEQ SYM_LT SYM_LEQ SYM_GT SYM_GEQ
+non-terminals S INSTR INSTRS LINSTRS ELSE EXPR FACTOR
+non-terminals LPARAMS REST_PARAMS
+non-terminals IDENTIFIER INTEGER
+non-terminals GLOBDEF
+non-terminals ADD_EXPRS ADD_EXPR
+non-terminals MUL_EXPRS MUL_EXPR
+non-terminals CMP_EXPRS CMP_EXPR
+non-terminals REQ_EXPRS REQ_EXPR
+axiom S
+{
+
+  open Symbols
+  open Utils
+  open Ast
+  open BatPrintf
+  open BatBuffer
+  open Batteries
+
+  (* TODO *)
+  let resolve_associativity term other =
+       (* TODO *)
+    term
+
+
+}
+
+rules
+S -> GLOBDEF SYM_EOF {  Node (Tlistglobdef, [$1]) }
+IDENTIFIER -> SYM_IDENTIFIER {  StringLeaf ($1) }
+INTEGER -> SYM_INTEGER { IntLeaf ($1) }
+GLOBDEF -> IDENTIFIER SYM_LPARENTHESIS LPARAMS SYM_RPARENTHESIS INSTR {
+    let fargs = $3 in
+    let instr = $5 in
+    Node (Tfundef, [$1; Node (Tfunargs, fargs) ; instr ])
+}

ldb/ldb.html

+<!DOCTYPE html>
+<html>
+<meta charset="utf-8">
+
+<head>
+    <link rel="stylesheet" type="text/css" href="style.css">
+</head>
+
+<body>
+    <div class="title">
+        <h2>LTL Trace Explorer : <span id="traceName"></span> </h2>
+    </div>
+    <div id="step_navigator">
+        Parameters : <input type="text" id="init_params" />
+        <input type="button" value="Init" id="btn_init" />
+        <input type="button" id="quit_btn" value="Quit" />
+        <input type="button" id="graph_btn" value="Draw graph" />
+        <input type="button" id="prev_bp" value="&#8606;" />
+        &nbsp;
+        <input type="button" id="prev_step" value="&larr;" />
+        &nbsp;
+        <span id="curstep"></span> of <span id="total_num_steps"></span>
+        &nbsp;
+        <input type="button" id="next_step" value=" &rarr;" />
+        &nbsp;
+        <input type="button" id="next_bp" value="&#8608;" />
+        <input type="button" id="play" value="Play" />
+        &nbsp;
+        <input type="button" id="pause" value="Pause" />
+    </div>
+
+    <div id="body">
+
+        <!-- <div id="left"> -->
+     
+        <div id="code"></div>
+        <div id="cfg"><h1>CFG</h1><div id="cfg_cont"></div> </div>
+        <!-- </div> -->
+        <div id="output"></div>
+        <div id="log"></div>
+        <!-- <div id="right-panel"> -->
+        <div id="state">
+            <div id="regstate"></div>
+            <div id="memstate"></div>
+        </div>
+            <div id="expr">
+                <input type="text" id="expr_input" size="30" /><br>
+                Result: <span id="expr_res"></span><hr>
+                <div id="subexprs"></div>
+            </div>
+            <div id="legend">
+                <!-- <h3>Legend</h3>
+                     <h4>State</h4>
+                     <span class="touched">Address written to</span><br>
+                     <span class="read">Address read from</span><br>
+                     <h4>Instructions</h4>
+                     <span class="break">Instruction with breakpoint</span><br>
+                     <span class="current">Instruction to be executed next</span><br>
+                     <span class="break current">Next instruction has a breakpoint</span><br> -->
+                <h4>Vars</h4>
+                <div id="vars"></div>
+                <h4>CFG</h4>
+                <div id="cfg_legend"></div>
+                <h4>Status</h4>
+                <div id="status"></div>
+            </div>
+            <!-- </div> -->
+    </div>
+    <script src="d3.v5.min.js"></script>
+    <script src="https://cdnjs.cloudflare.com/ajax/libs/vis/4.21.0/vis.min.js"></script>
+    <script src="expr.js"></script>
+    <script src="ldb.js"></script>
+
+</body>
+
+</html>