7 files changed, 116 insertions(+), 1 deletions(-)

M lib/dune
A lib/lex_sexp.mll
A lib/parse_sexp.mly
A lib/sexp.ml
A test/data/sexp/sym-lib-table
M test/dune
A test/test_sexp.ml

@@ 5,7 5,8 @@
   (preprocess (pps ppx_deriving.show ppx_compare))
   )
 (menhir
-  (modules sch_legacy parse_lib))
+  (modules sch_legacy parse_lib parse_sexp))
 (ocamllex lex_sch_legacy)
 (ocamllex lex_tokenize)
 (ocamllex lex_lib)
+(ocamllex lex_sexp)

@@ 0,0 1,33 @@
+{
+  open Lexing
+  open Parse_sexp
+  exception SyntaxError of string
+
+}
+
+let space = [' ' '\t']
+let unquoted = [ ^ ' ' '\n' '\r' '\t' '"' '(' ')']
+
+rule read =
+  parse
+  | '(' { LPAREN }
+  | ')' { RPAREN }
+  | '\n' { new_line lexbuf; read lexbuf }
+  | '"' { read_string (Buffer.create 17) lexbuf }
+  | unquoted + { QUOTED_STRING (lexeme lexbuf) }
+  | space { read lexbuf }
+  | eof { EOF }
+  | _ { failwith (Printf.sprintf "unexpected character: line %d:%d" lexbuf.lex_curr_p.pos_lnum (lexbuf.lex_curr_p.pos_cnum - lexbuf.lex_curr_p.pos_bol + 1) )}
+
+and read_string buf =
+  parse
+  | '"' { QUOTED_STRING (Buffer.contents buf) }
+  | '\\' '"'
+    {
+      Buffer.add_char buf '\\';
+      read_string buf lexbuf
+    }
+  | [^ '"' '\\' '\n']+
+    { Buffer.add_string buf (lexeme lexbuf);
+      read_string buf lexbuf
+    }

@@ 0,0 1,28 @@
+%token LPAREN
+%token RPAREN
+%token <string> QUOTED_STRING
+%token <string> UNQUOTED_STRING
+%token EOF
+
+%start <Sexp.t> main
+
+%{
+  open Sexp
+%}
+
+%%
+
+main:
+  | e=sexp; EOF; { e }
+  | error {
+    Printf.printf "sexp parsing error:%d\n" $startpos.pos_lnum;
+    Atom "fail"
+  }
+
+sexp:
+  | LPAREN; id=atom; params=list(sexp); RPAREN; { Sexp (id, params) }
+  | a=atom; { a }
+
+atom:
+  | s=QUOTED_STRING {Atom s}
+  | s=UNQUOTED_STRING {Atom s}

@@ 0,0 1,11 @@
+type t =
+  | Sexp of (t * t list)
+  | Atom of string
+
+let quote_string s = "\"" ^ s ^ "\""
+
+let rec show = function
+  | Sexp (id, tail) -> "(" ^ (show id) ^ " " ^ (String.concat " " (List.map show tail)) ^ ")"
+  | Atom s -> quote_string s
+
+

@@ 0,0 1,3 @@
+(sym_lib_table
+  (lib (name WasserMarschV2-eagle-import)(type Legacy)(uri ${KIPRJMOD}/WasserMarschV2-eagle-import.lib)(options "")(descr ""))
+)

@@ 1,4 1,11 @@
 (test
   (name tokenize)
+  (modules tokenize)
+  (libraries eeschema alcotest)
+  )
+
+(test
+  (name test_sexp)
+  (modules test_sexp)
   (libraries eeschema alcotest)
   )

@@ 0,0 1,32 @@
+open Eeschema
+
+let parse_sexp filename =
+  let inch = open_in filename in
+  let lexbuf = Lexing.from_channel inch in
+  lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = filename };
+  Parse_sexp.main Lex_sexp.read lexbuf
+
+let pp_sexp fmt e =
+  Format.fprintf fmt "%s" (Sexp.show e)
+
+let sexp = Alcotest.testable pp_sexp (fun a b -> a = b)
+
+let test () = let parsed = parse_sexp "test/data/sexp/sym-lib-table" in
+  let expected = (
+    Sexp.Sexp (Sexp.Atom "sym_lib_table", [
+      Sexp.Sexp (Sexp.Atom "lib", [
+        Sexp.Sexp (Sexp.Atom "name", [Sexp.Atom "WasserMarschV2-eagle-import"]);
+        Sexp.Sexp (Sexp.Atom "type", [Sexp.Atom "Legacy"]);
+        Sexp.Sexp (Sexp.Atom "uri", [Sexp.Atom "${KIPRJMOD}/WasserMarschV2-eagle-import.lib"]);
+        Sexp.Sexp (Sexp.Atom "options", [Sexp.Atom ""]);
+        Sexp.Sexp (Sexp.Atom "descr", [Sexp.Atom ""]);
+      ])
+    ])
+  ) in
+  Printf.eprintf "sexp parsing result: %s" (Sexp.show parsed);
+  Alcotest.(check sexp) "ok" expected parsed
+
+let () =
+  Alcotest.run "parse_sexp" [
+    "all", ["small sexp", `Quick, test]
+  ]