GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 03:32:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

fix for EPatt

Browse Source
This commit is contained in:
krasimir
2017-03-06 17:15:46 +00:00
parent 0d08ec8756
commit 821bd7bf6e
1 changed files with 9 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
View File

@@ -238,13 +238,16 @@ tcRho ge scope (Strs ss) mb_ty = do
tcRho ge scope (EPattType ty) mb_ty = do tcRho ge scope (EPattType ty) mb_ty = do
(ty, _) <- tcRho ge scope ty (Just vtypeType) (ty, _) <- tcRho ge scope ty (Just vtypeType)
instSigma ge scope (EPattType ty) vtypeType mb_ty instSigma ge scope (EPattType ty) vtypeType mb_ty
tcRho ge scope (EPatt p) mb_ty = do tcRho ge scope t@(EPatt p) mb_ty = do
ty <- case mb_ty of (scope,f,ty) <- case mb_ty of
Nothing -> do i <- newMeta scope vtypeType Nothing -> do i <- newMeta scope vtypeType
return (VMeta i (scopeEnv scope) []) return (scope,id,VMeta i (scopeEnv scope) [])
Just ty -> unifyPatt ge scope ty Just ty -> do (scope,f,ty) <- skolemise ge scope ty
case ty of
VPattType ty -> return (scope,f,ty)
_ -> tcError (ppTerm Unqualified 0 t <+> "must be of pattern type but" <+> ppTerm Unqualified 0 t <+> "is expected")
tcPatt ge scope p ty tcPatt ge scope p ty
return (EPatt p, ty) return (f (EPatt p), ty)
tcRho gr scope t _ = unimplemented ("tcRho "++show t) tcRho gr scope t _ = unimplemented ("tcRho "++show t)
tcCases ge scope [] p_ty mb_res_ty = return ([],mb_res_ty) tcCases ge scope [] p_ty mb_res_ty = return ([],mb_res_ty)
@@ -521,14 +524,6 @@ unifyTbl ge scope tau = do
unify ge scope tau (VTblType arg res) unify ge scope tau (VTblType arg res)
return (arg,res) return (arg,res)
unifyPatt ge scope (VPattType ty) =
return ty
unifyPatt ge scope ty = do
i <- newMeta scope vtypeType
let ty = VMeta i (scopeEnv scope) []
unify ge scope ty (VPattType ty)
return ty
unify ge scope (VApp f1 vs1) (VApp f2 vs2) unify ge scope (VApp f1 vs1) (VApp f2 vs2)
| f1 == f2 = sequence_ (zipWith (unify ge scope) vs1 vs2) | f1 == f2 = sequence_ (zipWith (unify ge scope) vs1 vs2)
unify ge scope (VCApp f1 vs1) (VCApp f2 vs2) unify ge scope (VCApp f1 vs1) (VCApp f2 vs2)