Browse Source

Added typecheck test in the for syntax

Chimrod 3 months ago
parent
commit
4d060b8bb7
2 changed files with 51 additions and 12 deletions
  1. 34 12
      lib/syntax/type_of.ml
  2. 17 0
      test/type_of.ml

+ 34 - 12
lib/syntax/type_of.ml

@@ -144,6 +144,7 @@ module TypeBuilder = Compose.Expression (Get_type)
 
 type t' = { result : Get_type.t Lazy.t; pos : S.pos }
 
+(** Evaluate the expression, and extract it’s type. *)
 let arg_of_repr : Get_type.t Lazy.t -> S.pos -> Helper.argument_repr =
  fun type_of pos -> { pos; t = Lazy.force type_of }
 
@@ -210,7 +211,6 @@ module TypedExpression = struct
     let types, report =
       List.fold_left params ~init:([], [])
         ~f:(fun (types, report) (type_of, param) ->
-          ignore type_of;
           let t, r = param in
           let arg = arg_of_repr type_of t.pos in
           (arg :: types, r @ report))
@@ -359,6 +359,10 @@ end
 
 module Expression = TypeBuilder.Make (TypedExpression)
 
+let arg_of_expr : Expression.t' -> Helper.argument_repr * Report.t list =
+ fun (expression, report) ->
+  ({ pos = expression.pos; t = Lazy.force expression.result }, report)
+
 module Instruction = struct
   type t = Report.t list
   type t' = Report.t list
@@ -470,21 +474,39 @@ module Instruction = struct
               [ op1; op2 ] report
         | reports -> reports @ report)
 
+  let ( @@ ) = List.rev_append
+
   let for_ :
       S.pos ->
-      (S.pos, Expression.t') S.variable ->
-      start:Expression.t' ->
-      to_:Expression.t' ->
-      step:Expression.t' option ->
+      (S.pos, expression) S.variable ->
+      start:expression ->
+      to_:expression ->
+      step:expression option ->
       t list ->
       t =
-   fun _loc variable ~start ~to_ ~step statements ->
-    ignore variable;
-    ignore start;
-    ignore to_;
-    ignore step;
-    (* TODO ensure all the variable are INT *)
-    let report = [] in
+   fun pos variable ~start ~to_ ~step statements ->
+    let expected = Helper.[ Fixed Integer ] in
+
+    let variable' =
+      arg_of_repr (Lazy.from_val (Get_type.ident variable)) variable.pos
+    in
+
+    let step_report =
+      Option.map
+        (fun step ->
+          let step, report = arg_of_expr step in
+          Helper.compare_args pos expected [ step ] report)
+        step
+      |> Option.value ~default:[]
+    in
+    let start', report_start = arg_of_expr start
+    and to', report_to = arg_of_expr to_ in
+    let report =
+      Helper.compare_args ~strict:true pos expected [ start' ]
+        (step_report @@ report_start @@ report_to)
+      |> Helper.compare_args ~strict:true pos expected [ to' ]
+      |> Helper.compare_args ~strict:true pos expected [ variable' ]
+    in
     List.fold_left statements ~init:report ~f:(fun acc a ->
         let report = a in
         (List.rev_append report) acc)

+ 17 - 0
test/type_of.ml

@@ -76,6 +76,19 @@ let wrong_predicate () =
 
 let concat_text () = _test_instruction {|$a = 'A' + 1|} []
 let increment_string () = _test_instruction {|$a += 1|} (message' Error)
+let for_ok () = _test_instruction {|for i = 0 to 5 step 1: msg i|} []
+
+let for_start_string () =
+  _test_instruction {|for i = '' to 5: msg i|} (message Warn)
+
+let for_to_string () =
+  _test_instruction {|for i = 0 to '': msg i|} (message Warn)
+
+let for_variable () =
+  _test_instruction {|for $i = 0 to 5: msg i|} (message Warn)
+
+let for_step () =
+  _test_instruction {|for i = 0 to 5 step '': msg i|} (message Warn)
 
 let test =
   ( "Typechecking",
@@ -96,4 +109,8 @@ let test =
       Alcotest.test_case "Wrong predicate" `Quick wrong_predicate;
       Alcotest.test_case "+(int, str)" `Quick concat_text;
       Alcotest.test_case "str += int" `Quick increment_string;
+      Alcotest.test_case "correct for" `Quick for_ok;
+      Alcotest.test_case "for i = ''" `Quick for_start_string;
+      Alcotest.test_case "for $i" `Quick for_variable;
+      Alcotest.test_case "for … step ''" `Quick for_step;
     ] )