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

make sure that types in ResValue are precomputed

Browse Source
This commit is contained in:
krangelov
2021-12-21 09:16:53 +01:00
parent f2b6f36e02
commit 0a8b6d2586
2 changed files with 10 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
src/compiler/GF/Compile/CheckGrammar.hs
View File

@@ -242,8 +242,8 @@ checkInfo opts cwd sgr sm (c,info) = checkInModule cwd (snd sm) NoLoc empty $ do
update sm c (ResOverload os [(y,x) | (x,y) <- tysts']) update sm c (ResOverload os [(y,x) | (x,y) <- tysts'])
ResParam (Just (L loc pcs)) _ -> do ResParam (Just (L loc pcs)) _ -> do
(sm,cnt,ts) <- chIn loc "parameter type" $ (sm,cnt,ts,pcs) <- chIn loc "parameter type" $
mkParamValues sm 0 [] pcs mkParamValues sm c 0 [] pcs
update sm c (ResParam (Just (L loc pcs)) (Just (ts,cnt))) update sm c (ResParam (Just (L loc pcs)) (Just (ts,cnt)))
_ -> return sm _ -> return sm
@@ -251,14 +251,15 @@ checkInfo opts cwd sgr sm (c,info) = checkInModule cwd (snd sm) NoLoc empty $ do
gr = prependModule sgr sm gr = prependModule sgr sm
chIn loc cat = checkInModule cwd (snd sm) loc ("Happened in" <+> cat <+> c) chIn loc cat = checkInModule cwd (snd sm) loc ("Happened in" <+> cat <+> c)
mkParamValues sm cnt ts [] = return (sm,cnt,[]) mkParamValues sm c cnt ts [] = return (sm,cnt,[],[])
mkParamValues sm@(mn,mi) cnt ts ((f,co):fs) = do mkParamValues sm@(mn,mi) c cnt ts ((p,co):pcs) = do
sm <- case lookupIdent f (jments mi) of co <- mapM (\(b,v,ty) -> normalForm gr ty >>= \ty -> return (b,v,ty)) co
Ok (ResValue ty _) -> update sm f (ResValue ty cnt) sm <- case lookupIdent p (jments mi) of
Bad msg -> checkError (pp msg) Ok (ResValue (L loc _) _) -> update sm p (ResValue (L loc (mkProdSimple co (QC (mn,c)))) cnt)
Bad msg -> checkError (pp msg)
vs <- liftM sequence $ mapM (\(_,_,ty) -> allParamValues gr ty) co vs <- liftM sequence $ mapM (\(_,_,ty) -> allParamValues gr ty) co
(sm,cnt,ts) <- mkParamValues sm (cnt+length vs) ts fs (sm,cnt,ts,pcs) <- mkParamValues sm c (cnt+length vs) ts pcs
return (sm,cnt,map (mkApp (QC (mn,f))) vs ++ ts) return (sm,cnt,map (mkApp (QC (mn,p))) vs ++ ts,(p,co):pcs)
checkUniq xss = case xss of checkUniq xss = case xss of
x:y:xs x:y:xs

1
src/compiler/GF/Compile/Compute/Concrete.hs
View File

@@ -34,7 +34,6 @@ import qualified Control.Monad.Fail as Fail
import qualified Data.Map as Map import qualified Data.Map as Map
import GF.Text.Pretty import GF.Text.Pretty
import PGF2.Transactions(LIndex) import PGF2.Transactions(LIndex)
import Debug.Trace
-- * Main entry points -- * Main entry points