Module Name:    othersrc
Committed By:   dholland
Date:           Tue Oct 15 08:36:34 UTC 2019

Modified Files:
        othersrc/external/bsd/testcompat/parser: lexer.mll parser.mly
        othersrc/external/bsd/testcompat/support: pos.ml

Log Message:
Improve this to use ocamlyacc's internal position tracking.


To generate a diff of this commit:
cvs rdiff -u -r1.1 -r1.2 othersrc/external/bsd/testcompat/parser/lexer.mll \
    othersrc/external/bsd/testcompat/parser/parser.mly
cvs rdiff -u -r1.1 -r1.2 othersrc/external/bsd/testcompat/support/pos.ml

Please note that diffs are not public domain; they are subject to the
copyright notices on the relevant files.

Modified files:

Index: othersrc/external/bsd/testcompat/parser/lexer.mll
diff -u othersrc/external/bsd/testcompat/parser/lexer.mll:1.1 othersrc/external/bsd/testcompat/parser/lexer.mll:1.2
--- othersrc/external/bsd/testcompat/parser/lexer.mll:1.1	Thu Dec  7 05:55:36 2017
+++ othersrc/external/bsd/testcompat/parser/lexer.mll	Tue Oct 15 08:36:34 2019
@@ -57,15 +57,16 @@ let pos lexbuf =
    advance lexbuf;
    ret
 
-let posval' lexbuf f =
-   let x = f (Lexing.lexeme lexbuf) in
-   { pos = (pos lexbuf); x; }
+let tval' lexbuf f =
+   advance lexbuf;
+   f  (Lexing.lexeme lexbuf)
+
+let tval lexbuf =
+   advance lexbuf;
+   Lexing.lexeme lexbuf
 
 let posval lexbuf =
-   posval' lexbuf (fun x -> x)
-
-let text lexbuf =
-   (posval lexbuf).x
+   (pos lexbuf, Lexing.lexeme lexbuf)
 
 (* string accumulation buffer *)
 
@@ -79,56 +80,53 @@ let addstring s =
 let addchar c =
    addstring (String.make 1 c)
 let getstring () =
-   let s = Buffer.contents !stringdata in
-   let p0 = !stringstart in 
-   { pos = p0; x = s; }
+   Buffer.contents !stringdata
 
 (* identifiers and keywords *)
 
 let keywords = Types.stringmap_of_list [
-   (* bloody ocaml, you can't partially apply data constructors *)
-   ("abi", (fun pos -> ABI pos));
-   ("add", (fun pos -> ADD pos));
-   ("allocate", (fun pos -> ALLOCATE pos));
-   ("arg", (fun pos -> ARG pos));
-   ("asm", (fun pos -> ASM pos));
-   ("attributes", (fun pos -> ATTRIBUTES pos));
-   ("calltable", (fun pos -> CALLTABLE pos));
-   ("concretize", (fun pos -> CONCRETIZE pos));
-   ("const", (fun pos -> CONST pos));
-   ("enum", (fun pos -> ENUM pos));
-   ("field", (fun pos -> FIELD pos));
-   ("flag", (fun pos -> FLAG pos));
-   ("flagword", (fun pos -> FLAGWORD pos));
-   ("for", (fun pos -> FOR pos));
-   ("in", (fun pos -> IN pos));
-   ("match", (fun pos -> MATCH pos));
-   ("out", (fun pos -> OUT pos));
-   ("place", (fun pos -> PLACE pos));
-   ("pointer", (fun pos -> POINTER pos));
-   ("register", (fun pos -> REGISTER pos));
-   ("ret", (fun pos -> RET pos));
-   ("set", (fun pos -> SET pos));
-   ("specialize", (fun pos -> SPECIALIZE pos));
-   ("stack", (fun pos -> STACK pos));
-   ("struct", (fun pos -> STRUCT pos));
-   ("syscall", (fun pos -> SYSCALL pos));
-   ("syscallframe", (fun pos -> SYSCALLFRAME pos));
-   ("test", (fun pos -> TEST pos));
-   ("type", (fun pos -> TYPE pos));
-   ("var", (fun pos -> VAR pos));
+   ("abi", ABI);
+   ("add", ADD);
+   ("allocate", ALLOCATE);
+   ("arg", ARG);
+   ("asm", ASM);
+   ("attributes", ATTRIBUTES);
+   ("calltable", CALLTABLE);
+   ("concretize", CONCRETIZE);
+   ("const", CONST);
+   ("enum", ENUM);
+   ("field", FIELD);
+   ("flag", FLAG);
+   ("flagword", FLAGWORD);
+   ("for", FOR);
+   ("in", IN);
+   ("match", MATCH);
+   ("out", OUT);
+   ("place", PLACE);
+   ("pointer", POINTER);
+   ("register", REGISTER);
+   ("ret", RET);
+   ("set", SET);
+   ("specialize", SPECIALIZE);
+   ("stack", STACK);
+   ("struct", STRUCT);
+   ("syscall", SYSCALL);
+   ("syscallframe", SYSCALLFRAME);
+   ("test", TEST);
+   ("type", TYPE);
+   ("var", VAR);
 ]
 
-let doident tval =
+let doident x =
    try
-      (Types.StringMap.find tval.x keywords) tval.pos
+      Types.StringMap.find x keywords
    with Not_found ->
-      IDENT tval
+      IDENT x
 
 (* for invalid input *)
-let badchar tval =
-   let postxt = Pos.string_of_pos tval.pos in
-   Util.say (postxt ^ ": Invalid input character " ^ tval.x);
+let badchar (pos, x) =
+   let postxt = Pos.string_of_pos pos in
+   Util.say (postxt ^ ": Invalid input character " ^ x);
    Util.fail ()
 
 let badstring pos =
@@ -153,28 +151,28 @@ rule base = parse
      ws+		{ advance lexbuf; base lexbuf }
    | '\n'		{ nl (); base lexbuf }
    | '#' 		{ comment lexbuf; base lexbuf }
-   | digit alnum*	{ NUMBER (posval' lexbuf int_of_string) }
+   | digit alnum*	{ NUMBER (tval' lexbuf int_of_string) }
    | '"' 		{ startstring lexbuf; strconst lexbuf }
-   | letter alnum*	{ doident (posval lexbuf) }
-   | '-' '>'		{ RARROW (pos lexbuf) }
-   | '&'		{ AMP (pos lexbuf) }
-   | ':'		{ COLON (pos lexbuf) }
-   | ','		{ COMMA (pos lexbuf) }
-   | '='		{ EQ (pos lexbuf) }
-   | '+'		{ PLUS (pos lexbuf) }
-   | ';'		{ SEMIC (pos lexbuf) }
-   | '*'		{ STAR (pos lexbuf) }
-   | '('		{ LPAREN (pos lexbuf) }
-   | ')'		{ RPAREN (pos lexbuf) }
-   | '['		{ LBRACK (pos lexbuf) }
-   | ']'		{ RBRACK (pos lexbuf) }
-   | '{'		{ LBRACE (pos lexbuf) }
-   | '}'		{ RBRACE (pos lexbuf) }
+   | letter alnum*	{ doident (tval lexbuf) }
+   | '-' '>'		{ RARROW }
+   | '&'		{ AMP }
+   | ':'		{ COLON }
+   | ','		{ COMMA }
+   | '='		{ EQ }
+   | '+'		{ PLUS }
+   | ';'		{ SEMIC }
+   | '*'		{ STAR }
+   | '('		{ LPAREN }
+   | ')'		{ RPAREN }
+   | '['		{ LBRACK }
+   | ']'		{ RBRACK }
+   | '{'		{ LBRACE }
+   | '}'		{ RBRACE }
    | _			{ badchar (posval lexbuf); base lexbuf }
    | eof		{ EOF }
 
 and strconst = parse
-     [ ^ '"' '\n' ]+	{ addstring (text lexbuf); strconst lexbuf }
+     [ ^ '"' '\n' ]+	{ addstring (tval lexbuf); strconst lexbuf }
    | '\\' '"'		{ addchar '"'; advance lexbuf; strconst lexbuf }
    | '"'		{ advance lexbuf; QSTRING (getstring ()) }  (* done *)
    | '\n'		{ badstring (pos lexbuf); QSTRING (getstring ())}
@@ -186,60 +184,64 @@ and comment = parse
 (* trailer code *)
 {
 
-let dump' pos txt =
-   print_string (Pos.string_of_pos pos ^ " " ^ txt);
-   print_newline ()
+let dumpone t =
+   match t with
+      | EOF ->          "EOF"
+      | NUMBER x ->     ("NUMBER " ^ string_of_int x)
+      | QSTRING x ->    ("QSTRING " ^ x)
+      | IDENT x ->      ("IDENT " ^ x)
+      | ABI ->          "ABI"
+      | ADD ->          "ADD"
+      | ALLOCATE ->     "ALLOCATE"
+      | ARG ->          "ARG"
+      | ASM ->          "ASM"
+      | ATTRIBUTES ->   "ATTRIBUTES"
+      | CALLTABLE ->    "CALLTABLE"
+      | CONCRETIZE ->   "CONCRETIZE"
+      | CONST ->        "CONST"
+      | ENUM ->         "ENUM"
+      | FIELD ->        "FIELD"
+      | FLAG ->         "FLAG"
+      | FLAGWORD ->     "FLAGWORD"
+      | FOR ->          "FOR"
+      | IN ->           "IN"
+      | MATCH ->        "MATCH"
+      | OUT ->          "OUT"
+      | PLACE ->        "PLACE"
+      | POINTER ->      "POINTER"
+      | REGISTER ->     "REGISTER"
+      | RET ->          "RET"
+      | SET ->          "SET"
+      | SPECIALIZE ->   "SPECIALIZE"
+      | STACK ->        "STACK"
+      | STRUCT ->       "STRUCT"
+      | SYSCALL ->      "SYSCALL"
+      | SYSCALLFRAME -> "SYSCALLFRAME"
+      | TEST ->         "TEST"
+      | TYPE ->         "TYPE"
+      | VAR ->          "VAR"
+      | LBRACE ->       "LBRACE"
+      | RBRACE ->       "RBRACE"
+      | LBRACK ->       "LBRACK"
+      | RBRACK ->       "RBRACK"
+      | LPAREN ->       "LPAREN"
+      | RPAREN ->       "RPAREN"
+      | RARROW ->       "RARROW"
+      | AMP ->          "AMP"
+      | COLON ->        "COLON"
+      | COMMA ->        "COMMA"
+      | EQ ->           "EQ"
+      | PLUS ->         "PLUS"
+      | SEMIC ->        "SEMIC"
+      | STAR ->         "STAR"
 
 let rec dump f b =
-   match f b with
-	EOF -> ()
-      | NUMBER pv -> dump' pv.pos ("NUMBER " ^ string_of_int pv.x); dump f b
-      | QSTRING pv -> dump' pv.pos ("QSTRING " ^ pv.x); dump f b
-      | IDENT pv -> dump' pv.pos ("IDENT " ^ pv.x); dump f b
-      | ABI pos -> dump' pos "ABI"; dump f b
-      | ADD pos -> dump' pos "ADD"; dump f b
-      | ALLOCATE pos -> dump' pos "ALLOCATE"; dump f b
-      | ARG pos -> dump' pos "ARG"; dump f b
-      | ASM pos -> dump' pos "ASM"; dump f b
-      | ATTRIBUTES pos -> dump' pos "ATTRIBUTES"; dump f b
-      | CALLTABLE pos -> dump' pos "CALLTABLE"; dump f b
-      | CONCRETIZE pos -> dump' pos "CONCRETIZE"; dump f b
-      | CONST pos -> dump' pos "CONST"; dump f b
-      | ENUM pos -> dump' pos "ENUM"; dump f b
-      | FIELD pos -> dump' pos "FIELD"; dump f b
-      | FLAG pos -> dump' pos "FLAG"; dump f b
-      | FLAGWORD pos -> dump' pos "FLAGWORD"; dump f b
-      | FOR pos -> dump' pos "FOR"; dump f b
-      | IN pos -> dump' pos "IN"; dump f b
-      | MATCH pos -> dump' pos "MATCH"; dump f b
-      | OUT pos -> dump' pos "OUT"; dump f b
-      | PLACE pos -> dump' pos "PLACE"; dump f b
-      | POINTER pos -> dump' pos "POINTER"; dump f b
-      | REGISTER pos -> dump' pos "REGISTER"; dump f b
-      | RET pos -> dump' pos "RET"; dump f b
-      | SET pos -> dump' pos "SET"; dump f b
-      | SPECIALIZE pos -> dump' pos "SPECIALIZE"; dump f b
-      | STACK pos -> dump' pos "STACK"; dump f b
-      | STRUCT pos -> dump' pos "STRUCT"; dump f b
-      | SYSCALL pos -> dump' pos "SYSCALL"; dump f b
-      | SYSCALLFRAME pos -> dump' pos "SYSCALLFRAME"; dump f b
-      | TEST pos -> dump' pos "TEST"; dump f b
-      | TYPE pos -> dump' pos "TYPE"; dump f b
-      | VAR pos -> dump' pos "VAR"; dump f b
-      | LBRACE pos -> dump' pos "LBRACE"; dump f b
-      | RBRACE pos -> dump' pos "RBRACE"; dump f b
-      | LBRACK pos -> dump' pos "LBRACK"; dump f b
-      | RBRACK pos -> dump' pos "RBRACK"; dump f b
-      | LPAREN pos -> dump' pos "LPAREN"; dump f b
-      | RPAREN pos -> dump' pos "RPAREN"; dump f b
-      | RARROW pos -> dump' pos "RARROW"; dump f b
-      | AMP pos -> dump' pos "AMP"; dump f b
-      | COLON pos -> dump' pos "COLON"; dump f b
-      | COMMA pos -> dump' pos "COMMA"; dump f b
-      | EQ pos -> dump' pos "EQ"; dump f b
-      | PLUS pos -> dump' pos "PLUS"; dump f b
-      | SEMIC pos -> dump' pos "SEMIC"; dump f b
-      | STAR pos -> dump' pos "STAR"; dump f b
+   let t = f b in
+   print_string (dumpone t);
+   print_newline ();
+   match t with
+   | EOF -> ()
+   | _ -> dump f b
 
 let read pathname =
    curfile := pathname;
Index: othersrc/external/bsd/testcompat/parser/parser.mly
diff -u othersrc/external/bsd/testcompat/parser/parser.mly:1.1 othersrc/external/bsd/testcompat/parser/parser.mly:1.2
--- othersrc/external/bsd/testcompat/parser/parser.mly:1.1	Thu Dec  7 05:55:36 2017
+++ othersrc/external/bsd/testcompat/parser/parser.mly	Tue Oct 15 08:36:34 2019
@@ -31,22 +31,25 @@
 open Pos
 module T = Ptree
 
+let pos () = Pos.fromparser ()
+
+
 %}
 
 %token EOF
-%token <int Pos.posval> NUMBER
-%token <string Pos.posval> QSTRING IDENT
+%token <int> NUMBER
+%token <string> QSTRING IDENT
 /* reserved words */
-%token <Pos.pos> ABI ADD ALLOCATE ARG ASM ATTRIBUTES CALLTABLE
-%token <Pos.pos> CONCRETIZE CONST ENUM FIELD FLAG FLAGWORD FOR IN
-%token <Pos.pos> MATCH OUT PLACE POINTER REGISTER RET SET SPECIALIZE
-%token <Pos.pos> STACK STRUCT SYSCALL SYSCALLFRAME TEST TYPE VAR
+%token ABI ADD ALLOCATE ARG ASM ATTRIBUTES CALLTABLE
+%token CONCRETIZE CONST ENUM FIELD FLAG FLAGWORD FOR IN
+%token MATCH OUT PLACE POINTER REGISTER RET SET SPECIALIZE
+%token STACK STRUCT SYSCALL SYSCALLFRAME TEST TYPE VAR
 /* grouping punctuation */
-%token <Pos.pos> LBRACE RBRACE LBRACK RBRACK LPAREN RPAREN
+%token LBRACE RBRACE LBRACK RBRACK LPAREN RPAREN
 /* multicharacter punctuation */
-%token <Pos.pos> RARROW
+%token RARROW
 /* single-character punctuation */
-%token <Pos.pos> AMP COLON COMMA EQ PLUS SEMIC STAR
+%token AMP COLON COMMA EQ PLUS SEMIC STAR
 
 %type <Ptree.decl list> file
 %start file
@@ -79,15 +82,15 @@ decl:
 ;
 
 type_decl:
-   TYPE IDENT SEMIC		{ T.TYPEDECL ($2.pos, $2.x) }
+   TYPE IDENT SEMIC		{ T.TYPEDECL (pos (), $2) }
 ;
 
 enum_decl:
-     ENUM IDENT LBRACE RBRACE	{ T.ENUMDECL ($2.pos, $2.x, []) }
+     ENUM IDENT LBRACE RBRACE	{ T.ENUMDECL (pos (), $2, []) }
    | ENUM IDENT LBRACE enumerators RBRACE
-				{ T.ENUMDECL ($2.pos, $2.x, List.rev $4) }
+				{ T.ENUMDECL (pos (), $2, List.rev $4) }
    | ENUM IDENT LBRACE enumerators COMMA RBRACE
-				{ T.ENUMDECL ($2.pos, $2.x, List.rev $4) }
+				{ T.ENUMDECL (pos (), $2, List.rev $4) }
 ;
 
 enumerators: /* built in reverse order */
@@ -96,12 +99,12 @@ enumerators: /* built in reverse order *
 ;
 
 enumerator:
-   IDENT			{ T.ENUMERATOR ($1.pos, $1.x) }
+   IDENT			{ T.ENUMERATOR (pos (), $1) }
 ;
 
 flagword_decl:
    FLAGWORD IDENT LBRACE flagerators RBRACE
-				{ T.FLAGDECL ($2.pos, $2.x, List.rev $4) }
+				{ T.FLAGDECL (pos (), $2, List.rev $4) }
 ;
 
 flagerators: /* built in reverse order */
@@ -110,13 +113,13 @@ flagerators: /* built in reverse order *
 ;
 
 flagerator:
-     FIELD IDENT COLON typename SEMIC	{ T.FLAGFIELD ($2.pos, $2.x, $4) }
-   | FLAG IDENT SEMIC		{ T.FLAG ($2.pos, $2.x) }
+     FIELD IDENT COLON typename SEMIC	{ T.FLAGFIELD (pos (), $2, $4) }
+   | FLAG IDENT SEMIC		{ T.FLAG (pos (), $2) }
 ;
 
 struct_decl:
    STRUCT IDENT LBRACE members RBRACE
-				{ T.STRUCTDECL ($2.pos, $2.x, List.rev $4) }
+				{ T.STRUCTDECL (pos (), $2, List.rev $4) }
 ;
 
 members: /* built in reverse order */
@@ -125,12 +128,12 @@ members: /* built in reverse order */
 ;
 
 member:
-   IDENT COLON typename SEMIC	{ T.MEMBER ($1.pos, $1.x, $3) }
+   IDENT COLON typename SEMIC	{ T.MEMBER (pos (), $1, $3) }
 ;
 
 syscall_decl:
    SYSCALL IDENT LBRACE syscall_elements RBRACE
-				{ T.SYSCALL ($2.pos, $2.x, List.rev $4) }
+				{ T.SYSCALL (pos (), $2, List.rev $4) }
 ;
 
 syscall_elements: /* built in reverse order */
@@ -146,11 +149,11 @@ syscall_element:
 ;
 
 arg_decl:
-   ARG IDENT COLON typename SEMIC	{ T.ARG ($2.pos, $2.x, $4) }
+   ARG IDENT COLON typename SEMIC	{ T.ARG (pos (), $2, $4) }
 ;
 
 ret_decl:
-   RET IDENT COLON typename SEMIC	{ T.RET ($2.pos, $2.x, $4) }
+   RET IDENT COLON typename SEMIC	{ T.RET (pos (), $2, $4) }
 ;
 
 attributes_decl:
@@ -158,8 +161,8 @@ attributes_decl:
 ;
 
 idents: /* built in reverse order */
-     IDENT			{ [($1.pos, $1.x)] }
-   | idents IDENT		{ ($2.pos, $2.x) :: $1 }
+     IDENT			{ [(pos (), $1)] }
+   | idents IDENT		{ (pos (), $2) :: $1 }
 ;
 
 global_concretize:
@@ -176,13 +179,13 @@ concretize_block:
 
 concretize_body:
      FOR TYPE IDENT COMMA concretize_body
-				{ T.CONCR_FORTYPE ($3.pos, $3.x, $5) }
+				{ T.CONCR_FORTYPE (pos (), $3, $5) }
    | FOR VAR IDENT COMMA concretize_body
-				{ T.CONCR_FORVAR ($3.pos, $3.x, $5) }
+				{ T.CONCR_FORVAR (pos (), $3, $5) }
    | MATCH ARG IDENT COLON typename COMMA concretize_body
-				{ T.CONCR_MATCHARG ($3.pos, $3.x, $5, $7) }
+				{ T.CONCR_MATCHARG (pos (), $3, $5, $7) }
    | MATCH RET IDENT COLON typename COMMA concretize_body
-				{ T.CONCR_MATCHRET ($3.pos, $3.x, $5, $7) }
+				{ T.CONCR_MATCHRET (pos (), $3, $5, $7) }
    | statements			{ T.CONCR_BLOCK (List.rev $1) }
 ;
 
@@ -191,7 +194,7 @@ calltable_decl:
 ;
 
 setting_decl:
-   SET IDENT expr SEMIC		{ T.SETTING ($2.pos, $2.x, $3) }
+   SET IDENT expr SEMIC		{ T.SETTING (pos (), $2, $3) }
 ;
 
 specialize_block:
@@ -205,12 +208,12 @@ specialize_items: /* built in reverse or
 ;
 
 specialize_item:
-     TYPE IDENT EQ typename SEMIC { T.SPEC_TYPE ($2.pos, $2.x, $4) }
-   | CONST IDENT EQ expr SEMIC	{ T.SPEC_VALUE ($2.pos, $2.x, $4) }
+     TYPE IDENT EQ typename SEMIC { T.SPEC_TYPE (pos (), $2, $4) }
+   | CONST IDENT EQ expr SEMIC	{ T.SPEC_VALUE (pos (), $2, $4) }
 ;
 
 abi_decl:
-     ABI IDENT LBRACE abi_items RBRACE	{ T.ABI ($2.pos, $2.x, List.rev $4) }
+     ABI IDENT LBRACE abi_items RBRACE	{ T.ABI (pos (), $2, List.rev $4) }
 ;
 
 abi_items: /* built in reverse order */
@@ -236,13 +239,13 @@ syscallframe_elements: /* built in rever
 
 syscallframe_element:
      setting_decl		{ $1 }
-   | PLACE NUMBER placement	{ T.PLACE ($2.pos, $2.x, $3) }
+   | PLACE NUMBER placement	{ T.PLACE (pos (), $2, $3) }
 ;
 
 placement:
-     REGISTER QSTRING SEMIC	{ T.PLACEREG ($2.pos, $2.x) }
-   | STACK SEMIC		{ T.PLACESTACK ($1, T.E_NUMBER ($1, 0)) }
-   | STACK PLUS expr SEMIC	{ T.PLACESTACK ($2, $3) }
+     REGISTER QSTRING SEMIC	{ T.PLACEREG (pos (), $2) }
+   | STACK SEMIC		{ T.PLACESTACK (pos (), T.E_NUMBER (pos (),0))}
+   | STACK PLUS expr SEMIC	{ T.PLACESTACK (pos (), $3) }
 ;
 
 asm_decl:
@@ -255,12 +258,12 @@ asm_elements: /* built in reverse order 
 ;
 
 asm_element:
-   IDENT QSTRING SEMIC		{ T.ASMELEMENT ($1.pos, $1.x, $2.x) }
+   IDENT QSTRING SEMIC		{ T.ASMELEMENT (pos (), $1, $2) }
 ;
 
 test_decl:
-     TEST IDENT STAR SEMIC		{ T.TEST ($2.pos, $2.x, None) }
-   | TEST IDENT LBRACE machines RBRACE	{ T.TEST ($2.pos, $2.x, Some $4) }
+     TEST IDENT STAR SEMIC		{ T.TEST (pos (), $2, None) }
+   | TEST IDENT LBRACE machines RBRACE	{ T.TEST (pos (), $2, Some $4) }
 ;
 
 machines: /* built in reverse order */
@@ -269,8 +272,8 @@ machines: /* built in reverse order */
 ;
 
 machine:
-     IDENT SEMIC		{ T.MACHINE ($1.pos, $1.x, None) }
-   | IDENT IDENT SEMIC		{ T.MACHINE ($1.pos, $1.x, Some $2.x) }
+     IDENT SEMIC		{ T.MACHINE (pos (), $1, None) }
+   | IDENT IDENT SEMIC		{ T.MACHINE (pos (), $1, Some $2) }
 ;
 
 /**************************************************************/
@@ -281,31 +284,31 @@ statements: /* built in reverse order */
 ;
 
 statement:
-     ADD ARG IDENT COLON typename SEMIC { T.ADDARG ($3.pos, $3.x, $5) }
-   | ADD RET IDENT COLON typename SEMIC { T.ADDRET ($3.pos, $3.x, $5) }
-   | ALLOCATE IDENT SEMIC	{ T.ALLOCATE ($2.pos, $2.x) }
-   | SET lvalue EQ expr SEMIC	{ T.SET ($1, $2, $4) }
-   | IDENT IDENT SEMIC	{ T.DO ($1.pos, $1.x, $1.x) }
+     ADD ARG IDENT COLON typename SEMIC { T.ADDARG (pos (), $3, $5) }
+   | ADD RET IDENT COLON typename SEMIC { T.ADDRET (pos (), $3, $5) }
+   | ALLOCATE IDENT SEMIC	{ T.ALLOCATE (pos (), $2) }
+   | SET lvalue EQ expr SEMIC	{ T.SET (pos (), $2, $4) }
+   | IDENT IDENT SEMIC		{ T.DO (pos (), $1, $1) }
 ;
 
 lvalue:
-     IDENT			{ T.L_PLAIN ($1.pos, $1.x) }
-   | base_expr LBRACK NUMBER RBRACK	{ T.L_ARRAY ($3.pos, $1, $3.x) }
+     IDENT			{ T.L_PLAIN (pos (), $1) }
+   | base_expr LBRACK NUMBER RBRACK	{ T.L_ARRAY (pos (), $1, $3) }
 ;
 
 expr:
      suffix_expr		{ $1 }
-   | AMP expr			{ T.E_ADDROF ($1, $2) }
+   | AMP expr			{ T.E_ADDROF (pos (), $2) }
 ;
 
 suffix_expr:
      base_expr			{ $1 }
-   | suffix_expr LBRACK NUMBER RBRACK	{ T.E_ARRAY ($3.pos, $1, $3.x) }
+   | suffix_expr LBRACK NUMBER RBRACK	{ T.E_ARRAY (pos (), $1, $3) }
 ;
 
 base_expr:
-     NUMBER			{ T.E_NUMBER ($1.pos, $1.x) }
-   | IDENT			{ T.E_READVAR ($1.pos, $1.x) }
+     NUMBER			{ T.E_NUMBER (pos (), $1) }
+   | IDENT			{ T.E_READVAR (pos (), $1) }
    | list_literal		{ T.E_LIST $1 }
    | map_literal		{ T.E_MAP $1 }
 ;
@@ -329,13 +332,13 @@ mappings: /* built in reverse order */
 ;
 
 mapping:
-   NUMBER RARROW expr SEMIC	{ T.MAPPING ($2, $1.x, $3) }
+   NUMBER RARROW expr SEMIC	{ T.MAPPING (pos (), $1, $3) }
 ;
 
 typename:
-     IDENT				{ T.PLAINTYPE ($1.pos, $1.x) }
-   | IDENT LPAREN typeargs RPAREN	{ T.ARGTYPE ($1.pos, $1.x, $3) }
-   | direction POINTER LPAREN typename RPAREN { T.POINTER ($2, $1, $4) }
+     IDENT				{ T.PLAINTYPE (pos (), $1) }
+   | IDENT LPAREN typeargs RPAREN	{ T.ARGTYPE (pos (), $1, $3) }
+   | direction POINTER LPAREN typename RPAREN { T.POINTER (pos (), $1, $4) }
 ;
 
 typeargs: /* built in reverse order */
@@ -344,7 +347,7 @@ typeargs: /* built in reverse order */
 ;
 
 typearg:
-     NUMBER			{ T.TNUMBER ($1.pos, $1.x) }
+     NUMBER			{ T.TNUMBER (pos (), $1) }
    | typename			{ T.TTYPE $1 }
 ;
 

Index: othersrc/external/bsd/testcompat/support/pos.ml
diff -u othersrc/external/bsd/testcompat/support/pos.ml:1.1 othersrc/external/bsd/testcompat/support/pos.ml:1.2
--- othersrc/external/bsd/testcompat/support/pos.ml:1.1	Thu Dec  7 05:55:36 2017
+++ othersrc/external/bsd/testcompat/support/pos.ml	Tue Oct 15 08:36:34 2019
@@ -37,6 +37,13 @@ type pos = {
    column: int;
 }
 
+let fromparser () =
+   let lp = Parsing.symbol_start_pos () in
+   let file = lp.Lexing.pos_fname in
+   let line = lp.Lexing.pos_lnum in
+   let column = lp.Lexing.pos_cnum - lp.Lexing.pos_bol + 1 in
+   { file; line; column; }
+
 (* position along with a value *)
 type 't posval = {
    pos: pos;

Reply via email to