Something went wrong. Try again.
A component based functional template language
Something went wrong. Try again.
35 kB · 986 lines
OCaml
at compiler
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987module Parsetree = Parsetreemodule Diagnostics = Pinc_diagnosticsmodule Operators = Pinc_types.Operatorsopen Diagnostics
type t = { lexer : Lexer.t; mutable prev_token : Token.t; mutable token : Token.t; next : Token.t Queue.t;}
let ( let* ) = Option.bind
let get_next_token t = match Queue.take_opt t.next with | None -> Lexer.scan t.lexer | Some token -> token;;
let next t = let token = get_next_token t in t.prev_token <- t.token; t.token <- token;;
let current_non_annotation_token t = let rec loop token = match token.Token.typ with | Token.COMMENT _ | Token.BLANKLINE -> let token = Lexer.scan t.lexer in Queue.add token t.next; loop token | t -> t in loop t.token;;
let peek t = let token = match Queue.peek_opt t.next with | None -> let token = Lexer.scan t.lexer in Queue.add token t.next; token | Some token -> token in token.typ;;
let peek_2 t = let token = match Queue.to_seq t.next |> List.of_seq with | [] -> let token = Lexer.scan t.lexer in Queue.add token t.next; let token = Lexer.scan t.lexer in Queue.add token t.next; token | [ _ ] -> let token = Lexer.scan t.lexer in Queue.add token t.next; token | _ :: token :: _ -> token in token.typ;;
let optional token t = let test = t.token.typ = token in if test then next t; test;;
let expect token t = let test = t.token.typ = token in if test then next t else Diagnostics.raise_error t.token.location (Printf.sprintf "Expected: `%s`, got `%s`" (Token.to_string token) (Token.to_string t.token.typ));;
let make source = let lexer = Lexer.make source in let initial_pos = Location.Position.make ~source ~line:0 ~column:0 in let location = Location.make ~s:initial_pos () in let initial_token = Token.make ~indentation:0 ~location Token.END_OF_INPUT in let t = { lexer; prev_token = initial_token; token = initial_token; next = Queue.create () } in next t; t;;
module Helpers = struct let expect_identifier ?error_message ?(typ = `All) t = let location = t.token.location in match t.token.typ with | Token.IDENT_UPPER i when typ = `Upper || typ = `All -> next t; (i, location) | Token.IDENT_LOWER i when typ = `Lower || typ = `All -> next t; (i, location) | token when typ = `Lower -> Diagnostics.raise_error location (match (error_message, token) with | Some message, _ -> message | None, Token.IDENT_UPPER i -> "Expected to see a lowercase identifier at this point. Did you mean " ^ String.lowercase_ascii i ^ " instead of " ^ i ^ "?" | None, t -> "Expected to see a lowercase identifier at this point. Instead saw " ^ Token.to_string t) | token when typ = `Upper -> Diagnostics.raise_error location (match (error_message, token) with | Some message, _ -> message | None, Token.IDENT_LOWER i -> "Expected to see an uppercase identifier at this point. Did you mean " ^ String.capitalize_ascii i ^ " instead of " ^ i ^ "?" | None, _ -> "Expected to see an uppercase identifier at this point.") | token -> Diagnostics.raise_error location (match (error_message, token) with | Some message, _ -> message | None, t when Token.is_keyword t -> "\"" ^ Token.to_string t ^ "\" is a keyword. Please choose another name." | None, _ -> "Expected to see an identifier at this point.") ;;
let separated_list ~sep ~fn t = let rec loop acc = let has_sep = optional sep t in match fn t with | Some r -> if has_sep || acc = [] then loop (r :: acc) else Diagnostics.raise_error t.token.location ("Expected list to be separated by `" ^ Token.to_string sep ^ "`") | None -> List.rev acc in loop [] ;;
let list ~fn t = let rec loop acc = match fn t with | Some r -> loop (r :: acc) | None -> List.rev acc in loop [] ;;end
module Rules = struct let rec parse_annotations t = let rec loop acc = match t.token.typ with | Token.COMMENT s -> next t; loop (Parsetree.P_Comment_Annotation s :: acc) | Token.BLANKLINE when peek t = Token.BLANKLINE -> next t; loop acc | Token.BLANKLINE -> next t; loop (Parsetree.P_Blankline_Annotation :: acc) | _ -> List.rev acc in loop []
and parse_string_template t = let string_template_start = t.token.location in let* string_template_desc = match t.token.typ with | Token.STRING s -> next t; Some (Parsetree.P_StringText s) | Token.OPEN_TEMPLATE_LITERAL -> next t; let identifier = t |> Helpers.expect_identifier ~typ:`Lower ~error_message: "Only lowercase identifiers are allowed as string interpolation \ placeholders.\n\ If you want to use more complex constructs, you can always assign \ them to a let binding." in t |> expect Token.RIGHT_PAREN; Some (Parsetree.P_StringInterpolation (P_Lowercase_Id identifier)) | _ -> None in let string_template_end = t.token.location in let string_template_loc = Location.merge ~s:string_template_start ~e:string_template_end () in Parsetree.{ string_template_desc; string_template_loc } |> Option.some
and parse_fn_param t = match t.token.typ with | Token.IDENT_LOWER key -> let location = t.token.location in next t; Some (Parsetree.P_Lowercase_Id (key, location)) | _ -> None
and parse_attribute ?(sep = Token.COLON) t = match t.token.typ with | Token.IDENT_LOWER key -> next t; expect sep t; let value = parse_expression t in value |> Option.map (fun value -> (key, value)) | _ -> None
and parse_record_field t = match t.token.typ with | Token.IDENT_LOWER key -> next t; let requirement = if optional Token.QUESTIONMARK t then `Optional else `Required in expect Token.COLON t; let value = parse_expression t in value |> Option.map (fun value -> (key, (requirement, value))) | _ -> None
and parse_block t = let expression_annotations = parse_annotations t in let expr_start = t.token.location in let* expression_parenthesized, expression_desc = match t.token.typ with | Token.LEFT_BRACE -> next t; let rec get_statements acc = match parse_statement t with | Some r when optional Token.SEMICOLON t -> get_statements (r :: acc) | Some r -> List.rev (r :: acc) | _ -> List.rev acc in let statements = get_statements [] in t |> expect Token.RIGHT_BRACE; (false, Parsetree.P_BlockExpression statements) |> Option.some | _ -> let* expr = parse_expression t in (expr.Parsetree.expression_parenthesized, expr.Parsetree.expression_desc) |> Option.some in let expr_end = t.token.location in let expression_loc = Location.merge ~s:expr_start ~e:expr_end () in Parsetree. { expression_desc; expression_loc; expression_annotations; expression_parenthesized; } |> Option.some
and parse_tag ~name t = let start_token = t.token in let attributes = if t |> optional Token.LEFT_PAREN then ( let res = t |> Helpers.separated_list ~fn:parse_attribute ~sep:Token.COMMA in t |> expect Token.RIGHT_PAREN; res) else [] in let tag = match name with | "String" -> Parsetree.P_Tag_String | "Int" -> Parsetree.P_Tag_Int | "Float" -> Parsetree.P_Tag_Float | "Boolean" -> Parsetree.P_Tag_Boolean | "Array" -> Parsetree.P_Tag_Array | "Record" -> Parsetree.P_Tag_Record | "Slot" -> Parsetree.P_Tag_Slot | "Store" -> Parsetree.P_Tag_Store | "SetContext" -> Parsetree.P_Tag_SetContext | "GetContext" -> Parsetree.P_Tag_GetContext | other -> Parsetree.P_Tag_Custom other in let tag_loc = Location.merge ~s:start_token.location ~e:t.token.location () in let tag_desc = Parsetree.{ tag; attributes } in Parsetree.P_TagExpression Parsetree.{ tag_loc; tag_desc } |> Option.some
and parse_template_node t = let template_node_annotations = parse_annotations t in let node_start = t.token in let indentation = t.token.indentation in let* template_node_desc = match t.token.typ with | Token.Html_TEXT text_template_node_text -> next t; Some (Parsetree.P_TextTemplateNode text_template_node_text) | Token.LEFT_BRACE -> let start_token = t.token in next t; let comment = match t.token.typ with | Token.COMMENT s -> Some s | _ -> None in let template_node = match parse_expression t with | Some template_expression_node_expression -> Parsetree.P_ExpressionTemplateNode template_expression_node_expression | None -> ( let location = Location.merge ~s:start_token.location ~e:t.token.location () in match comment with | None -> Diagnostics.warn location "Expected to see an expression between these braces. \n\ This is currently not doing anything, so you can safely remove it.\n\ If you wanted to have an empty record here, you need to write \ `{{}}`"; Parsetree.P_ExpressionTemplateNode Parsetree. { expression_loc = location; expression_desc = Parsetree.P_Record []; expression_parenthesized = false; expression_annotations = []; } | Some comment -> Parsetree.P_TemplateComment comment) in t |> expect Token.RIGHT_BRACE; Some template_node | Token.PORTAL_OPEN_TAG portal_tag_name -> next t; let portal_tag_attributes = t |> Helpers.list ~fn:(parse_attribute ~sep:Token.EQUAL) in t |> expect Token.Html_OR_COMPONENT_TAG_SELF_CLOSING; Some (Parsetree.P_PortalTemplateNode { portal_tag_name; portal_tag_attributes }) | Token.Html_OPEN_TAG html_tag_identifier -> next t; let html_tag_attributes = t |> Helpers.list ~fn:(parse_attribute ~sep:Token.EQUAL) in let html_tag_self_closing = t |> optional Token.Html_OR_COMPONENT_TAG_SELF_CLOSING in let html_tag_children = if html_tag_self_closing then [] else ( t |> expect Token.Html_OR_COMPONENT_TAG_END; let children = t |> Helpers.list ~fn:parse_template_node in t |> expect (Token.Html_CLOSE_TAG html_tag_identifier); children) in Some (Parsetree.P_HtmlTemplateNode { html_tag_identifier; html_tag_attributes; html_tag_children }) | Token.Html_OPEN_FRAGMENT -> next t; let fragement_children = t |> Helpers.list ~fn:parse_template_node in t |> expect Token.Html_CLOSE_FRAGMENT; Some (Parsetree.P_FragmentTemplateNode fragement_children) | Token.COMPONENT_OPEN_TAG identifier -> let component_tag_identifier = Parsetree.P_Uppercase_Id (identifier, t.token.location) in next t; let component_tag_attributes = t |> Helpers.list ~fn:(parse_attribute ~sep:Token.EQUAL) in let component_tag_self_closing = t |> optional Token.Html_OR_COMPONENT_TAG_SELF_CLOSING in let component_tag_children = if component_tag_self_closing then [] else ( t |> expect Token.Html_OR_COMPONENT_TAG_END; let children = t |> Helpers.list ~fn:parse_template_node in t |> expect (Token.COMPONENT_CLOSE_TAG identifier); children) in Some (Parsetree.P_ComponentTemplateNode { component_tag_identifier; component_tag_attributes; component_tag_children; }) | Token.Html_DOCTYPE text_template_node_text -> next t; Some (Parsetree.P_TextTemplateNode text_template_node_text) | _ -> None in let node_end = t.prev_token in let template_node_loc = Location.merge ~s:node_start.location ~e:node_end.location () in let template_node_indent = indentation in Parsetree. { template_node_desc; template_node_loc; template_node_annotations; template_node_indent; } |> Option.some
and parse_statement t = let statement_annotations = parse_annotations t in let statement_start = t.token in let* statement_desc = match t.token.typ with (* PARSING BREAK STATEMENT *) | Token.KEYWORD_BREAK -> next t; Some Parsetree.P_BreakStatement (* PARSING CONTINUE STATEMENT *) | Token.KEYWORD_CONTINUE -> next t; Some Parsetree.P_ContinueStatement (* PARSING LET STATEMENT *) | Token.KEYWORD_LET -> let rec parse_let_definitions ~expect_function acc t = let start_token = t.token in next t; let is_mutable = t |> optional Token.KEYWORD_MUTABLE in let identifier = Helpers.expect_identifier ~typ:`Lower t in let is_optional = t |> optional Token.QUESTIONMARK in t |> expect Token.EQUAL; let end_token = t.token in let expression = match parse_expression t with | Some expression -> expression | None -> Diagnostics.raise_error (Location.merge ~s:start_token.location ~e:end_token.location ()) "Expected expression as right hand side of let declaration" in let let_definition = (~is_optional, ~is_mutable, Parsetree.P_Lowercase_Id identifier, expression) in let is_function = match expression.expression_desc with | Parsetree.P_Function _ -> true | _ when expect_function -> Diagnostics.raise_error expression.expression_loc "All expressions in `let ... and` declarations must be function \ definitions" | _ -> false in match current_non_annotation_token t with | Token.KEYWORD_AND when is_function -> let () = ignore @@ parse_annotations t in parse_let_definitions ~expect_function:true (let_definition :: acc) t | Token.KEYWORD_AND -> Diagnostics.raise_error expression.expression_loc "All expressions in `let ... and` declarations must be function \ definitions" | _ -> List.rev (let_definition :: acc) in let let_definitions = parse_let_definitions ~expect_function:false [] t in let stmt = match let_definitions with | [] -> assert false | [ definition ] -> Parsetree.P_LetStatement definition | definitions -> Parsetree.P_LetGroupStatement definitions in Some stmt (* PARSING MUTATION STATEMENT *) | Token.IDENT_LOWER identifier when peek t = Token.COLON_EQUAL -> let start_token = t.token in let identifier_location = t.token.location in next t; next t; let end_token = t.token in let expression = match parse_expression t with | Some expression -> expression | None -> Diagnostics.raise_error (Location.merge ~s:start_token.location ~e:end_token.location ()) "Expected expression as right hand side of mutation statement" in Some (Parsetree.P_MutationStatement (P_Lowercase_Id (identifier, identifier_location), expression)) | _ -> let* expr = parse_expression t in Some (Parsetree.P_ExpressionStatement expr) in let statement_end = t.token in let statement_loc = Location.merge ~s:statement_start.location ~e:statement_end.location () in Parsetree.{ statement_desc; statement_loc; statement_annotations } |> Option.some
and parse_unary_expression t = let* operator = match t.token.typ with | Token.NOT -> Some Operators.Unary.NOT | Token.MINUS -> Some Operators.Unary.MINUS | _ -> None in next t; let* argument = parse_expression ~prio:(Operators.Unary.get_precedence operator) t in Parsetree.P_UnaryExpression (operator, argument) |> Option.some
and parse_expression_part t = let expression_annotations = parse_annotations t in let expr_start = t.token.location in let* expression_parenthesized, expression_desc, expr_end = match t.token.typ with (* PARSING PARENTHESIZED EXPRESSION *) | Token.LEFT_PAREN -> next t; let expr = parse_expression t in t |> expect Token.RIGHT_PAREN; let end_location = t.token.location in expr |> Option.map (fun expr -> (true, expr.Parsetree.expression_desc, end_location)) (* PARSING RECORD or BLOCK EXPRESSION *) | Token.LEFT_BRACE -> let is_record = match (peek t, peek_2 t) with | Token.IDENT_LOWER _, (Token.COLON | Token.QUESTIONMARK) -> true | Token.RIGHT_BRACE, _ -> true | _ -> false in if is_record then ( next t; let attrs = t |> Helpers.separated_list ~sep:Token.COMMA ~fn:parse_record_field in t |> expect Token.RIGHT_BRACE; let end_location = t.token.location in Some (false, Parsetree.P_Record attrs, end_location)) else let* expr = parse_block t in let end_location = t.token.location in Some (false, expr.Parsetree.expression_desc, end_location) (* PARSING FOR IN EXPRESSION *) | Token.KEYWORD_FOR -> ( next t; let _ = optional Token.LEFT_PAREN t in let index_or_iterator = Helpers.expect_identifier ~typ:`Lower t in let index, iterator = if optional Token.COMMA t then ( let identifier = Helpers.expect_identifier ~typ:`Lower t in (Some (Parsetree.P_Lowercase_Id index_or_iterator), identifier)) else (None, index_or_iterator) in let iterator = Parsetree.P_Lowercase_Id iterator in expect Token.KEYWORD_IN t; let* expr1 = parse_expression t in let _ = optional Token.RIGHT_PAREN t in let end_location = t.token.location in let body = parse_block t in match body with | None -> Diagnostics.raise_error t.token.location "Expected expression as body of for loop" | Some body -> Some ( false, Parsetree.P_ForInExpression { index; iterator; iterable = expr1; body }, end_location )) (* PARSING FN EXPRESSION *) | Token.KEYWORD_FN -> ( let fn_loc = t.token.location in next t; let open_paren = t |> optional Token.LEFT_PAREN in let parameters = if open_paren then ( let params = t |> Helpers.separated_list ~sep:Token.COMMA ~fn:parse_fn_param in t |> expect Token.RIGHT_PAREN; params) else ( match t |> parse_fn_param with | Some p -> [ p ] | None -> Diagnostics.raise_error fn_loc "Expected this function to have exactly one parameter,\n\ or a `()` if no parameter is needed.") in let end_location = t.token.location in expect Token.ARROW t; match t.token.typ with | Token.EXTERNAL_FUNCTION_SYMBOL name -> let end_location = t.token.location in next t; Option.some @@ (false, Parsetree.P_ExternalFunction { parameters; name }, end_location) | _ -> let* body = t |> parse_block in Option.some @@ (false, Parsetree.P_Function { parameters; body }, end_location)) (* PARSING IF EXPRESSION *) | Token.KEYWORD_IF -> next t; let _ = optional Token.LEFT_PAREN t in let* condition = t |> parse_expression in let end_location = t.token.location in let _ = optional Token.RIGHT_PAREN t in let* consequent = match parse_statement t with | None -> None | Some { statement_loc = _; statement_desc = P_ExpressionStatement e; statement_annotations; } -> Some { e with expression_annotations = statement_annotations @ e.expression_annotations; } | Some ({ statement_loc; statement_annotations; statement_desc = _ } as s) -> Some Parsetree. { expression_loc = statement_loc; expression_desc = P_BlockExpression [ s ]; expression_parenthesized = false; expression_annotations = statement_annotations; } in let alternate = if optional Token.KEYWORD_ELSE t then ( match parse_statement t with | None -> None | Some { statement_loc = _; statement_desc = P_ExpressionStatement e; statement_annotations; } -> Some { e with expression_annotations = statement_annotations @ e.expression_annotations; } | Some ({ statement_loc; statement_annotations; statement_desc = _ } as s) -> Some Parsetree. { expression_loc = statement_loc; expression_desc = P_BlockExpression [ s ]; expression_parenthesized = false; expression_annotations = statement_annotations; }) else None in Option.some @@ ( false, Parsetree.P_ConditionalExpression { condition; consequent; alternate }, end_location ) (* PARSING TAG EXPRESSION *) | Token.TAG name -> let end_location = t.token.location in next t; parse_tag ~name t |> Option.map (fun tag -> (false, tag, end_location)) (* PARSING TEMPLATE EXPRESSION *) | Token.TEMPLATE_NEWLINE | Token.Html_TEXT _ | Token.Html_OPEN_TAG _ | Token.COMPONENT_OPEN_TAG _ | Token.PORTAL_OPEN_TAG _ | Token.Html_OPEN_FRAGMENT | Token.Html_DOCTYPE _ -> let* template_node = parse_template_node t in let end_location = t.token.location in Option.some @@ (false, Parsetree.P_TemplateExpression template_node, end_location) (* PARSING IDENTIFIER EXPRESSION *) | Token.IDENT_LOWER identifier -> let end_location = t.token.location in next t; Option.some @@ (false, Parsetree.P_LowercaseIdentifierExpression identifier, end_location) | Token.IDENT_UPPER identifier -> let end_location = t.token.location in next t; Option.some @@ (false, Parsetree.P_UppercaseIdentifierExpression identifier, end_location) (* PARSING VALUE EXPRESSION *) | Token.DOUBLE_QUOTE -> next t; let s = t |> Helpers.list ~fn:parse_string_template in let end_location = t.token.location in t |> expect Token.DOUBLE_QUOTE; Option.some @@ (false, Parsetree.(P_String s), end_location) | Token.INT i -> let end_location = t.token.location in next t; Option.some @@ (false, Parsetree.(P_Int i), end_location) | Token.CHAR c -> let end_location = t.token.location in next t; Option.some @@ (false, Parsetree.(P_Char c), end_location) | Token.FLOAT f -> let end_location = t.token.location in next t; Option.some @@ (false, Parsetree.(P_Float f), end_location) | Token.KEYWORD_TRUE -> let end_location = t.token.location in next t; Option.some @@ (false, Parsetree.(P_Bool true), end_location) | Token.KEYWORD_FALSE -> let end_location = t.token.location in next t; Option.some @@ (false, Parsetree.(P_Bool false), end_location) | Token.LEFT_BRACK -> next t; let expressions = Helpers.separated_list ~sep:Token.COMMA ~fn:parse_expression t in let end_location = t.token.location in expect Token.RIGHT_BRACK t; Option.some @@ (false, Parsetree.(P_Array expressions), end_location) | _ -> parse_unary_expression t |> Option.map (fun expr -> (false, expr, t.token.location)) in let expression_loc = Location.merge ~s:expr_start ~e:expr_end () in Parsetree. { expression_desc; expression_loc; expression_annotations; expression_parenthesized; } |> Option.some
and parse_binary_operator t = match t.token.typ with | Token.LOGICAL_AND -> Some Operators.Binary.AND | Token.LOGICAL_OR -> Some Operators.Binary.OR | Token.EQUAL_EQUAL -> Some Operators.Binary.EQUAL | Token.NOT_EQUAL -> Some Operators.Binary.NOT_EQUAL | Token.GREATER -> Some Operators.Binary.GREATER | Token.GREATER_EQUAL -> Some Operators.Binary.GREATER_EQUAL | Token.LESS -> Some Operators.Binary.LESS | Token.LESS_EQUAL -> Some Operators.Binary.LESS_EQUAL | Token.PLUSPLUS -> Some Operators.Binary.CONCAT | Token.PLUS -> Some Operators.Binary.PLUS | Token.MINUS -> Some Operators.Binary.MINUS | Token.STAR -> Some Operators.Binary.TIMES | Token.SLASH -> Some Operators.Binary.DIV | Token.STAR_STAR -> Some Operators.Binary.POW | Token.PERCENT -> Some Operators.Binary.MODULO | Token.DOT -> Some Operators.Binary.DOT_ACCESS | Token.LEFT_BRACK -> Some Operators.Binary.BRACKET_ACCESS | Token.DOTDOT -> Some Operators.Binary.RANGE | Token.DOTDOTDOT -> Some Operators.Binary.INCLUSIVE_RANGE | Token.PIPE -> Some Operators.Binary.PIPE | _ -> None
and parse_expression ?(prio = -999) t = let rec loop ~prio ~left t = let expression_start = t.token.location in match t.token.typ with | Token.SEMICOLON -> left | Token.LEFT_PAREN -> let expression_annotations = parse_annotations t in next t; let arguments = t |> Helpers.separated_list ~sep:Token.COMMA ~fn:parse_expression in let expression_desc = Parsetree.P_FunctionCall { function_definition = left; arguments } in expect Token.RIGHT_PAREN t; let expression_end = t.token.location in let expression_loc = Location.merge ~s:expression_start ~e:expression_end () in let left = Parsetree. { expression_desc; expression_loc; expression_annotations; expression_parenthesized = false; } in loop ~left ~prio t | _ -> ( match parse_binary_operator t with | None -> left | Some operator -> let precedence = Operators.Binary.get_precedence operator in if precedence < prio then left else ( let expression_annotations = parse_annotations t in next t; (* NOTE: The new_prio was moved out of the | operator branch, so it now also updates the prio on function calls. Tests are still passing, but if there are precendence errors with functions in the future, this is probably the reason. - 2026-06-26 *) let new_prio = match Operators.Binary.get_associativity operator with | Assoc_Left -> precedence + 1 | Assoc_Right -> precedence in let expression_desc = match operator with | Operators.Binary.DOT_ACCESS -> let id, loc = Helpers.expect_identifier ~typ:`Lower t in let expr = Parsetree. { expression_loc = loc; expression_desc = Parsetree.P_LowercaseIdentifierExpression id; expression_parenthesized = false; expression_annotations = []; } in Parsetree.P_BinaryExpression (left, operator, expr) | operator -> ( match parse_expression ~prio:new_prio t with | None -> Diagnostics.raise_error t.token.location ("Expected expression on right hand side of `" ^ Operators.Binary.to_string operator ^ "`") | Some right -> Parsetree.P_BinaryExpression (left, operator, right) ) in let () = match operator with | Operators.Binary.BRACKET_ACCESS -> expect Token.RIGHT_BRACK t | _ -> () in let expression_end = t.token.location in let expression_loc = Location.merge ~s:expression_start ~e:expression_end () in let left = Parsetree. { expression_desc; expression_loc; expression_annotations; expression_parenthesized = false; } in loop ~left ~prio t)) in let* left = parse_expression_part t in Some (loop ~prio ~left t)
and parse_declaration t = let declaration_annotations = parse_annotations t in let declaration_start = t.token.location in let* declaration_kind = match t.token.typ with | 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; declaration_attributes; declaration_body; declaration_annotations; } ) |> Option.some ;;end
let parse_source source = let parser = make source in parser |> Helpers.list ~fn:Rules.parse_declaration;;
let stdlib = Pinc_stdlib.file_list |> List.map (fun filename -> filename |> Pinc_stdlib.read |> Option.get |> Pinc_source.of_string ~filename);;
let parse ?(include_stdlib = true) sources : Parsetree.t = let stdlib = if include_stdlib then stdlib else [] in stdlib @ sources |> ListLabels.fold_left ~init:[] ~f:(fun acc source -> let decls = parse_source source in ListLabels.fold_left decls ~init:acc ~f:(fun acc (key, decl) -> match List.assoc_opt key acc with | None -> (key, decl) :: acc | Some _ -> let message = Printf.sprintf "Found multiple declarations with identifier `%s`.\n\ Every declaration has to have a unique name in pinc." key in
Pinc_diagnostics.raise_error decl.Parsetree.declaration_loc message)) |> List.rev;;