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;