diff --git a/lib/02_parsing/Ast.ml b/lib/02_parsing/Ast.ml index 85a0507..03472a5 100644 --- a/lib/02_parsing/Ast.ml +++ b/lib/02_parsing/Ast.ml @@ -131,19 +131,16 @@ and statement_desc = and declaration = { declaration_loc : Pinc_Diagnostics.Location.t; declaration_kind : declaration_kind; -} - -and declaration_kind = - | Declaration_Component of declaration_desc - | Declaration_Library of declaration_desc - | Declaration_Page of declaration_desc - | Declaration_Store of declaration_desc - -and declaration_desc = { declaration_attributes : expression StringMap.t; declaration_body : expression; } +and declaration_kind = + | Declaration_Component + | Declaration_Library + | Declaration_Page + | Declaration_Store + and t = declaration StringMap.t module Declaration = struct diff --git a/lib/02_parsing/Parser.ml b/lib/02_parsing/Parser.ml index 597af53..a84e947 100644 --- a/lib/02_parsing/Parser.ml +++ b/lib/02_parsing/Parser.ml @@ -816,53 +816,49 @@ module Rules = struct and parse_declaration t = let declaration_start = t.token.location in - let* identifier, declaration_kind = + let* declaration_kind = match t.token.typ with - | ( Token.KEYWORD_PAGE - | Token.KEYWORD_COMPONENT - | Token.KEYWORD_LIBRARY - | Token.KEYWORD_STORE ) as typ -> ( - next t; - let identifier = Helpers.expect_identifier ~typ:`Upper t |> fst in - let declaration_attributes = - if optional Token.LEFT_PAREN t then ( - let attributes = - Helpers.separated_list ~sep:Token.COMMA ~fn:parse_attribute t - in - t |> expect Token.RIGHT_PAREN; - attributes) - else - [] - in - let declaration_body = t |> parse_expression in - match declaration_body with - | None -> - Diagnostics.raise_error - t.token.location - "Expected declaration to have a body" - | Some declaration_body -> ( - let declaration_desc = - Parsetree.{ declaration_attributes; declaration_body } - in - match typ with - | Token.KEYWORD_PAGE -> - Some (identifier, Parsetree.P_Declaration_Page declaration_desc) - | Token.KEYWORD_COMPONENT -> - Some (identifier, Parsetree.P_Declaration_Component declaration_desc) - | Token.KEYWORD_STORE -> - Some (identifier, Parsetree.P_Declaration_Store declaration_desc) - | Token.KEYWORD_LIBRARY -> - Some (identifier, Parsetree.P_Declaration_Library declaration_desc) - | _ -> assert false)) + | Token.KEYWORD_PAGE -> + next t; + Some Parsetree.P_Declaration_Page + | Token.KEYWORD_COMPONENT -> + next t; + Some Parsetree.P_Declaration_Component + | Token.KEYWORD_STORE -> + next t; + Some Parsetree.P_Declaration_Store + | Token.KEYWORD_LIBRARY -> + next t; + Some Parsetree.P_Declaration_Library | Token.END_OF_INPUT -> None | _ -> Diagnostics.raise_error t.token.location "Expected to see a declaration (page, component, store or library)." in + + let identifier = Helpers.expect_identifier ~typ:`Upper t |> fst in + let declaration_attributes = + if optional Token.LEFT_PAREN t then ( + let attributes = Helpers.separated_list ~sep:Token.COMMA ~fn:parse_attribute t in + t |> expect Token.RIGHT_PAREN; + attributes) + else + [] + in + let declaration_body = + match t |> parse_expression with + | None -> + Diagnostics.raise_error t.token.location "Expected declaration to have a body" + | Some declaration_body -> declaration_body + in + let declaration_end = t.token.location in let declaration_loc = Location.merge ~s:declaration_start ~e:declaration_end () in - (identifier, Parsetree.{ declaration_loc; declaration_kind }) |> Option.some + ( identifier, + Parsetree. + { declaration_loc; declaration_kind; declaration_attributes; declaration_body } ) + |> Option.some ;; end diff --git a/lib/02_parsing/Parsetree.ml b/lib/02_parsing/Parsetree.ml index 6ce64eb..7ee9bce 100644 --- a/lib/02_parsing/Parsetree.ml +++ b/lib/02_parsing/Parsetree.ml @@ -126,19 +126,16 @@ and statement_desc = and declaration = { declaration_loc : Pinc_Diagnostics.Location.t; declaration_kind : declaration_kind; -} - -and declaration_kind = - | P_Declaration_Component of declaration_desc - | P_Declaration_Library of declaration_desc - | P_Declaration_Page of declaration_desc - | P_Declaration_Store of declaration_desc - -and declaration_desc = { declaration_attributes : (string * expression) list; declaration_body : expression; } +and declaration_kind = + | P_Declaration_Component + | P_Declaration_Library + | P_Declaration_Page + | P_Declaration_Store + and t = (string * declaration) list module Declaration = struct diff --git a/lib/02_parsing/Transformer.ml b/lib/02_parsing/Transformer.ml index 8fce0c1..e32594f 100644 --- a/lib/02_parsing/Transformer.ml +++ b/lib/02_parsing/Transformer.ml @@ -559,51 +559,27 @@ and transform_statement env (statement : Parsetree.statement) = in (env, { statement_loc = statement.statement_loc; statement_desc = desc }) -and transform_component_declaration env (declaration : Parsetree.declaration_desc) = - let env, declaration_attributes = - declaration.declaration_attributes - |> StringMap.of_list - |> StringMap.fold_map ~init:env ~f:transform_expression - in - let env, declaration_body = transform_expression env declaration.declaration_body in - (env, Declaration_Component { declaration_attributes; declaration_body }) - -and transform_library_declaration env (declaration : Parsetree.declaration_desc) = - let env, declaration_attributes = - declaration.declaration_attributes - |> StringMap.of_list - |> StringMap.fold_map ~init:env ~f:transform_expression - in - let env, declaration_body = transform_expression env declaration.declaration_body in - (env, Declaration_Library { declaration_attributes; declaration_body }) - -and transform_page_declaration env (declaration : Parsetree.declaration_desc) = - let env, declaration_attributes = - declaration.declaration_attributes - |> StringMap.of_list - |> StringMap.fold_map ~init:env ~f:transform_expression +and transform_declaration env (declaration : Parsetree.declaration) = + let declaration_kind = + match declaration.declaration_kind with + | P_Declaration_Component -> Declaration_Component + | P_Declaration_Library -> Declaration_Library + | P_Declaration_Page -> Declaration_Page + | P_Declaration_Store -> Declaration_Store in - let env, declaration_body = transform_expression env declaration.declaration_body in - (env, Declaration_Page { declaration_attributes; declaration_body }) - -and transform_store_declaration env (declaration : Parsetree.declaration_desc) = let env, declaration_attributes = declaration.declaration_attributes |> StringMap.of_list |> StringMap.fold_map ~init:env ~f:transform_expression in let env, declaration_body = transform_expression env declaration.declaration_body in - (env, Declaration_Store { declaration_attributes; declaration_body }) - -and transform_declaration env (declaration : Parsetree.declaration) = - let env, declaration_kind = - match declaration.declaration_kind with - | P_Declaration_Component desc -> transform_component_declaration env desc - | P_Declaration_Library desc -> transform_library_declaration env desc - | P_Declaration_Page desc -> transform_page_declaration env desc - | P_Declaration_Store desc -> transform_store_declaration env desc - in - (env, { declaration_loc = declaration.declaration_loc; declaration_kind }) + ( env, + { + declaration_loc = declaration.declaration_loc; + declaration_kind; + declaration_attributes; + declaration_body; + } ) and transform_declarations env declarations = declarations diff --git a/lib/pinc_backend/DeclarationEvaluator.ml b/lib/pinc_backend/DeclarationEvaluator.ml index dde6ab2..3ed072c 100644 --- a/lib/pinc_backend/DeclarationEvaluator.ml +++ b/lib/pinc_backend/DeclarationEvaluator.ml @@ -1,14 +1,7 @@ let eval ~eval_expression ~state declaration = state.Types.Type_State.declarations |> StringMap.find_opt declaration |> function - | Some - { - Pinc_Parser.Ast.declaration_kind = - ( Declaration_Component { declaration_body; _ } - | Declaration_Library { declaration_body; _ } - | Declaration_Page { declaration_body; _ } - | Declaration_Store { declaration_body; _ } ); - _; - } -> eval_expression ~state declaration_body + | Some { Pinc_Parser.Ast.declaration_body; _ } -> + eval_expression ~state declaration_body | None -> Pinc_Diagnostics.raise_error Pinc_Diagnostics.Location.none diff --git a/lib/pinc_backend/Helpers.ml b/lib/pinc_backend/Helpers.ml index 7ed4165..5729a84 100644 --- a/lib/pinc_backend/Helpers.ml +++ b/lib/pinc_backend/Helpers.ml @@ -154,10 +154,10 @@ module Expect = struct StringMap.fold (fun id decl acc -> match (typ, decl.Pinc_Parser.Ast.declaration_kind) with - | (`All | `Component), Declaration_Component _ -> id :: acc - | (`All | `Library), Declaration_Library _ -> id :: acc - | (`All | `Page), Declaration_Page _ -> id :: acc - | (`All | `Store), Declaration_Store _ -> id :: acc + | (`All | `Component), Declaration_Component -> id :: acc + | (`All | `Library), Declaration_Library -> id :: acc + | (`All | `Page), Declaration_Page -> id :: acc + | (`All | `Store), Declaration_Store -> id :: acc | _ -> acc) declarations [] diff --git a/lib/pinc_backend/Interpreter.ml b/lib/pinc_backend/Interpreter.ml index 2149579..3beee9a 100644 --- a/lib/pinc_backend/Interpreter.ml +++ b/lib/pinc_backend/Interpreter.ml @@ -18,13 +18,14 @@ let rec get_uppercase_identifier_typ ~state ident = let declaration = state.declarations |> StringMap.find_opt ident in match declaration with | None -> (state, None) - | Some { declaration_kind = Ast.Declaration_Component _; _ } -> + | Some { declaration_kind = Ast.Declaration_Component; _ } -> (state, Some Definition_Component) - | Some { declaration_kind = Ast.Declaration_Page _; _ } -> (state, Some Definition_Page) + | Some { declaration_kind = Ast.Declaration_Page; _ } -> (state, Some Definition_Page) | Some { - declaration_kind = - Ast.Declaration_Store { declaration_attributes; declaration_body }; + declaration_kind = Ast.Declaration_Store; + declaration_attributes; + declaration_body; _; } -> ( match Hashtbl.find_opt stores ident with @@ -57,7 +58,7 @@ let rec get_uppercase_identifier_typ ~state ident = let store = Type_Store.make ~singleton ~body:declaration_body in add_store ~store ~ident; (state, Some (Definition_Store store))) - | Some { declaration_kind = Ast.Declaration_Library { declaration_body; _ }; _ } -> ( + | Some { declaration_kind = Ast.Declaration_Library; declaration_body; _ } -> ( match Hashtbl.find_opt libraries ident with | Some library -> (state, Some (Definition_Library library)) | None -> @@ -1383,20 +1384,20 @@ let eval_meta sources = |> StringMap.map (function | { declaration_loc; - declaration_kind = Declaration_Component { declaration_attributes; _ }; + declaration_kind = Declaration_Component; + declaration_attributes; + _; } -> `Component (declaration_loc, eval declaration_attributes) | { declaration_loc; - declaration_kind = Declaration_Library { declaration_attributes; _ }; + declaration_kind = Declaration_Library; + declaration_attributes; + _; } -> `Library (declaration_loc, eval declaration_attributes) - | { - declaration_loc; - declaration_kind = Declaration_Page { declaration_attributes; _ }; - } -> `Page (declaration_loc, eval declaration_attributes) - | { - declaration_loc; - declaration_kind = Declaration_Store { declaration_attributes; _ }; - } -> `Store (declaration_loc, eval declaration_attributes)) + | { declaration_loc; declaration_kind = Declaration_Page; declaration_attributes; _ } + -> `Page (declaration_loc, eval declaration_attributes) + | { declaration_loc; declaration_kind = Declaration_Store; declaration_attributes; _ } + -> `Store (declaration_loc, eval declaration_attributes)) ;; let eval_declarations @@ -1407,7 +1408,7 @@ let eval_declarations Hashtbl.reset Tag.Tag_Portal.portals; (match declarations |> StringMap.find_opt root with - | Some { Ast.declaration_kind = Declaration_Library _ | Declaration_Store _; _ } -> + | Some { Ast.declaration_kind = Declaration_Library | Declaration_Store; _ } -> raise_notrace (Invalid_argument (root ^ " can not be evaluated")) | _ -> ()); diff --git a/lib/pinc_format/Formatter.ml b/lib/pinc_format/Formatter.ml index c49093b..9923481 100644 --- a/lib/pinc_format/Formatter.ml +++ b/lib/pinc_format/Formatter.ml @@ -451,48 +451,21 @@ and format_statement (statement : Parsetree.statement) = | P_MutationStatement (id, expr) -> format_mutation id expr | P_ExpressionStatement s -> format_expression_stmt s -and format_component_declaration key (declaration : Parsetree.declaration_desc) = - let attributes = - Helpers.comma_separated_attributes - format_expression - declaration.declaration_attributes - in - let body = format_expression declaration.declaration_body in - string "component" ^^ blank 1 ^^ string key ^^ parens attributes ^^ blank 1 ^^ body - -and format_library_declaration key (declaration : Parsetree.declaration_desc) = - let attributes = - Helpers.comma_separated_attributes - format_expression - declaration.declaration_attributes - in - let body = format_expression declaration.declaration_body in - string "library" ^^ blank 1 ^^ string key ^^ parens attributes ^^ blank 1 ^^ body - -and format_page_declaration key (declaration : Parsetree.declaration_desc) = - let attributes = - Helpers.comma_separated_attributes - format_expression - declaration.declaration_attributes +and format_declaration key (declaration : Parsetree.declaration) = + let typ = + match declaration.declaration_kind with + | P_Declaration_Component -> string "component" + | P_Declaration_Library -> string "library" + | P_Declaration_Page -> string "page" + | P_Declaration_Store -> string "store" in - let body = format_expression declaration.declaration_body in - string "page" ^^ blank 1 ^^ string key ^^ parens attributes ^^ blank 1 ^^ body - -and format_store_declaration key (declaration : Parsetree.declaration_desc) = let attributes = Helpers.comma_separated_attributes format_expression declaration.declaration_attributes in let body = format_expression declaration.declaration_body in - string "store" ^^ blank 1 ^^ string key ^^ parens attributes ^^ blank 1 ^^ body - -and format_declaration key (declaration : Parsetree.declaration) = - match declaration.declaration_kind with - | P_Declaration_Component desc -> format_component_declaration key desc - | P_Declaration_Library desc -> format_library_declaration key desc - | P_Declaration_Page desc -> format_page_declaration key desc - | P_Declaration_Store desc -> format_store_declaration key desc + typ ^^ blank 1 ^^ string key ^^ parens attributes ^^ blank 1 ^^ body and format_declarations declarations = let declarations =