Add the constructor [PVarLocated] to the IL.

src/IL.ml

@@ -11,6 +11,8 @@
 (*                                                                            *)
 (******************************************************************************)
 
+open Positions
+
 (* Abstract syntax of the language used for code production. *)
 
 type interface =
@@ -219,6 +221,8 @@ and pattern =
 
   (* Variable. *)
   | PVar of string
+  | PVarLocated of string located
+      (* The positions must not be dummies. Use [pvarlocated]. *)
 
   (* Data deconstruction. Tuples of length 1 are considered nonexistent,
      that is, [PTuple [p]] is considered the same pattern as [p]. *)

src/codeBits.ml

@@ -16,6 +16,17 @@
 
 open IL
 
+(* A smart constructor for [PVarLocated]. *)
+
+let pvarlocated id =
+  let x, pos = Positions.decompose id in
+  let pos1 = Positions.start_of_position pos
+  and pos2 = Positions.end_of_position pos in
+  if pos1 == Lexing.dummy_pos || pos2 == Lexing.dummy_pos then
+    PVar x
+  else
+    PVarLocated id
+
 (* Tuples. *)
 
 let etuple = function

src/codeBits.mli

@@ -14,8 +14,13 @@
 (* This module provides a number of tiny functions that help produce
    [IL] code. *)
 
+open Positions
 open IL
 
+(* A smart constructor for [PVarLocated]. *)
+
+val pvarlocated: string located -> pattern
+
 (* Tuples. *)
 
 val etuple: expr list -> expr

src/printer.ml

@@ -468,6 +468,9 @@ and pat0 f = function
       fprintf f "_"
   | PVar x ->
       var f x
+  | PVarLocated x ->
+      (* Turn [x] on the fly into a stretch and print that. *)
+      stretch true f (Lexer.stretch_of_id x)
   | PData (d, []) ->
       var f d
   | PTuple [] ->

src/rawPrinter.ml

@@ -181,6 +181,9 @@ and pat = function
       node "pwildcard" []
   | PVar x ->
       node "pvar" [ string x ]
+  | PVarLocated x ->
+      let x = Positions.value x in
+      node "pvar" [ string x ]
   | PTuple ps ->
       node "ptuple" (pats ps)
   | PAnnot (p, t) ->

src/traverse.ml

@@ -47,6 +47,9 @@ class virtual ['env] env = object(self)
         env
     | PVar id ->
         self#pvar env id
+    | PVarLocated id ->
+        let id = Positions.value id in
+        self#pvar env id
     | PTuple ps
     | POr ps
     | PData (_, ps) ->
@@ -546,4 +549,3 @@ class virtual ['env, 'a] fold = object (self)
     List.fold_left (self#valdef env) accu defs
 
 end
-