mlton/atoms/generic-scheme.fun

   1 (* Copyright (C) 2015 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 GenericScheme (S: GENERIC_SCHEME_STRUCTS): GENERIC_SCHEME =
  11 struct
  12
  13 open S
  14
  15 type ty = Type.t
  16 type tyvar = Tyvar.t
  17
  18 datatype t = T of {tyvars: tyvar vector,
  19                    ty: ty}
  20
  21 local
  22    fun make f (T r) = f r
  23 in
  24    val ty = make #ty
  25 end
  26
  27 fun layout (T {tyvars, ty}) =
  28    let open Layout
  29       val ty = Type.layout ty
  30    in
  31       if Vector.isEmpty tyvars
  32          then ty
  33       else
  34          align [seq [str "Forall ",
  35                      Vector.layout Tyvar.layout tyvars,
  36                      str "."],
  37                 ty]
  38    end
  39
  40 fun apply (T {tyvars, ty}, args) =
  41    if Vector.isEmpty tyvars andalso Vector.isEmpty args
  42       then ty (* Must special case this, since don't want to substitute
  43                * in monotypes.
  44                *)
  45    else Type.substitute (ty, Vector.zip (tyvars, args))
  46
  47 val apply =
  48    Trace.trace ("GenericScheme.apply", Layout.tuple2 (layout, Vector.layout Type.layout), Type.layout)
  49    apply
  50
  51 end