git.joshuawise.com / snipe.git / blame
| Commit | Line | Data |
|---|---|---|
| 12aa4087 JW |
1 | (* L1 Compiler |
| 2 | * Positional Markers | |
| 3 | * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu> | |
| 4 | * Annotations / bugfixes: Alex Vaynberg <alv@andrew.cmu.edu> | |
| 5 | *) | |
| 6 | ||
| 7 | signature MARK = | |
| 8 | sig | |
| 9 | type ext = (int * int) * (int * int) * string (* position *) | |
| 10 | ||
| 11 | val show : ext -> string (* converts the data into human readable form *) | |
| 12 | ||
| 13 | type 'a marked (* value with positional information *) | |
| 14 | ||
| 15 | (* INTRODUCTION FUNCTIONS for type 'a marked *) | |
| 16 | ||
| 17 | (* put together a value and positional information *) | |
| 18 | val mark : 'a * ext -> 'a marked | |
| 19 | ||
| 20 | (* put together a value and an option of positional information *) | |
| 21 | val mark' : 'a * ext option -> 'a marked | |
| 22 | ||
| 23 | (* mark the value with no positional information *) | |
| 24 | val naked : 'a -> 'a marked | |
| 25 | ||
| 26 | (* ELIMINATION FUNCTIONS for type a' marked *) | |
| 27 | ||
| 28 | (* data: remove the markings *) | |
| 29 | val data : 'a marked -> 'a | |
| 6ade8b0a | 30 | val kane : 'a marked -> 'a |
| 12aa4087 JW |
31 | |
| 32 | (* ext: retrieve positional information from marked value*) | |
| 33 | val ext : 'a marked -> ext option | |
| 34 | ||
| 35 | ||
| 36 | (* USEFUL TOOLS *) | |
| 37 | ||
| 38 | (* wrap: | |
| 39 | * returns SOME of positional information unit that contains each one in the list | |
| 40 | * NONE if such wrap is not possible (spans several files, etc.) | |
| 41 | *) | |
| 42 | val wrap : ext option list -> ext option | |
| 43 | ||
| 44 | (* map: make your function keep positional information *) | |
| 45 | val map : ('a -> 'b) -> 'a marked -> 'b marked | |
| 46 | (* map': similar to map, but f can now use positional information | |
| 47 | * and preserve it at the same time | |
| 48 | *) | |
| 49 | val map' : ('a marked -> 'b) -> 'a marked -> 'b marked | |
| 50 | end | |
| 51 | ||
| 52 | structure Mark :> MARK = | |
| 53 | struct | |
| 54 | type ext = (int * int) * (int * int) * string | |
| 55 | ||
| 56 | fun pos (row, 0) = Int.toString row | |
| 57 | | pos (row, col) = Int.toString row ^ "." ^ Int.toString col | |
| 58 | ||
| 59 | fun show (l, r, file) = file ^ ":" ^ pos l ^ "-" ^ pos r | |
| 60 | ||
| 61 | type 'a marked = 'a * ext option | |
| 62 | ||
| 63 | fun mark (d, e) = (d, SOME e) | |
| 64 | fun mark' (d, e) = (d, e) | |
| 65 | fun naked d = (d, NONE) | |
| 66 | ||
| 67 | fun data (d, e) = d | |
| 6ade8b0a | 68 | val kane = data |
| 12aa4087 JW |
69 | fun ext (d, e) = e |
| 70 | ||
| 71 | fun extmin ((l1, c1), (l2, c2)) = | |
| 72 | if l1 < l2 then (l1, c1) | |
| 73 | else | |
| 74 | if l1 > l2 then (l2, c2) | |
| 75 | else (l1, Int.min (c1, c2)) | |
| 76 | fun extmax ((l1, c1), (l2, c2)) = | |
| 77 | if l1 > l2 then (l1, c1) | |
| 78 | else | |
| 79 | if l1 > l2 then (l2, c2) | |
| 80 | else (l1, Int.min (c1, c2)) | |
| 81 | ||
| 82 | fun wrap [] = NONE | |
| 83 | | wrap (e :: []) = e | |
| 84 | | wrap (e :: el) = | |
| 85 | (case wrap el of | |
| 86 | NONE => NONE | |
| 87 | | SOME (el1, el2, elf) => | |
| 88 | (case e of | |
| 89 | SOME (e1, e2, ef) => | |
| 90 | if String.compare (ef, elf) = EQUAL then | |
| 91 | SOME (extmin (e1, el1), extmax (e2, el2), ef) | |
| 92 | else NONE | |
| 93 | | NONE => SOME (el1, el2, elf))) | |
| 94 | ||
| 95 | ||
| 96 | fun map f (d, e) = (f d, e) | |
| 97 | fun map' f (m as (d, e)) = (f m, e) | |
| 98 | end |