Commit 917868b1 authored by Jan Rasmus Tikovsky 's avatar Jan Rasmus Tikovsky
Browse files

Merge remote-tracking branch 'origin' into records

parents 966a325b ddfaf3e7
......@@ -4,6 +4,12 @@ Change log for curry-frontend
Under development
=================
* Removed record type extensions
* Enabled declaration of (mutually) recursive record types
* Removed expansion of record types in type error messages
* Replaced `MessageM` monad with `CYT` monads and moved `CYT` monads
to package `curry-base`
......
......@@ -16,7 +16,6 @@ module Base.TypeSubst
) where
import Data.List (nub)
import Data.Maybe (fromJust)
import Base.Subst
import Base.TopEnv
......@@ -89,4 +88,6 @@ expandAliasType tys (TypeRecord fs) = TypeRecord fs'
normalize :: Type -> Type
normalize ty = expandAliasType [TypeVariable (occur tv) | tv <- [0 ..]] ty
where tvs = zip (nub (filter (>= 0) (typeVars ty))) [0 ..]
occur tv = fromJust (lookup tv tvs)
occur tv = case lookup tv tvs of
Just t -> t
Nothing -> error "Base.TypeSubst.normalize"
......@@ -43,10 +43,10 @@ interfaceCheck _ env intf
-- disambiguated
-- * Environment: remains unchanged
kindCheck :: Monad m => Check m Module
kindCheck _ env (Module ps m es is ds)
| null msgs = ok (env, Module ps m es is ds')
kindCheck _ env mdl
| null msgs = ok (env, mdl')
| otherwise = failMessages msgs
where (ds', msgs) = KC.kindCheck (moduleIdent env) (tyConsEnv env) ds
where (mdl', msgs) = KC.kindCheck (tyConsEnv env) mdl
-- |Check for a correct syntax.
--
......
......@@ -50,22 +50,26 @@ import Env.TypeConstructor (TCEnv, tcArity)
-- defined type constructors are inserted into the environment, and,
-- finally, the declarations are checked within this environment.
kindCheck :: ModuleIdent -> TCEnv -> [Decl] -> ([Decl], [Message])
kindCheck m tcEnv decls = case findMultiples $ map typeConstr tds of
[] -> runKCM (mapM checkDecl decls) initState
ms -> (decls, map errMultipleDeclaration ms)
where tds = filter isTypeDecl decls
kEnv = foldr (bindKind m) (fmap tcArity tcEnv) tds
initState = KCState m kEnv []
kindCheck :: TCEnv -> Module -> (Module, [Message])
kindCheck tcEnv mdl@(Module _ m _ _ ds) =
case findMultiples $ map typeConstr tds of
[] -> runKCM (checkModule mdl) state
tss -> (mdl, map errMultipleDeclaration tss)
where
tds = filter isTypeDecl ds
kEnv = foldr (bindKind m) (fmap tcArity tcEnv) tds
state = KCState m kEnv []
-- Kind Check Monad
type KCM = S.State KCState
-- |Internal state of the kind check
data KCState = KCState
{ moduleIdent :: ModuleIdent
, kindEnv :: KindEnv
, errors :: [Message]
}
type KCM = S.State KCState -- the Kind Check Monad
runKCM :: KCM a -> KCState -> (a, [Message])
runKCM kcm s = let (a, s') = S.runState kcm s in (a, reverse $ errors s')
......@@ -100,6 +104,9 @@ lookupKind = lookupTopEnv
qualLookupKind :: QualIdent -> KindEnv -> [Int]
qualLookupKind = qualLookupTopEnv
checkModule :: Module -> KCM Module
checkModule (Module ps m es is ds) = Module ps m es is `liftM` mapM checkDecl ds
-- When type declarations are checked, the compiler will allow anonymous
-- type variables on the left hand side of the declaration, but not on
-- the right hand side. Function and pattern declarations must be
......
......@@ -24,11 +24,11 @@
module Checks.SyntaxCheck (syntaxCheck) where
import Control.Monad (liftM, liftM2, liftM3, unless, when)
import Control.Monad (forM_, liftM, liftM2, liftM3, unless, when)
import qualified Control.Monad.State as S (State, runState, gets, modify)
import Data.List ((\\), insertBy, nub, partition)
import Data.Maybe (fromJust, isJust, isNothing, maybeToList)
import qualified Data.Set as Set (empty, insert, member)
import Data.List ((\\), insertBy, nub, partition)
import Data.Maybe (isJust, isNothing, maybeToList)
import qualified Data.Set as Set (empty, insert, member)
import Curry.Base.Ident
import Curry.Base.Position
......@@ -40,10 +40,10 @@ import Base.Expr
import Base.Messages (Message, posMessage, internalError)
import Base.NestEnv
import Base.Types
import Base.Utils ((++!), findDouble, findMultiples)
import Base.Utils ((++!), findDouble, findMultiples)
import Env.TypeConstructor (TCEnv, TypeInfo (..), qualLookupTC)
import Env.Value (ValueEnv, ValueInfo (..))
import Env.Value (ValueEnv, ValueInfo (..))
import CompilerOpts
......@@ -59,14 +59,14 @@ import CompilerOpts
syntaxCheck :: Options -> ValueEnv -> TCEnv -> Module
-> ((Module, [KnownExtension]), [Message])
syntaxCheck opts tyEnv tcEnv mdl@(Module _ m _ _ ds) =
case findMultiples $ concatMap constrs typeDecls of
case findMultiples $ concatMap constrs tds of
[] -> runSC (checkModule mdl) state
css -> ((mdl, exts), map errMultipleDataConstructor css)
where
typeDecls = filter isTypeDecl ds
rEnv = globalEnv $ fmap (renameInfo tcEnv) tyEnv
state = initState exts m rEnv
exts = optExtensions opts
tds = filter isTypeDecl ds
rEnv = globalEnv $ fmap (renameInfo tcEnv) tyEnv
state = initState exts m rEnv
exts = optExtensions opts
-- A global state transformer is used for generating fresh integer keys with
-- which the variables are renamed.
......@@ -159,6 +159,7 @@ inNestedScope act = withLocalEnv (incNesting >> act)
report :: Message -> SCM ()
report msg = S.modify $ \ s -> s { errors = msg : errors s }
-- |Everything is checked.
ok :: SCM ()
ok = return ()
......@@ -182,13 +183,13 @@ type RenameEnv = NestEnv RenameInfo
data RenameInfo
-- |Arity of data constructor
= Constr QualIdent Int
= Constr QualIdent Int
-- |Record type and all labels for a single record label
| RecordLabel QualIdent [Ident]
-- |Arity of global function
| GlobalVar QualIdent Int
| GlobalVar QualIdent Int
-- |Arity of local function
| LocalVar Ident Int
| LocalVar Ident Int
deriving (Eq, Show)
ppRenameInfo :: RenameInfo -> Doc
......@@ -219,15 +220,11 @@ bindLocal = bindNestEnv
-- |Bind type constructor information
bindTypeDecl :: Decl -> SCM ()
bindTypeDecl (DataDecl _ _ _ cs) = mapM_ bindConstr cs
bindTypeDecl (NewtypeDecl _ _ _ nc) = bindNewConstr nc
bindTypeDecl (TypeDecl _ t _ (RecordType fs)) = do
m <- getModuleIdent
others <- qualLookupVar (qualifyWith m t) `liftM` getRenameEnv
when (any isConstr others) $ report $ errIllegalRecordId t
mapM_ (bindRecordLabel t allLabels) allLabels
where allLabels = concatMap fst fs
bindTypeDecl _ = return ()
bindTypeDecl (DataDecl _ _ _ cs) = mapM_ bindConstr cs
bindTypeDecl (NewtypeDecl _ _ _ nc) = bindNewConstr nc
bindTypeDecl (TypeDecl _ t _ (RecordType fs)) = bindRecordLabels t
(concatMap fst fs)
bindTypeDecl _ = return ()
bindConstr :: ConstrDecl -> SCM ()
bindConstr (ConstrDecl _ _ c tys) = do
......@@ -242,12 +239,13 @@ bindNewConstr (NewConstrDecl _ _ c _) = do
m <- getModuleIdent
modifyRenameEnv $ bindGlobal m c (Constr (qualifyWith m c) 1)
bindRecordLabel :: Ident -> [Ident] -> Ident -> SCM ()
bindRecordLabel t allLabels l = do
bindRecordLabels :: Ident -> [Ident] -> SCM ()
bindRecordLabels t labels = do
m <- getModuleIdent
new <- (null . lookupVar l) `liftM` getRenameEnv
unless new $ report $ errDuplicateDefinition l
modifyRenameEnv $ bindGlobal m l (RecordLabel (qualifyWith m t) allLabels)
forM_ labels $ \l -> do
new <- (null . lookupVar l) `liftM` getRenameEnv
unless new $ report $ errDuplicateDefinition l
modifyRenameEnv $ bindGlobal m l (RecordLabel (qualifyWith m t) labels)
-- ------------------------------------------------------------------------------
......@@ -314,14 +312,13 @@ qualLookupListCons v env
-- local declarations.
checkModule :: Module -> SCM (Module, [KnownExtension])
checkModule (Module ps m es is decls) = do
mapM_ checkPragma ps
mapM_ bindTypeDecl (rds ++ dds)
decls' <- liftM2 (++) (mapM checkTypeDecl tds) (checkTopDecls vds)
checkModule (Module ps m es is ds) = do
mapM_ checkPragma ps
mapM_ bindTypeDecl tds
ds' <- liftM2 (++) (mapM checkTypeDecl tds) (checkTopDecls vds)
exts <- getExtensions
return (Module ps m es is decls', exts)
where (tds, vds) = partition isTypeDecl decls
(rds, dds) = partition isRecordDecl tds
return (Module ps m es is ds', exts)
where (tds, vds) = partition isTypeDecl ds
checkPragma :: ModulePragma -> SCM ()
checkPragma (LanguagePragma _ exts) = mapM_ checkExtension exts
......@@ -334,14 +331,14 @@ checkExtension (UnknownExtension p e) = report $ errUnknownExtension p e
checkTypeDecl :: Decl -> SCM Decl
checkTypeDecl rec@(TypeDecl _ r _ (RecordType fs)) = do
checkRecordExtension $ idPosition r
when (null fs) $ report $ errEmptyRecord $ idPosition r
when (null fs) $ report $ errEmptyRecord $ idPosition r
return rec
checkTypeDecl d = return d
checkTopDecls :: [Decl] -> SCM [Decl]
checkTopDecls decls = do
checkTopDecls ds = do
m <- getModuleIdent
checkDeclGroup (bindFuncDecl m) decls
checkDeclGroup (bindFuncDecl m) ds
-- Each declaration group opens a new scope and uses a distinct key
-- for renaming the variables in this scope. In a declaration group,
......@@ -659,21 +656,21 @@ checkRecordPattern p fs t = do
env <- getRenameEnv
case lookupVar l env of
[RecordLabel r ls] -> do
when (isJust duplicate) $ report $ errDuplicateLabel
$ fromJust duplicate
if isNothing t
then do
case findDouble ls' of
Just l' -> report $ errDuplicateLabel l'
_ -> ok
case t of
Nothing -> do
when (not $ null missings) $ report $ errMissingLabel
(idPosition l) (head missings) r "record pattern"
flip RecordPattern t `liftM` mapM (checkFieldPatt r) fs
else if t == Just (VariablePattern anonId)
then liftM2 RecordPattern
(mapM (checkFieldPatt r) fs)
(Just `liftM` checkPattern p (fromJust t))
else do report (errIllegalRecordPattern p)
return $ RecordPattern fs t
Just pat | pat == VariablePattern anonId -> do
liftM2 RecordPattern (mapM (checkFieldPatt r) fs)
(Just `liftM` checkPattern p pat)
_ -> do
report (errIllegalRecordPattern p)
return $ RecordPattern fs t
where ls' = map fieldLabel fs
duplicate = findDouble ls'
missings = ls \\ ls'
[] -> report (errUndefinedLabel l) >> return (RecordPattern fs t)
[_] -> report (errNotALabel l) >> return (RecordPattern fs t)
......@@ -793,7 +790,7 @@ checkVariable v
case qualLookupVar v env of
[] -> do report $ errUndefinedVariable v
return $ Variable v
[Constr _ _] -> return $ Constructor v
[Constr _ _] -> return $ Constructor v
[GlobalVar _ _] -> return $ Variable v
[LocalVar v' _] -> return $ Variable $ qualify v'
rs -> do
......@@ -801,7 +798,7 @@ checkVariable v
case qualLookupVar (qualQualify m v) env of
[] -> do report $ errAmbiguousIdent rs v
return $ Variable v
[Constr _ _] -> return $ Constructor v
[Constr _ _] -> return $ Constructor v
[GlobalVar _ _] -> return $ Variable v
[LocalVar v' _] -> return $ Variable $ qualify v'
rs' -> do report $ errAmbiguousIdent rs' v
......@@ -886,11 +883,12 @@ checkFieldExpr r (Field p l e) = do
-- ---------------------------------------------------------------------------
constrs :: Decl -> [Ident]
constrs (DataDecl _ _ _ cs) = map constr cs
constrs (DataDecl _ _ _ cs ) = map constr cs
where constr (ConstrDecl _ _ c _) = c
constr (ConOpDecl _ _ _ op _) = op
constrs (NewtypeDecl _ _ _ (NewConstrDecl _ _ c _)) = [c]
constrs _ = []
constrs (TypeDecl _ r _ (RecordType _)) = [r]
constrs _ = []
vars :: Decl -> [Ident]
vars (TypeSig _ fs _) = fs
......@@ -903,7 +901,7 @@ vars _ = []
renameLiteral :: Literal -> SCM Literal
renameLiteral (Int v i) = liftM (flip Int i . renameIdent v) newId
renameLiteral l = return l
renameLiteral l = return l
-- Since the compiler expects all rules of the same function to be together,
-- it is necessary to sort the list of declarations.
......@@ -1078,7 +1076,7 @@ errMultipleDataConstructor :: [Ident] -> Message
errMultipleDataConstructor [] = internalError
"SyntaxCheck.errMultipleDataDeclaration: empty list"
errMultipleDataConstructor (i:is) = posMessage i $
text "Multiple definitions for data constructor" <+> text (escName i)
text "Multiple definitions for data/record constructor" <+> text (escName i)
<+> text "at:" $+$
nest 2 (vcat (map (ppPosition . getPosition) (i:is)))
......@@ -1102,10 +1100,6 @@ errIllegalLabel :: Ident -> QualIdent -> Message
errIllegalLabel l r = posMessage l $ hsep $ map text
["Label", escName l, "is not defined in record", escQualName r]
errIllegalRecordId :: Ident -> Message
errIllegalRecordId r = posMessage r $ hsep $ map text
["Record identifier", escName r, "already assigned to a data constructor"]
errNonVariable :: String -> Ident -> Message
errNonVariable what c = posMessage c $ hsep $ map text
["Data constructor", escName c, "in left hand side of", what]
......
......@@ -524,8 +524,10 @@ simplifyPat (ConstructorPattern c ps) = ConstructorPattern c `liftM`
simplifyPat (InfixPattern p1 c p2) = ConstructorPattern c `liftM`
mapM simplifyPat [p1, p2]
simplifyPat (ParenPattern p) = simplifyPat p
simplifyPat (TuplePattern _ ps) = ConstructorPattern (qTupleId (length ps))
`liftM` mapM simplifyPat ps
simplifyPat (TuplePattern _ ps)
| null ps = return $ ConstructorPattern qUnitId []
| otherwise = ConstructorPattern (qTupleId (length ps))
`liftM` mapM simplifyPat ps
simplifyPat (ListPattern _ ps) = simplifyListPattern `liftM`
mapM simplifyPat ps
simplifyPat (AsPattern _ p) = simplifyPat p
......@@ -730,6 +732,7 @@ tidyPat :: Pattern -> WCM Pattern
tidyPat p@(LiteralPattern _) = return p
tidyPat p@(VariablePattern _) = return p
tidyPat p@(ConstructorPattern c ps)
| c == qUnitId && null ps = return $ TuplePattern noRef []
| isQTupleId c = TuplePattern noRef `liftM` mapM tidyPat ps
| c == qConsId && isFiniteList p = ListPattern [] `liftM`
mapM tidyPat (unwrapFinite p)
......
......@@ -70,12 +70,16 @@ instance Entity TypeInfo where
mergeData (d : ds) (d' : ds') = d `mplus` d' : mergeData ds ds'
merge (DataType tc n _) (RenamingType tc' _ nc)
| tc == tc' = Just (RenamingType tc n nc)
merge (RenamingType tc n nc) (DataType tc' _ _)
| tc == tc' = Just (RenamingType tc n nc)
merge (RenamingType tc n nc) (RenamingType tc' _ _)
| tc == tc' = Just (RenamingType tc n nc)
merge (AliasType tc n ty) (AliasType tc' _ _)
| tc == tc' = Just (AliasType tc n ty)
merge l@(RenamingType tc _ _) (DataType tc' _ _)
| tc == tc' = Just l
merge l@(RenamingType tc _ _) (RenamingType tc' _ _)
| tc == tc' = Just l
merge l@(AliasType tc _ _) (AliasType tc' _ _)
| tc == tc' = Just l
merge l@(AliasType tc _ (TypeRecord _)) (DataType tc' _ _)
| tc == tc' = Just l
merge (DataType tc' _ _) r@(AliasType tc _ (TypeRecord _))
| tc == tc' = Just r
merge _ _ = Nothing
tcArity :: TypeInfo -> Int
......
......@@ -15,10 +15,10 @@
module Generators.GenAbstractCurry
( genTypedAbstract, genUntypedAbstract ) where
import Data.List (find, mapAccumL)
import qualified Data.Map as Map
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Set as Set
import Data.List (find, mapAccumL)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Set as Set
import Curry.AbstractCurry
import Curry.Base.Ident
......@@ -448,13 +448,11 @@ genExpr :: Position -> AbstractEnv -> Expression -> (AbstractEnv, CExpr)
genExpr pos env (Literal l) = case l of
String _ cs -> genExpr pos env $ List [] $ map (Literal . Char noRef) cs
_ -> (env, CLit $ genLiteral l)
genExpr _ env (Variable v)
| isJust midx = (env, CVar (fromJust midx, idName ident))
| v == qSuccessId = (env, CSymbol $ genQName False env qSuccessFunId)
| otherwise = (env, CSymbol $ genQName False env v)
where
ident = unqualify v
midx = getVarIndex env ident
genExpr _ env (Variable v) = case getVarIndex env ident of
Just idx -> (env, CVar (idx, idName ident))
_ | v == qSuccessId -> (env, CSymbol $ genQName False env qSuccessFunId)
| otherwise -> (env, CSymbol $ genQName False env v)
where ident = unqualify v
genExpr _ env (Constructor c) = (env, CSymbol $ genQName False env c)
genExpr pos env (Paren expr) = genExpr pos env expr
genExpr pos env (Typed expr _) = genExpr pos env expr
......@@ -563,8 +561,10 @@ genPattern pos env (LiteralPattern l) = case l of
String _ cs -> genPattern pos env $ ListPattern [] $ map (LiteralPattern . Char noRef) cs
_ -> (env, CPLit $ genLiteral l)
genPattern _ env (VariablePattern v)
= let (env', idx) = genVarIndex env v
in (env', CPVar (idx, idName v))
= case getVarIndex env v of
Just idx -> (env, CPVar (idx, idName v))
Nothing -> let (env', idx') = genVarIndex env v
in (env', CPVar (idx', idName v))
genPattern pos env (ConstructorPattern qident args)
= let (env', args') = mapAccumL (genPattern pos) env args
in (env', CPComb (genQName False env qident) args')
......@@ -722,15 +722,11 @@ buildExportTable mid _ exptab (ExportTypeWith qident ids)
(insertExportedIdent exptab (unqualify qident))
ids
| otherwise = exptab
buildExportTable mid decls exptab (ExportTypeAll qident)
| isJust ident'
= foldl insertExportedIdent
(insertExportedIdent exptab ident)
(maybe [] getConstrIdents (find (isDataDeclOf ident) decls))
| otherwise = exptab
where
ident' = localIdent mid qident
ident = fromJust ident'
buildExportTable mid ds exptab (ExportTypeAll qid) = case localIdent mid qid of
Just ident -> foldl insertExportedIdent
(insertExportedIdent exptab ident)
(maybe [] getConstrIdents (find (isDataDeclOf ident) ds))
Nothing -> exptab
buildExportTable _ _ exptab (ExportModule _) = exptab
--
......@@ -864,10 +860,10 @@ isDataDeclOf _ _ = False
-- Checks, whether a symbol is defined in the Prelude.
isPreludeSymbol :: QualIdent -> Bool
isPreludeSymbol qident
= let (mmid, ident) = (qidModule qident, qidIdent qident)
in (isJust mmid && preludeMIdent == fromJust mmid)
|| elem ident [unitId, listId, nilId, consId]
|| isTupleId ident
= let (mmid, ident) = (qidModule qident, qidIdent qident)
in mmid == Just preludeMIdent
|| elem ident [unitId, listId, nilId, consId]
|| isTupleId ident
-- Converts an infix operator to an expression
opToExpr :: InfixOp -> Expression
......
......@@ -14,7 +14,7 @@ import Control.Monad (filterM, liftM, liftM2, liftM3, mplus)
import Control.Monad.State (State, evalState, gets, modify)
import Data.List (mapAccumL, nub)
import qualified Data.Map as Map (Map, empty, insert, lookup, fromList, toList)
import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust)
import Data.Maybe (catMaybes, fromMaybe, isJust)
-- curry-base
import Curry.Base.Ident as Id
......@@ -750,13 +750,10 @@ cs2ilType :: [(Ident,Int)] -> CS.TypeExpr -> ([(Ident,Int)], IL.Type)
cs2ilType ids (CS.ConstructorType qident typeexprs)
= let (ids', ilTypeexprs) = mapAccumL cs2ilType ids typeexprs
in (ids', IL.TypeConstructor qident ilTypeexprs)
cs2ilType ids (CS.VariableType ident)
= let mid = lookup ident ids
nid | null ids = 0
| otherwise = 1 + snd (head ids)
(ident1, ids') | isJust mid = (fromJust mid, ids)
| otherwise = (nid, (ident, nid):ids)
in (ids', IL.TypeVariable ident1)
cs2ilType ids (CS.VariableType ident) = case lookup ident ids of
Just i -> (ids, IL.TypeVariable i)
Nothing -> let nid = 1 + case ids of { [] -> 0; (_, j):_ -> j }
in ((ident, nid):ids, IL.TypeVariable nid)
cs2ilType ids (CS.ArrowType type1 type2)
= let (ids', ilType1) = cs2ilType ids type1
(ids'', ilType2) = cs2ilType ids' type2
......
......@@ -15,11 +15,11 @@
-}
module Imports (importInterfaces, importModules, qualifyEnv) where
import Control.Monad (liftM, unless)
import qualified Control.Monad.State as S (State, gets, modify, runState)
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Set as Set
import Control.Monad (liftM, unless)
import qualified Control.Monad.State as S (State, gets, modify, runState)
import qualified Data.Map as Map
import Data.Maybe (catMaybes, fromMaybe)
import qualified Data.Set as Set
import Curry.Base.Ident
import Curry.Base.Monad
......@@ -438,11 +438,16 @@ importUnifyData cEnv = cEnv { tyConsEnv = importUnifyData' $ tyConsEnv cEnv }
importUnifyData' :: TCEnv -> TCEnv
importUnifyData' tcEnv = fmap (setInfo allTyCons) tcEnv
where
setInfo tcs t = fromJust $ Map.lookup (origName t) tcs
setInfo tcs t = case Map.lookup (origName t) tcs of
Nothing -> error "Imports.importUnifyData'"
Just ty -> ty
allTyCons = foldr (mergeData . snd) Map.empty $ allImports tcEnv
mergeData t tcs =
Map.insert tc (maybe t (fromJust . merge t) $ Map.lookup tc tcs) tcs
Map.insert tc (maybe t (sureMerge t) $ Map.lookup tc tcs) tcs
where tc = origName t
sureMerge x y = case merge x y of
Nothing -> error "Imports.importUnifyData'.sureMerge"
Just z -> z
-- ---------------------------------------------------------------------------
......
......@@ -25,7 +25,6 @@ import Control.Monad (liftM, liftM2)
import qualified Control.Monad.Reader as R
import Data.List (nub, partition)
import qualified Data.Map as Map (Map, empty, insert, lookup)
import Data.Maybe (fromJust)
import qualified Data.Set as Set (Set, empty, insert, delete, toList)
import Curry.Base.Position
......@@ -270,7 +269,9 @@ trArgs :: [Equation] -> [Ident] -> [Ident]
trArgs [Equation _ (FunLhs _ (t:ts)) _] (v:_) =
v : map (translArg (bindRenameEnv v t Map.empty)) ts
where
translArg env (VariablePattern v') = fromJust (Map.lookup v' env)
translArg env (VariablePattern v') = case Map.lookup v' env of
Just x -> x
Nothing -> internalError "Transformations.CurryToIL.trArgs"
translArg _ _ = internalError "Translation of arguments not defined"
trArgs _ _ = internalError "Translation of arguments not defined" -- TODO
......
add x x = x + x
test x y = x + y
\ No newline at end of file
{-# LANGUAGE Records #-}
module RecIdent where
data Rec0 = Rec
type Rec = { int :: Int }
type Rec2 = { int2 :: Int }
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment