1structure locn :> locn = 2struct 3 4 datatype locn_point = LocP of int 5 * int 6 * int 7 | LocA of int 8 * int 9 | LocPBeg of int 10 | LocPEnd of int 11 12 fun locn_point_toString (LocP(nf,r,c)) 13 = "frag "^Int.toString(nf)^" row "^Int.toString(r)^" col "^Int.toString(c) 14 | locn_point_toString (LocA(r,c)) 15 = "line "^Int.toString(r+1)^", character "^Int.toString(c+1) 16 | locn_point_toString (LocPBeg(nf)) 17 = "beginning of frag "^Int.toString(nf) 18 | locn_point_toString (LocPEnd(nf)) 19 = "end of frag "^Int.toString(nf) 20 21 fun rel_to_abs row col (LocP(nf,r,c)) 22 = if r = 0 then 23 LocA(row,col+c) 24 else 25 LocA(row+r,c) 26 | rel_to_abs row col locp 27 = locp 28 29 datatype locn = Loc of locn_point * locn_point (* start and end character *) 30 | Loc_None (* compiler-generated *) 31 | Loc_Unknown 32 | Loc_Near of locn 33 34 (* trying to be a little clever about common cases *) 35 fun toString (Loc(LocP(nf1,r1,c1),LocP(nf2,r2,c2))) 36 = if nf1 <> nf2 then 37 "between frag "^ 38 Int.toString(nf1)^" row "^Int.toString(r1)^" col "^Int.toString(c1)^ 39 " and frag "^ 40 Int.toString(nf2)^" row "^Int.toString(r2)^" col "^Int.toString(c2) 41 else if r1 <> r2 then 42 "in frag "^Int.toString(nf1)^", between row "^ 43 Int.toString(r1)^" col "^Int.toString(c1)^ 44 " and row "^ 45 Int.toString(r2)^" col "^Int.toString(c2) 46 else if c1 <> c2 then 47 "on frag "^Int.toString(nf1)^" row "^Int.toString(r1)^ 48 ", between cols "^ 49 Int.toString(c1)^" and "^Int.toString(c2) 50 else 51 "at frag "^Int.toString(nf1)^" row "^Int.toString(r1)^" col "^Int.toString(c1) 52 | toString (Loc(LocA(r1,c1),LocA(r2,c2))) 53 = if r1 <> r2 then 54 "between line "^ 55 Int.toString(r1+1)^", character "^Int.toString c1^ 56 " and line "^ 57 Int.toString(r2+1)^", character "^Int.toString c2 58 else if c1 <> c2 then 59 "on line "^Int.toString(r1+1)^ 60 ", characters "^ 61 Int.toString c1^"-"^Int.toString c2 62 else 63 "at line "^Int.toString(r1+1)^", character "^Int.toString c1 64 | toString (Loc(s,e)) 65 = if s = e then 66 "at "^locn_point_toString s 67 else 68 "between "^locn_point_toString s^" and "^locn_point_toString e 69 | toString (Loc_None) 70 = "in compiler-generated text" 71 | toString (Loc_Unknown) 72 = "in unknown location" 73 | toString (Loc_Near(locn)) 74 = "roughly "^toString locn 75 76 fun toShortString loc = let 77 fun p2str lp = 78 case lp of 79 LocP(f,l,c) => "f"^Int.toString f^":"^Int.toString l^":"^ 80 Int.toString c 81 | LocA(l,c) => Int.toString (l+1)^":"^ Int.toString c 82 | LocPBeg i => "f"^Int.toString i 83 | LocPEnd i => "f"^Int.toString i 84 in 85 case loc of 86 Loc(p1,p2) => p2str p1 ^ "-" ^ p2str p2 87 | Loc_None => "<no loc>" 88 | Loc_Unknown => "<??>" 89 | Loc_Near loc => "~" ^ toShortString loc 90 end 91 92 fun locp p = Loc(p,p) 93 94 fun locfrag nf = Loc(LocPBeg nf,LocPEnd nf) 95 96 fun move_start delta (Loc(LocP(nf,r,c),e)) = Loc(LocP(nf,r,c+delta),e) 97 | move_start delta (Loc(LocA(r,c),e)) = Loc(LocA(r,c+delta),e) 98 | move_start delta locn = locn 99 100 fun split_at delta (Loc(LocP(nf,r,c),e)) 101 = (Loc(LocP(nf,r,c),LocP(nf,r,c+delta-1)), 102 Loc(LocP(nf,r,c+delta),e)) 103 | split_at delta (Loc(LocA(r,c),e)) 104 = (Loc(LocA(r,c),LocA(r,c+delta-1)), 105 Loc(LocA(r,c+delta),e)) 106 | split_at delta locn 107 = (locn,locn) 108 109 fun near (loc as Loc_Near _) = loc 110 | near loc = Loc_Near loc 111 112 fun between (Loc(lploc,_)) (Loc(_,rploc)) = Loc(lploc,rploc) 113 | between Loc_None rloc = rloc 114 | between lloc Loc_None = lloc 115 | between Loc_Unknown rloc = near rloc 116 | between lloc Loc_Unknown = near lloc 117 | between (Loc_Near lloc) rloc = near (between lloc rloc) 118 | between lloc (Loc_Near rloc) = near (between lloc rloc) 119 120 type 'a located = 'a * locn 121 122end; 123