GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -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'])
ResParam (Just (L loc pcs)) _ -> do
(sm,cnt,ts) <- chIn loc "parameter type" $
mkParamValues sm 0 [] pcs
(sm,cnt,ts,pcs) <- chIn loc "parameter type" $
mkParamValues sm c 0 [] pcs
update sm c (ResParam (Just (L loc pcs)) (Just (ts,cnt)))
_ -> return sm
@@ -251,14 +251,15 @@ checkInfo opts cwd sgr sm (c,info) = checkInModule cwd (snd sm) NoLoc empty $ do
gr = prependModule sgr sm
chIn loc cat = checkInModule cwd (snd sm) loc ("Happened in" <+> cat <+> c)
mkParamValues sm cnt ts [] = return (sm,cnt,[])
mkParamValues sm@(mn,mi) cnt ts ((f,co):fs) = do
sm <- case lookupIdent f (jments mi) of
Ok (ResValue ty _) -> update sm f (ResValue ty cnt)
Bad msg -> checkError (pp msg)
mkParamValues sm c cnt ts [] = return (sm,cnt,[],[])
mkParamValues sm@(mn,mi) c cnt ts ((p,co):pcs) = do
co <- mapM (\(b,v,ty) -> normalForm gr ty >>= \ty -> return (b,v,ty)) co
sm <- case lookupIdent p (jments mi) of
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
(sm,cnt,ts) <- mkParamValues sm (cnt+length vs) ts fs
return (sm,cnt,map (mkApp (QC (mn,f))) vs ++ ts)
(sm,cnt,ts,pcs) <- mkParamValues sm c (cnt+length vs) ts pcs
return (sm,cnt,map (mkApp (QC (mn,p))) vs ++ ts,(p,co):pcs)
checkUniq xss = case xss of
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 GF.Text.Pretty
import PGF2.Transactions(LIndex)
import Debug.Trace
-- * Main entry points