haskell - Getting a <<loop>> when implementing block-visibility in a type-checker -

i'm writing simple type-checker simple imperative language, , i'm stuck kind of output:

testchecker: <<loop>> 

i have alread read this question, know must doing wrong circular reference. i'm pretty sure problem in following function, responsible checking block of statements:

checkgroup :: environ -> [prog] -> (state, environ, [string]) checkgroup env progs = (finalstate, finalenv, messages)     (finalstate, finalenv, messages) = foldl checksingleprog (ok, empty, []) progs           checksingleprog (s, e, msg) prog = (ress, mergeenv e e', mess)               (s', e', msg') = checkprog (mergeenv' env finalenv) prog                     mess = msg ++ msg'                     ress = if s == err || s' == err err else ok 

note the:

checkprog (mergeenv' env finalenv) prog 

where checkprog uses environment merging of environment of father of group plus environment generated whole group.

(edit: yes know finalenv part of output of call checkprog. that's point of question. know can done, don't understand i'm doing wrong trick.)

the mergeenv' function union between environments (it preferes right argument, opposed m.union), keeping left-argument's variables. it's definition is:

-- 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)) 

(the mergeenv (no apos @ end) 3 unions.)

the prog type type of statements (e.g. if, for, group etc.) state type either ok or err, signal successful , unsuccessful checking.

what i'm trying achieve have block-visibility function definitions (and labels) , forward visibility variables, without doing 2 different runs.

if change:

(mergeenv' env finalenv) 

to:

env 

everything runs "fine", visibility forward everything.

i know it's possible achieve want in way similar i'm trying (i got idea professor of languages , compilers), seems i'm doing wrong merging of environments.

am doing wrong? or should work , problem hidden somewhere else in type-checker?

---

here's minimal working example demonstrates problem. it's still 180 lines:

module main   import qualified data.map 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' && , (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, [])     checkexpr expr = let (t, msg) = checkrexpr env expr                            in if t == error                                  (err, empty, msg)                                  else (ok, empty, msg)  checkgroup :: environ -> [prog] -> (state, environ, [string]) checkgroup env progs = (finalstate, finalenv, messages)     (finalstate, finalenv, messages) = foldl checksingleprog (ok, empty, []) progs           checksingleprog (s, e, msg) prog = (resstate, mergeenv e e', message)               (s', e', msg') = checkprog (mergeenv' env finalenv) prog                     message = msg ++ msg'                     resstate = if s == err || s' == err 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)     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                                  (err, empty, msg)                                  else if compatible t ty                                          (ok, putvar empty name ty, msg)                                          else (err, empty, msg ++ errmsg)     (t, msg) = checkrexpr env expr           errmsg = ["incompatible assignment of type: " ++ show t ++ " 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                          (getvartype env name, [])                          else (error, ["undefined identifier: " ++ name])     (ident name) = lexp  checkcall env name params = if not $ env `hasfunc` name                                (error, ["undefined function: " ++ name])                                else let (func retty paramsty) = getfunctype env name                                     in if length params /= length paramsty                                           (error, ["wrong number of arguments."])                                           else if , $ zipwith checkparam paramsty params                                                   (retty, [])                                                   else (error, ["wrong type argument."])     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 =     let (s,e,msg) = checkprog empty testprog     if s == ok        putstrln "correct!"        else putstrln "error!"     putstrln $ concatmap (++ "\n") msg 

you're defining finalenv in terms of foldl , you're defining foldl, via checkprog, in terms of finalenv seems algorithm wrong.