feat(value): add runtime value representation
This commit is contained in:
1 parent
e3ff306205
commit
296e6ffe54
1 file changed
+83
@@ -0,0 +1,83 @@
|
||||
module Fml.Core.Value
|
||||
|
||||
open Fml.Core.Ast
|
||||
|
||||
// Runtime values shared by the tree-walking interpreter and the bytecode VM.
|
||||
// Interpreter closures carry a mutable environment cell so let rec can tie the
|
||||
// recursive knot. VM closures carry a code-object id plus a captured de Bruijn
|
||||
// environment cell for the same reason.
|
||||
|
||||
type Value =
|
||||
| VInt of int
|
||||
| VBool of bool
|
||||
| VString of string
|
||||
| VUnit
|
||||
| VTuple of Value list
|
||||
| VList of Value list
|
||||
| VConstruct of string * Value list
|
||||
| VRecord of Map<string, Value>
|
||||
| VClosure of string * Expr * Env ref
|
||||
| VCode of int * Value list ref
|
||||
| VBuiltin of string * (Value -> Value)
|
||||
|
||||
and Env = Map<string, Value>
|
||||
|
||||
exception RuntimeError of string
|
||||
|
||||
let rec valueEquals (a: Value) (b: Value) : bool =
|
||||
match a, b with
|
||||
| VInt x, VInt y -> x = y
|
||||
| VBool x, VBool y -> x = y
|
||||
| VString x, VString y -> x = y
|
||||
| VUnit, VUnit -> true
|
||||
| VTuple xs, VTuple ys -> List.length xs = List.length ys && List.forall2 valueEquals xs ys
|
||||
| VList xs, VList ys -> List.length xs = List.length ys && List.forall2 valueEquals xs ys
|
||||
| VConstruct(t1, xs), VConstruct(t2, ys) ->
|
||||
t1 = t2 && List.length xs = List.length ys && List.forall2 valueEquals xs ys
|
||||
| VRecord m1, VRecord m2 ->
|
||||
Map.count m1 = Map.count m2
|
||||
&& m1 |> Map.forall (fun k v -> match Map.tryFind k m2 with
|
||||
| Some w -> valueEquals v w
|
||||
| None -> false)
|
||||
| (VClosure _ | VBuiltin _ | VCode _), _
|
||||
| _, (VClosure _ | VBuiltin _ | VCode _) -> raise (RuntimeError "cannot compare functions for equality")
|
||||
| _ -> false
|
||||
|
||||
let private escapeString (s: string) =
|
||||
let sb = System.Text.StringBuilder()
|
||||
for ch in s do
|
||||
match ch with
|
||||
| '"' -> sb.Append("\\\"") |> ignore
|
||||
| '\\' -> sb.Append("\\\\") |> ignore
|
||||
| '\n' -> sb.Append("\\n") |> ignore
|
||||
| '\t' -> sb.Append("\\t") |> ignore
|
||||
| '\r' -> sb.Append("\\r") |> ignore
|
||||
| c -> sb.Append(c) |> ignore
|
||||
sb.ToString()
|
||||
|
||||
let rec prettyValue (v: Value) : string =
|
||||
match v with
|
||||
| VInt n -> string n
|
||||
| VBool b -> if b then "true" else "false"
|
||||
| VString s -> "\"" + escapeString s + "\""
|
||||
| VUnit -> "()"
|
||||
| VTuple parts -> "(" + (parts |> List.map prettyValue |> String.concat ", ") + ")"
|
||||
| VList items -> "[" + (items |> List.map prettyValue |> String.concat "; ") + "]"
|
||||
| VConstruct(name, []) -> name
|
||||
| VConstruct(name, [ single ]) -> name + " " + prettyAtom single
|
||||
| VConstruct(name, args) -> name + " (" + (args |> List.map prettyValue |> String.concat ", ") + ")"
|
||||
| VRecord fields ->
|
||||
let body =
|
||||
fields
|
||||
|> Map.toList
|
||||
|> List.map (fun (k, fv) -> k + " = " + prettyValue fv)
|
||||
|> String.concat "; "
|
||||
"{ " + body + " }"
|
||||
| VClosure _ -> "<fun>"
|
||||
| VCode _ -> "<fun>"
|
||||
| VBuiltin _ -> "<fun>"
|
||||
|
||||
and prettyAtom (v: Value) : string =
|
||||
match v with
|
||||
| VConstruct(_, _ :: _) -> "(" + prettyValue v + ")"
|
||||
| _ -> prettyValue v
|
||||
Reference in new issue
Block a user