PageRenderTime 62ms CodeModel.GetById 17ms app.highlight 41ms RepoModel.GetById 1ms app.codeStats 0ms

/Fing/FSharpTypes.fs

http://github.com/sandersn/fing
F# | 101 lines | 75 code | 4 blank | 22 comment | 12 complexity | 9a361bceb477c8856688cb8adde56af9 MD5 | raw file
  1// Copyright (c) 2010, Nathan Sanders
  2// Licence: New BSD. See accompanying documentation.
  3
  4
  5/// code specific to types retrieved from FSharp.Powerpack.Metadata
  6module FSharpTypes
  7open Microsoft.FSharp.Metadata
  8open Types
  9
 10let rec debinarize t =
 11  let rec debinarise = function
 12  | Arrow [t; Arrow ts] -> match debinarize (Arrow ts) with
 13                           | Arrow ts -> Some (Arrow (debinarize t::ts))
 14                           | _ -> failwith "oh no"
 15  | _ -> None
 16  Types.map debinarise id t
 17
 18let isArray (e:FSharpType) =
 19  let name = e.NamedEntity.DisplayName
 20  // it appears that DisplayName can either be array or []
 21  // I think this is inconsistency on the part of either the Powerpack or (more likely)
 22  // the F# runtime in allowing Set.ofArray : array<'t> -> Set<'t>
 23  // while all the Array functions are eg : ('a -> 'b) -> 'a[] -> 'b[]
 24  // OH WELL. Should work now
 25  name = "array" || name.StartsWith "[" && name.EndsWith "]"
 26/// e must be the FSharpType of an array
 27let dimensions (e:FSharpType) = 
 28  match e.NamedEntity.DisplayName with
 29  | "array" -> 1
 30  | brackets -> brackets.Length - 1
 31let tryFindConstraint (param:FSharpGenericParameter) (p,f) =
 32  match param.Constraints |> Seq.tryFind p with
 33  | Some(x) -> Some (f x)
 34  | None -> None
 35let rec optionsum = function
 36| [] -> None
 37| Some(x)::xs -> Some(x)
 38| None::xs -> optionsum xs
 39(* FSharpType -> Typ, no longer a Ty<System.Type,string> 
 40TODO: cvtParam is not done, it really only does type defaulting as yet
 41*)
 42let rec cvt (e:FSharpType) =
 43  if e.IsTuple then
 44    Tuple (e.GenericArguments |> Seq.map cvt |> List.ofSeq)
 45  elif e.IsFunction then
 46      Arrow (e.GenericArguments |> Seq.map cvt |> List.ofSeq)
 47  elif e.IsGenericParameter then
 48    cvtParam e.GenericParameter // TODO: cvtParam is very much not done
 49  elif e |> isArray then // It only has in defaulting so far
 50    Array(dimensions e, e.GenericArguments |> Seq.map cvt |> Seq.head)
 51  else
 52    match e.NamedEntity |> canonicalType, e.GenericArguments |> Seq.map cvt |> List.ofSeq with
 53    | t,[] -> t
 54    | Generic(t,_),args -> Generic(t,args)
 55    | t,args -> Generic(t, args)
 56and cvtParam (param:FSharpGenericParameter) =
 57  if Seq.isEmpty param.Constraints then
 58    Var (Normal param.Name)
 59  else
 60    match param.Constraints 
 61          |> Seq.tryFind (fun c -> c.IsDefaultsToConstraint 
 62                                   && c.DefaultsToTarget.IsNamed) with
 63    | Some def -> def.DefaultsToTarget.NamedEntity |> canonicalType
 64    | None -> Var (Normal param.Name)
 65    // param.Constraints |> Seq.map whenify |> Seq.fold SOMETHING param
 66(* Gets something stable from an FSharpEntity so that we can see if two are identical *)
 67and canonicalType (e:FSharpEntity) =
 68  if e.IsAbbreviation then
 69    cvt e.AbbreviatedType
 70  else
 71    // the dealias here is a hack because
 72    // unit-of-measure types do not have IsAbbreviation set.
 73    // TODO: I have no idea how to make this work once real alias detection
 74    // is implemented, because it will (probably) be based on IsAbbreviation.
 75    Id e.DisplayName |> ParsedTypes.dealias // e.ReflectionType |> string
 76and whenify (param:FSharpGenericParameter) (con:FSharpGenericParameterConstraint) =
 77  // NOTE: This is missing several important (but non-syntactic) kinds of constraints
 78  // particuarly the defaults constraint
 79  // Also: I have no way to compose whenify's results  in cvtParam. Most types with constraints
 80  // have multiple constraints, and these are also duplicated for each occurrence of the type
 81  if con.IsSupportsNullConstraint then
 82    Null (Normal param.Name)
 83  elif con.IsReferenceTypeConstraint then
 84    NotStruct (Normal param.Name)
 85  elif con.IsNonNullableValueTypeConstraint then
 86    Struct (Normal param.Name)
 87  elif con.IsRequiresDefaultConstructorConstraint then
 88    DefaultConstructor (Normal param.Name)
 89  elif con.IsEnumConstraint then
 90    Enum(Normal param.Name, cvt con.EnumConstraintTarget)
 91  elif con.IsDelegateConstraint then
 92    Delegate(Normal param.Name, cvt con.DelegateTupledArgumentType, cvt con.DelegateReturnType)
 93  elif con.IsCoercesToConstraint then
 94    Subtype(Normal param.Name, cvt con.CoercesToTarget)
 95  elif con.IsMemberConstraint then
 96    Sig(Structural param.Name,
 97        Id con.MemberName,
 98        Arrow (List.ofSeq (Seq.map cvt con.MemberArgumentTypes) @ [cvt con.MemberReturnType]), 
 99        Function)
100  else
101    failwith "basically this style of data structure just sucks"