refactor(syntax): encapsulate smtml.value in a syntax module

This commit removes dynamic types from the lexer/parser, as they are now
represented by normal strings in the typeof operator. Therefore, there is
no need to store a type as a value. This change should not break any existing
functionality.

ECMA-SL/semantics/core/concrete/external.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open EslSyntax
 
@@ -42,17 +41,7 @@ module Impl = struct
     | App (`Op "symbol", [ Str _ ]) -> Str "symbol"
     | App (`Op "loc", [ Int _ ]) -> Str "object"
     | List _ -> Str "list"
-    | App (`Op "NullType", [])
-    | App (`Op "IntType", [])
-    | App (`Op "FltType", [])
-    | App (`Op "StrType", [])
-    | App (`Op "BoolType", [])
-    | App (`Op "SymbolType", [])
-    | App (`Op "LocType", [])
-    | App (`Op "ListType", [])
-    | App (`Op "TupleType", [])
-    | App (`Op "CurryType", []) ->
-      Str "type"
+    | App (`Op "type", [ Str _ ]) -> Str "type"
     | App (`Op _, _) -> Str "curry"
     | _ -> unexpected_err 1 op_lbl "value type"
 

ECMA-SL/semantics/core/concrete/instrumentors/debugger/debugger_cmd.ml

@@ -1,4 +1,3 @@
-open Smtml
 open Debugger_types
 
 module Message = struct

ECMA-SL/semantics/core/concrete/instrumentors/monitor.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslSyntax
 
 type stmt_eval =

ECMA-SL/semantics/core/concrete/instrumentors/monitors/nsu/domains/NSULabel.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslSyntax
 
 type 'sl t =

ECMA-SL/semantics/core/concrete/instrumentors/tracer.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open EslSyntax
 open EslBase.Fmt
@@ -51,7 +50,7 @@ let rec heapval_pp ?(depth : int = 0) (heap : heap) (ppf : Fmt.t) (v : Value.t)
     match Heap.get heap l with
     | Ok obj -> Object.pp (heapval_pp ~depth:(depth + 1) heap) ppf obj
     | _ -> pp_str ppf "{ ??? }" )
-  | _ -> EExpr.pp_val ppf v
+  | _ -> Value.pp ppf v
 
 let val_pp (limit : int) (ppf : Fmt.t) (v_str : string) : unit =
   (Font.pp_err [ Cyan ] (Truncate.pp limit pp_str)) ppf v_str

ECMA-SL/semantics/core/concrete/interpreter.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open EslSyntax
 open EslSyntax.Source
@@ -166,7 +165,7 @@ module M (Instrument : Instrument.M) = struct
       Hashtbl.add visited l ();
       (Object.pp heapval_pp') ppf (get_loc heap l);
       Hashtbl.remove visited l
-    | _ -> EExpr.pp_custom_val heapval_pp' ppf v
+    | _ -> Value.pp_custom_val heapval_pp' ppf v
 
   let print_pp (heap : heap) (ppf : Fmt.t) (v : Value.t) : unit =
     match v with

ECMA-SL/semantics/core/parser/lexer.mll

@@ -144,7 +144,6 @@ rule read =
   | '>'               { GT }
   | "<="              { LE }
   | ">="              { GE }
-  | "__$"             { read_type lexbuf }
   | '"'               { read_string (Buffer.create 16) lexbuf }
   | int               { INT (int_of_string (Lexing.lexeme lexbuf)) }
   | float             { FLOAT (float_of_string (Lexing.lexeme lexbuf)) }
@@ -198,19 +197,3 @@ and read_comment =
   | newline { new_line lexbuf; read_comment lexbuf }
   | _       { read_comment lexbuf }
   | eof     { raise (create_syntax_error ~eof:true "Comment is not terminated" lexbuf)}
-
-(* ========== Runtime type reader ========== *)
-
-and read_type =
-  parse
-  | "Null"   { DTYPE_NULL }
-  | "Int"    { DTYPE_INT }
-  | "Flt"    { DTYPE_FLT }
-  | "Str"    { DTYPE_STR }
-  | "Bool"   { DTYPE_BOOL }
-  | "Symbol" { DTYPE_SYMBOL }
-  | "Obj"    { DTYPE_LOC }
-  | "List"   { DTYPE_LIST }
-  | "Tuple"  { DTYPE_TUPLE }
-  | "Curry"  { DTYPE_CURRY }
-  | _        { raise (create_syntax_error "Unexpected runtime type" lexbuf) }

ECMA-SL/semantics/core/parser/parser.mly

@@ -3,7 +3,6 @@
 (* ================================= *)
 
 %{
-  open Smtml
   open EslSyntax
   open EslSyntax.Source
 
@@ -58,12 +57,6 @@
 %token OBJECT_TO_LIST OBJECT_FIELDS
 %token OBJECT_MEM
 
-(* ========== Runtime type tokens ========== *)
-
-%token DTYPE_NULL
-%token DTYPE_INT DTYPE_FLT DTYPE_STR DTYPE_BOOL DTYPE_SYMBOL
-%token DTYPE_LOC DTYPE_LIST DTYPE_TUPLE DTYPE_CURRY
-
 (* ========== Precedence and associativity ========== *)
 
 %left LAND LOR
@@ -211,18 +204,5 @@ let val_target :=
   | f = FLOAT;           < Value.Real >
   | s = STRING;          < Value.Str >
   | b = BOOLEAN;         { if b then Value.True else Value.False }
-  | s = SYMBOL;          { Value.App (`Op "symbol", [Value.Str s])}
   | l = LOC;             { Value.App (`Op "loc", [Value.Int l])}
-  | t = dtype_target;    { Value.App (`Op t, []) }
-
-let dtype_target :=
-  | DTYPE_NULL;          { "NullType" }
-  | DTYPE_INT;           { "IntType" }
-  | DTYPE_FLT;           { "FltType" }
-  | DTYPE_STR;           { "StrType" }
-  | DTYPE_BOOL;          { "BoolType" }
-  | DTYPE_SYMBOL;        { "SymbolType" }
-  | DTYPE_LOC;           { "LocType" }
-  | DTYPE_LIST;          { "ListType" }
-  | DTYPE_TUPLE;         { "TupleType" }
-  | DTYPE_CURRY;         { "CurryType" }
+  | s = SYMBOL;          { Value.App (`Op "symbol", [Value.Str s])}

ECMA-SL/semantics/core/parser/parsing_helper.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslSyntax
 open EslSyntax.Source
 

ECMA-SL/semantics/error/compile_error.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open EslSyntax
 module ErrSrc = Error_source
@@ -75,7 +74,7 @@ module CompileErr : Error_type.ERROR_TYPE with type t = msg = struct
     | BadNArgs (npxs, nargs) ->
       format ppf "Expected %d arguments, but got %d." npxs nargs
     | DuplicatedSwitchCase v ->
-      format ppf "Duplicated case value '%a' for switch statement." EExpr.pp_val
+      format ppf "Duplicated case value '%a' for switch statement." Value.pp
         v
     | DuplicatedTField fn ->
       format ppf "Duplicated field name '%a' for object type." Id.pp fn

ECMA-SL/semantics/error/error_trace.ml

@@ -1,5 +1,5 @@
 open EslBase
-open Smtml
+open EslSyntax
 
 type t = Value.t Store.t Call_stack.t
 

ECMA-SL/semantics/error/runtime_error.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open EslSyntax
 module ErrSrc = Error_source
@@ -57,7 +56,7 @@ module RuntimeErr : Error_type.ERROR_TYPE with type t = msg = struct
     | Custom msg' -> format ppf "%s" msg'
     | Unexpected msg -> format ppf "Unexpected %s." msg
     | UnexpectedExitVal v ->
-      format ppf "Unexpected exit value '%a'." EExpr.pp_val v
+      format ppf "Unexpected exit value '%a'." Value.pp v
     | Failure msg -> format ppf "Failure %s." msg
     | UncaughtExn msg -> format ppf "Uncaught exception %s." msg
     | OpEvalErr oplbl -> format ppf "Exception in Operator.%s." oplbl
@@ -66,18 +65,18 @@ module RuntimeErr : Error_type.ERROR_TYPE with type t = msg = struct
     | BadNArgs (npxs, nargs) ->
       format ppf "Expected %d arguments, but got %d." npxs nargs
     | BadVal (texpr, v) ->
-      format ppf "Expecting %s value, but got '%a'." texpr EExpr.pp_val v
+      format ppf "Expecting %s value, but got '%a'." texpr Value.pp v
     | BadExpr (texpr, v) ->
-      format ppf "Expecting %s expression, but got '%a'." texpr EExpr.pp_val v
+      format ppf "Expecting %s expression, but got '%a'." texpr Value.pp v
     | BadFuncId v ->
-      format ppf "Expecting a function identifier, but got '%a'." EExpr.pp_val v
+      format ppf "Expecting a function identifier, but got '%a'." Value.pp v
     | BadOpArgs (texpr, vs) when List.length vs = 1 ->
       format ppf "Expecting argument of type '%s', but got '%a'." texpr
-        (pp_lst !>", " EExpr.pp_val)
+        (pp_lst !>", " Value.pp)
         vs
     | BadOpArgs (texpr, vs) ->
       format ppf "Expecting arguments of types '%s', but got '(%a)'." texpr
-        (pp_lst !>", " EExpr.pp_val)
+        (pp_lst !>", " Value.pp)
         vs
     | MissingReturn fn -> format ppf "Missing return in function '%a'." Id.pp fn
 

ECMA-SL/semantics/extended/compiler/compiler.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open EslSyntax
 open EslSyntax.Source

ECMA-SL/semantics/extended/parser/eLexer.mll

@@ -181,7 +181,6 @@ rule read =
   | "<="              { LE }
   | ">="              { GE }
   | "->"              { RIGHT_ARROW }
-  | "__$"             { read_type lexbuf }
   | '"'               { read_string (Buffer.create 16) lexbuf }
   | int               { INT (int_of_string (Lexing.lexeme lexbuf)) }
   | float             { FLOAT (float_of_string (Lexing.lexeme lexbuf)) }
@@ -238,19 +237,3 @@ and read_comment =
   | newline { new_line lexbuf; read_comment lexbuf }
   | _       { read_comment lexbuf }
   | eof     { raise (create_syntax_error ~eof:true "Comment is not terminated" lexbuf)}
-
-(* ========== Runtime type reader ========== *)
-
-and read_type =
-  parse
-  | "Null"   { DTYPE_NULL }
-  | "Int"    { DTYPE_INT }
-  | "Flt"    { DTYPE_FLT }
-  | "Str"    { DTYPE_STR }
-  | "Bool"   { DTYPE_BOOL }
-  | "Symbol" { DTYPE_SYMBOL }
-  | "Obj"    { DTYPE_LOC }
-  | "List"   { DTYPE_LIST }
-  | "Tuple"  { DTYPE_TUPLE }
-  | "Curry"  { DTYPE_CURRY }
-  | _        { raise (create_syntax_error "Unexpected runtime type" lexbuf) }

ECMA-SL/semantics/extended/parser/eParser.mly

@@ -3,7 +3,6 @@
 (* ================================= *)
 
 %{
-  open Smtml
   open EslSyntax
   open EslSyntax.Source
 
@@ -70,12 +69,6 @@
 %token OBJECT_TO_LIST OBJECT_FIELDS
 %token OBJECT_MEM
 
-(* ========== Runtime type tokens ========== *)
-
-%token DTYPE_NULL
-%token DTYPE_INT DTYPE_FLT DTYPE_STR DTYPE_BOOL DTYPE_SYMBOL
-%token DTYPE_LOC DTYPE_LIST DTYPE_TUPLE DTYPE_CURRY
-
 (* ========== Type system tokens ========== *)
 
 %token TYPEDEF
@@ -353,21 +346,8 @@ let val_target :=
   | f = FLOAT;           < Value.Real >
   | s = STRING;          < Value.Str >
   | b = BOOLEAN;         { if b then Value.True else Value.False }
-  | s = SYMBOL;          { Value.App (`Op "symbol", [Value.Str s])}
   | l = LOC;             { Value.App (`Op "loc", [Value.Int l])}
-  | t = dtype_target;    { Value.App (`Op t, []) }
-
-let dtype_target :=
-  | DTYPE_NULL;          { "NullType" }
-  | DTYPE_INT;           { "IntType" }
-  | DTYPE_FLT;           { "FltType" }
-  | DTYPE_STR;           { "StrType" }
-  | DTYPE_BOOL;          { "BoolType" }
-  | DTYPE_SYMBOL;        { "SymbolType" }
-  | DTYPE_LOC;           { "LocType" }
-  | DTYPE_LIST;          { "ListType" }
-  | DTYPE_TUPLE;         { "TupleType" }
-  | DTYPE_CURRY;         { "CurryType" }
+  | s = SYMBOL;          { Value.App (`Op "symbol", [Value.Str s])}
 
 (* ==================== Operators ==================== *)
 

ECMA-SL/semantics/extended/typing/tExpr.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open EslSyntax
 open EslSyntax.Source

ECMA-SL/syntax/core/expr.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 
 type t = t' Source.phrase
@@ -16,7 +15,7 @@ and t' =
 let rec pp (ppf : Fmt.t) (e : t) : unit =
   let open Fmt in
   match e.it with
-  | Val v -> EExpr.pp_val ppf v
+  | Val v -> Value.pp ppf v
   | Var x -> pp_str ppf x
   | UnOpt (op, e') -> Operator.pp_of_unopt pp ppf (op, e')
   | BinOpt (op, e1, e2) -> Operator.pp_of_binopt pp ppf (op, e1, e2)

ECMA-SL/syntax/core/stmt.ml

@@ -64,7 +64,7 @@ let rec pp (ppf : Fmt.t) (s : t) : unit =
     format ppf "if (%a) %a%a" Expr.pp e pp s1 (pp_opt pp_else) s2
   | While (e, s') -> format ppf "while (%a) %a" Expr.pp e pp s'
   | Switch (e, css, dflt) ->
-    let pp_case ppf (v, s) = format ppf "\ncase %a: %a" EExpr.pp_val v pp s in
+    let pp_case ppf (v, s) = format ppf "\ncase %a: %a" Value.pp v pp s in
     let pp_default ppf s = format ppf "\nsdefault: %a" pp s in
     format ppf "switch (%a) {%a%a\n}" Expr.pp e (pp_hashtbl !>"" pp_case) css
       (pp_opt pp_default) dflt

ECMA-SL/syntax/dune

@@ -8,6 +8,7 @@
   id
   loc
   type
+  value
   source
   object
   operator

ECMA-SL/syntax/extended/eExpr.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open Source
 
@@ -20,49 +19,10 @@ and t' =
   | Curry of t * t list
   | Symbolic of Type.t * t
 
-let is_special_number (s : string) : bool =
-  List.mem s [ "nan"; "inf"; "-inf" ]
-  || String.contains s 'e'
-  || String.contains s 'E'
-
-let float_str (f : float) : string =
-  let f_str = Printf.sprintf "%.17g" f in
-  if is_special_number f_str || String.contains f_str '.' then f_str
-  else f_str ^ ".0"
-
-let pp_custom_val (pp_inner_val : Fmt.t -> Smtml.Value.t -> unit) (ppf : Fmt.t)
-  (v : Smtml.Value.t) : unit =
-  let open Fmt in
-  match v with
-  | App (`Op "null", []) -> format ppf "null"
-  | App (`Op "void", []) -> ()
-  | Int i -> format ppf "%i" i
-  | Real f -> format ppf "%s" (float_str f)
-  | Str s -> format ppf "%S" s
-  | True -> format ppf "true"
-  | False -> format ppf "false"
-  | App (`Op "symbol", [ Str s ]) -> format ppf "'%s" s
-  | App (`Op "loc", [ Int l ]) -> Loc.pp ppf l
-  | List lst -> format ppf "[%a]" (pp_lst !>", " pp_inner_val) lst
-  | App (`Op "NullType", []) -> format ppf "null"
-  | App (`Op "IntType", []) -> format ppf "int"
-  | App (`Op "FltType", []) -> format ppf "float"
-  | App (`Op "StrType", []) -> format ppf "string"
-  | App (`Op "BoolType", []) -> format ppf "bool"
-  | App (`Op "SymbolType", []) -> format ppf "symbol"
-  | App (`Op "LocType", []) -> format ppf "object"
-  | App (`Op "ListType", []) -> format ppf "list"
-  | App (`Op "CurryType", []) -> format ppf "curry"
-  | App (`Op fn, fvs) ->
-    format ppf "{%S}@(%a)" fn (pp_lst !>", " pp_inner_val) fvs
-  | _ -> Log.fail "Val.pp_custom_val: unexpected case"
-
-let rec pp_val (ppf : Fmt.t) (v : Value.t) : unit = pp_custom_val pp_val ppf v
-
 let rec pp (ppf : Fmt.t) (e : t) : unit =
   let open Fmt in
   match e.it with
-  | Val v -> pp_val ppf v
+  | Val v -> Value.pp ppf v
   | Var x -> pp_str ppf x
   | GVar x -> format ppf "|%s|" x
   | Const c -> Operator.pp_of_const ppf c

ECMA-SL/syntax/extended/ePat.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open Source
 module Meta = EMetadata.Pat
@@ -13,7 +12,7 @@ and pv' =
 let pv_pp (ppf : Fmt.t) (pv : pv) : unit =
   match pv.it with
   | PatVar x -> Fmt.pp_str ppf x
-  | PatVal v -> EExpr.pp_val ppf v
+  | PatVal v -> Value.pp ppf v
   | PatNone -> Fmt.pp_str ppf "None"
 
 let pv_str (pv : pv) : string = Fmt.str "%a" pv_pp pv

ECMA-SL/syntax/extended/eType.ml

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open Source
 
@@ -122,7 +121,7 @@ let rec pp (ppf : Fmt.t) (t : t) : unit =
   | StringType -> pp_str ppf "string"
   | BooleanType -> pp_str ppf "boolean"
   | SymbolType -> pp_str ppf "symbol"
-  | LiteralType (_, tl) -> EExpr.pp_val ppf (tliteral_to_val tl)
+  | LiteralType (_, tl) -> Value.pp ppf (tliteral_to_val tl)
   | ObjectType { flds; smry; _ } when Hashtbl.length flds = 0 ->
     let pp_smry ppf (_, tsmry) = format ppf " *: %a " pp tsmry in
     format ppf "{%a}" (pp_opt pp_smry) smry