获得＆lt; <loop>＆gt;在类型检查器</loop>中实现块可见性时

Question

我正在为一种简单的命令式语言编写一个简单的类型检查器，我现在仍然坚持使用这种输出：

TestChecker: <<loop>>

我已经阅读了this个问题，所以我知道我必须对循环引用做错了。我很确定问题出现在以下函数中，该函数负责检查语句块：

checkGroup :: Environ -> [Prog] -> (State, Environ, [String])
checkGroup env progs = (finalState, finalEnv, messages)
    where (finalState, finalEnv, messages) = foldl checkSingleProg (Ok, empty, []) progs
          checkSingleProg (s, e, msg) prog = (resS, mergeEnv e e', mess)
              where (s', e', msg') = checkProg (mergeEnv' env finalEnv) prog
                    mess = msg ++ msg'
                    resS = if s == Err || s' == Err then Err else Ok

请注意：

checkProg (mergeEnv' env finalEnv) prog

checkProg使用Group父亲的环境与整个Group生成的环境合并作为环境。

（编辑：是的，我知道finalEnv是此次checkProg调用输出的一部分。这是问题的关键点。我知道< / strong>它可以完成，我只是不明白我对这个技巧的错误。）

mergeEnv'函数只是简单地在环境之间建立联合（它优先于正确的参数，而不是M.union），但保留左参数的变量。它的定义是：

-- variables, functions, labels [for goto]
type Environ = (M.Map String Type, M.Map String Type, S.Set String)

mergeEnv' :: Environ -> Environ -> Environ
mergeEnv' env1 env2 = (fst' env1,
                       M.union (snd' env2) (snd' env1),
                       S.union (thr' env2) (thr' env1))

（mergeEnv（最后没有）只做所有三个工会。）

Prog类型是语句的类型（例如If，For，Group等。） State类型为Ok或Err，表示检查成功和失败。

我想要实现的是对函数定义（和标签）进行块可见性并转发变量的可见性，而不进行两次不同的运行。

如果我改变：

(mergeEnv' env finalEnv)

要：

env

一切都运行得很好，但只有一切都可以看到。

我知道我可以通过与我正在尝试的方式非常相似的方式实现我想要的东西（我从我的语言和编译器教授那里得到了这个想法），但似乎我在合并环境方面做错了。

我做错了什么吗？或者这应该工作，问题可能隐藏在类型检查器的其他地方？

---

这是一个演示问题的最小工作示例。然而，它仍然是大约180行：

module Main where


import qualified Data.Map as M


data Prog = Group [Prog]
          | Fdecl Type String [(Type, String)] Prog
          | Simple Simple
    deriving (Eq, Show)

data Simple = Rexp Rexp
            | Vdecl Type String Rexp
            | Return Rexp
    deriving (Eq, Show)


data Rexp = Call String [Rexp]
          | Lexp Lexp
          | Const Const
    deriving(Eq, Show)


data Lexp = Ident String
    deriving (Eq, Show)

data Const = Integer Integer
    deriving (Eq, Show)


data Type = Func Type [Type]
          | Int
          | Error
    deriving (Eq, Show)




compatible :: Type -> Type -> Bool
compatible _ Error = True
compatible x y | x == y = True
compatible (Func ty types) (Func ty' types') = compatible ty ty' && and (zipWith compatible types types')
compatible _ _ = False




type Environ = (M.Map String Type, M.Map String Type)

empty :: Environ
empty = (M.empty, M.empty)


hasVar :: Environ -> String -> Bool
hasVar env var = M.member var $ fst env

getVarType :: Environ -> String -> Type
getVarType env var = fst env M.! var

putVar :: Environ -> String -> Type -> Environ
putVar env var ty = (M.insert var ty $ fst env, snd env)

hasFunc :: Environ -> String -> Bool
hasFunc env func = M.member func $ snd env

getFuncType :: Environ -> String -> Type
getFuncType env func = snd env M.! func

putFunc :: Environ -> String -> Type -> Environ
putFunc env func ty = (fst env, M.insert func ty $ snd env)

vars :: Environ -> M.Map String Type
vars = fst

funcs :: Environ -> M.Map String Type
funcs = snd


mergeEnv :: Environ -> Environ -> Environ
mergeEnv env1 env2 = (M.union (fst env2) (fst env1),
                      M.union (snd env2) (snd env1))


mergeEnv' :: Environ -> Environ -> Environ
mergeEnv' env1 env2 = (fst env1,
                       M.union (snd env2) (snd env1))



data State = Ok | Err
    deriving (Eq, Show)





checkProg :: Environ -> Prog -> (State, Environ, [String])
checkProg env prog = case prog of
                          Group progs -> checkGroup env progs
                          Fdecl retType name params body -> checkFdecl env retType name params body
                          Simple simple -> checkSimple env simple

checkSimple :: Environ -> Simple -> (State, Environ, [String])
checkSimple env simple = case simple of
                              Rexp expr -> checkExpr expr
                              Vdecl typ name expr -> checkVdecl env typ name expr
                              Return expr -> (Ok, empty, [])
    where checkExpr expr = let (t, msg) = checkRExpr env expr
                           in if t == Error
                                 then (Err, empty, msg)
                                 else (Ok, empty, msg)

checkGroup :: Environ -> [Prog] -> (State, Environ, [String])
checkGroup env progs = (finalState, finalEnv, messages)
    where (finalState, finalEnv, messages) = foldl checkSingleProg (Ok, empty, []) progs
          checkSingleProg (s, e, msg) prog = (resState, mergeEnv e e', message)
              where (s', e', msg') = checkProg (mergeEnv' env finalEnv) prog
                    message = msg ++ msg'
                    resState = if s == Err || s' == Err then Err else Ok

checkFdecl :: Environ -> Type -> String -> [(Type, String)] -> Prog -> (State, Environ, [String])
checkFdecl env rTy name params body = (s, putFunc empty name funType, msg)
    where funType = Func rTy [t | (t,_) <- params]
          paramEnv = (M.fromList [(x, ty) | (ty, x) <- params], M.empty)
          baseEnv = mergeEnv paramEnv (putFunc env name funType)
          (s, e', msg) = checkProg baseEnv body

checkVdecl :: Environ -> Type -> String -> Rexp -> (State, Environ, [String])
checkVdecl env ty name expr = if t == Error
                                 then (Err, empty, msg)
                                 else if compatible t ty
                                         then (Ok, putVar empty name ty, msg)
                                         else (Err, empty, msg ++ errMsg)
    where (t, msg) = checkRExpr env expr
          errMsg = ["Incompatible assignment of type: " ++ show t ++ " to a variable of type: " ++ show ty]


checkRExpr env expr = case expr of
                           Const _-> (Int, [])
                           Lexp lexp -> checkLExpr env lexp
                           Call name params -> checkCall env name params

checkLExpr env lexp = if env `hasVar` name
                         then (getVarType env name, [])
                         else (Error, ["Undefined identifier: " ++ name])
    where (Ident name) = lexp

checkCall env name params = if not $ env `hasFunc` name
                               then (Error, ["Undefined function: " ++ name])
                               else let (Func retTy paramsTy) = getFuncType env name
                                    in if length params /= length paramsTy
                                          then (Error, ["wrong number of arguments."])
                                          else if and $ zipWith checkParam paramsTy params
                                                  then (retTy, [])
                                                  else (Error, ["Wrong type for argument."])
    where checkParam typ param = let (t, _) = checkRExpr env param
                                 in compatible t typ



{-
def f() -> int:
    return g()

def g() -> int:
    return 1

f()
-}

testProg = Group [Fdecl Int "f" [] $ Group [Simple $ Return $ Call "g" []],
                  Fdecl Int "g" [] $ Group [Simple $ Return $ Const $ Integer 1],
                  Simple $ Rexp $ Call "f" []]


main = do
    let (s,e,msg) = checkProg empty testProg
    if s == Ok
       then putStrLn "Correct!"
       else putStrLn "Error!"
    putStrLn $ concatMap (++ "\n") msg

Answer 1

您根据finalEnv定义foldl，并且foldl通过checkProg定义finalEnv，{{1}}所以它似乎你的算法错了。