Non-located variants of equality and serialisation (#35)

src/AST.mli

@@ -19,6 +19,11 @@
 (*  along with this program.  If not, see <http://www.gnu.org/licenses/>.  *)
 (***************************************************************************)
 
+(** A type alias for located pieces of AST. *)
+(* NOTE: This type alias allows `ppx_import`-based modules to override the
+   behaviour of the derivers when it comes to locations. *)
+type 'a located = 'a Location.located
+
 (** Names in Shell are just strings with a few additional
    conditions. *)
 
@@ -52,17 +57,17 @@ and word_component =
   | WBracketExpression (* FIXME *)
 
 and word = word_component list
-and word' = word Location.located
+and word' = word located
 
 (** For now, a {!pattern} is just a {!word}. *)
 
 and pattern = word list
-and pattern' = pattern Location.located
+and pattern' = pattern located
 
 (** An assignment is just a pair of a {!name} and a {!word}. *)
 
 and assignment = name * word
-and assignment' = assignment Location.located
+and assignment' = assignment located
 
 (** A file descriptor {!descr} is an integer. *)
 
@@ -215,11 +220,11 @@ and command =
   | Redirection of command' * descr * kind * word'
   | HereDocument of command' * descr * word'
 
-and command' = command Location.located
+and command' = command located
 
 and case_item = pattern' * command' option
 
-and case_item' = case_item Location.located
+and case_item' = case_item located
 
 and kind =
   | Output          (*  > *)

src/equality/locatedEquality.ml

@@ -19,21 +19,29 @@
 (*  along with this program.  If not, see <http://www.gnu.org/licenses/>.  *)
 (***************************************************************************)
 
+type lexing_position = [%import: Location.lexing_position]
+and position = [%import: Location.position]
+and 'a located = [%import: 'a Location.located]
+
+[@@deriving eq]
+
 type name = [%import: AST.name]
 and character_range = [%import: AST.character_range]
 and attribute = [%import: AST.attribute]
 and word_component = [%import: AST.word_component]
 and word = [%import: AST.word]
-and word' = [%import: AST.word']
 and pattern = [%import: AST.pattern]
-and pattern' = [%import: AST.pattern']
 and assignment = [%import: AST.assignment]
-and assignment' = [%import: AST.assignment']
 and descr = [%import: AST.descr]
 and program = [%import: AST.program]
 and command = [%import: AST.command]
-and command' = [%import: AST.command']
 and case_item = [%import: AST.case_item]
-and case_item' = [%import: AST.case_item']
 and kind = [%import: AST.kind]
+
+and word' = [%import: AST.word']
+and pattern' = [%import: AST.pattern']
+and assignment' = [%import: AST.assignment']
+and command' = [%import: AST.command']
+and case_item' = [%import: AST.case_item']
+
 [@@deriving eq]

src/equality/nonLocatedEquality.ml

@@ -0,0 +1,47 @@
+(***************************************************************************)
+(*                                 Morsmall                                *)
+(*                      A concise AST for POSIX shell                      *)
+(*                                                                         *)
+(*  Copyright (C) 2017,2018,2019 Yann Régis-Gianas, Ralf Treinen,          *)
+(*  Nicolas Jeannerod                                                      *)
+(*                                                                         *)
+(*  This program is free software: you can redistribute it and/or modify   *)
+(*  it under the terms of the GNU General Public License as published by   *)
+(*  the Free Software Foundation, either version 3 of the License, or      *)
+(*  (at your option) any later version.                                    *)
+(*                                                                         *)
+(*  This program is distributed in the hope that it will be useful,        *)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of         *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          *)
+(*  GNU General Public License for more details.                           *)
+(*                                                                         *)
+(*  You should have received a copy of the GNU General Public License      *)
+(*  along with this program.  If not, see <http://www.gnu.org/licenses/>.  *)
+(***************************************************************************)
+
+type lexing_position = [%import: Location.lexing_position]
+and position = [%import: Location.position]
+and 'a located = [%import: 'a Location.located]
+
+let equal_located eq_a x y = eq_a x.value y.value
+
+type name = [%import: AST.name]
+and character_range = [%import: AST.character_range]
+and attribute = [%import: AST.attribute]
+and word_component = [%import: AST.word_component]
+and word = [%import: AST.word]
+and pattern = [%import: AST.pattern]
+and assignment = [%import: AST.assignment]
+and descr = [%import: AST.descr]
+and program = [%import: AST.program]
+and command = [%import: AST.command]
+and case_item = [%import: AST.case_item]
+and kind = [%import: AST.kind]
+
+and word' = [%import: AST.word']
+and pattern' = [%import: AST.pattern']
+and assignment' = [%import: AST.assignment']
+and command' = [%import: AST.command']
+and case_item' = [%import: AST.case_item']
+
+[@@deriving eq]

src/location.ml

@@ -19,30 +19,9 @@
 (*  along with this program.  If not, see <http://www.gnu.org/licenses/>.  *)
 (***************************************************************************)
 
-type lexing_position = Morbig.CST.lexing_position =
-  { pos_fname : string ;
-    pos_lnum : int ;
-    pos_bol : int ;
-    pos_cnum : int }
-[@@deriving eq, show {with_path=false}, yojson]
-
-type position = Morbig.CST.position =
-  { start_p : lexing_position ;
-    end_p : lexing_position }
-[@@deriving eq, show {with_path=false}, yojson]
-
-type 'a located = 'a Morbig.CST.located =
-  { value : 'a ;
-    position : position }
-[@@deriving eq, show {with_path=false}, yojson]
-
-class virtual ['a] located_iter      = ['a] Morbig.CSTVisitors.located_iter
-class virtual ['a] located_map       = ['a] Morbig.CSTVisitors.located_map
-class virtual ['a] located_reduce    = ['a] Morbig.CSTVisitors.located_reduce
-class virtual ['a] located_mapreduce = ['a] Morbig.CSTVisitors.located_mapreduce
-class virtual ['a] located_iter2     = ['a] Morbig.CSTVisitors.located_iter2
-class virtual ['a] located_map2      = ['a] Morbig.CSTVisitors.located_map2
-class virtual ['a] located_reduce2   = ['a] Morbig.CSTVisitors.located_reduce2
+type lexing_position = [%import: Morbig.CST.lexing_position]
+and position = [%import: Morbig.CST.position]
+and 'a located = [%import: 'a Morbig.CST.located]
 
 let dummily_located value =
   { value ; position = Morbig.CSTHelpers.dummy_position }

src/morsmall.ml

@@ -40,9 +40,11 @@ let parse_file filename =
 
 let pp_print_safe = SafePrinter.pp_program
 let pp_print_json = JsonPrinter.pp_program
+let pp_print_json_noloc = JsonNonLocatedPrinter.pp_program
 let pp_print_debug = DebugPrinter.pp_program
 
 let equal_program = LocatedEquality.equal_program
+let equal_program_noloc = NonLocatedEquality.equal_program
 
 include ASTUtils
 

src/morsmall.mli

@@ -42,6 +42,10 @@ val equal_program : t -> t -> bool
 (** Check that two programs are equal. This takes into account the locations of
     the various elements of the AST. *)
 
+val equal_program_noloc : t -> t -> bool
+(** Check that two programs are equal, ignoring the locations of the various
+    elements of the AST. *)
+
 (** {2 Printers} *)
 
 val pp_print_safe : Format.formatter -> t -> unit
@@ -50,6 +54,10 @@ val pp_print_safe : Format.formatter -> t -> unit
 val pp_print_json : Format.formatter -> t -> unit
 (** Prints a representation of the AST in JSON. *)
 
+val pp_print_json_noloc : Format.formatter -> t -> unit
+(** Prints a representation of the AST in JSON, ignoring the locations of the
+    various elements of the AST. *)
+
 val pp_print_debug : Format.formatter -> t -> unit
 (** Prints a representation of the AST in OCaml-style. *)
 

src/printer/debugPrinter.ml

@@ -19,21 +19,29 @@
 (*  along with this program.  If not, see <http://www.gnu.org/licenses/>.  *)
 (***************************************************************************)
 
+type lexing_position = [%import: Location.lexing_position]
+and position = [%import: Location.position]
+and 'a located = [%import: 'a Location.located]
+
+[@@deriving show]
+
 type name = [%import: AST.name]
 and character_range = [%import: AST.character_range]
 and attribute = [%import: AST.attribute]
 and word_component = [%import: AST.word_component]
 and word = [%import: AST.word]
-and word' = [%import: AST.word']
 and pattern = [%import: AST.pattern]
-and pattern' = [%import: AST.pattern']
 and assignment = [%import: AST.assignment]
-and assignment' = [%import: AST.assignment']
 and descr = [%import: AST.descr]
 and program = [%import: AST.program]
 and command = [%import: AST.command]
-and command' = [%import: AST.command']
 and case_item = [%import: AST.case_item]
-and case_item' = [%import: AST.case_item']
 and kind = [%import: AST.kind]
+
+and word' = [%import: AST.word']
+and pattern' = [%import: AST.pattern']
+and assignment' = [%import: AST.assignment']
+and command' = [%import: AST.command']
+and case_item' = [%import: AST.case_item']
+
 [@@deriving show]

src/printer/jsonNonLocatedPrinter.ml

@@ -0,0 +1,50 @@
+(***************************************************************************)
+(*                                 Morsmall                                *)
+(*                      A concise AST for POSIX shell                      *)
+(*                                                                         *)
+(*  Copyright (C) 2017,2018,2019 Yann Régis-Gianas, Ralf Treinen,          *)
+(*  Nicolas Jeannerod                                                      *)
+(*                                                                         *)
+(*  This program is free software: you can redistribute it and/or modify   *)
+(*  it under the terms of the GNU General Public License as published by   *)
+(*  the Free Software Foundation, either version 3 of the License, or      *)
+(*  (at your option) any later version.                                    *)
+(*                                                                         *)
+(*  This program is distributed in the hope that it will be useful,        *)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of         *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          *)
+(*  GNU General Public License for more details.                           *)
+(*                                                                         *)
+(*  You should have received a copy of the GNU General Public License      *)
+(*  along with this program.  If not, see <http://www.gnu.org/licenses/>.  *)
+(***************************************************************************)
+
+type lexing_position = [%import: Location.lexing_position]
+and position = [%import: Location.position]
+and 'a located = [%import: 'a Location.located]
+
+let located_to_yojson a_to_yojson x = a_to_yojson x.value
+
+type name = [%import: AST.name]
+and character_range = [%import: AST.character_range]
+and attribute = [%import: AST.attribute]
+and word_component = [%import: AST.word_component]
+and word = [%import: AST.word]
+and pattern = [%import: AST.pattern]
+and assignment = [%import: AST.assignment]
+and descr = [%import: AST.descr]
+and program = [%import: AST.program]
+and command = [%import: AST.command]
+and case_item = [%import: AST.case_item]
+and kind = [%import: AST.kind]
+
+and word' = [%import: AST.word']
+and pattern' = [%import: AST.pattern']
+and assignment' = [%import: AST.assignment']
+and command' = [%import: AST.command']
+and case_item' = [%import: AST.case_item']
+
+[@@deriving to_yojson]
+
+let pp_program fmt program =
+  Yojson.Safe.pretty_print fmt (program_to_yojson program)

src/printer/jsonPrinter.ml

@@ -19,23 +19,31 @@
 (*  along with this program.  If not, see <http://www.gnu.org/licenses/>.  *)
 (***************************************************************************)
 
+type lexing_position = [%import: Location.lexing_position]
+and position = [%import: Location.position]
+and 'a located = [%import: 'a Location.located]
+
+[@@deriving yojson]
+
 type name = [%import: AST.name]
 and character_range = [%import: AST.character_range]
 and attribute = [%import: AST.attribute]
 and word_component = [%import: AST.word_component]
 and word = [%import: AST.word]
-and word' = [%import: AST.word']
 and pattern = [%import: AST.pattern]
-and pattern' = [%import: AST.pattern']
 and assignment = [%import: AST.assignment]
-and assignment' = [%import: AST.assignment']
 and descr = [%import: AST.descr]
 and program = [%import: AST.program]
 and command = [%import: AST.command]
-and command' = [%import: AST.command']
 and case_item = [%import: AST.case_item]
-and case_item' = [%import: AST.case_item']
 and kind = [%import: AST.kind]
+
+and word' = [%import: AST.word']
+and pattern' = [%import: AST.pattern']
+and assignment' = [%import: AST.assignment']
+and command' = [%import: AST.command']
+and case_item' = [%import: AST.case_item']
+
 [@@deriving yojson]
 
 let pp_program fmt program =

src/visitors.ml

@@ -19,29 +19,43 @@
 (*  along with this program.  If not, see <http://www.gnu.org/licenses/>.  *)
 (***************************************************************************)
 
+type lexing_position = [%import: Location.lexing_position]
+and position = [%import: Location.position]
+and 'a located = [%import: 'a Location.located]
+
+class virtual ['a] located_iter      = ['a] Morbig.CSTVisitors.located_iter
+class virtual ['a] located_map       = ['a] Morbig.CSTVisitors.located_map
+class virtual ['a] located_reduce    = ['a] Morbig.CSTVisitors.located_reduce
+class virtual ['a] located_mapreduce = ['a] Morbig.CSTVisitors.located_mapreduce
+class virtual ['a] located_iter2     = ['a] Morbig.CSTVisitors.located_iter2
+class virtual ['a] located_map2      = ['a] Morbig.CSTVisitors.located_map2
+class virtual ['a] located_reduce2   = ['a] Morbig.CSTVisitors.located_reduce2
+
 type name = [%import: AST.name]
 and character_range = [%import: AST.character_range]
 and attribute = [%import: AST.attribute]
 and word_component = [%import: AST.word_component]
 and word = [%import: AST.word]
-and word' = [%import: AST.word']
 and pattern = [%import: AST.pattern]
-and pattern' = [%import: AST.pattern']
 and assignment = [%import: AST.assignment]
-and assignment' = [%import: AST.assignment']
 and descr = [%import: AST.descr]
 and program = [%import: AST.program]
 and command = [%import: AST.command]
-and command' = [%import: AST.command']
 and case_item = [%import: AST.case_item]
-and case_item' = [%import: AST.case_item']
 and kind = [%import: AST.kind]
+
+and word' = [%import: AST.word']
+and pattern' = [%import: AST.pattern']
+and assignment' = [%import: AST.assignment']
+and command' = [%import: AST.command']
+and case_item' = [%import: AST.case_item']
+
 [@@deriving
-  visitors {variety = "iter";       ancestors=["Location.located_iter"];      nude=true},
-  visitors {variety = "map";        ancestors=["Location.located_map"];       nude=true},
-  visitors {variety = "reduce";     ancestors=["Location.located_reduce"];    nude=true},
-  visitors {variety = "mapreduce";  ancestors=["Location.located_mapreduce"]; nude=true},
-  visitors {variety = "iter2";      ancestors=["Location.located_iter2"];     nude=true},
-  visitors {variety = "map2";       ancestors=["Location.located_map2"];      nude=true},
-  visitors {variety = "reduce2";    ancestors=["Location.located_reduce2"];   nude=true}
+  visitors {variety = "iter";       ancestors=["located_iter"];      nude=true},
+  visitors {variety = "map";        ancestors=["located_map"];       nude=true},
+  visitors {variety = "reduce";     ancestors=["located_reduce"];    nude=true},
+  visitors {variety = "mapreduce";  ancestors=["located_mapreduce"]; nude=true},
+  visitors {variety = "iter2";      ancestors=["located_iter2"];     nude=true},
+  visitors {variety = "map2";       ancestors=["located_map2"];      nude=true},
+  visitors {variety = "reduce2";    ancestors=["located_reduce2"];   nude=true}
 ]

tests/run.ml

@@ -96,7 +96,7 @@ let run_one_test ~test_number =
 
   let fname = artifacts_file ~test_number "input.json" in
   Log.debug (fun m -> m "Printing it to `%s`..." fname);
-  with_file fname (fun fmt -> Morsmall.pp_print_json fmt input);
+  with_file fname (fun fmt -> Morsmall.pp_print_json_noloc fmt input);
 
   let fname = artifacts_file ~test_number "input.sh" in
   Log.debug (fun m -> m "Printing it to `%s`..." fname);
@@ -114,9 +114,9 @@ let run_one_test ~test_number =
 
   let fname = artifacts_file ~test_number "output.json" in
   Log.debug (fun m -> m "Printing it to `%s`..." fname);
-  with_file fname (fun fmt -> Morsmall.pp_print_json fmt output);
+  with_file fname (fun fmt -> Morsmall.pp_print_json_noloc fmt output);
 
-  if not (Morsmall.equal_program input output) then
+  if not (Morsmall.equal_program_noloc input output) then
     (
       Log.debug (fun m -> m "AST do not match. Incoming error.");
       raise (ASTsDontMatch (input, output))