Skip to content
Browse files

Fix default arguments in pattern context

  • Loading branch information...
1 parent 1f95beb commit ec631d73706b317bb6202f7669cc3d537dbf6aa1 Edwin Brady committed May 4, 2012
Showing with 12 additions and 10 deletions.
  1. +1 −1 lib/io.idr
  2. +8 −8 src/Idris/AbsSyntax.hs
  3. +3 −1 src/Idris/Compiler.hs
View
2 lib/io.idr
@@ -9,7 +9,7 @@ io_bind : IO a -> (a -> IO b) -> IO b
io_bind (prim__IO v) k = k v
unsafePerformIO : IO a -> a
-unsafePerformIO (prim__IO x) = x
+-- compiled as primitive
abstract
io_return : a -> IO a
View
16 src/Idris/AbsSyntax.hs
@@ -1575,9 +1575,9 @@ addImpl' :: Bool -> [Name] -> IState -> PTerm -> PTerm
addImpl' inpat env ist ptm = ai env ptm
where
ai env (PRef fc f)
- | not (f `elem` env) = handleErr $ aiFn inpat ist fc f []
+ | not (f `elem` env) = handleErr $ aiFn inpat inpat ist fc f []
ai env (PHidden (PRef fc f))
- | not (f `elem` env) = handleErr $ aiFn False ist fc f []
+ | not (f `elem` env) = handleErr $ aiFn inpat False ist fc f []
ai env (PEq fc l r) = let l' = ai env l
r' = ai env r in
PEq fc l' r'
@@ -1596,7 +1596,7 @@ addImpl' inpat env ist ptm = ai env ptm
ai env (PApp fc (PRef _ f) as)
| not (f `elem` env)
= let as' = map (fmap (ai env)) as in
- handleErr $ aiFn False ist fc f as'
+ handleErr $ aiFn inpat False ist fc f as'
ai env (PApp fc f as) = let f' = ai env f
as' = map (fmap (ai env)) as in
mkPApp fc 1 f' as'
@@ -1625,18 +1625,18 @@ addImpl' inpat env ist ptm = ai env ptm
-- if in a pattern, and there are no arguments, and there's no possible
-- names with zero explicit arguments, don't add implicits.
-aiFn :: Bool -> IState -> FC -> Name -> [PArg] -> Either Err PTerm
-aiFn True ist fc f []
+aiFn :: Bool -> Bool -> IState -> FC -> Name -> [PArg] -> Either Err PTerm
+aiFn inpat True ist fc f []
= case lookupCtxt Nothing f (idris_implicits ist) of
[] -> Right $ PRef fc f
alts -> if (any (all imp) alts)
- then aiFn False ist fc f [] -- use it as a constructor
+ then aiFn inpat False ist fc f [] -- use it as a constructor
else Right $ PRef fc f
where imp (PExp _ _ _) = False
imp _ = True
-aiFn inpat ist fc f as
+aiFn inpat expat ist fc f as
| f `elem` primNames = Right $ PApp fc (PRef fc f) as
-aiFn inpat ist fc f as
+aiFn inpat expat ist fc f as
-- This is where namespaces get resolved by adding PAlternative
= case lookupCtxtName Nothing f (idris_implicits ist) of
[(f',ns)] -> Right $ mkPApp fc (length ns) (PRef fc f') (insertImpl ns as)
View
4 src/Idris/Compiler.hs
@@ -21,7 +21,7 @@ import Paths_idris
import Epic.Epic hiding (Term, Type, Name, fn, compile)
import qualified Epic.Epic as E
-primDefs = [UN "mkLazyForeign", UN "mkForeign", UN "FalseElim"]
+primDefs = [UN "unsafePerformIO", UN "mkLazyForeign", UN "mkForeign", UN "FalseElim"]
compile :: FilePath -> Term -> Idris ()
compile f tm
@@ -105,6 +105,8 @@ instance ToEpic (TT Name) where
= doForeign False args
| (P _ (UN "mkLazyForeign") _, args) <- unApply tm
= doForeign True args
+ | (P _ (UN "unsafePerformIO") _, [_, arg]) <- unApply tm
+ = epic' env arg
| (P _ (UN "lazy") _, [_,arg]) <- unApply tm
= do arg' <- epic' env arg
return $ lazy_ arg'

0 comments on commit ec631d7

Please sign in to comment.
Something went wrong with that request. Please try again.