Validate top level clauses in Sakura files

Author: EduardoLR10

lib/Executor.ml

@@ -8,11 +8,6 @@ let parse : string -> Ast.ParserClause.t list attempt = function
       if in_channel_length inc = 0 then error @@ Error.EmptyFile str
       else ok @@ Parser.parse str (In_channel.input_all inc)
 
-let preprocess (preprocessor : Preprocessor.t) :
-    Ast.ParserClause.t list -> Preprocessor.output attempt =
- fun decls_queries ->
-  ok @@ Preprocessor.group_clauses preprocessor decls_queries
-
 let compile' (step : Ast.Clause.t list * Compiler.Types.t -> Compiler.Types.t)
     (compiler : Compiler.Types.t) :
     Ast.Clause.t list -> Compiler.Types.t attempt =
@@ -44,23 +39,27 @@ end
 type preprocessed_files = Ast.Clause.t BatFingerTree.t BatMap.String.t
 type preprocessed_result = Preprocessor.DependencyGraph.t * preprocessed_files
 
+let preprocess filepath =
+  Error.map @@ Preprocessor.run (Preprocessor.initialize filepath)
+
 (* FIXME: hook up dependency information and sort the file list before compiling *)
 (* TODO: compilation cache *)
 let compile ({ sakura_module_name } : Compiler.Types.cli)
     (persist : Compiler.Types.Persist.t) (filepaths : string list) :
     unit attempt =
-  let is_sakura_file filepath = Filename.extension filepath = ".skr" in
   let sakura_filename = sakura_module_name ^ ".skr" in
-  let sakura_files, karuta_files = BatList.partition is_sakura_file filepaths in
+  let sakura_files, karuta_files =
+    BatList.partition Preprocessor.is_sakura_file filepaths
+  in
   let* sakura_output =
     sakura_files
     |> Error.fold (fun parsed filepath ->
         parse filepath |> Error.map (List.append parsed))
-    ||> preprocess (Preprocessor.initialize sakura_filename)
+    |> preprocess sakura_filename
   in
   let compile_one_file (preprocessed : preprocessed_files) filepath externals =
     let compiler_config =
-      if is_sakura_file filepath then
+      if Preprocessor.is_sakura_file filepath then
         (module Sakura : Compiler.Types.COMPILER_CONFIG)
       else (module Karuta : Compiler.Types.COMPILER_CONFIG)
     in
@@ -81,7 +80,7 @@ let compile ({ sakura_module_name } : Compiler.Types.cli)
       { (Preprocessor.initialize filepath) with dependencies }
     in
     let* { dependencies; clauses } =
-      filepath |> parse ||> preprocess preprocessor
+      filepath |> parse |> Error.map @@ Preprocessor.run preprocessor
     in
     ok (dependencies, BatMap.String.add filepath clauses preprocessed)
   in

lib/Preprocessor.ml

@@ -462,3 +462,26 @@ and group_clauses ({ dependencies; _ } as preprocessor : t)
   |> List.map check_empty_heads |> List.group compare_clauses
   |> fold_map preprocessor.dependencies multi_mapper
   |> map_clauses (BatFingerTree.sort canonical_order)
+
+let is_sakura_file filepath = Filename.extension filepath = ".skr"
+
+let validate_top_level (clauses : Ast.ParserClause.t list) :
+    Ast.ParserClause.t list =
+  let open Ast.ParserClause in
+  let open Location in
+  let is_not_directive = function
+    | { content = Declaration _; _ } -> true
+    | { content = QueryConjunction _; _ } -> true
+    | { content = Directive _; _ } -> false
+  in
+  match List.find_opt is_not_directive clauses with
+  | None -> clauses
+  | Some { loc; _ } ->
+      Logger.error loc "Found a non-directive in a Sakura file";
+      exit 1
+
+let run ({ filename; _ } as preprocessor : t)
+    (clauses : Ast.ParserClause.t list) : output =
+  if is_sakura_file filename then
+    validate_top_level clauses |> group_clauses preprocessor
+  else group_clauses preprocessor clauses

lib/database/Directive.ml

@@ -7,9 +7,13 @@ let compile (directive_loc : Location.location)
     (initialize_nested : Compiler.Types.initialize_nested) : t =
   let module Lookup = (val compiler.lookup) in
   match (Ast.Expr.extract_func_label func, arity, body) with
-  | "module", _, _ | "signature", _, _ ->
+  | "module", _, _ ->
       Shared.Directive.compile directive_loc func body step compiler
         initialize_nested
+  | "signature", _, _ ->
+      Logger.error directive_loc
+        "TODO: Sakura has special treatment for signatures";
+      exit 1
   | "project", 0, _ ->
       Logger.error directive_loc "Sakura does not support project directive";
       exit 1