msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

in splitContraints the values first have to be reduced

Browse Source
This commit is contained in:
krasimir
2009-06-19 14:37:58 +00:00
parent bc4d9df645
commit 3db76063a4
1 changed files with 8 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
src/PGF/TypeCheck.hs
View File

@@ -33,7 +33,7 @@ typecheck pgf e = case inferExpr pgf (newMetas e) of
inferExpr :: PGF -> Expr -> Err Expr inferExpr :: PGF -> Expr -> Err Expr
inferExpr pgf e = case infer pgf emptyTCEnv e of inferExpr pgf e = case infer pgf emptyTCEnv e of
Ok (e,_,cs) -> let (ms,cs2) = splitConstraints cs in case cs2 of Ok (e,_,cs) -> let (ms,cs2) = splitConstraints pgf cs in case cs2 of
[] -> Ok (metaSubst ms e) [] -> Ok (metaSubst ms e)
_ -> Bad ("Error in tree " ++ showExpr e ++ " :\n " ++ prConstraints cs2) _ -> Bad ("Error in tree " ++ showExpr e ++ " :\n " ++ prConstraints cs2)
Bad s -> Bad s Bad s -> Bad s
@@ -117,12 +117,17 @@ prConstraints cs = unwords
-- work more on this: unification, compute,... -- work more on this: unification, compute,...
splitConstraints :: [(Value,Value)] -> ([(Int,Expr)],[(Value,Value)]) splitConstraints :: PGF -> [(Value,Value)] -> ([(Int,Expr)],[(Value,Value)])
splitConstraints = mkSplit . partition isSubst . regroup . map reorder where splitConstraints pgf = mkSplit . partition isSubst . regroup . map reorder . map reduce where
reorder (v,w) = case w of reorder (v,w) = case w of
VMeta _ _ -> (w,v) VMeta _ _ -> (w,v)
_ -> (v,w) _ -> (v,w)
reduce (v,w) = (whnf v,whnf w)
whnf (VClosure env e) = eval (getFunEnv (abstract pgf)) env e -- should be removed when the typechecker is improved
whnf v = v
regroup = groupBy (\x y -> fst x == fst y) . sort regroup = groupBy (\x y -> fst x == fst y) . sort
isSubst cs@((v,u):_) = case v of isSubst cs@((v,u):_) = case v of