Commit d7d2ecc4 authored by alexandre dang's avatar alexandre dang
Browse files

Build pour le 1er TP

parents
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 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
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
File added
S .
B _build
PKG batteries
\ No newline at end of file
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 (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.
<.>: include
true: package(str, batteries)
true: use_menhir
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
{
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 }
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
%{
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 } }
;
%%
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)
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;