From dfd35511b191da2c03195bc43e6382bc7d8b3a4e Mon Sep 17 00:00:00 2001 From: Torben Ewert Date: Wed, 24 Jun 2026 21:57:14 +0200 Subject: [PATCH] feat: compile strings, string interpolation and concatenation --- lib/pinc_bytecode/instruction.ml | 10 +++++-- lib/pinc_bytecode/value.ml | 6 +++++ lib/pinc_compiler/compiler.ml | 45 +++++++++++++++++++++++--------- lib/pinc_vm/vm.ml | 23 +++++++++++++++- test/vm/run.t | 31 ++++++++++++++++++++++ test/vm/strings.pi | 12 +++++++++ 6 files changed, 112 insertions(+), 15 deletions(-) create mode 100644 test/vm/strings.pi diff --git a/lib/pinc_bytecode/instruction.ml b/lib/pinc_bytecode/instruction.ml index 74de0a5..14408ea 100644 --- a/lib/pinc_bytecode/instruction.ml +++ b/lib/pinc_bytecode/instruction.ml @@ -24,6 +24,7 @@ type t = | I_Jump_If_False of Int32.t | I_Set_Global of Int32.t | I_Get_Global of Int32.t + | I_Concat let byte = function | I_Pop -> 0x00 @@ -51,6 +52,7 @@ let byte = function | I_Null -> 0x16 | I_Set_Global _ -> 0x17 | I_Get_Global _ -> 0x18 + | I_Concat -> 0x19 ;; let operands_length = function @@ -75,7 +77,8 @@ let operands_length = function | I_Or | I_Minus | I_Not - | I_Null -> 0 + | I_Null + | I_Concat -> 0 ;; let decode bytes offset = @@ -117,6 +120,7 @@ let decode bytes offset = | 0x18 -> let offset, addr = Int32.read_bytes bytes offset in (offset, I_Get_Global addr) + | 0x19 -> (offset, I_Concat) | _ -> raise_notrace (Invalid_argument (Printf.sprintf "unknown instruction: 0x%.2X" instruction)) @@ -148,6 +152,7 @@ let pp fmt = function | I_Null -> Format.fprintf fmt "I_Null" | I_Get_Global addr -> Format.fprintf fmt "I_Get_Global %a" Int32.pp addr | I_Set_Global addr -> Format.fprintf fmt "I_Set_Global %a" Int32.pp addr + | I_Concat -> Format.fprintf fmt "I_Concat" ;; let to_bytes t = @@ -183,7 +188,8 @@ let to_bytes t = | I_Or | I_Minus | I_Not - | I_Null -> () + | I_Null + | I_Concat -> () in bytes diff --git a/lib/pinc_bytecode/value.ml b/lib/pinc_bytecode/value.ml index abbf3ba..46dc0e0 100644 --- a/lib/pinc_bytecode/value.ml +++ b/lib/pinc_bytecode/value.ml @@ -3,12 +3,14 @@ type t = | Int of int | Float of float | Bool of bool + | String of string let pp fmt = function | Null -> Format.fprintf fmt "\n%!" | Int i -> Format.fprintf fmt "%i\n%!" i | Float f -> Format.fprintf fmt "%f\n%!" f | Bool b -> Format.fprintf fmt "%b\n%!" b + | String s -> Format.fprintf fmt "%S\n%!" s ;; let to_string = function @@ -17,6 +19,7 @@ let to_string = function | Float f when Float.is_integer f -> string_of_int (int_of_float f) | Float f -> string_of_float f | Bool b -> string_of_bool b + | String s -> s ;; let is_true = function @@ -24,6 +27,7 @@ let is_true = function | Bool b -> b | Int _ -> true | Float _ -> true + | String s -> s <> "" ;; let equal a b = @@ -33,6 +37,7 @@ let equal a b = | Float a, Int b -> a = float_of_int b | Int a, Float b -> float_of_int a = b | Bool a, Bool b -> a = b + | String a, String b -> a = b | Null, Null -> true | _ -> false ;; @@ -44,6 +49,7 @@ let compare a b = | Float a, Int b -> Float.compare a (float_of_int b) | Int a, Float b -> Float.compare (float_of_int a) b | Bool a, Bool b -> Bool.compare a b + | String a, String b -> String.compare a b | Null, Null -> 0 | _ -> 0 ;; diff --git a/lib/pinc_compiler/compiler.ml b/lib/pinc_compiler/compiler.ml index dbe9c02..a430158 100644 --- a/lib/pinc_compiler/compiler.ml +++ b/lib/pinc_compiler/compiler.ml @@ -72,26 +72,47 @@ let add_symbol t name = ({ t with symbol_table }, SymbolTable.length symbol_table) ;; +let get_symbol ~loc t name = + let symbol = SymbolTable.resolve_symbol t.symbol_table ~name in + match symbol with + | None -> Pinc_Diagnostics.raise_error loc ("Unbound identifier `" ^ name ^ "`") + | Some symbol -> symbol +;; + +let compile_string_template t s = + s + |> List.fold_left + (fun (t, index) template -> + let t = + match template.Pinc_Types.Ast.string_template_desc with + | StringInterpolation (Lowercase_Id (name, loc)) -> + let symbol = get_symbol t ~loc name in + emit t @@ Pinc_Bytecode.Instruction.I_Get_Global symbol.address + | StringText s -> emit_constant t (Pinc_Bytecode.Value.String s) + in + let t = + if index > 0 then + emit t @@ Pinc_Bytecode.Instruction.I_Concat + else + t + in + (t, succ index)) + (t, 0) + |> fst +;; + let rec compile_expr t (expr : Pinc_Types.Ast.expression) = match expr.expression_desc with | Void -> t - | String _ -> raise_notrace TODO + | String s -> compile_string_template t s | Char _ -> raise_notrace TODO | Int i -> emit_constant t (Pinc_Bytecode.Value.Int i) | Float f -> emit_constant t (Pinc_Bytecode.Value.Float f) | Bool true -> emit t Pinc_Bytecode.Instruction.I_True | Bool false -> emit t Pinc_Bytecode.Instruction.I_False | LowercaseIdentifierExpression name -> - let symbol = SymbolTable.resolve_symbol t.symbol_table ~name in - let t = - match symbol with - | None -> - Pinc_Diagnostics.raise_error - expr.expression_loc - ("Unbound identifier `" ^ name ^ "`") - | Some symbol -> emit t @@ Pinc_Bytecode.Instruction.I_Get_Global symbol.address - in - t + let symbol = get_symbol ~loc:expr.expression_loc t name in + emit t @@ Pinc_Bytecode.Instruction.I_Get_Global symbol.address | ExternalFunction _ -> raise_notrace TODO | UppercaseIdentifierExpression _ -> raise_notrace TODO | Array _ -> raise_notrace TODO @@ -133,7 +154,7 @@ and compile_binary_expression t ~left ~op ~right = emit t Pinc_Bytecode.Instruction.I_Less_Equal | Pinc_Types.Operators.Binary.AND -> emit t Pinc_Bytecode.Instruction.I_And | Pinc_Types.Operators.Binary.OR -> emit t Pinc_Bytecode.Instruction.I_Or - | Pinc_Types.Operators.Binary.CONCAT -> raise_notrace TODO + | Pinc_Types.Operators.Binary.CONCAT -> emit t Pinc_Bytecode.Instruction.I_Concat | Pinc_Types.Operators.Binary.DOT_ACCESS -> raise_notrace TODO | Pinc_Types.Operators.Binary.BRACKET_ACCESS -> raise_notrace TODO | Pinc_Types.Operators.Binary.FUNCTION_CALL -> raise_notrace TODO diff --git a/lib/pinc_vm/vm.ml b/lib/pinc_vm/vm.ml index 4c1c516..c5c5365 100644 --- a/lib/pinc_vm/vm.ml +++ b/lib/pinc_vm/vm.ml @@ -39,7 +39,7 @@ let rec execute_binary_operation t op = | Pinc_Types.Operators.Binary.LESS_EQUAL -> execute_binary_less_equal l r | Pinc_Types.Operators.Binary.AND -> execute_binary_and l r | Pinc_Types.Operators.Binary.OR -> execute_binary_or l r - | Pinc_Types.Operators.Binary.CONCAT -> raise_notrace TODO + | Pinc_Types.Operators.Binary.CONCAT -> execute_binary_concat l r | Pinc_Types.Operators.Binary.DOT_ACCESS -> raise_notrace TODO | Pinc_Types.Operators.Binary.BRACKET_ACCESS -> raise_notrace TODO | Pinc_Types.Operators.Binary.FUNCTION_CALL -> raise_notrace TODO @@ -118,6 +118,26 @@ and execute_binary_pow l r = | (Value.Int _ | Value.Float _), _ | _, (Value.Int _ | Value.Float _) | _ -> raise_notrace (Invalid_argument "Trying to raise non numeric values.") +and execute_binary_concat l r = + let buf = Buffer.create 32 in + let () = + match (l, r) with + | Value.String a, Value.String b -> + Buffer.add_string buf a; + Buffer.add_string buf b + (* | Value.String a, Value.Char b -> + Buffer.add_string buf a; + Buffer.add_utf_8_uchar buf b + | Value.Char a, Value.String b -> + Buffer.add_utf_8_uchar buf a; + Buffer.add_string buf b + | Value.Char a, Value.Char b -> + Buffer.add_utf_8_uchar buf a; + Buffer.add_utf_8_uchar buf b *) + | _ -> raise_notrace (Invalid_argument "Trying to concat non string literals.") + in + Value.String (Buffer.contents buf) + and execute_binary_equal l r = if Value.equal l r then Value.constant_true @@ -222,6 +242,7 @@ let run t = | Instruction.I_Less_Equal -> execute_binary_operation t Operators.Binary.LESS_EQUAL | Instruction.I_And -> execute_binary_operation t Operators.Binary.AND | Instruction.I_Or -> execute_binary_operation t Operators.Binary.OR + | Instruction.I_Concat -> execute_binary_operation t Operators.Binary.CONCAT | Instruction.I_Minus -> execute_unary_operation t Operators.Unary.MINUS | Instruction.I_Not -> execute_unary_operation t Operators.Unary.NOT | Instruction.I_Jump addr -> ip := Int32.to_int addr diff --git a/test/vm/run.t b/test/vm/run.t index d7455a4..22353e6 100644 --- a/test/vm/run.t +++ b/test/vm/run.t @@ -250,3 +250,34 @@ Unbound identifier `one` [1] + + $ NO_COLOR="1" print_vm . String + Hello! + + $ NO_COLOR="1" print_instructions . String + 0000 I_Constant 0x00000001 (00000001) + 0005 I_Pop + + $ NO_COLOR="1" print_vm . StringConcat + Hello World! + + $ NO_COLOR="1" print_instructions . StringConcat + 0000 I_Constant 0x00000001 (00000001) + 0005 I_Constant 0x00000002 (00000002) + 0010 I_Concat + 0011 I_Constant 0x00000003 (00000003) + 0016 I_Concat + 0017 I_Pop + + $ NO_COLOR="1" print_vm . StringInterpolation + Hello World! + + $ NO_COLOR="1" print_instructions . StringInterpolation + 0000 I_Constant 0x00000001 (00000001) + 0005 I_Set_Global 0x00000001 (00000001) + 0010 I_Constant 0x00000002 (00000002) + 0015 I_Get_Global 0x00000001 (00000001) + 0020 I_Concat + 0021 I_Constant 0x00000003 (00000003) + 0026 I_Concat + 0027 I_Pop diff --git a/test/vm/strings.pi b/test/vm/strings.pi new file mode 100644 index 0000000..70af512 --- /dev/null +++ b/test/vm/strings.pi @@ -0,0 +1,12 @@ +component String { + "Hello!" +} + +component StringConcat { + "Hello " ++ "World" ++ "!" +} + +component StringInterpolation { + let subject = "World"; + "Hello $(subject)!" +} -- 2.54.0