diff --git a/MateFun/MateFun.cabal b/MateFun/MateFun.cabal
index 077bcfdf8196e77c845be615cff573073dc7c0c8..56afa93b394e85428ef85f3a1934188464f1da30 100644
--- a/MateFun/MateFun.cabal
+++ b/MateFun/MateFun.cabal
@@ -1,7 +1,7 @@
cabal-version: >= 1.24
build-type: Simple
name: MateFun
-version: 0.4.2
+version: 0.4.4
license: LGPL
license-file: LICENSE-LGPL
maintainer: Marcos Viera <mviera@fing.edu.uy>
diff --git a/MateFun/examples/Manual.mf b/MateFun/examples/Manual.mf
index 32caef97836252adaa4e4fbdea4e0c2ccd1b32b5..3b9172ceb3de14cd679ca4f82475a0acec8167a6 100644
--- a/MateFun/examples/Manual.mf
+++ b/MateFun/examples/Manual.mf
@@ -220,4 +220,4 @@ rodar (f) = f:rotar(f,45):rotar(f,90):rotar(f,135):
--incluir Estacionar
-{--}
\ No newline at end of file
+{--}
diff --git a/MateFun/src/MateFun.hs b/MateFun/src/MateFun.hs
index e00dac6e7cbd56065c9269f2ddb416a71252bb2b..f9e25c6b1936b583820eec963e3f417856259fcb 100644
--- a/MateFun/src/MateFun.hs
+++ b/MateFun/src/MateFun.hs
@@ -51,7 +51,7 @@ isPreFlag _ = False
logo = " __ __ _ _____ \n" ++
- "| \\/ | __ _| |_ ___| ___| _ _ __ v 0.4.2 \n" ++
+ "| \\/ | __ _| |_ ___| ___| _ _ __ v 0.4.4 \n" ++
"| |\\/| |/ _` | __/ _ \\ |_ | | | | '_ \\ \n" ++
"| | | | (_| | || __/ _|| |_| | | | | \n" ++
"|_| |_|\\__,_|\\__\\___|_| \\__,_|_| |_| \n\n"
@@ -171,8 +171,8 @@ colapseExpectedAux (Expect s:xs) = s:colapseExpectedAux xs
colapseFounds :: [Message] -> String
colapseFounds [] = []
-colapseFounds (SysUnExpect s:xs) = "Se enocntró " ++ colapseFounds2 (SysUnExpect s:xs)
-colapseFounds (UnExpect s:xs) = "Se enocntró " ++ colapseFounds2 (UnExpect s:xs)
+colapseFounds (SysUnExpect s:xs) = "Se encontró " ++ colapseFounds2 (SysUnExpect s:xs)
+colapseFounds (UnExpect s:xs) = "Se encontró " ++ colapseFounds2 (UnExpect s:xs)
colapseFoundsAux :: [Message] -> [String]
colapseFoundsAux [] = []
diff --git a/MateFun/src/MateFun/Core.hs b/MateFun/src/MateFun/Core.hs
index 385d7d1c9d4dc7faf2754adae3a0431932a6102b..44b74d460955fb9d8796b1855ad794638831c86d 100644
--- a/MateFun/src/MateFun/Core.hs
+++ b/MateFun/src/MateFun/Core.hs
@@ -25,7 +25,7 @@ data Program = Program CDefL FDefL
type CDefL = [ CDef ]
type FDefL = [ FDef ]
-data CDef = CDef NConj TConj
+data CDef = CDef NConj TConj Ann
deriving Show
data TConj = Enum NEnumL
@@ -50,7 +50,7 @@ data Cond = Rel Exp TCond Exp Ann
type CondL = [Cond]
-data FDef = FDef NFun Sig Ecu
+data FDef = FDef NFun Sig Ecu Ann
deriving Show
data Sig = Sig Conj Conj
@@ -212,6 +212,7 @@ red(VR x) = vr $ fromIntegral (round x)
men (VR x) = vr $ -x
sen (VR x) = vr $ sin x
cos (VR x) = vr $ P.cos x
+raizcuad(VR x) = vr $ sqrt x
rgb (VProd [VR r,VR g, VR b]) = VColor $ D.rgb r g b
rect (VProd [VR a, VR l]) = VFig $ D.rect a l
circ (VR r) = VFig $ D.circle r
@@ -236,7 +237,7 @@ figVacia = VFig D.empty
stdFT = [("-", (TyR,TyR))
,("red", (TyR,TyR))
- ,("sen", (TyR,TyR)), ("cos", (TyR,TyR))
+ ,("sen", (TyR,TyR)), ("cos", (TyR,TyR)), ("raizcuad", (TyR,TyR))
,("rgb", (TyProd [TyR,TyR,TyR],TyColor))
,("rect", (TyProd [TyR,TyR],TyFig)),("circ", (TyR,TyFig))
,("linea", (TyProd [TyProd [TyR,TyR],TyProd [TyR,TyR]],TyFig))
@@ -252,7 +253,7 @@ stdFT = [("-", (TyR,TyR))
stdF = [("-",men)
,("red", red)
- ,("sen", sen), ("cos", cos)
+ ,("sen", sen), ("cos", cos), ("raizcuad",raizcuad)
,("rgb", rgb)
,("rect", rect),("circ", circ),("linea", linea)
,("poli", poli),("juntar", juntar),("color", color)
@@ -343,4 +344,3 @@ data Interp = None
| Help
deriving Show
-
diff --git a/MateFun/src/MateFun/Parser.hs b/MateFun/src/MateFun/Parser.hs
index 84287a4c722865bc19467fed901e21413ef62795..af18df3e7b876368a8200700f98b9527b28f2ad6 100644
--- a/MateFun/src/MateFun/Parser.hs
+++ b/MateFun/src/MateFun/Parser.hs
@@ -78,11 +78,12 @@ pImport :: Parser String
pImport = m_reserved "incluir" >> pNFile
pCDef :: Parser CDef
-pCDef = do m_reserved "conj"
+pCDef = do p <- getPosition
+ m_reserved "conj"
nm <- pNConj
m_reservedOp "="
tc <- between (m_symbol "{") (m_symbol "}") pTConj
- return (CDef nm tc)
+ return (CDef nm tc (mkAnn p))
pTConj :: Parser TConj
pTConj = fmap Enum (sepBy1 pEnum (m_symbol ","))
@@ -94,7 +95,8 @@ pTConj = fmap Enum (sepBy1 pEnum (m_symbol ","))
return (Comp pat base pred)
pFDef :: Parser FDef
-pFDef = do fn <- m_identifier
+pFDef = do p <- getPosition
+ fn <- m_identifier
m_reservedOp "::"
dom <- pConj
m_reservedOp "->"
@@ -103,7 +105,7 @@ pFDef = do fn <- m_identifier
args <- m_parens (sepBy m_identifier (m_symbol ","))
m_reservedOp "="
bdy <- pExpG
- return (FDef fn (Sig dom codom) (Ecu args bdy))
+ return (FDef fn (Sig dom codom) (Ecu args bdy) (mkAnn p))
pConj :: Parser Conj
pConj = do cnj <- pSConj
diff --git a/MateFun/src/MateFun/TypeCheck.hs b/MateFun/src/MateFun/TypeCheck.hs
index a04ad659736e7ad58a17ea05deadbf2eb1bcc092..b0c71bf563d50388544a994c2e24dfdf1ee05ff2 100644
--- a/MateFun/src/MateFun/TypeCheck.hs
+++ b/MateFun/src/MateFun/TypeCheck.hs
@@ -21,9 +21,11 @@ import MateFun.Core
data Error = NoError
- | EnumDup String [String]
- | ArgsNoDom String Int Int
- | ArgsDup String [String]
+ | FunDup String [Maybe SourcePos]
+ | CnjDup String [Maybe SourcePos]
+ | EnumDup SourcePos String [String]
+ | ArgsNoDom SourcePos String Int Int
+ | ArgsDup SourcePos String [String]
| ArgsNoDomApp SourcePos String Int Int
| EnumNoConj SourcePos String
| VarNoDef SourcePos String
@@ -43,29 +45,34 @@ showErrors :: [Error] -> String
showErrors errs = (unlines . take 10 . map ((++) "Error: " . show)) errs ++
if length errs > 10 then "...y hay más, pero me cansé.\n" else ""
+showErr p msg = showPos p ++ "\n" ++ msg
+
instance Show Error where
show NoError = ""
- show (EnumDup cn dup) = " En la definición del conjunto " ++ cn ++
- " elementos duplicados: " ++ show dup ++ "."
- show (ArgsNoDom fn ld la) = " En la definición de " ++ fn ++
+ show (CnjDup cn dup) = " El conjunto " ++ cn ++ " se definió más de una vez. Definido en:\n" ++
+ (intercalate "\n" . map showDup) dup
+ show (FunDup fn dup) = " La función " ++ fn ++ " se definió más de una vez. Definida en:\n" ++
+ (intercalate "\n" . map showDup) dup
+ show (EnumDup pos cn dup) = showErr pos $ " En la definición del conjunto " ++ cn ++ " elementos duplicados: " ++ show dup ++ "."
+ show (ArgsNoDom pos fn ld la) = showErr pos $ " En la definición de " ++ fn ++
" el número de argumentos no coincide con el dominio de la función: " ++ show ld ++ " contra " ++ show la ++ "."
- show (ArgsDup fn dup) = " En la definición de " ++ fn ++
+ show (ArgsDup pos fn dup) = showErr pos $ " En la definición de " ++ fn ++
" argumentos duplicados: " ++ show dup ++ "."
- show (ArgsNoDomApp pos fn ld la) = showPos pos ++ " El número de argumentos no coincide con el dominio de la función: " ++ show ld ++ " contra " ++ show la ++ "."
- show (EnumNoConj pos nm) = showPos pos ++ " El elemento " ++ nm ++ " no pertenece a ningún conjunto definido."
- show (VarNoDef pos nm) = showPos pos ++ " La variable " ++ nm ++ " no está definida."
- show (ConjNoDef pos nm) = showPos pos ++ " El conjunto " ++ nm ++ " no está definido."
- show (FunNoDef pos nm) = showPos pos ++ " La función " ++ nm ++ " no está definida."
+ show (ArgsNoDomApp pos fn ld la) = showErr pos $ " El número de argumentos no coincide con el dominio de la función: " ++ show ld ++ " contra " ++ show la ++ "."
+ show (EnumNoConj pos nm) = showErr pos $ " El elemento " ++ nm ++ " no pertenece a ningún conjunto definido."
+ show (VarNoDef pos nm) = showErr pos $ " La variable " ++ nm ++ " no está definida."
+ show (ConjNoDef pos nm) = showErr pos $ " El conjunto " ++ nm ++ " no está definido."
+ show (FunNoDef pos nm) = showErr pos $ " La función " ++ nm ++ " no está definida."
show (NoCond pos val cnj cnds)
- = showPos pos ++ " El valor " ++ show val ++ " no pertenece al conjunto " ++ cnj ++ "\n"
+ = showErr pos $ " El valor " ++ show val ++ " no pertenece al conjunto " ++ cnj ++ "\n"
++ " porque no se cumple: " ++ show (map (\(var,cnd) -> replCnd (var,val) cnd) cnds) ++ "."
- show (Expected pos ts t) = showPos pos ++ " Se esperan elementos de " ++ showCnjs ts ++ " pero se encontró " ++ show t ++ "."
- show (IndInv pos) = showPos pos ++ " Indice inválido."
- show (OutOfRange pos) = showPos pos ++ " Indice fuera de rango."
- show (ProdLength pos l1 l2) = showPos pos ++ " El largo de la tupla es distinto al esperado: " ++ show l1 ++ " contra " ++ show l2 ++ "."
- show (EvalLimit pos) = showPos pos ++ " Se ha excedido el límite de pasos de evaluación."
- show (DivZero pos) = showPos pos ++ " División por 0.\n La división es una función parcial, no está definida para 0."
- show (EmptySec pos fn) = showPos pos ++ " Secuencia vacía.\n La función " ++ fn ++ " es parcial, no está definida para secuencias vacías."
+ show (Expected pos ts t) = showErr pos $ " Se esperan elementos de " ++ showCnjs ts ++ " pero se encontró " ++ show t ++ "."
+ show (IndInv pos) = showErr pos $ " Indice inválido."
+ show (OutOfRange pos) = showErr pos $ " Indice fuera de rango."
+ show (ProdLength pos l1 l2) = showErr pos $ " El largo de la tupla es distinto al esperado: " ++ show l1 ++ " contra " ++ show l2 ++ "."
+ show (EvalLimit pos) = showErr pos $ " Se ha excedido el límite de pasos de evaluación."
+ show (DivZero pos) = showErr pos $ " División por 0.\n La división es una función parcial, no está definida para 0."
+ show (EmptySec pos fn) = showErr pos $ " Secuencia vacía.\n La función " ++ fn ++ " es parcial, no está definida para secuencias vacías."
showCnjs [] = ""
showCnjs (c:[]) = show c
@@ -74,7 +81,11 @@ showCnjs (c:cs) = show c ++ ", " ++ showCnjs cs
showPos pos = "{" ++ (if sourceName pos == "" then "Intérprete"
else "archivo: " ++ sourceName pos ++ " línea: " ++ show (sourceLine pos) ) ++
- " columna: " ++ show (sourceColumn pos) ++ "}\n"
+ " columna: " ++ show (sourceColumn pos) ++ "}"
+
+showDup Nothing = "- MateFun"
+showDup (Just p) = "- " ++ showPos p
+
-------------------------------------------------
@@ -102,14 +113,14 @@ initCtx fn px wrn wrnA (Program cnjs fns)
, ctxC = initCnjs cnjs, ctxV = [], ctxF = [], ctxPF = stdFT
, ctxE = initEnv fns }
-initCnjs = map (\(CDef nm ty) -> (nm,ty))
+initCnjs = map (\(CDef nm ty _) -> (nm,ty))
initEnv fns = Env {envC = 0, envV = [], envF = stdF, envO = stdOp, funs = initFuns fns}
initFuns :: [FDef] -> [(NFun, ([NVar],ExpG))]
initFuns = map initFun
-initFun (FDef fn (Sig dom codom) (Ecu pat bdy)) = (fn, (pat, bdy))
+initFun (FDef fn (Sig dom codom) (Ecu pat bdy) _) = (fn, (pat, bdy))
cnjToTy _ R = return TyR
@@ -148,35 +159,54 @@ runCheck prg ctx = run prg ctx [NoError]
runCheckExp exp ty ctx = runWriter (runReaderT (ckExp exp ty) ctx)
ckProgram :: Program -> Check Ctx
-ckProgram (Program cnjs funs) = do ctx <- updFns funs
- local (const ctx) $ do cns <- mapM ckCDef cnjs
- fns <- mapM ckFDef funs
- modifyCtx cnjs fns
+ckProgram (Program cnjs funs) = do ctx <- ask
+ case (getCnjDup cnjs, getFnDup funs (ctxPF ctx)) of
+ ([],[]) -> do ctx <- updFns funs
+ local (const ctx) $ do cns <- mapM ckCDef cnjs
+ fns <- mapM ckFDef funs
+ modifyCtx cnjs fns
+ (cds,fds) -> do tell $ map (\ds -> CnjDup (fst . head $ ds) (map snd ds)) cds
+ tell $ map (\ds -> FunDup (fst . head $ ds) (map snd ds)) fds
+ return ctx
+
+
+getFnDup funs pfuns = let defs = map (\(FDef fn _ _ ann) -> (fn,Just $ pos ann)) funs ++
+ map (\(fn,_) -> (fn,Nothing)) pfuns
+ in filter (not . null . tail) . groupBy (appFst (==)) . sortBy (appFst compare) $ defs
+
+appFst f x y = f (fst x) (fst y)
+
+getCnjDup cnjs = let defs = map (\(CDef cn _ ann) -> (cn,Just $ pos ann)) cnjs ++
+ map (\cn -> (cn,Nothing)) ["R","Fig","Color"]
+ in filter (not . null . tail) . groupBy (appFst (==)) . sortBy (appFst compare) $ defs
+
+
updFns funs = do ctx <- ask
fns <- mapM funTy funs
return ctx { ctxF = fns }
-funTy (FDef fn (Sig dom codom) _) = do d <- cnjToTy False dom
- c <- cnjToTy False codom
- return (fn,(d,c))
+funTy (FDef fn (Sig dom codom) _ _) = do d <- cnjToTy False dom
+ c <- cnjToTy False codom
+ return (fn,(d,c))
modifyCtx cns fns = do ctx <- ask
let env = (ctxE ctx)
- {funs = map (\(FDef fn _ (Ecu args exp)) -> (fn,(args,exp))) fns }
- let cnjs = map (\(CDef cn tcn) -> (cn,tcn)) cns
+ {funs = map (\(FDef fn _ (Ecu args exp) _) -> (fn,(args,exp))) fns }
+ let cnjs = map (\(CDef cn tcn _) -> (cn,tcn)) cns
return (ctx {ctxC = cnjs, ctxE = env})
ckCDef :: CDef -> Check CDef
-ckCDef cnj@(CDef cn (Enum es)) = do let dup = nub (es \\ nub es)
- when (length dup > 0) (tell [EnumDup cn dup])
- return cnj
-ckCDef (CDef cn (Comp nvar cnj cnd)) = do ty <- cnjToTy True cnj
- cnd' <- local (addVars [(nvar,ty)])
- (ckCond cnd)
- return $ CDef cn (Comp nvar cnj cnd')
+ckCDef cnj@(CDef cn (Enum es) ann) = do let dup = nub (es \\ nub es)
+ when (length dup > 0) (tell [EnumDup (pos ann) cn dup])
+ return cnj
+ckCDef (CDef cn (Comp nvar cnj cnd) ann) = do ty <- cnjToTy True cnj
+ cnd' <- local (addVars [(nvar,ty)])
+ (ckCond cnd)
+ return $ CDef cn (Comp nvar cnj cnd') ann
ckFDef :: FDef -> Check FDef
-ckFDef (FDef fn (Sig dom codom) (Ecu args exp)) = do ty <- cnjToTy True codom
+ckFDef (FDef fn (Sig dom codom) (Ecu args exp) ann)
+ = do ty <- cnjToTy True codom
tds <- case args of
[arg] -> (:[]) <$> cnjToTy True dom
_ -> do let (ld,td) = case dom of
@@ -184,13 +214,13 @@ ckFDef (FDef fn (Sig dom codom) (Ecu args exp)) = do ty <- cnjToTy True codom
_ -> (1,[dom])
let la = length args
let dup = nub (args \\ nub args)
- when (ld /= la) (tell [ArgsNoDom fn ld la])
- when (length dup > 0) (tell [ArgsDup fn dup])
+ when (ld /= la) (tell [ArgsNoDom (pos ann) fn ld la])
+ when (length dup > 0) (tell [ArgsDup (pos ann) fn dup])
ty <- cnjToTy True codom
mapM (cnjToTy True) td
e' <- local (addVars (zip args tds))
(ckExpG exp ty)
- return $ FDef fn (Sig dom codom) (Ecu args e')
+ return $ FDef fn (Sig dom codom) (Ecu args e') ann
addVars :: [(NVar,Ty)] -> Ctx -> Ctx
addVars vs ctx = ctx { ctxV = vs ++ (ctxV ctx)}