General improvements to the ECMA-SL syntax

ECMA-SL/semantics/core/concrete/domains/heap.ml

@@ -43,7 +43,7 @@ let rec pp (pp_obj : Fmt.t -> 'a obj -> unit) (ppf : Fmt.t) (heap : 'a t) : unit
   let pp_binding ppf (loc, obj) = format ppf "%a: %a" Loc.pp loc pp_obj obj in
   let pp_map ppf map =
     if Loc.Tbl.length map = 0 then pp_str ppf "{}"
-    else format ppf "{ %a }" (Loc.Tbl.pp ", " pp_binding) map
+    else format ppf "{ %a }" (Loc.Tbl.pp !>", " pp_binding) map
   in
   let pp_parent ppf heap = format ppf "%a <- " (pp pp_obj) heap in
   format ppf "%a%a" (pp_opt pp_parent) heap.parent pp_map heap.map
@@ -61,7 +61,8 @@ let rec pp_tabular (pp_obj : Fmt.t -> 'a obj -> unit) (ppf : Fmt.t) (heap : 'a t
     format ppf "%s%a  <-  %a" (indent x) Loc.pp x pp_obj v
   in
   let pp_parent ppf heap = format ppf "%a\n\n^\n\n" (pp_tabular pp_obj) heap in
-  format ppf "%a%a" (pp_opt pp_parent) heap.parent (Loc.Tbl.pp "\n" pp_bind)
+  format ppf "%a%a" (pp_opt pp_parent) heap.parent
+    (Loc.Tbl.pp !>"\n" pp_bind)
     heap.map
 
 let str ?(tabular : bool = false) (pp_obj : Fmt.t -> 'a obj -> unit)

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

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open EslSyntax
 
@@ -42,17 +41,6 @@ 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 _, _) -> 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/debugger/debugger_tui_code.ml

@@ -47,13 +47,13 @@ let set_data (code : t) (at : Source.region) : t = { code with at }
 let render_static (code : t) : unit = Frame.draw code.frame
 
 let codeblock (nlines : int) (at : Source.region) : (int * string) list * int =
-  let file = Source.Code.get_file at.file in
-  let file_sz = Source.Code.get_file_size file in
+  let file = Code_utils.get_file at.file in
+  let file_sz = Code_utils.get_file_size file in
   let line = at.left.line in
   let prev_nlines = proportional_sz nlines 3 1 in
   let codeblock_start = max (line - prev_nlines) 1 in
   let codeblock_sz = min nlines (file_sz - codeblock_start + 1) in
-  let codeblock = Source.Code.get_lines file codeblock_start codeblock_sz in
+  let codeblock = Code_utils.get_lines file codeblock_start codeblock_sz in
   let last_line = codeblock_start + codeblock_sz in
   (codeblock, last_line)
 

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
@@ -68,7 +67,7 @@ module CallFmt = struct
 
   let pp_func_call (ppf : Fmt.t) ((lvl, s) : int * Stmt.t) : unit =
     let limit = Truncate.limit_indent lvl - 7 in
-    let pp_stmt = Font.pp_err [ Cyan ] (Truncate.pp limit Source.Code.pp) in
+    let pp_stmt = Font.pp_err [ Cyan ] (Truncate.pp limit Code_utils.pp) in
     format ppf "%a%a called%a" indent_pp lvl pp_stmt s.at
       (cond_region_pp (lvl + 1))
       s.at
@@ -138,8 +137,8 @@ module EslCodeFmt : CODE_FMT = struct
   let log_stmt (s : Stmt.t) : bool =
     s.at.real && match s.it with Skip | Merge | Block _ -> false | _ -> true
 
-  let expr_str (e : Expr.t) : string = Source.Code.str e.at
-  let stmt_pp (ppf : Fmt.t) (s : Stmt.t) : unit = Source.Code.pp ppf s.at
+  let expr_str (e : Expr.t) : string = Code_utils.str e.at
+  let stmt_pp (ppf : Fmt.t) (s : Stmt.t) : unit = Code_utils.pp ppf s.at
 end
 
 module CeslCodeFmt : CODE_FMT = struct

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

@@ -1,4 +1,3 @@
-open Smtml
 open EslBase
 open EslSyntax
 open EslSyntax.Source
@@ -112,8 +111,8 @@ module M (Instrument : Instrument.M) = struct
       (* TODO:x should change?*)
       Random.self_init ();
       match t with
-      | Type.IntType -> Value.Int (Random.int 128)
-      | Type.FltType -> Value.Real (Random.float 128.0)
+      | Type.Ty_int -> Value.Int (Random.int 128)
+      | Type.Ty_real -> Value.Real (Random.float 128.0)
       | _ -> Log.fail "not implemented: symbolic %a" Type.pp t )
 
   and eval_expr (state : state) (e : Expr.t) : Value.t =
@@ -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/functorial/symbolic_memory.ml

@@ -79,7 +79,7 @@ module Make (O : Object_intf.S with type value = V.value) = struct
     let pp_parent ppf v =
       pp_opt (fun ppf h -> format ppf "%a@ <-@ " pp h) ppf v
     in
-    format ppf "%a{ %a }" pp_parent parent (Loc.Tbl.pp ", " pp_v) data
+    format ppf "%a{ %a }" pp_parent parent (Loc.Tbl.pp !>", " pp_v) data
 
   let rec unfold_ite ~(accum : value) (e : value) : (value option * int) list =
     match E.view e with

ECMA-SL/semantics/core/functorial/symbolic_value.ml

@@ -224,22 +224,6 @@ module M = struct
       fun vs -> E.(make (List vs))
     | ArrayExpr -> assert false
 
-  let eval_type (t : Type.t) =
-    let open Ty in
-    match t with
-    | NullType -> Log.fail "eval_type null"
-    | IntType -> Ty_int
-    | FltType -> Ty_real
-    | StrType -> Ty_str
-    | BoolType -> Ty_bool
-    | SymbolType -> Log.fail "eval_type symbol"
-    | LocType -> Log.fail "eval_type loc"
-    | ArrayType -> Log.fail "eval_type array"
-    | ListType -> Ty_list
-    | TupleType -> Log.fail "eval_type tuple"
-    | TypeType -> Log.fail "eval_type type"
-    | CurryType -> Ty_app
-
   let rec eval_expr (store : store) (e : Expr.t) : value =
     match e.it with
     | Val v -> E.value v
@@ -270,7 +254,6 @@ module M = struct
       | _ -> Log.fail "error" )
     | Symbolic (t, x) -> (
       let x' = eval_expr store x in
-      let t = eval_type t in
       match E.view x' with
       | Val (Value.Str x') -> E.(make (Symbol (Symbol.make t x')))
       | _ -> Log.fail "error" )

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/dune

@@ -89,11 +89,12 @@
   ;  utils
   arith_utils
   byte_utils
+  code_utils
   date_utils
   parsing_utils
   string_utils)
  (preprocess
   (staged_pps ppx_import ppx_deriving.std))
- (libraries eslBase eslSyntax eslJSParser str menhirLib yojson curses smtml)
+ (libraries eslBase eslSyntax eslJSParser str menhirLib yojson curses)
  (instrumentation
   (backend bisect_ppx)))

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_source.ml

@@ -40,8 +40,12 @@ module ErrSrcFmt (ErrorType : Error_type.ERROR_TYPE) = struct
       (String.make (right - left) '^')
 
   let pp_region (ppf : Fmt.t) (region : region) : unit =
-    let (file, line, left, right) = region_unfold region in
-    let (start, code) = format_code (Code.line file line) in
+    (* FIXME: Improve this for multiple-lines *)
+    let file = region.file in
+    let line = region.left.line in
+    let left = region.left.column in
+    let right = region.right.column in
+    let (start, code) = format_code (Code_utils.line file line) in
     let (left', right') = (left - start, right - start) in
     Fmt.format ppf "\n%a\n%d |   %s\n%a%a" pp_location region line code
       pp_indent line pp_highlight (code, left', right')

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
@@ -357,9 +356,8 @@ and compile_fielddelete (at : region) (oe : EExpr.t) (fe : EExpr.t) : c_stmt =
   let (fe_s, fe_e) = compile_expr at fe in
   oe_s @ fe_s @ [ Stmt.FieldDelete (oe_e, fe_e) @?> at ]
 
-and compile_if
-  (ifcss : (EExpr.t * EStmt.t * EStmt_metadata.t list * region) list)
-  (elsecs : (EStmt.t * EStmt_metadata.t list) option) : c_stmt =
+and compile_if (ifcss : (EExpr.t * EStmt.t * EStmt.Meta.t list * region) list)
+  (elsecs : (EStmt.t * EStmt.Meta.t list) option) : c_stmt =
   let compile_ifcs_f (e, s, _, at) acc =
     let (e_s, e_e) = compile_expr at e in
     let sblock = Builder.block ~at:s.at (compile_stmt s) in

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) }