From c5f82f65d13f3421d4e0ec0da67d42a9517dbe6c Mon Sep 17 00:00:00 2001 From: Torben Ewert Date: Fri, 28 Aug 2026 09:33:29 +0200 Subject: [PATCH] feat: add primitive tags (string, int, float, bool, custom) --- bin/print_vm.ml | 2 +- lib/Pinc_lang.ml | 7 +- lib/pinc_bytecode/instruction.ml | 36 ++- lib/pinc_bytecode/value.ml | 34 ++- lib/pinc_compiler/compiler.ml | 64 +++++- lib/pinc_core/StdlibExtension.ml | 7 + lib/pinc_vm/dune | 2 + lib/pinc_vm/tag/exceptions.ml | 14 ++ lib/pinc_vm/tag/tag_boolean.ml | 20 ++ lib/pinc_vm/tag/tag_custom.ml | 19 ++ lib/pinc_vm/tag/tag_float.ml | 20 ++ lib/pinc_vm/tag/tag_int.ml | 20 ++ lib/pinc_vm/tag/tag_string.ml | 20 ++ lib/pinc_vm/tag/types.ml | 43 ++++ lib/pinc_vm/tag/utils.ml | 2 + lib/pinc_vm/vm.ml | 256 +++++++++++++++++---- test/vm/component/component.pi | 6 +- test/vm/component/component.t | 2 +- test/vm/component/component_instructions.t | 62 ++--- 19 files changed, 551 insertions(+), 85 deletions(-) create mode 100644 lib/pinc_vm/tag/exceptions.ml create mode 100644 lib/pinc_vm/tag/tag_boolean.ml create mode 100644 lib/pinc_vm/tag/tag_custom.ml create mode 100644 lib/pinc_vm/tag/tag_float.ml create mode 100644 lib/pinc_vm/tag/tag_int.ml create mode 100644 lib/pinc_vm/tag/tag_string.ml create mode 100644 lib/pinc_vm/tag/types.ml create mode 100644 lib/pinc_vm/tag/utils.ml diff --git a/bin/print_vm.ml b/bin/print_vm.ml index 11b706b..50db02e 100644 --- a/bin/print_vm.ml +++ b/bin/print_vm.ml @@ -29,7 +29,7 @@ let main = sources |> Parser.get_ast ~include_stdlib:true |> Compiler.compile - |> Vm.eval ~root + |> Vm.eval ~root ~tag_data_provider:Vm.Tag.Utils.noop_data_provider |> print_endline with Diagnostics.Pinc_error _ -> exit 1 ;; diff --git a/lib/Pinc_lang.ml b/lib/Pinc_lang.ml index 521f91e..746e20d 100644 --- a/lib/Pinc_lang.ml +++ b/lib/Pinc_lang.ml @@ -11,7 +11,12 @@ end module Compiler = Pinc_Compiler.Compiler module Bytecode = Pinc_Bytecode.Bytecode -module Vm = Pinc_Vm.Vm + +module Vm = struct + include Pinc_Vm.Vm + module Tag = Pinc_Vm.Tag +end + module StringMap = Pinc_Core.StringMap module StringSet = Pinc_Core.StringSet module Helpers = Pinc_Backend.Helpers diff --git a/lib/pinc_bytecode/instruction.ml b/lib/pinc_bytecode/instruction.ml index 7a3fee2..b94bc5f 100644 --- a/lib/pinc_bytecode/instruction.ml +++ b/lib/pinc_bytecode/instruction.ml @@ -43,6 +43,8 @@ type t = | I_Html_Template | I_Fragment_Template | I_Get_Declaration of int + | I_Call_Template_Declaration of int + | I_Tag of int | I_Halt | I_Debug_Print_Stack @@ -91,12 +93,15 @@ let byte = function | I_Html_Template -> 0x2A | I_Fragment_Template -> 0x2B | I_Get_Declaration _ -> 0x2C + | I_Tag _ -> 0x2D + | I_Call_Template_Declaration _ -> 0x2E | I_Halt -> 0xFE | I_Debug_Print_Stack -> 0xFF ;; -let operands_length = function - | I_Get_Declaration _ -> 2 +let operands_length_in_byte = function + | I_Tag _ -> 1 + | I_Get_Declaration _ | I_Call_Template_Declaration _ -> 2 | I_Constant _ | I_Jump _ | I_Jump_If_False _ @@ -144,7 +149,7 @@ let operands_length = function | I_Debug_Print_Stack -> 0 ;; -let length t = 1 + operands_length t +let length t = 1 + operands_length_in_byte t let decode bytes offset = let instruction = Bytes.get_uint8 bytes offset in @@ -222,6 +227,14 @@ let decode bytes offset = let addr = Bytes.get_int16_be bytes offset in let offset = offset + 2 in (offset, I_Get_Declaration addr) + | 0x2D -> + let flags = Bytes.get_int8 bytes offset in + let offset = offset + 1 in + (offset, I_Tag flags) + | 0x2E -> + let addr = Bytes.get_int16_be bytes offset in + let offset = offset + 2 in + (offset, I_Call_Template_Declaration addr) | 0xFE -> (offset, I_Halt) | 0xFF -> (offset, I_Debug_Print_Stack) | _ -> @@ -280,6 +293,16 @@ let pp fmt = function | I_Html_Template -> Format.fprintf fmt "I_Html_Template" | I_Fragment_Template -> Format.fprintf fmt "I_Fragment_Template" | I_Get_Declaration addr -> Format.fprintf fmt "I_Get_Declaration 0x%04X" addr + | I_Tag flags -> + Format.fprintf + fmt + "I_Tag (required: %b; attributes: %b; children: %b; transformer: %b)" + (0 <> 0b0001 land flags) + (0 <> 0b0010 land flags) + (0 <> 0b0100 land flags) + (0 <> 0b1000 land flags) + | I_Call_Template_Declaration addr -> + Format.fprintf fmt "I_Call_Template_Declaration 0x%04X" addr | I_Halt -> Format.fprintf fmt "I_Halt" | I_Debug_Print_Stack -> Format.fprintf fmt "I_Debug_Print_Stack" ;; @@ -287,7 +310,7 @@ let pp fmt = function let to_bytes t = let instruction_length = let initial = 1 in - initial + operands_length t + initial + operands_length_in_byte t in let bytes = Bytes.create instruction_length in @@ -296,7 +319,10 @@ let to_bytes t = let () = match t with - | I_Get_Declaration op -> + | I_Tag flags -> + Bytes.set_int8 bytes !offset flags; + offset := !offset + 1 + | I_Get_Declaration op | I_Call_Template_Declaration op -> Bytes.set_int16_be bytes !offset op; offset := !offset + 2 | I_Constant op diff --git a/lib/pinc_bytecode/value.ml b/lib/pinc_bytecode/value.ml index 68f9ce7..57f9eaf 100644 --- a/lib/pinc_bytecode/value.ml +++ b/lib/pinc_bytecode/value.ml @@ -36,7 +36,21 @@ and closure = { free_variables : t Array.t; } -let pp fmt = function +let show = function + | Null -> "null" + | Int i -> "int (" ^ string_of_int i ^ ")" + | Float f -> "float (" ^ string_of_float f ^ ")" + | Bool b -> "bool (" ^ string_of_bool b ^ ")" + | Char c -> "char (" ^ (string_of_int @@ Uchar.to_int c) ^ ")" + | String s -> "string (" ^ s ^ ")" + | Array _ -> "array" + | Record _ -> "record" + | Closure _ | Function _ | BuiltinFunction _ -> "function" + | HtmlTemplateNode _ -> "HtmlTemplateNode" + | FragmentTemplateNode _ -> "FragmentTemplateNode" +;; + +let rec pp fmt = function | Null -> Format.fprintf fmt "\n%!" | Int i -> Format.fprintf fmt "%i\n%!" i | Float f -> Format.fprintf fmt "%f\n%!" f @@ -44,12 +58,28 @@ let pp fmt = function | Char c -> Format.fprintf fmt "%x\n%!" (Uchar.to_int c) | String s -> Format.fprintf fmt "%S\n%!" s | Array _ -> Format.fprintf fmt "\n%!" - | Record _ -> Format.fprintf fmt "\n%!" + | Record r -> Format.fprintf fmt "\n%!" pp_record r | Closure _ -> Format.fprintf fmt "\n%!" | Function _ -> Format.fprintf fmt "\n%!" | BuiltinFunction _ -> Format.fprintf fmt "\n%!" | HtmlTemplateNode _ -> Format.fprintf fmt "\n%!" | FragmentTemplateNode _ -> Format.fprintf fmt "\n%!" + +and pp_record fmt r = + StringMap.iter (fun key value -> Format.fprintf fmt "@;@[ %s: %a@]" key pp value) r +;; + +let find_path path value = + let rec aux path value = + match (path, value) with + | key :: rest, Record r -> ( + try aux rest @@ StringMap.find key r with Not_found -> None) + | key :: rest, Array a -> ( + try Array.get a (int_of_string key) |> aux rest + with Failure _ | Invalid_argument _ -> None) + | _, value -> Some value + in + aux path value ;; let rec to_string = function diff --git a/lib/pinc_compiler/compiler.ml b/lib/pinc_compiler/compiler.ml index 9d06697..904587d 100644 --- a/lib/pinc_compiler/compiler.ml +++ b/lib/pinc_compiler/compiler.ml @@ -284,7 +284,7 @@ let rec compile_expr t (expr : Pinc_Types.Ast.expression) = compile_function t ~identifier ~parameters ~body | FunctionCall { function_definition; arguments } -> compile_function_call t ~fn:function_definition ~arguments - | TagExpression _ -> raise_notrace (TODO "Tag Expression") + | TagExpression { tag_desc = tag; tag_loc = _ } -> compile_tag_expression t ~tag | ForInExpression { index; iterator; reverse; iterable; body } -> compile_loop_expression t ~index ~iterator ~reverse ~iterable ~body | TemplateExpression node -> compile_template_node t node @@ -586,6 +586,60 @@ and compile_conditional_expression t ~condition ~consequent ~alternate = in t +and compile_tag_expression t ~tag = + let kind_string = + match tag.kind with + | Tag_String -> "String" + | Tag_Int -> "Int" + | Tag_Float -> "Float" + | Tag_Boolean -> "Boolean" + | Tag_Array -> "Array" + | Tag_Record -> "Record" + | Tag_Slot -> "Slot" + | Tag_Store -> "Store" + | Tag_SetContext -> "SetContext" + | Tag_GetContext -> "GetContext" + | Tag_CreatePortal -> "CreatePortal" + | Tag_Portal -> "Portal" + | Tag_Custom name -> name + in + let t = emit_constant t (Pinc_Bytecode.Value.String kind_string) in + let t = emit_constant t (Pinc_Bytecode.Value.String tag.key) in + let flags = 0b0000 in + let flags = + match tag.required with + | true -> flags lor 0b0001 + | false -> flags lor 0b0000 + in + let t, flags = + match StringMap.is_empty tag.attributes with + | true -> (t, flags lor 0b0000) + | false -> (compile_tag_expression_attributes t tag.attributes, flags lor 0b0010) + in + let t, flags = + match tag.children with + | None -> (t, flags lor 0b0000) + | Some children -> (compile_expr t children, flags lor 0b0100) + in + let t, flags = + match tag.transformer with + | None -> (t, flags lor 0b0000) + | Some transformer -> (compile_expr t transformer, flags lor 0b1000) + in + let t = emit t @@ Pinc_Bytecode.Instruction.I_Tag flags in + t + +and compile_tag_expression_attributes t attributes = + let bindings = StringMap.bindings attributes in + let keys, values = List.split bindings in + let emit_key t key = emit_constant t (Pinc_Bytecode.Value.String key) in + let t = List.fold_left emit_key t keys in + let emit_value t expr = compile_expr t expr in + let t = List.fold_left emit_value t values in + let length = List.length keys in + let t = emit t @@ Pinc_Bytecode.Instruction.I_Record length in + t + and compile_loop_expression t ~index ~iterator ~reverse:_ ~iterable ~body = let (Lowercase_Id (iterator, _)) = iterator in let t = add_scope t in @@ -760,10 +814,9 @@ and compile_template_node_html_tag t ~id ~attributes ~children = and compile_template_node_component t ~id ~attributes ~children = let (Pinc_Types.Ast.Uppercase_Id (id, loc)) = id in let id = get_declaration_id t ~loc id in - let t = emit_get_declaration t id in let t = compile_template_node_attributes t attributes in let t = compile_template_node_children t children in - let t = emit t @@ Pinc_Bytecode.Instruction.I_Call 2 in + let t = emit t @@ Pinc_Bytecode.Instruction.I_Call_Template_Declaration id in t and compile_template_node_fragment t children = @@ -828,16 +881,13 @@ let compile_template_declaration t identifier declaration = let num_locals = SymbolTable.length t.symbol_table in let t, frame = pop_frame t in let t = List.fold_left emit_get_symbol t free_variables in - let num_free_variables = List.length free_variables in assert (num_free_variables = 0); - (* The number of parameters is fixed to 2 (props and children) *) - let num_parameters = 2 in let instructions = Dynarray.to_array @@ frame.instructions in let fn_addr, t = add_constant t @@ Pinc_Bytecode.Value.Function - { fn_addr = -1; num_locals; num_parameters; instructions } + { fn_addr = -1; num_locals; num_parameters = 0; instructions } in let t = emit t @@ Pinc_Bytecode.Instruction.I_Closure (fn_addr, num_free_variables) in t diff --git a/lib/pinc_core/StdlibExtension.ml b/lib/pinc_core/StdlibExtension.ml index 07be403..82b8e72 100644 --- a/lib/pinc_core/StdlibExtension.ml +++ b/lib/pinc_core/StdlibExtension.ml @@ -35,6 +35,13 @@ module List = struct | _ :: tl -> last tl | [] -> None ;; + + let rec last_exn list = + match list with + | [ x ] -> x + | _ :: tl -> last_exn tl + | [] -> raise (Invalid_argument "List.last_exn") + ;; end module Array = struct diff --git a/lib/pinc_vm/dune b/lib/pinc_vm/dune index af361df..417661c 100644 --- a/lib/pinc_vm/dune +++ b/lib/pinc_vm/dune @@ -1,3 +1,5 @@ +(include_subdirs qualified) + (library (name Pinc_Vm) (public_name pinc-lang.vm) diff --git a/lib/pinc_vm/tag/exceptions.ml b/lib/pinc_vm/tag/exceptions.ml new file mode 100644 index 0000000..36b3ba1 --- /dev/null +++ b/lib/pinc_vm/tag/exceptions.ml @@ -0,0 +1,14 @@ +let required name = + Invalid_argument ("Attribute " ^ name ^ " is required, but was not provided a value.") +;; + +let invalid_type name expected actual = + Invalid_argument + ("Expected attribute " + ^ name + ^ " to be of type " + ^ expected + ^ ", instead got " + ^ Pinc_Bytecode.Value.show actual + ^ ".") +;; diff --git a/lib/pinc_vm/tag/tag_boolean.ml b/lib/pinc_vm/tag/tag_boolean.ml new file mode 100644 index 0000000..b7710cb --- /dev/null +++ b/lib/pinc_vm/tag/tag_boolean.ml @@ -0,0 +1,20 @@ +open Pinc_Bytecode + +let eval ~tag_meta_provider ~tag_data_provider ~required ~attributes ~key = + let meta = + match tag_meta_provider with + | None -> None + | Some fn -> fn ~kind:Types.Boolean ~attributes ~required ~key + in + let data = + tag_data_provider ~kind:Types.Boolean ~attributes ~required ~key + |> Option.value ~default:Value.Null + in + + let attribute_name = List.last_exn key in + + match data with + | Value.Null when required -> raise_notrace @@ Exceptions.required attribute_name + | (Value.Null | Value.Bool _) as value -> (value, meta) + | v -> raise_notrace @@ Exceptions.invalid_type attribute_name "boolean" v +;; diff --git a/lib/pinc_vm/tag/tag_custom.ml b/lib/pinc_vm/tag/tag_custom.ml new file mode 100644 index 0000000..b5e8c7c --- /dev/null +++ b/lib/pinc_vm/tag/tag_custom.ml @@ -0,0 +1,19 @@ +open Pinc_Bytecode + +let eval ~tag_meta_provider ~tag_data_provider ~required ~attributes ~key ~name = + let meta = + match tag_meta_provider with + | None -> None + | Some fn -> fn ~kind:(Types.Custom name) ~attributes ~required ~key + in + let data = + tag_data_provider ~kind:(Types.Custom name) ~attributes ~required ~key + |> Option.value ~default:Value.Null + in + + let attribute_name = List.last_exn key in + + match data with + | Value.Null when required -> raise_notrace @@ Exceptions.required attribute_name + | value -> (value, meta) +;; diff --git a/lib/pinc_vm/tag/tag_float.ml b/lib/pinc_vm/tag/tag_float.ml new file mode 100644 index 0000000..22c69c8 --- /dev/null +++ b/lib/pinc_vm/tag/tag_float.ml @@ -0,0 +1,20 @@ +open Pinc_Bytecode + +let eval ~tag_meta_provider ~tag_data_provider ~required ~attributes ~key = + let meta = + match tag_meta_provider with + | None -> None + | Some fn -> fn ~kind:Types.Float ~attributes ~required ~key + in + let data = + tag_data_provider ~kind:Types.Float ~attributes ~required ~key + |> Option.value ~default:Value.Null + in + + let attribute_name = List.last_exn key in + + match data with + | Value.Null when required -> raise_notrace @@ Exceptions.required attribute_name + | (Value.Null | Value.Float _) as value -> (value, meta) + | v -> raise_notrace @@ Exceptions.invalid_type attribute_name "float" v +;; diff --git a/lib/pinc_vm/tag/tag_int.ml b/lib/pinc_vm/tag/tag_int.ml new file mode 100644 index 0000000..d1f4dd9 --- /dev/null +++ b/lib/pinc_vm/tag/tag_int.ml @@ -0,0 +1,20 @@ +open Pinc_Bytecode + +let eval ~tag_meta_provider ~tag_data_provider ~required ~attributes ~key = + let meta = + match tag_meta_provider with + | None -> None + | Some fn -> fn ~kind:Types.Int ~attributes ~required ~key + in + let data = + tag_data_provider ~kind:Types.Int ~attributes ~required ~key + |> Option.value ~default:Value.Null + in + + let attribute_name = List.last_exn key in + + match data with + | Value.Null when required -> raise_notrace @@ Exceptions.required attribute_name + | (Value.Null | Value.Int _) as value -> (value, meta) + | v -> raise_notrace @@ Exceptions.invalid_type attribute_name "int" v +;; diff --git a/lib/pinc_vm/tag/tag_string.ml b/lib/pinc_vm/tag/tag_string.ml new file mode 100644 index 0000000..b2000fb --- /dev/null +++ b/lib/pinc_vm/tag/tag_string.ml @@ -0,0 +1,20 @@ +open Pinc_Bytecode + +let eval ~tag_meta_provider ~tag_data_provider ~required ~attributes ~key = + let meta = + match tag_meta_provider with + | None -> None + | Some fn -> fn ~kind:Types.String ~attributes ~required ~key + in + let data = + tag_data_provider ~kind:Types.String ~attributes ~required ~key + |> Option.value ~default:Value.Null + in + + let attribute_name = List.last_exn key in + + match data with + | Value.Null when required -> raise_notrace @@ Exceptions.required attribute_name + | (Value.Null | Value.String _) as value -> (value, meta) + | v -> raise_notrace @@ Exceptions.invalid_type attribute_name "string" v +;; diff --git a/lib/pinc_vm/tag/types.ml b/lib/pinc_vm/tag/types.ml new file mode 100644 index 0000000..37f631d --- /dev/null +++ b/lib/pinc_vm/tag/types.ml @@ -0,0 +1,43 @@ +open Pinc_Bytecode + +type meta = + [ `String of string + | `Int of int + | `Float of float + | `Boolean of bool + | `Array of meta list + | `Record of (string * meta) list + | `SubTagPlaceholder + | `TemplatePlaceholder + | `Errors of string list + ] + +and kind = + | Custom of string + | String + | Int + | Float + | Boolean + | Array + | Record + | Slot of + (tag:string -> + ?additional_declarations:Bytecode.t -> + ?tag_meta_provider:meta_provider -> + tag_data_provider:data_provider -> + unit -> + (string * meta) list * Value.t) + +and data_provider = + kind:kind -> + attributes:Value.t StringMap.t -> + required:bool -> + key:string list -> + Value.t option + +and meta_provider = + kind:kind -> + attributes:Value.t StringMap.t -> + required:bool -> + key:string list -> + meta option diff --git a/lib/pinc_vm/tag/utils.ml b/lib/pinc_vm/tag/utils.ml new file mode 100644 index 0000000..8df54cc --- /dev/null +++ b/lib/pinc_vm/tag/utils.ml @@ -0,0 +1,2 @@ +let noop_data_provider ~kind:_ ~attributes:_ ~required:_ ~key:_ = None +let noop_meta_provider ~kind:_ ~attributes:_ ~required:_ ~key:_ = None diff --git a/lib/pinc_vm/vm.ml b/lib/pinc_vm/vm.ml index 10fbf2e..d6e12ab 100644 --- a/lib/pinc_vm/vm.ml +++ b/lib/pinc_vm/vm.ml @@ -6,6 +6,7 @@ exception TODO let stack_size = 2048 type t = { + name : string; stack : Vm_stack.t; resolved_functions : (t -> t) Array.t Array.t; globals : Value.t Array.t; @@ -13,6 +14,8 @@ type t = { current_frame : frame; constants : Value.t Array.t; declarations : declaration StringMap.t; + tag_data_provider : Tag.Types.data_provider; + tag_meta_provider : Tag.Types.meta_provider option; } and declaration = { @@ -79,11 +82,18 @@ let make_main_frame addr = make_frame ~base_pointer:0 ~closure ;; -let make ~declarations ~constants ~resolved_functions ~instructions = +let make + ~tag_meta_provider + ~tag_data_provider + ~declarations + ~constants + ~resolved_functions + ~instructions = let resolved_functions = Array.append resolved_functions [| instructions |] in let main_fn_addr = Array.length resolved_functions - 1 in let main_frame = make_main_frame main_fn_addr in { + name = "Original"; declarations; constants; resolved_functions; @@ -91,24 +101,26 @@ let make ~declarations ~constants ~resolved_functions ~instructions = globals = Array.make (2 lsl 16) Value.Null; past_frames = []; current_frame = main_frame; + tag_meta_provider; + tag_data_provider; } ;; -let copy ~instructions t = - let declarations = t.declarations in - let constants = t.constants in +let copy ~instructions ~tag_data_provider ~tag_meta_provider t = let resolved_functions = Array.copy t.resolved_functions in let main_fn_addr = Array.length resolved_functions - 1 in let () = Array.unsafe_set resolved_functions main_fn_addr instructions in let main_frame = make_main_frame main_fn_addr in { - declarations; - constants; + t with + name = "Copy"; resolved_functions; stack = Stack.make ~size:stack_size; globals = Array.make (2 lsl 16) Value.Null; past_frames = []; current_frame = main_frame; + tag_meta_provider; + tag_data_provider; } ;; @@ -125,6 +137,17 @@ let memoize_declaration t name value = { t with declarations } ;; +let debug_print_stack t = + Format.printf "--------- (STACK) -------\n%!"; + Stack.iteri (fun i value -> Format.printf "[%i] %a%!" i Value.pp value) t.stack; + Format.printf "--------- (/STACK) -------\n%!" +;; + +let execute_debug_print_stack t = + debug_print_stack t; + call_next_instruction t +;; + let execute_halt t = t let execute_binary_add t = @@ -775,18 +798,6 @@ and call_closure ~closure ~num_arguments t = call_current_instruction t ;; -let execute_root_declaration_call t = - (* - TODO: - This should be marked as the top level declaration call, - so tags can change their behavior from looking into the arguments to requesting the data dynamically - *) - let fn = Stack.top t.stack in - match fn with - | Value.Closure closure -> call_closure t ~closure ~num_arguments:0 - | _ -> assert false -;; - let execute_length t = let value = Stack.pop_value t.stack in let len = @@ -802,17 +813,6 @@ let execute_length t = call_next_instruction t ;; -let debug_print_stack t = - Format.printf "--------- (STACK) -------\n%!"; - Stack.iteri (fun i value -> Format.printf "[%i] %a%!" i Value.pp value) t.stack; - Format.printf "--------- (/STACK) -------\n%!" -;; - -let execute_debug_print_stack t = - debug_print_stack t; - call_next_instruction t -;; - let execute_pop t = Stack.drop t.stack; call_next_instruction t @@ -922,7 +922,13 @@ let execute_get_declaration name = t | Library, None -> let instructions = Array.append declaration.instructions [| execute_halt |] in - let t' = copy t ~instructions in + let t' = + copy + t + ~instructions + ~tag_data_provider:t.tag_data_provider + ~tag_meta_provider:t.tag_meta_provider + in let t' = call_current_instruction t' in let value = Stack.top t'.stack in Stack.push_value t.stack value; @@ -937,7 +943,13 @@ let execute_get_declaration name = An alternative would be to use a sequence or iterator of instructions into which I can insert instructions in between. *) - let t' = copy t ~instructions in + let t' = + copy + t + ~instructions + ~tag_meta_provider:t.tag_meta_provider + ~tag_data_provider:t.tag_data_provider + in let t' = call_current_instruction t' in let value = Stack.top t'.stack in Stack.push_value t.stack value; @@ -946,6 +958,64 @@ let execute_get_declaration name = call_next_instruction t ;; +let execute_call_template_declaration name = + fun t -> + let declaration = StringMap.find name t.declarations in + let _template_children = + match Stack.pop_value t.stack with + | Value.Array children -> children + | _ -> assert false + in + let template_attributes = + match Stack.pop_value t.stack with + | Value.Record attributes -> attributes + | _ -> assert false + in + let tag_data_provider ~kind ~attributes:_ ~required:_ ~key = + match kind with + (* TODO: slot has to be implemented *) + (* | Tag.Types.Slot _ -> + let key = key |> List.rev |> List.hd in + let items = + template_children + |> Array.fold_left (Tag.Slot.keep_slotted ~key) [] + |> List.rev + |> Array.of_list + in + Some (Value.Array items) *) + | Tag.Types.Array -> + template_attributes + |> StringMap.find_opt (List.hd key) + |> Fun.flip Option.bind (Value.find_path (List.tl key)) + |> Fun.flip Option.bind (function + | Value.Array a -> + let items = Array.mapi (fun i _ -> Value.String (string_of_int i)) a in + Some (Value.Array items) + | _ -> None) + | _ -> + template_attributes + |> StringMap.find_opt (List.hd key) + |> Fun.flip Option.bind (Value.find_path (List.tl key)) + in + + let instructions = + Array.append declaration.instructions [| execute_function_call 0; execute_halt |] + in + (* + TODO: (PERFORMANCE) + This copy is not needed and allocates a lot just to put a closure onto the stack. + The address spaces for the different components are separate, so they are already isolated. + I currently need the copy to create the new main frame and call its instructions. + An alternative would be to use a sequence or iterator of instructions into which I can + insert instructions in between. + *) + let t' = copy t ~instructions ~tag_meta_provider:None ~tag_data_provider in + let t' = call_current_instruction t' in + let value = Stack.top t'.stack in + Stack.push_value t.stack value; + call_next_instruction t +;; + let execute_array t = let length = match Stack.peek_tag t.stack 0 with @@ -1040,7 +1110,92 @@ let execute_fragment_template t = call_next_instruction t ;; +let execute_tag flags = + let required = flags land 0b0001 <> 0 in + let has_attributes = flags land 0b0010 <> 0 in + let has_children = flags land 0b0100 <> 0 in + let has_transformer = flags land 0b1000 <> 0 in + fun t -> + let _transformer = + if has_transformer then + Some (Stack.pop_value t.stack) + else + None + in + let _children = + if has_children then + Some (Stack.pop_value t.stack) + else + None + in + let attributes = + if has_attributes then ( + match + Stack.pop_value t.stack + with + | Value.Record r -> r + | _ -> assert false) + else + StringMap.empty + in + let key = + match Stack.pop_value t.stack with + | Value.String s -> s + | _ -> assert false + in + (* TODO: key is not correct *) + let key = [ key ] in + (* TODO: metadata has to be collected *) + let value, _meta = + (* TODO: slot has to be fixed *) + match Stack.pop_value t.stack with + | Value.String "String" -> + Tag.Tag_string.eval + ~tag_meta_provider:t.tag_meta_provider + ~tag_data_provider:t.tag_data_provider + ~required + ~attributes + ~key + | Value.String "Int" -> + Tag.Tag_int.eval + ~tag_meta_provider:t.tag_meta_provider + ~tag_data_provider:t.tag_data_provider + ~required + ~attributes + ~key + | Value.String "Float" -> + Tag.Tag_float.eval + ~tag_meta_provider:t.tag_meta_provider + ~tag_data_provider:t.tag_data_provider + ~required + ~attributes + ~key + | Value.String "Boolean" -> + Tag.Tag_boolean.eval + ~tag_meta_provider:t.tag_meta_provider + ~tag_data_provider:t.tag_data_provider + ~required + ~attributes + ~key + (* TODO: | Value.String "Array" -> *) + (* TODO: | Value.String "Record" -> *) + (* TODO: | Value.String "Slot" -> *) + | Value.String name -> + Tag.Tag_custom.eval + ~tag_meta_provider:t.tag_meta_provider + ~tag_data_provider:t.tag_data_provider + ~required + ~attributes + ~key + ~name + | _ -> assert false + in + Stack.push_value t.stack value; + call_next_instruction t +;; + let resolve_instructions ~declarations instructions = + let declaration_list = StringMap.to_list declarations in Array.map (fun instruction -> match instruction with @@ -1088,18 +1243,31 @@ let resolve_instructions ~declarations instructions = | Instruction.I_Length -> execute_length | Instruction.I_Current_Closure -> execute_current_closure | Instruction.I_Html_Template -> execute_html_template + | Instruction.I_Tag flags -> execute_tag flags | Instruction.I_Get_Declaration addr -> ( let name = - StringMap.to_list declarations - |> List.find_map (fun (name, declaration) -> - if declaration.Pinc_Bytecode.Bytecode.id = addr then - Some name - else - None) + declaration_list + |> List.find_map @@ fun (name, declaration) -> + if declaration.Pinc_Bytecode.Bytecode.id = addr then + Some name + else + None in match name with | None -> assert false | Some name -> execute_get_declaration name) + | Instruction.I_Call_Template_Declaration addr -> ( + let name = + declaration_list + |> List.find_map @@ fun (name, declaration) -> + if declaration.Pinc_Bytecode.Bytecode.id = addr then + Some name + else + None + in + match name with + | None -> assert false + | Some name -> execute_call_template_declaration name) | Instruction.I_Fragment_Template -> execute_fragment_template | Instruction.I_Halt -> execute_halt) instructions @@ -1230,7 +1398,7 @@ let merge_address_space declarations = (code, Dynarray.to_array @@ all_constants, !function_index + 1) ;; -let eval ~root bytecode = +let eval ~root ~tag_data_provider ?tag_meta_provider bytecode = let declarations, constants, function_count = bytecode |> Pinc_Bytecode.Bytecode.deserialize |> merge_address_space in @@ -1241,7 +1409,7 @@ let eval ~root bytecode = | Some { kind = Pinc_Bytecode.Bytecode.Library; _ } -> [| execute_halt |] | Some { kind = Pinc_Bytecode.Bytecode.Template; instructions; _ } -> let resolved = resolve_instructions ~declarations instructions in - Array.append resolved [| execute_root_declaration_call; execute_halt |] + Array.append resolved [| execute_function_call 0; execute_halt |] in let resolved_functions = @@ -1260,7 +1428,15 @@ let eval ~root bytecode = declarations in - let t = make ~declarations ~resolved_functions ~instructions ~constants in + let t = + make + ~tag_data_provider + ~tag_meta_provider + ~declarations + ~resolved_functions + ~instructions + ~constants + in let t = call_current_instruction t in t.stack |> Stack.top |> Value.to_string ;; diff --git a/test/vm/component/component.pi b/test/vm/component/component.pi index ab19c41..71b1ba4 100644 --- a/test/vm/component/component.pi +++ b/test/vm/component/component.pi @@ -1,9 +1,11 @@ component Headline { -

Static Headline

+ let text = #String; + +

{text}

} component Component {
- +
} diff --git a/test/vm/component/component.t b/test/vm/component/component.t index 12ef267..c924154 100644 --- a/test/vm/component/component.t +++ b/test/vm/component/component.t @@ -1,4 +1,4 @@ $ NO_COLOR="1" print_vm . Component
-

Static Headline

+

My Headline

diff --git a/test/vm/component/component_instructions.t b/test/vm/component/component_instructions.t index 401b484..23aae46 100644 --- a/test/vm/component/component_instructions.t +++ b/test/vm/component/component_instructions.t @@ -3,45 +3,55 @@ [CONSTANTS] 0x00000000 (00000000) : "section" 0x00000001 (00000001) : "\n" - 0x00000002 (00000002) : 0 - 0x00000003 (00000003) : "\n" - 0x00000004 (00000004) : 3 - 0x00000005 (00000005) : [ + 0x00000002 (00000002) : "text" + 0x00000003 (00000003) : "My Headline" + 0x00000004 (00000004) : 0 + 0x00000005 (00000005) : "\n" + 0x00000006 (00000006) : 3 + 0x00000007 (00000007) : [ 0000 I_Constant 0x00000000 (00000000) 0005 I_Record 0 0010 I_Constant 0x00000001 (00000001) - 0015 I_Get_Declaration 0x0001 - 0018 I_Record 0 - 0023 I_Constant 0x00000002 (00000002) - 0028 I_Array - 0029 I_Call 2 - 0034 I_Constant 0x00000003 (00000003) - 0039 I_Constant 0x00000004 (00000004) - 0044 I_Array - 0045 I_Html_Template - 0046 I_Return + 0015 I_Constant 0x00000002 (00000002) + 0020 I_Constant 0x00000003 (00000003) + 0025 I_Record 1 + 0030 I_Constant 0x00000004 (00000004) + 0035 I_Array + 0036 I_Call_Template_Declaration 0x0001 + 0039 I_Constant 0x00000005 (00000005) + 0044 I_Constant 0x00000006 (00000006) + 0049 I_Array + 0050 I_Html_Template + 0051 I_Return ] [INSTRUCTIONS] - 0000 I_Closure 0x00000005 (00000005) (free variables: 0) + 0000 I_Closure 0x00000007 (00000007) (free variables: 0) ] [ [CONSTANTS] - 0x00000000 (00000000) : "h2" - 0x00000001 (00000001) : "Static Headline" - 0x00000002 (00000002) : 1 - 0x00000003 (00000003) : [ + 0x00000000 (00000000) : "String" + 0x00000001 (00000001) : "text" + 0x00000002 (00000002) : "h2" + 0x00000003 (00000003) : 1 + 0x00000004 (00000004) : [ 0000 I_Constant 0x00000000 (00000000) - 0005 I_Record 0 - 0010 I_Constant 0x00000001 (00000001) - 0015 I_Constant 0x00000002 (00000002) - 0020 I_Array - 0021 I_Html_Template - 0022 I_Return + 0005 I_Constant 0x00000001 (00000001) + 0010 I_Tag (required: true; attributes: false; children: false; transformer: false) + 0012 I_Set_Local 0x00000000 (00000000) + 0017 I_Null + 0018 I_Pop + 0019 I_Constant 0x00000002 (00000002) + 0024 I_Record 0 + 0029 I_Get_Local 0x00000000 (00000000) + 0034 I_Constant 0x00000003 (00000003) + 0039 I_Array + 0040 I_Html_Template + 0041 I_Return ] [INSTRUCTIONS] - 0000 I_Closure 0x00000003 (00000003) (free variables: 0) + 0000 I_Closure 0x00000004 (00000004) (free variables: 0) ] -- 2.51.2