fmt

flap/src/hopix/hopixTypechecker.ml

@@ -5,98 +5,96 @@ open HopixAST
 (** Error messages *)
 
 let invalid_instantiation pos given expected =
-  HopixTypes.type_error pos (
+  HopixTypes.type_error
-      Printf.sprintf
+    pos
-        "Invalid number of types in instantiation: \
+    (Printf.sprintf
-         %d given while %d were expected." given expected
+       "Invalid number of types in instantiation: %d given while %d were expected."
-    )
+       given
+       expected)
+;;
 
 let check_equal_types pos ~expected ~given =
   if expected <> given
   then
-    HopixTypes.(type_error pos
+    HopixTypes.(
-                  Printf.(sprintf
+      type_error
-                            "Type mismatch.\nExpected:\n  %s\nGiven:\n  %s"
+        pos
-                            (string_of_aty expected)
+        Printf.(
-                            (string_of_aty given)))
+          sprintf
+            "Type mismatch.\nExpected:\n  %s\nGiven:\n  %s"
+            (string_of_aty expected)
+            (string_of_aty given)))
+;;
 
 (** Linearity-checking code for patterns *)
-
 let rec check_pattern_linearity
-        : identifier list -> pattern Position.located -> identifier list
+  : identifier list -> pattern Position.located -> identifier list
-  = fun vars Position.{ value; position; } ->
+  =
-  failwith "Students! This is your job!"
+  fun vars Position.{ value; position } -> failwith "Students! This is your job!"
+;;
 
 (** Type-checking code *)
 
-let check_type_scheme :
+let check_type_scheme
-      HopixTypes.typing_environment ->
+  :  HopixTypes.typing_environment -> Position.t -> HopixAST.type_scheme
-      Position.t ->
+  -> HopixTypes.aty_scheme * HopixTypes.typing_environment
-      HopixAST.type_scheme ->
+  =
-      HopixTypes.aty_scheme * HopixTypes.typing_environment
+  fun env pos (ForallTy (ts, ty)) -> failwith "Students! This is your job!"
-  = fun env pos (ForallTy (ts, ty)) ->
+;;
-  failwith "Students! This is your job!"
 
 let synth_literal : HopixAST.literal -> HopixTypes.aty =
-  fun l ->
+  fun l -> failwith "Students! This is your job!"
+;;
+
+let rec check_pattern
+  :  HopixTypes.typing_environment -> HopixAST.pattern Position.located -> HopixTypes.aty
+  -> HopixTypes.typing_environment
+  =
+  fun env Position.({ value = p; position = pos } as pat) expected ->
   failwith "Students! This is your job!"
 
-let rec check_pattern :
+and synth_pattern
-          HopixTypes.typing_environment ->
+  :  HopixTypes.typing_environment -> HopixAST.pattern Position.located
-          HopixAST.pattern Position.located ->
+  -> HopixTypes.aty * HopixTypes.typing_environment
-          HopixTypes.aty ->
+  =
-          HopixTypes.typing_environment
+  fun env Position.{ value = p; position = pos } -> failwith "Students! This is your job!"
-  = fun env Position.({ value = p; position = pos; } as pat) expected ->
+;;
+
+let rec synth_expression
+  :  HopixTypes.typing_environment -> HopixAST.expression Position.located
+  -> HopixTypes.aty
+  =
+  fun env Position.{ value = e; position = pos } -> failwith "Students! This is your job!"
+
+and check_expression
+  :  HopixTypes.typing_environment -> HopixAST.expression Position.located
+  -> HopixTypes.aty -> unit
+  =
+  fun env (Position.{ value = e; position = pos } as exp) expected ->
   failwith "Students! This is your job!"
 
-and synth_pattern :
+and check_value_definition
-      HopixTypes.typing_environment ->
+  :  HopixTypes.typing_environment -> HopixAST.value_definition
-      HopixAST.pattern Position.located ->
+  -> HopixTypes.typing_environment
-      HopixTypes.aty * HopixTypes.typing_environment
+  =
-  = fun env Position.{ value = p; position = pos; } ->
+  fun env def -> failwith "Students! This is your job!"
-  failwith "Students! This is your job!"
+;;
-
-let rec synth_expression :
-      HopixTypes.typing_environment ->
-      HopixAST.expression Position.located ->
-      HopixTypes.aty
-  = fun env Position.{ value = e; position = pos; } ->
-  failwith "Students! This is your job!"
-
-and check_expression :
-      HopixTypes.typing_environment ->
-      HopixAST.expression Position.located ->
-      HopixTypes.aty ->
-      unit
-  = fun env (Position.{ value = e; position = pos; } as exp) expected ->
-  failwith "Students! This is your job!"
-
-and check_value_definition :
-      HopixTypes.typing_environment ->
-      HopixAST.value_definition ->
-      HopixTypes.typing_environment
-  = fun env def ->
-  failwith "Students! This is your job!"
 
 let check_definition env = function
-  | DefineValue vdef ->
+  | DefineValue vdef -> check_value_definition env vdef
-     check_value_definition env vdef
-
   | DefineType (t, ts, tdef) ->
-     let ts = List.map Position.value ts in
+    let ts = List.map Position.value ts in
-     HopixTypes.bind_type_definition (Position.value t) ts tdef env
+    HopixTypes.bind_type_definition (Position.value t) ts tdef env
-
   | DeclareExtern (x, tys) ->
-     let tys, _ = Position.located_pos (check_type_scheme env) tys in
+    let tys, _ = Position.located_pos (check_type_scheme env) tys in
-     HopixTypes.bind_value (Position.value x) tys env
+    HopixTypes.bind_value (Position.value x) tys env
+;;
 
 let typecheck env program =
-  List.fold_left
+  List.fold_left (fun env d -> Position.located (check_definition env) d) env program
-    (fun env d -> Position.located (check_definition env) d)
+;;
-    env program
 
 type typing_environment = HopixTypes.typing_environment
 
 let initial_typing_environment = HopixTypes.initial_typing_environment
-
 let print_typing_environment = HopixTypes.string_of_typing_environment