[parser] parses and dumps content (without expressions)

Makefile

@@ -0,0 +1,5 @@
+all:
+	(cd src ; make)
+
+clean:
+	(cd src ; make clean)

src/Makefile

@@ -0,0 +1,5 @@
+all:
+	ocamlbuild -no-links -classic-display -tags debug,annot calc.native
+
+clean:
+	rm -r _build

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
+

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
+

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)))}
+

src/parser.mly

@@ -0,0 +1,95 @@
+%{
+  let current_location () = symbol_start_pos (), symbol_end_pos ()
+%}
+
+%token EOF
+%token<string> 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 <Ast.p_prog> 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 }
+;
+

src/pp.ml

@@ -0,0 +1,58 @@
+open Ast
+
+let pp_loc fmt (start, stop) =
+  Lexing.(
+    Format.fprintf fmt "%s: <l: %d, c: %d> -- <l: %d, c: %d>"
+      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
+
+

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