@@ -264,21 +264,24 @@ instance ToIR (TT Name) where
264 doForeign :: [Name] -> [TT Name] -> Idris LExp
264 doForeign :: [Name] -> [TT Name] -> Idris LExp
265 doForeign env (_ : fgn : args)
265 doForeign env (_ : fgn : args)
266 | (_, (Constant (Str fgnName) : fgnArgTys : ret : [])) <- unApply fgn
266 | (_, (Constant (Str fgnName) : fgnArgTys : ret : [])) <- unApply fgn
267− = let tys = getFTypes fgnArgTys
267+ = let maybeTys = getFTypes fgnArgTys
268 rty = mkIty' ret in
268 rty = mkIty' ret in
270+ Nothing -> fail $ "Foreign type specification is not a constant list: " ++ show (fgn:args)
269− do args' <- mapM (ir' env) args
272+ args' <- mapM (ir' env) args
270− -- wrap it in a prim__IO
273+ -- wrap it in a prim__IO
271− -- return $ con_ 0 @@ impossible @@
274+ -- return $ con_ 0 @@ impossible @@
272− return $ -- LLazyExp $
275+ return $ -- LLazyExp $
273− LForeign LANG_C rty fgnName (zip tys args')
276+ LForeign LANG_C rty fgnName (zip tys args')
274 | otherwise = fail "Badly formed foreign function call"
277 | otherwise = fail "Badly formed foreign function call"
276−getFTypes :: TT Name -> [FType]
279+getFTypes :: TT Name -> Maybe [FType]
277getFTypes tm = case unApply tm of
280getFTypes tm = case unApply tm of
278− (nil, []) -> []
281+ (nil, []) -> Just []
279 (cons, [ty, xs]) ->
282 (cons, [ty, xs]) ->
280− let rest = getFTypes xs in
281− mkIty' ty : rest
283+ fmap (mkIty' ty :) (getFTypes xs)
283mkIty' (P _ (UN ty) _) = mkIty ty
286mkIty' (P _ (UN ty) _) = mkIty ty
284mkIty' _ = FAny
287mkIty' _ = FAny