feat: Add typecheck to the AST

bin/dune

@@ -3,4 +3,4 @@
 (executable
  (name main)
  (public_name croissant)
- (libraries analyzer ast))
+ (libraries ast))

bin/main.ml

@@ -1,7 +1,7 @@
 (* bin/main.ml *)
 
 open Printf
-open Ast.Print
+open Ast
 
 exception Error of string
 
@@ -12,7 +12,7 @@ let () =
   if args_count >= 2 then printf "%s" help_message
   else if args_count = 1 then
     let file_path = Sys.argv.(1) in
-    let ast = string_of_source_file (Analyzer.analyze_file file_path) in
+    let ast = Print.string_of_source_file (Analyzer.analyze_file file_path) in
     printf "%s\n" ast
   else raise (Error "interpreter from stdin is not implemented yet")
 (* TODO: Implement interpreter from stdin *)

lib/ast/analyzer.ml

@@ -1,4 +1,5 @@
 open Printf
+open Typecheck
 
 let analyze lexbuf =
   let ast =
@@ -19,6 +20,7 @@ let analyze lexbuf =
           file_name line_num col_num "Erreur syntaxique" "Syntaxe incorrecte";
         exit 1
   in
+  let _ = type_of_source_file ast in
   ast
 
 let analyze_file file_name =

lib/ast/dune

@@ -1,3 +1,10 @@
 (library
  (name ast)
- (modules syntax print))
+ (modules lexer parser syntax print typecheck analyzer)
+)
+
+(menhir
+ (modules parser))
+
+(ocamllex
+ (modules lexer))

lib/ast/parser.mly

@@ -1,6 +1,6 @@
 /* lib/parser.mly */
 %{
-   open Ast.Syntax
+   open Syntax
 %}
 
 %token <int> INTEGER
@@ -103,7 +103,7 @@ unary_expression:
 
 binary_expression:
   | e1=expression "+" e2=expression { BinaryExpression(Add, e1, e2) }
-  | e1=expression "-" e2=expression { BinaryExpression(Substract, e1, e2) }
+  | e1=expression "-" e2=expression { BinaryExpression(Subtract, e1, e2) }
   | e1=expression "*" e2=expression { BinaryExpression(Multiply, e1, e2) }
   | e1=expression "/" e2=expression { BinaryExpression(Divide, e1, e2) }
   | e1=expression "&&" e2=expression { BinaryExpression(AmpersandAmpersand, e1, e2) }

lib/ast/print.ml

@@ -11,10 +11,19 @@ let string_of_type = function
   | BooleanType -> "BooleanType"
   | VoidType -> "VoidType"
 
+(** [string_of_literal l] returns a string representation of the literal [l]. *)
+let string_of_literal = function
+  | Integer i -> "Integer(" ^ string_of_int i ^ ")"
+  | Float f -> "Float(" ^ string_of_float f ^ ")"
+  | Character c -> "Character('" ^ Char.escaped c ^ "')"
+  | String s -> "String(\"" ^ s ^ "\")"
+  | Boolean b -> "Boolean(" ^ string_of_bool b ^ ")"
+  | Null -> "Null"
+
 (** [string_of_binary_operator op] returns a string representation of the binary operator [op]. *)
 let string_of_binary_operator = function
   | Add -> "Add"
-  | Substract -> "Substract"
+  | Subtract -> "Subtract"
   | Multiply -> "Multiply"
   | Divide -> "Divide"
   | AmpersandAmpersand -> "AmpersandAmpersand"
@@ -30,15 +39,6 @@ let string_of_binary_operator = function
 (** [string_of_unary_operator op] returns a string representation of the unary operator [op]. *)
 let string_of_unary_operator = function Negate -> "Negate" | Not -> "Not"
 
-(** [string_of_literal l] returns a string representation of the literal [l]. *)
-let string_of_literal = function
-  | Integer i -> "Integer(" ^ string_of_int i ^ ")"
-  | Float f -> "Float(" ^ string_of_float f ^ ")"
-  | Character c -> "Character('" ^ Char.escaped c ^ "')"
-  | String s -> "String(\"" ^ s ^ "\")"
-  | Boolean b -> "Boolean(" ^ string_of_bool b ^ ")"
-  | Null -> "Null"
-
 (** [string_of_expression e] returns a string representation of the expression [e]. *)
 let rec string_of_expression = function
   | Literal l -> "Literal(" ^ string_of_literal l ^ ")"

lib/ast/syntax.ml

@@ -18,7 +18,7 @@ type literal =
 
 type binary_operator =
   | Add
-  | Substract
+  | Subtract
   | Multiply
   | Divide
   | AmpersandAmpersand

lib/ast/typecheck.ml

@@ -0,0 +1,97 @@
+(* lib/ast/syntax.ml *)
+
+open Syntax
+
+exception Type_error of string
+
+type environment = { variables : (string * _type) list }
+
+(** [type_of_literal lit] returns the type of the given literal. *)
+let type_of_literal (lit : literal) : _type =
+  match lit with
+  | Integer _ -> IntegerType
+  | Float _ -> FloatType
+  | Character _ -> CharacterType
+  | String _ -> StringType
+  | Boolean _ -> BooleanType
+  | Null -> VoidType
+
+(** [type_of_expression env expr] returns the type of the given expression. *)
+let rec type_of_expression (env : environment) (expr : expression) : _type =
+  match expr with
+  | Literal lit -> type_of_literal lit
+  | Identifier id -> (
+      try List.assoc id env.variables
+      with Not_found -> raise (Type_error ("Unknown variable " ^ id)))
+  | UnaryExpression (op, expr) -> (
+      let expr_type = type_of_expression env expr in
+      match op with
+      | Negate -> (
+          match expr_type with
+          | IntegerType | FloatType -> expr_type
+          | _ ->
+              raise
+                (Type_error "Negate operator can only be applied to numbers"))
+      | Not -> (
+          match expr_type with
+          | BooleanType -> BooleanType
+          | _ ->
+              raise (Type_error "Not operator can only be applied to booleans"))
+      )
+  | BinaryExpression (op, left, right) -> (
+      let left_type = type_of_expression env left in
+      let right_type = type_of_expression env right in
+      match op with
+      | Add | Subtract | Multiply | Divide -> (
+          match (left_type, right_type) with
+          | IntegerType, IntegerType -> IntegerType
+          | FloatType, FloatType -> FloatType
+          | IntegerType, FloatType | FloatType, IntegerType -> FloatType
+          | _ -> raise (Type_error "Arithmetic operations require numbers"))
+      | AmpersandAmpersand | BarBar -> (
+          match (left_type, right_type) with
+          | BooleanType, BooleanType -> BooleanType
+          | _ -> raise (Type_error "Logical operations require booleans"))
+      | EqualsEquals | ExclamationEquals -> BooleanType
+      | LessThan | LessThanEquals | GreaterThan | GreaterThanEquals -> (
+          match (left_type, right_type) with
+          | IntegerType, IntegerType | FloatType, FloatType -> BooleanType
+          | IntegerType, FloatType | FloatType, IntegerType -> BooleanType
+          | _ -> raise (Type_error "Comparison operations require numbers"))
+      | Assign -> (
+          match left with
+          | Identifier _ ->
+              if left_type = right_type then left_type
+              else raise (Type_error "Assignment requires matching types")
+          | _ ->
+              raise
+                (Type_error
+                   "Assignment requires a variable on the left-hand side")))
+
+(** [type_of_variable_declaration env var_decl] returns the environment after
+    processing the given variable declaration. *)
+let type_of_variable_declaration (env : environment)
+    (VariableDeclaration (_type, id_expr, expr)) =
+  match id_expr with
+  | Identifier id ->
+      let expr_type = type_of_expression env expr in
+      if expr_type = _type then { variables = (id, _type) :: env.variables }
+      else
+        raise (Type_error ("Type mismatch in variable declaration for " ^ id))
+  | _ -> raise (Type_error "Variable name must be an identifier")
+
+(** [type_of_statement env stmt] returns the environment after processing the
+    given statement. *)
+let type_of_statement (env : environment) (stmt : statement) =
+  match stmt with
+  | ExpressionStatement expr ->
+      let _ = type_of_expression env expr in
+      env
+  | VariableStatement var_decls ->
+      List.fold_left type_of_variable_declaration env var_decls
+
+(** [type_of_source_file (SourceFile stmts)] returns the environment after
+    processing the given source file. *)
+let type_of_source_file (SourceFile stmts) =
+  let initial_env = { variables = [] } in
+  List.fold_left type_of_statement initial_env stmts

lib/dune

@@ -1,18 +1 @@
 ;lib/dune
-
-(library
- (name parser)
- (modules parser)
- (libraries ast))
-
-(library
-  (name analyzer)
-  (modules lexer analyzer)
-  (libraries parser)
-)
-
-(menhir
- (modules parser))
-
-(ocamllex
- (modules lexer))

lib/eval/dune

@@ -0,0 +1,5 @@
+; lib/eval/dune
+
+;(library
+; (name eval)
+; (modules eval))

test/ast/dune

@@ -3,4 +3,9 @@
 (test
  (name print)
  (libraries alcotest ast)
+)
+
+(test
+ (name typecheck)
+ (libraries alcotest ast)
 )

test/ast/print.ml

@@ -1,4 +1,4 @@
-(* test/print.ml *)
+(* test/ast/print.ml *)
 
 open Alcotest
 open Ast.Syntax
@@ -9,6 +9,7 @@ module To_test = struct
   let binary_operator = Ast.Print.string_of_binary_operator
   let unary_operator = Ast.Print.string_of_unary_operator
   let expression = Ast.Print.string_of_expression
+  let variable_declaration = Ast.Print.string_of_variable_declaration
   let statement = Ast.Print.string_of_statement
   let source_file = Ast.Print.string_of_source_file
 end
@@ -50,7 +51,7 @@ let test_string_of_binary_operator () =
   let tests =
     [
       ("+", "Add", Add);
-      ("-", "Substract", Substract);
+      ("-", "Subtract", Subtract);
       ("*", "Multiply", Multiply);
       ("/", "Divide", Divide);
       ("&&", "AmpersandAmpersand", AmpersandAmpersand);
@@ -94,18 +95,33 @@ let test_string_of_expression () =
       (check string) name expected (To_test.expression actual))
     tests
 
+let test_string_of_variable_declaration () =
+  let tests =
+    [
+      ( "var x: int = 42;",
+        "VariableDeclaration(IntegerType, Identifier(\"x\"), \
+         Literal(Integer(42)))",
+        VariableDeclaration (IntegerType, Identifier "x", Literal (Integer 42))
+      );
+    ]
+  in
+  List.iter
+    (fun (name, expected, actual) ->
+      (check string) name expected (To_test.variable_declaration actual))
+    tests
+
 let test_string_of_statement () =
   let tests =
     [
       ( "42;",
         "ExpressionStatement(Literal(Integer(42)))",
         ExpressionStatement (Literal (Integer 42)) );
-      ( "int x;",
+      ( "var x: int;",
         "VariableStatement([VariableDeclaration(IntegerType, \
          Identifier(\"x\"), Literal(Null))])",
         VariableStatement
           [ VariableDeclaration (IntegerType, Identifier "x", Literal Null) ] );
-      ( "int x = 42;",
+      ( "var x: int = 42;",
         "VariableStatement([VariableDeclaration(IntegerType, \
          Identifier(\"x\"), Literal(Integer(42)))])",
         VariableStatement
@@ -152,6 +168,11 @@ let () =
         [ test_case "binary_operator" `Quick test_string_of_binary_operator ] );
       ( "string_of_expression",
         [ test_case "expression" `Quick test_string_of_expression ] );
+      ( "string_of_variable_declaration",
+        [
+          test_case "variable_declaration" `Quick
+            test_string_of_variable_declaration;
+        ] );
       ( "string_of_statement",
         [ test_case "statement" `Quick test_string_of_statement ] );
       ( "string_of_source_file",

test/ast/typecheck.ml

@@ -0,0 +1,75 @@
+(* test/ast/typecheck.ml *)
+
+open Alcotest
+open Ast.Syntax
+open Ast.Typecheck
+
+let should_be_valid function_to_test tests =
+  List.iter
+    (fun (name, expected, source) ->
+      let actual = function_to_test source in
+      check (of_pp Fmt.nop) name expected actual)
+    tests
+
+let test_type_of_literal () =
+  let tests =
+    [
+      ("1", IntegerType, Integer 1);
+      ("1.0", FloatType, Float 1.0);
+      ("true", BooleanType, Boolean true);
+      ("false", BooleanType, Boolean false);
+      ("\"hello\"", StringType, String "hello");
+      ("'c'", CharacterType, Character 'c');
+      ("null", VoidType, Null);
+    ]
+  in
+  should_be_valid type_of_literal tests
+
+let test_type_of_expression () =
+  let tests =
+    [
+      ("42", IntegerType, Literal (Integer 42));
+      ("foo", StringType, Identifier "foo");
+      (* TODO Add tests *)
+    ]
+  and env : environment = { variables = [ ("foo", StringType) ] } in
+  should_be_valid (type_of_expression env) tests
+(* TODO Tests errors *)
+
+let test_type_of_variable_declaration () =
+  let tests =
+    [
+      ( "var bar: booleen = true;",
+        { variables = [ ("bar", BooleanType) ] },
+        VariableDeclaration
+          (BooleanType, Identifier "bar", Literal (Boolean true)) );
+    ]
+  and env : environment = { variables = [] } in
+  should_be_valid (type_of_variable_declaration env) tests
+(* TODO check other case should return an error *)
+
+let test_type_of_statement () =
+  let tests = [ (* TODO Add Tests *) ] and env = { variables = [] } in
+  should_be_valid (type_of_statement env) tests
+
+let test_type_of_source_file () =
+  let tests = [ (* TODO Add Tests *) ] in
+  should_be_valid type_of_source_file tests
+
+let () =
+  run "ast.typecheck"
+    [
+      ( "type_of_literal",
+        [ test_case "type_of_literal" `Quick test_type_of_literal ] );
+      ( "type_of_expression",
+        [ test_case "type_of_expression" `Quick test_type_of_expression ] );
+      ( "type_of_variable_declaration",
+        [
+          test_case "type_of_variable_declaration" `Quick
+            test_type_of_variable_declaration;
+        ] );
+      ( "type_of_statement",
+        [ test_case "type_of_statement" `Quick test_type_of_statement ] );
+      ( "type_of_source_file",
+        [ test_case "type_of_source_file" `Quick test_type_of_source_file ] );
+    ]

test/ressources/test.🥐

@@ -1,3 +1,3 @@
 /*Hello, World!*/
 
-var a : entier = 1;
+var a : chaine = "Hello World";