From e9e5cdcf4d91421fc022fd1049fc3150c6b6eea7 Mon Sep 17 00:00:00 2001 From: dsac Date: Wed, 7 Dec 2022 16:45:55 +0100 Subject: [PATCH] [parser] parses and dumps content (without expressions) --- Makefile | 5 +++ src/Makefile | 5 +++ src/ast.ml | 25 +++++++++++++ src/calc.ml | 12 +++++++ src/lexer.mll | 38 ++++++++++++++++++++ src/parser.mly | 95 ++++++++++++++++++++++++++++++++++++++++++++++++++ src/pp.ml | 58 ++++++++++++++++++++++++++++++ src/test.node | 7 ++++ 8 files changed, 245 insertions(+) create mode 100644 Makefile create mode 100644 src/Makefile create mode 100644 src/ast.ml create mode 100644 src/calc.ml create mode 100644 src/lexer.mll create mode 100644 src/parser.mly create mode 100644 src/pp.ml create mode 100644 src/test.node diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..e4c2322 --- /dev/null +++ b/Makefile @@ -0,0 +1,5 @@ +all: + (cd src ; make) + +clean: + (cd src ; make clean) diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 0000000..939101f --- /dev/null +++ b/src/Makefile @@ -0,0 +1,5 @@ +all: + ocamlbuild -no-links -classic-display -tags debug,annot calc.native + +clean: + rm -r _build diff --git a/src/ast.ml b/src/ast.ml new file mode 100644 index 0000000..2b2d9b8 --- /dev/null +++ b/src/ast.ml @@ -0,0 +1,25 @@ +type ident = string + +type location = Lexing.position * Lexing.position + +type base_ty = + | Tbool + | Tint + +type p_pattern = string +and p_expression = string + +type p_equation = + { peq_patt: p_pattern; + peq_expr: p_expression } + +type p_node = + { pn_name: ident; + pn_input: (ident * base_ty) list; + pn_output: (ident * base_ty) list; + pn_local_vars: (ident* base_ty) list; + pn_equations: p_equation list; + pn_loc: location; } + +type p_prog = p_node list + diff --git a/src/calc.ml b/src/calc.ml new file mode 100644 index 0000000..e591aa4 --- /dev/null +++ b/src/calc.ml @@ -0,0 +1,12 @@ +open Ast + +let _ = + try + let oi = open_in "test.node" in + let lexbuf = Lexing.from_channel oi in + let result = Parser.main Lexer.token lexbuf in + Format.printf "%a" Pp.pp_prog result; + close_in oi + with Lexer.Lexing_error s -> + Format.printf "Code d'erreur:\n\t%s\n\n" s + diff --git a/src/lexer.mll b/src/lexer.mll new file mode 100644 index 0000000..a1d105a --- /dev/null +++ b/src/lexer.mll @@ -0,0 +1,38 @@ +{ + open Lexing + open Ast + open Parser (* The type token is defined in parser.mli *) + + exception Lexing_error of string + + let id_or_keywork = + let h = Hashtbl.create 100 in + List.iter (fun (s,k) -> Hashtbl.add h s k) + [ ("let", LET); + ("tel", TEL); + ("node", NODE); + ("returns", RETURNS); + ("var", VAR); + ("int", INT); + ("bool", BOOL); + ]; + fun s -> + try Hashtbl.find h s with Not_found -> IDENT s +} + +let alpha = ['a'-'z' 'A'-'Z'] +let digit = ['0'-'9'] +let ident = alpha (alpha | digit | '_')* + +rule token = parse + ['\n' ' ' '\t'] { token lexbuf } (* skip blanks and newlines *) + | ident { id_or_keywork (lexeme lexbuf) } + | ',' { COMMA } + | '=' { EQUAL } + | '(' { LPAREN } + | ')' { RPAREN } + | ';' { SEMICOL } + | ':' { COLON } + | eof { EOF } + | _ { raise (Lexing_error (Format.sprintf "Erruer à la vue de %s" (lexeme lexbuf)))} + diff --git a/src/parser.mly b/src/parser.mly new file mode 100644 index 0000000..9a1a429 --- /dev/null +++ b/src/parser.mly @@ -0,0 +1,95 @@ +%{ + let current_location () = symbol_start_pos (), symbol_end_pos () +%} + +%token EOF +%token IDENT +%token LPAREN +%token RPAREN +%token RETURNS +%token SEMICOL +%token COLON +%token BOOL +%token INT +%token LET +%token TEL +%token NODE +%token VAR +%token EQUAL +%token COMMA + +/* The Entry Point */ +%start main +%type main + +%% + +main: nodes EOF { $1 }; + +nodes: + | /* empty */ { [] } + | node nodes { $1 :: $2 }; + +node: + NODE IDENT LPAREN in_params RPAREN + RETURNS LPAREN out_params RPAREN SEMICOL + local_params + LET equations TEL + { { pn_name = $2; + pn_input = $4; + pn_output = $8; + pn_local_vars = $11; + pn_equations = $13; + pn_loc = current_location (); } + } ; + +in_params: + | /* empty */ { [] } + | param_list { $1 } + ; + +out_params: param_list { $1 } ; + +local_params: + | /* empty */ { [] } + | VAR param_list_semicol { $2 } +; + +param_list_semicol: + | param SEMICOL { $1 } + | param SEMICOL param_list_semicol { $1 @ $3 } + +param_list: + | param { $1 } + | param SEMICOL param_list { $1 @ $3 } +; + +param: + ident_comma_list COLON typ + { let typ = $3 in List.map (fun i -> (i, typ)) $1 } +; + +equations: + | /* empty */ { [] } + | equation SEMICOL equations + { $1 :: $3 } +; + +equation: + pattern EQUAL expr + { { peq_patt = $1; peq_expr = $3; } } +; + +pattern: IDENT { $1 }; +expr: IDENT { $1 }; + +typ: + | BOOL { Tbool } + | INT { Tint } +; + +ident_comma_list: + | IDENT { [$1] } + | IDENT COMMA ident_comma_list { $1 :: $3 } +; + diff --git a/src/pp.ml b/src/pp.ml new file mode 100644 index 0000000..b82e8f7 --- /dev/null +++ b/src/pp.ml @@ -0,0 +1,58 @@ +open Ast + +let pp_loc fmt (start, stop) = + Lexing.( + Format.fprintf fmt "%s: -- " + start.pos_fname + start.pos_lnum start.pos_cnum + stop.pos_lnum stop.pos_cnum) + +let pp_pattern fmt pat = + Format.fprintf fmt "%s" pat + +let pp_expression fmt expression = + Format.fprintf fmt "%s" expression + +let rec pp_equations fmt eqs = + match eqs with + | [] -> () + | eq :: eqs -> + Format.fprintf fmt "\t\tPattern: %a\n\t\tExpression: %a\n%a" + pp_pattern eq.peq_patt + pp_expression eq.peq_expr + pp_equations eqs + +let rec pp_node_vars fmt vars = + match vars with + | [] -> () + | (v, t) :: vars -> + Format.fprintf fmt "\t\tVariable name: %s\n\t\tVariable type: %s\n%a" + v + (match t with + | Tbool -> "bool" + | Tint -> "int") + pp_node_vars vars + +let pp_node fmt node = + Format.fprintf fmt "\tNomdu nœud : %s\n\tInputs:\n%a\n\tOutputs:\n%a\n\t\ + Local variables:\n%a\n\tEquations:\n%a\n\tLocation in the parsed file: %a\n" + node.pn_name + pp_node_vars node.pn_input + pp_node_vars node.pn_output + pp_node_vars node.pn_local_vars + pp_equations node.pn_equations + pp_loc node.pn_loc + +let rec pp_nodes fmt nodes = + match nodes with + | [] -> () + | node :: nodes -> + Format.fprintf fmt "%a\n%a" pp_node node pp_nodes nodes + +let pp_prog fmt prog = + Format.fprintf fmt + "Le programme est composé de %d nœud(s), listés ci-dessous :\n%a" + (List.length prog) + pp_nodes prog + + diff --git a/src/test.node b/src/test.node new file mode 100644 index 0000000..4b07b68 --- /dev/null +++ b/src/test.node @@ -0,0 +1,7 @@ +node slfjsdfj (i1: bool; i2, i3: int) returns (o, o_ : int); +var l1, l3: bool; l2: int; +let + pat1 = expr1; + pat2 = expr2; + pat3 = expr3; +tel