Welcome to the Tsonnet series!
If you're not following along, check out how it all started in the first post of the series.
In the previous post, I reorganized function parameters and centralized error messages for consistency:
The project is getting more complex and not having an option to debug the AST is becoming cumbersome. We'll quickly explore how to improve this.
deriving show
Sometimes we want to see a data type in the console in its raw form. We could implement a function to do that ourselves, but it's repetitive and boring. Enter ppx_deriving.show:
diff --git a/lib/dune b/lib/dune
index 75a7340..22e9961 100644
--- a/lib/dune
+++ b/lib/dune
@@ -4,7 +4,7 @@
(backend bisect_ppx))
(libraries yojson)
(preprocess
- (pps ppx_deriving_qcheck)))
+ (pps ppx_deriving.show ppx_deriving_qcheck)))
(menhir
(modules parser))
This saves you from manually writing boilerplate code to convert your types to strings.
Then we annotate the expr and other types, and it automatically generates the show and pp (pretty-printer) functions:
diff --git a/lib/ast.ml b/lib/ast.ml
index f7964a8..58c4439 100644
--- a/lib/ast.ml
+++ b/lib/ast.ml
@@ -5,25 +5,33 @@ type bin_op =
| Subtract
| Multiply
| Divide
- [@@deriving qcheck]
+ [@@deriving qcheck, show]
type unary_op =
| Plus
| Minus
| Not
| BitwiseNot
- [@@deriving qcheck]
+ [@@deriving qcheck, show]
type number =
| Int of int
| Float of float
- [@@deriving qcheck]
+ [@@deriving qcheck, show]
type position = {
startpos: Lexing.position;
endpos: Lexing.position;
}
+let pp_position fmt pos =
+ Format.fprintf fmt "%d:%d"
+ pos.startpos.pos_lnum
+ pos.endpos.pos_lnum
+
+let show_position pos =
+ Format.asprintf "%a" pp_position pos
+
let dummy_pos = {
startpos = Lexing.dummy_pos;
endpos = Lexing.dummy_pos;
@@ -34,7 +42,16 @@ module StringSet = struct
let compare = String.compare
end
-module ObjectFields = Set.Make(StringSet)
+module ObjectFields = struct
+ include Set.Make(StringSet)
+
+ let pp fmt s =
+ Format.fprintf fmt "{%s}"
+ (String.concat ", " (to_list s))
+
+ let show s =
+ Format.asprintf "%a" pp s
+end
type expr =
| Unit
@@ -45,8 +62,8 @@ type expr =
| Ident of position * string
| Array of position * expr list
| ParsedObject of position * object_entry list
- | RuntimeObject of position * Env.env_id * ObjectFields.t
- | ObjectPtr of Env.env_id * object_scope
+ | RuntimeObject of position * (Env.env_id [@opaque]) * ObjectFields.t
+ | ObjectPtr of (Env.env_id [@opaque]) * object_scope
| ObjectFieldAccess of position * object_scope * expr list
| BinOp of position * bin_op * expr * expr
| UnaryOp of position * unary_op * expr
@@ -59,9 +76,15 @@ and object_entry =
and object_scope =
| Self
| TopLevel
+[@@deriving show]
let dummy_expr = Unit
+let debug (config : Config.t) (ast : expr) : (expr, string) result =
+ if config.debug_ast then
+ prerr_endline (show_expr ast);
+ Result.ok ast
+
let pos_from_lexbuf (lexbuf : Lexing.lexbuf) : position =
{ startpos = lexbuf.lex_curr_p;
endpos = lexbuf.lex_curr_p;
As you might have noticed, we can customize the functions for specific types. Neat!
This is required for our next step: printing the AST.
--debug-ast
We start by adding a new parameter:
diff --git a/bin/main.ml b/bin/main.ml
index e51d36b..64cf7b8 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1,13 +1,17 @@
let usage_msg = "tsonnet <file1> [<file2>] ..."
let input_files = ref []
let skip_typecheck = ref false
+let debug_ast = ref false
let anonymous_fun filename = input_files := filename :: !input_files
let spec_list = [
("--skip-typecheck", Arg.Set skip_typecheck, "Skip type checking step");
+ ("--debug-ast", Arg.Set debug_ast, "Print abstract syntax tree");
]
let run_parser filename =
- match Tsonnet.run ~skip_typecheck:!skip_typecheck filename with
+ let open Tsonnet in
+ let config = Config.make ~skip_typecheck:!skip_typecheck ~debug_ast:!debug_ast () in
+ match run config filename with
| Ok stringified_json -> print_endline stringified_json
| Error err -> prerr_endline err; exit 1
Instead of passing multiple options to the library, let's condense the configuration parameters in a Config module.
It has this interface:
type t = {
skip_typecheck : bool;
debug_ast : bool;
}
val default : t
val make : ?skip_typecheck:bool -> ?debug_ast:bool -> unit -> t
And this concrete implementation:
type t = {
skip_typecheck : bool;
debug_ast : bool;
}
let default = {
skip_typecheck = false;
debug_ast = false;
}
let make ?(skip_typecheck = false) ?(debug_ast = false) () = {
skip_typecheck;
debug_ast;
}
Now every function call has a clean config record to rely on:
diff --git a/lib/tsonnet.ml b/lib/tsonnet.ml
index 614b5ed..d142c9e 100644
--- a/lib/tsonnet.ml
+++ b/lib/tsonnet.ml
@@ -1,6 +1,8 @@
open Result
open Syntax_sugar
+module Config = Config
+
(** [parse s] parses [s] into an AST. *)
let parse (filename: string) =
let input = open_in filename in
@@ -10,16 +12,15 @@ let parse (filename: string) =
try ok (Parser.prog Lexer.read lexbuf)
with
| Lexer.SyntaxError err -> (Error.trace err (Ast.pos_from_lexbuf lexbuf)) >>= error
- | Parser.Error -> (Error.trace "Invalid syntax" (Ast.pos_from_lexbuf lexbuf)) >>= error
- | Failure err -> Error.trace ("Invalid token error: " ^ err) (Ast.pos_from_lexbuf lexbuf) >>= error
+ | Parser.Error -> (Error.trace Error.Msg.parse_error (Ast.pos_from_lexbuf lexbuf)) >>= error
+ | Failure err -> Error.trace (Error.Msg.parse_invalid_token err) (Ast.pos_from_lexbuf lexbuf) >>= error
in
close_in input;
result
-let run ?(skip_typecheck = false) (filename: string) : (string, string) result =
- if skip_typecheck then
- prerr_endline "Warning: Type checking is skipped. This is not recommended as it may lead to runtime errors.\n";
+let run (config : Config.t) (filename: string) : (string, string) result =
parse filename
- >>= (if skip_typecheck then ok else Type.check)
+ >>= Ast.debug config
+ >>= Type.check config
>>= Interpreter.eval
>>= Json.expr_to_string
diff --git a/lib/type.ml b/lib/type.ml
index f1f30af..390313f 100644
--- a/lib/type.ml
+++ b/lib/type.ml
@@ -315,10 +315,12 @@ and translate_object_field_access venv pos scope chain_exprs =
(ok (venv, obj))
chain_exprs
-let check expr =
- Scope.validate expr
- >>= fun _ -> translate Env.empty expr
- >>= fun _ ->
+let check (config : Config.t) expr =
+ let* _ = Scope.validate expr in
+ if config.skip_typecheck then
+ (prerr_endline Error.Msg.warn_skip_typecheck;
+ ok expr)
+ else
+ let* _ = translate Env.empty expr in
Env.Id.reset ();
ok expr
As always, cram tests FTW--they function as automated tests with a nice touch of documentation:
diff --git a/bin/help.t b/bin/help.t
index dcf8e30..ebdd411 100644
--- a/bin/help.t
+++ b/bin/help.t
@@ -3,6 +3,7 @@ Display help message with -help flag:
$ tsonnet -help
tsonnet <file1> [<file2>] ...
--skip-typecheck Skip type checking step
+ --debug-ast Print abstract syntax tree
-help Display this list of options
--help Display this list of options
@@ -11,6 +12,7 @@ Display help message with --help flag:
$ tsonnet --help
tsonnet <file1> [<file2>] ...
--skip-typecheck Skip type checking step
+ --debug-ast Print abstract syntax tree
-help Display this list of options
--help Display this list of options
@@ -27,3 +29,45 @@ Run with type checking skipped using long flag:
Warning: Type checking is skipped. This is not recommended as it may lead to runtime errors.
42
+
+Testing the --debug-ast flag:
+
+Run with AST debugging enabled:
+
+ $ tsonnet --debug-ast ../samples/literals/object.jsonnet
+ (Ast.ParsedObject (1:8,
+ [(Ast.ObjectField ("int_attr", (Ast.Number (2:2, (Ast.Int 1)))));
+ (Ast.ObjectField ("float_attr", (Ast.Number (3:3, (Ast.Float 4.2)))));
+ (Ast.ObjectField ("string_attr", (Ast.String (4:4, "Hello, world!"))));
+ (Ast.ObjectField ("null_attr", (Ast.Null 5:5)));
+ (Ast.ObjectField ("array_attr",
+ (Ast.Array (6:6,
+ [(Ast.Number (6:6, (Ast.Int 1))); (Ast.Bool (6:6, false));
+ (Ast.ParsedObject (6:6, []))]
+ ))
+ ));
+ (Ast.ObjectField ("obj_attr",
+ (Ast.ParsedObject (7:7,
+ [(Ast.ObjectField ("a", (Ast.Bool (7:7, true))));
+ (Ast.ObjectField ("b", (Ast.Bool (7:7, false))));
+ (Ast.ObjectField ("c",
+ (Ast.ParsedObject (7:7,
+ [(Ast.ObjectField ("d",
+ (Ast.Array (7:7, [(Ast.Number (7:7, (Ast.Int 42)))]))
+ ))
+ ]
+ ))
+ ))
+ ]
+ ))
+ ))
+ ]
+ ))
+ {
+ "array_attr": [ 1, false, {} ],
+ "float_attr": 4.2,
+ "int_attr": 1,
+ "null_attr": null,
+ "obj_attr": { "a": true, "b": false, "c": { "d": [ 42 ] } },
+ "string_attr": "Hello, world!"
+ }
Error messages
Some leftovers -- untamed error messages from previous changes:
diff --git a/lib/error.ml b/lib/error.ml
index e48ed89..cdbbada 100644
--- a/lib/error.ml
+++ b/lib/error.ml
@@ -3,6 +3,10 @@ open Result
open Syntax_sugar
module Msg = struct
+ (* Parameters configuration *)
+ let warn_skip_typecheck = "Warning: Type checking is skipped. This is not recommended as it may lead to runtime errors.\n"
+
+
(* Shared operation messages *)
let self_out_of_scope = "Can't use self outside of an object"
let no_toplevel_object = "No top-level object found"
@@ -10,6 +14,10 @@ module Msg = struct
let invalid_unary_op = "Invalid unary operation"
let must_be_object = "Must be an object"
+ (* Parser messages *)
+ let parse_error = "Parsing error. Invalid syntax:"
+ let parse_invalid_token err = "Invalid token error: " ^ err
+
(* Type checker messages *)
let type_cyclic_reference varname = "Cyclic reference found for " ^ varname
let type_non_indexable_value ty = ty ^ " is a non indexable value"
diff --git a/lib/error.mli b/lib/error.mli
index ddeb318..365af96 100644
--- a/lib/error.mli
+++ b/lib/error.mli
@@ -1,4 +1,7 @@
module Msg : sig
+ (* Parameters configuration *)
+ val warn_skip_typecheck : string
+
(* Scope-related messages *)
val self_out_of_scope : string
val no_toplevel_object : string
@@ -8,6 +11,10 @@ module Msg : sig
val invalid_unary_op : string
val must_be_object : string
+ (* Parser messages *)
+ val parse_error : string
+ val parse_invalid_token : string -> string
+
(* Type checker messages *)
val type_cyclic_reference : string -> string
val type_non_indexable_value : string -> string
diff --git a/test/cram/errors.t b/test/cram/errors.t
index b70b266..7c117b8 100644
--- a/test/cram/errors.t
+++ b/test/cram/errors.t
@@ -45,7 +45,7 @@
[1]
$ tsonnet ../../samples/errors/unscoped_local.jsonnet
- ../../samples/errors/unscoped_local.jsonnet:1:15 Invalid syntax
+ ../../samples/errors/unscoped_local.jsonnet:1:15 Parsing error. Invalid syntax:
1: local a = local b = 1;
^^^^^^^^^^^^^^^^
Conclusion
With ppx_deriving.show and a new --debug-ast flag, debugging Tsonnet just got a whole lot easier. And consolidating configuration into a Config module keeps the API clean as more options get added.
The error message cleanup was long overdue. Having all error strings centralized in Error.Msg makes them easier to maintain and ensures consistency between the parser, type checker, and interpreter. One less thing to worry about when adding new features!
The entire diff can be seen here.
Thanks for reading Bit Maybe Wise! Subscribe to see what else I can get the compiler to write for me.
Photo by Timothy Dykes on Unsplash
Top comments (0)