- htype <- mkHType ty
- let builtin_ty = do -- See if this is a tycon and lookup its name
- (tycon, args) <- Type.splitTyConApp_maybe ty
- let name = Name.getOccString (TyCon.tyConName tycon)
- Map.lookup name builtin_types
- -- If not a builtin type, try the custom types
- let existing_ty = (fmap fst) $ Map.lookup htype typemap
- case Monoid.getFirst $ Monoid.mconcat (map Monoid.First [builtin_ty, existing_ty]) of
- -- Found a type, return it
- Just t -> return (Right t)
- -- No type yet, try to construct it
- Nothing -> do
- newty_maybe <- (construct_vhdl_ty ty)
- case newty_maybe of
- Right (ty_id, ty_def) -> do
- -- TODO: Check name uniqueness
- modA vsTypes (Map.insert htype (ty_id, ty_def))
- modA vsTypeDecls (\typedefs -> typedefs ++ [mktydecl (ty_id, ty_def)])
- return (Right ty_id)
- Left err -> return $ Left $
- "VHDLTools.vhdl_ty: Unsupported Haskell type: " ++ pprString ty ++ "\n"
- ++ err
+ htype_either <- mkHType ty
+ case htype_either of
+ -- No errors
+ Right htype -> do
+ let builtin_ty = do -- See if this is a tycon and lookup its name
+ (tycon, args) <- Type.splitTyConApp_maybe ty
+ let name = Name.getOccString (TyCon.tyConName tycon)
+ Map.lookup name builtin_types
+ -- If not a builtin type, try the custom types
+ let existing_ty = (fmap fst) $ Map.lookup htype typemap
+ case Monoid.getFirst $ Monoid.mconcat (map Monoid.First [builtin_ty, existing_ty]) of
+ -- Found a type, return it
+ Just t -> return (Right t)
+ -- No type yet, try to construct it
+ Nothing -> do
+ newty_maybe <- (construct_vhdl_ty ty)
+ case newty_maybe of
+ Right (ty_id, ty_def) -> do
+ -- TODO: Check name uniqueness
+ modA vsTypes (Map.insert htype (ty_id, ty_def))
+ modA vsTypeDecls (\typedefs -> typedefs ++ [mktydecl (ty_id, ty_def)])
+ return (Right ty_id)
+ Left err -> return $ Left $
+ "VHDLTools.vhdl_ty: Unsupported Haskell type: " ++ pprString ty ++ "\n"
+ ++ err
+ -- Error when constructing htype
+ Left err -> return $ Left err