mlton/ast/longid.fun

   1 (* Copyright (C) 2017 Matthew Fluet.
   2  * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  * Copyright (C) 1997-2000 NEC Research Institute.
   5  *
   6  * MLton is released under a BSD-style license.
   7  * See the file MLton-LICENSE for details.
   8  *)
   9
  10 functor Longid (S: LONGID_STRUCTS): LONGID =
  11 struct
  12
  13 open S
  14
  15 datatype node = T of {strids: Strid.t list,
  16                       id: Id.t}
  17
  18 type node' = node
  19 structure Wrap = Region.Wrap
  20 open Wrap
  21 type t = node Wrap.t
  22 type obj = t
  23
  24 fun split id =
  25    let
  26       val T {strids, id, ...} = node id
  27    in
  28       (strids, id)
  29    end
  30
  31 val equals =
  32    fn (id, id') =>
  33    let
  34       val T {strids=ss, id=i} = node id
  35       val T {strids=ss', id=i'} = node id'
  36    in
  37       List.equals (ss, ss', Strid.equals) andalso Id.equals (i, i')
  38    end
  39
  40 fun long (strids, id) =
  41    makeRegion (T {strids = strids, id = id},
  42                case strids of
  43                   [] => Id.region id
  44                 | s :: _ => Region.append (Strid.region s, Id.region id))
  45
  46 fun short id = long ([], id)
  47
  48 fun layout id =
  49    let
  50       val T {strids, id} = node id
  51       open Layout
  52    in
  53       seq [case strids of
  54               [] => empty
  55             | _ => seq [seq (separate (List.map (strids, Strid.layout), ".")),
  56                         str "."],
  57            Id.layout id]
  58    end
  59
  60 val toString = Layout.toString o layout
  61
  62 fun fromSymbols (ss: Symbol.t list, region: Region.t): t =
  63    let
  64       val srs =
  65          case Region.left region of
  66              NONE => List.map (ss, fn s => (s, region))
  67            | SOME p =>
  68              let
  69                 val file = SourcePos.file p
  70                 val line = SourcePos.line p
  71              in
  72                 List.unfold
  73                 ((ss, SourcePos.column p),
  74                  fn (s::ss, cl) =>
  75                     let
  76                        val cr = cl + String.length (Symbol.toString s) - 1
  77                     in
  78                        SOME
  79                        ((s, Region.make
  80                             {left = SourcePos.make {column = cl,
  81                                                     file = file,
  82                                                     line = line},
  83                              right = SourcePos.make {column = cr,
  84                                                      file = file,
  85                                                      line = line}}),
  86                         (ss, cr + 2))
  87                     end
  88                   | ([], _) => NONE)
  89              end
  90       val (strids, id) = List.splitLast srs
  91    in
  92       makeRegion (T {strids = List.map (strids, Strid.fromSymbol),
  93                      id = Id.fromSymbol id},
  94                   region)
  95    end
  96
  97 end