diff --git a/lib/pinc_bytecode/bytecode.ml b/lib/pinc_bytecode/bytecode.ml index 163320b..605a1cf 100644 --- a/lib/pinc_bytecode/bytecode.ml +++ b/lib/pinc_bytecode/bytecode.ml @@ -27,6 +27,8 @@ let rec pp_value fmt = function Format.fprintf fmt "'%s'" @@ Buffer.contents buf | Value.Array _ -> Format.fprintf fmt "" | Value.Record _ -> Format.fprintf fmt "" + | Value.HtmlTemplateNode _ -> Format.fprintf fmt "" + | Value.FragmentTemplateNode _ -> Format.fprintf fmt "" | Value.Function fn -> Format.fprintf fmt ""; pp_function fmt fn diff --git a/lib/pinc_bytecode/instruction.ml b/lib/pinc_bytecode/instruction.ml index 1d971d5..2bf794a 100644 --- a/lib/pinc_bytecode/instruction.ml +++ b/lib/pinc_bytecode/instruction.ml @@ -40,6 +40,8 @@ type t = | I_Closure of (int * int) | I_Get_Free of int | I_Current_Closure + | I_Html_Template + | I_Fragment_Template | I_Halt | I_Debug_Print_Stack @@ -85,7 +87,9 @@ let byte = function | I_Closure _ -> 0x27 | I_Get_Free _ -> 0x28 | I_Current_Closure -> 0x29 - | I_Halt -> 0x2A + | I_Html_Template -> 0x2A + | I_Fragment_Template -> 0x2B + | I_Halt -> 0xFE | I_Debug_Print_Stack -> 0xFF ;; @@ -131,6 +135,8 @@ let operands_length = function | I_Length | I_Array | I_Current_Closure + | I_Html_Template + | I_Fragment_Template | I_Halt | I_Debug_Print_Stack -> 0 ;; @@ -207,7 +213,9 @@ let decode bytes offset = let offset, addr = Int32.read_bytes bytes offset in (offset, I_Get_Free (Int32.to_int addr)) | 0x29 -> (offset, I_Current_Closure) - | 0x2A -> (offset, I_Halt) + | 0x2A -> (offset, I_Html_Template) + | 0x2B -> (offset, I_Fragment_Template) + | 0xFE -> (offset, I_Halt) | 0xFF -> (offset, I_Debug_Print_Stack) | _ -> raise_notrace @@ -262,6 +270,8 @@ let pp fmt = function fn_addr free_variables | I_Current_Closure -> Format.fprintf fmt "I_Current_Closure" + | I_Html_Template -> Format.fprintf fmt "I_Html_Template" + | I_Fragment_Template -> Format.fprintf fmt "I_Fragment_Template" | I_Halt -> Format.fprintf fmt "I_Halt" | I_Debug_Print_Stack -> Format.fprintf fmt "I_Debug_Print_Stack" ;; @@ -321,6 +331,8 @@ let to_bytes t = | I_Length | I_Array | I_Current_Closure + | I_Html_Template + | I_Fragment_Template | I_Halt | I_Debug_Print_Stack -> () in diff --git a/lib/pinc_bytecode/value.ml b/lib/pinc_bytecode/value.ml index 4f87235..319e176 100644 --- a/lib/pinc_bytecode/value.ml +++ b/lib/pinc_bytecode/value.ml @@ -10,6 +10,14 @@ type t = | Function of compiled_function | Closure of closure | BuiltinFunction of builtin_function + | HtmlTemplateNode of html_template_node + | FragmentTemplateNode of t array + +and html_template_node = { + tag : string; + attributes : t StringMap.t; + children : t array; +} and builtin_function = { num_parameters : int; @@ -40,6 +48,8 @@ let pp fmt = function | 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%!" ;; let rec to_string = function @@ -72,6 +82,39 @@ let rec to_string = function is_first := false) m; Buffer.contents b + | HtmlTemplateNode { tag; attributes; children } -> + let buf = Buffer.create 128 in + Buffer.add_char buf '<'; + Buffer.add_string buf tag; + if not (StringMap.is_empty attributes) then + attributes + |> StringMap.iter (fun key value -> + match value with + | Null -> () + | value -> + Buffer.add_char buf ' '; + Buffer.add_string buf key; + Buffer.add_char buf '='; + Buffer.add_char buf '"'; + Buffer.add_string buf (to_string value); + Buffer.add_char buf '"'); + let () = + match children with + | [||] when HTML.is_void_el tag -> Buffer.add_string buf " />" + | children -> + Buffer.add_char buf '>'; + Array.iter (fun child -> Buffer.add_string buf (to_string child)) children; + Buffer.add_char buf '<'; + Buffer.add_char buf '/'; + Buffer.add_string buf tag; + Buffer.add_char buf '>' + in + Buffer.contents buf + | FragmentTemplateNode children -> + let buf = Buffer.create 128 in + Array.iter (fun child -> Buffer.add_string buf (to_string child)) children; + let content = Buffer.contents buf in + Dedent.string content | Closure _ -> "" | Function _ -> "" | BuiltinFunction _ -> "" @@ -87,6 +130,8 @@ let is_true = function | Array [||] -> false | Array _ -> true | Record m -> not (StringMap.is_empty m) + | HtmlTemplateNode _ -> true + | FragmentTemplateNode _ -> true | Closure _ -> true | Function _ -> true | BuiltinFunction _ -> true @@ -104,6 +149,8 @@ let rec equal a b = | Null, Null -> true | Array a, Array b -> Array.equal equal a b | Record a, Record b -> StringMap.equal equal a b + | HtmlTemplateNode _, HtmlTemplateNode _ -> false + | FragmentTemplateNode _, FragmentTemplateNode _ -> false | Function a, Function b -> equal_function a b | Closure a, Closure b -> Array.equal equal a.free_variables b.free_variables && equal_function a.fn b.fn @@ -127,6 +174,8 @@ let compare a b = | Null, Null -> 0 | Array a, Array b -> Int.compare (Array.length a) (Array.length b) | Record a, Record b -> StringMap.compare compare a b + | HtmlTemplateNode _, HtmlTemplateNode _ -> 0 + | FragmentTemplateNode _, FragmentTemplateNode _ -> 0 | Closure _, Closure _ -> 0 | Function _, Function _ -> 0 | BuiltinFunction _, BuiltinFunction _ -> 0 @@ -171,6 +220,8 @@ let rec serialize buf t = Buffer.add_string buf key; serialize buf value) r + | HtmlTemplateNode n -> serialize_html_template_node buf n + | FragmentTemplateNode n -> serialize_fragment_template_node buf n | Function f -> serialize_function buf f | Closure c -> serialize_closure buf c | BuiltinFunction f -> serialize_builtin_function buf f @@ -204,6 +255,41 @@ and serialize_closure buf c = Buffer.add_int32_be buf @@ Int32.of_int num_free_variables; Array.iter (serialize buf) free_variables; serialize_function buf fn + +and serialize_html_template_node buf n = + let tag = n.tag in + let attributes = n.attributes in + let children = n.children in + (* Value Tag *) + Buffer.add_int8 buf 0x0C; + (* Tag *) + let length = String.length tag in + Buffer.add_int8 buf @@ length; + Buffer.add_string buf tag; + (* Attributes *) + let length = StringMap.cardinal attributes in + Buffer.add_int32_be buf @@ Int32.of_int length; + StringMap.iter + (fun key value -> + let length = String.length key in + Buffer.add_int32_be buf @@ Int32.of_int length; + Buffer.add_string buf key; + serialize buf value) + attributes; + (* Children *) + let length = Array.length children in + Buffer.add_int32_be buf @@ Int32.of_int length; + Array.iter (serialize buf) children; + () + +and serialize_fragment_template_node buf children = + (* Value Tag *) + Buffer.add_int8 buf 0x0D; + (* Children *) + let length = Array.length children in + Buffer.add_int32_be buf @@ Int32.of_int length; + Array.iter (serialize buf) children; + () ;; let deserialize ~function_count bytes offset = @@ -254,6 +340,8 @@ let deserialize ~function_count bytes offset = | 0x09 -> Function (deserialize_function bytes offset) | 0x0A -> BuiltinFunction (deserialize_builtin_function bytes offset) | 0x0B -> Closure (deserialize_closure bytes offset) + | 0x0C -> HtmlTemplateNode (deserialize_html_template_node bytes offset) + | 0x0D -> FragmentTemplateNode (deserialize_fragment_template_node bytes offset) | _ -> raise @@ Invalid_argument "cannot deserialize bytecode" and deserialize_function bytes offset = let num_locals = Int32.to_int @@ Bytes.get_int32_be bytes !offset in @@ -285,6 +373,35 @@ let deserialize ~function_count bytes offset = in let fn = deserialize_function bytes offset in { free_variables; fn } + and deserialize_html_template_node bytes offset = + (* Tag *) + let length = Bytes.get_int8 bytes !offset in + offset := !offset + 1; + let tag = Bytes.sub_string bytes !offset length in + offset := !offset + length; + (* Attributes *) + let length = Int32.to_int @@ Bytes.get_int32_be bytes !offset in + offset := !offset + 4; + let attributes = + StringMap.of_list + @@ List.init length (fun _ -> + let length = Int32.to_int @@ Bytes.get_int32_be bytes !offset in + offset := !offset + 4; + let key = Bytes.sub_string bytes !offset length in + offset := !offset + length; + let value = deserialize_value bytes offset in + (key, value)) + in + (* Children *) + let length = Int32.to_int @@ Bytes.get_int32_be bytes !offset in + offset := !offset + 4; + let children = Array.init length (fun _ -> deserialize_value bytes offset) in + { tag; attributes; children } + and deserialize_fragment_template_node bytes offset = + let length = Int32.to_int @@ Bytes.get_int32_be bytes !offset in + offset := !offset + 4; + let children = Array.init length (fun _ -> deserialize_value bytes offset) in + children in deserialize_value bytes offset ;; diff --git a/lib/pinc_compiler/compiler.ml b/lib/pinc_compiler/compiler.ml index c276254..5967e81 100644 --- a/lib/pinc_compiler/compiler.ml +++ b/lib/pinc_compiler/compiler.ml @@ -691,13 +691,48 @@ and compile_let_group_stmt t definitions = in List.fold_left (compile_let_stmt ~predefined) t definitions -and compile_template_node _t (node : Pinc_Types.Ast.template_node) = +and compile_template_node t (node : Pinc_Types.Ast.template_node) = match node.template_node_desc with - | TextTemplateNode _ -> raise_notrace TODO - | FragmentTemplateNode _ -> raise_notrace TODO - | ExpressionTemplateNode _ -> raise_notrace TODO - | HtmlTemplateNode _ -> raise_notrace TODO + | TextTemplateNode s -> emit_constant t (Pinc_Bytecode.Value.String s) + | FragmentTemplateNode children -> compile_template_node_fragment t children + | ExpressionTemplateNode e -> compile_expr t e + | HtmlTemplateNode + { + html_tag_identifier = id; + html_tag_attributes = attributes; + html_tag_children = children; + } -> compile_template_node_html_tag t ~id ~attributes ~children | ComponentTemplateNode _ -> raise_notrace TODO + +and compile_template_node_html_tag t ~id ~attributes ~children = + let t = emit_constant t (Pinc_Bytecode.Value.String 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_Html_Template in + t + +and compile_template_node_fragment t children = + let t = compile_template_node_children t children in + let t = emit t @@ Pinc_Bytecode.Instruction.I_Fragment_Template in + t + +and compile_template_node_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_template_node_children t children = + let t = List.fold_left compile_template_node t children in + let length = List.length children in + let t = emit_constant t (Pinc_Bytecode.Value.Int length) in + let t = emit t @@ Pinc_Bytecode.Instruction.I_Array in + t ;; let compile_declaration (decl : Pinc_Types.Ast.declaration) t = diff --git a/lib/pinc_interpreter/HTML.ml b/lib/pinc_core/HTML.ml similarity index 100% rename from lib/pinc_interpreter/HTML.ml rename to lib/pinc_core/HTML.ml diff --git a/lib/pinc_interpreter/HTML.mli b/lib/pinc_core/HTML.mli similarity index 100% rename from lib/pinc_interpreter/HTML.mli rename to lib/pinc_core/HTML.mli diff --git a/lib/pinc_core/Pinc_Core.ml b/lib/pinc_core/Pinc_Core.ml index 5a46276..40432e9 100644 --- a/lib/pinc_core/Pinc_Core.ml +++ b/lib/pinc_core/Pinc_Core.ml @@ -4,6 +4,7 @@ module StringSet = StringSet module SymbolTable = SymbolTable module Identifier = Identifier module Utf8String = Utf8String +module HTML = HTML module Dedent = struct let indentation = diff --git a/lib/pinc_vm/vm.ml b/lib/pinc_vm/vm.ml index 3ddcc1e..bc6d7ea 100644 --- a/lib/pinc_vm/vm.ml +++ b/lib/pinc_vm/vm.ml @@ -914,6 +914,32 @@ let execute_return t = call_next_instruction t ;; +let execute_html_template t = + let children = Stack.pop_value t.stack in + let attributes = Stack.pop_value t.stack in + let tag = Stack.pop_value t.stack in + let html_node = + match (tag, attributes, children) with + | Value.String tag, Value.Record attributes, Value.Array children -> + Value.{ tag; attributes; children } + | _ -> assert false + in + let html_template_node = Value.HtmlTemplateNode html_node in + Stack.push_value t.stack html_template_node; + call_next_instruction t +;; + +let execute_fragment_template t = + let children = Stack.pop_value t.stack in + let children = + match children with + | Value.Array children -> children + | _ -> assert false + in + Stack.push_value t.stack @@ Value.FragmentTemplateNode children; + call_next_instruction t +;; + let execute_halt t = t let resolve_instructions instructions = @@ -963,6 +989,8 @@ let resolve_instructions instructions = | Instruction.I_Return -> execute_return | Instruction.I_Length -> execute_length | Instruction.I_Current_Closure -> execute_current_closure + | Instruction.I_Html_Template -> execute_html_template + | Instruction.I_Fragment_Template -> execute_fragment_template | Instruction.I_Halt -> execute_halt) instructions ;; @@ -980,6 +1008,10 @@ let resolve_constant_functions ~function_count constants = | Value.String _ -> () | Value.Array a -> Array.iter resolve_from_value a | Value.Record r -> StringMap.iter (fun _ -> resolve_from_value) r + | Value.HtmlTemplateNode { tag = _; attributes; children } -> + StringMap.iter (fun _ -> resolve_from_value) attributes; + Array.iter resolve_from_value children + | Value.FragmentTemplateNode children -> Array.iter resolve_from_value children | Value.Function fn -> let instructions = resolve_instructions fn.instructions in Array.set resolved_functions fn.fn_addr instructions diff --git a/test/vm/html.pi b/test/vm/html.pi new file mode 100644 index 0000000..1923867 --- /dev/null +++ b/test/vm/html.pi @@ -0,0 +1,37 @@ +component HtmlElement { +
+} + +component HtmlElementAttributes { +
+} + +component HtmlElementSelfClosingVoid { + +} + +component HtmlElementChildren { +
+

Enim commodo velit excepteur aute amet ut ad dolore.

+

Non et commodo anim eiusmod incididunt sint labore aliqua Lorem ea excepteur mollit sit.

+

Tempor ex aute minim ut minim excepteur enim aute.

+
+} + +component HtmlElementExpressions { + let class = "let-binding"; + let child = fn () ->