Skip to content
This repository has been archived by the owner on Jan 12, 2024. It is now read-only.

Commit

Permalink
Fixed type inference issues with ITuple active patterns (#95)
Browse files Browse the repository at this point in the history
  • Loading branch information
rsoiffer authored and Rory Soiffer committed Aug 19, 2019
1 parent 85d9499 commit 5427e3c
Showing 1 changed file with 16 additions and 13 deletions.
29 changes: 16 additions & 13 deletions src/QsCompiler/DataStructures/SyntaxExtensions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -298,27 +298,30 @@ type QsTuple<'I> with

// active pattern for tuple matching

let private TupleItems<'I> (arg : ITuple) = arg |> function // not the nicest solution, but unfortunatly type extensions cannot be used to satisfy member constraints...
| :? QsExpression as arg -> arg.TupleItems |> Option.map (List.map box)
| :? TypedExpression as arg -> arg.TupleItems |> Option.map (List.map box)
| :? QsType as arg -> arg.TupleItems |> Option.map (List.map box)
| :? ResolvedType as arg -> arg.TupleItems |> Option.map (List.map box)
| :? QsInitializer as arg -> arg.TupleItems |> Option.map (List.map box)
| :? ResolvedInitializer as arg -> arg.TupleItems |> Option.map (List.map box)
// not the nicest solution, but unfortunatly type extensions cannot be used to satisfy member constraints...
// the box >> unbox below is used to cast the value to the inferred type of 'T
let private TupleItems<'T when 'T :> ITuple> (arg: 'T): 'T list option =
let cast a = box >> unbox |> List.map |> Option.map <| a
match box arg with
| :? QsExpression as arg -> cast arg.TupleItems
| :? TypedExpression as arg -> cast arg.TupleItems
| :? QsType as arg -> cast arg.TupleItems
| :? ResolvedType as arg -> cast arg.TupleItems
| :? QsInitializer as arg -> cast arg.TupleItems
| :? ResolvedInitializer as arg -> cast arg.TupleItems
// TODO: can be made an ITuple again once empty symbol tuples are no longer valid for functor specialiations...
//| :? QsSymbol as arg -> arg.TupleItems |> Option.map (List.map box)
| :? SymbolTuple as arg -> arg.TupleItems |> Option.map (List.map box)
//| :? QsSymbol as arg -> arg.TupleItems |> Option.map (List.map box)
| :? SymbolTuple as arg -> cast arg.TupleItems
| _ -> InvalidOperationException("no extension provided for tuple matching of the given ITuple object") |> raise

let (| Item | _ |) arg =
match TupleItems arg with
| Some [item] -> Some (item |> unbox)
| Some [item] -> Some item
| _ -> None

let (| Tuple | _ |) arg =
match TupleItems arg with
| Some [] | Some [_] -> None
| Some items when items.Length > 1 -> Some (items |> List.map unbox)
match TupleItems arg with
| Some items when items.Length > 1 -> Some items
| _ -> None

let (| Missing | _ |) arg =
Expand Down

0 comments on commit 5427e3c

Please sign in to comment.