diff --git a/examples/features/Param.gf b/examples/features/Param.gf new file mode 100644 index 000000000..0b5ed2453 --- /dev/null +++ b/examples/features/Param.gf @@ -0,0 +1,10 @@ +resource Param = { + + param Bool = True | False ; + + oper and : Bool -> Bool -> Bool = \x,y -> case x of { + True => y ; + _ => False + } ; + +} diff --git a/src/GF/Devel/Compile/CheckGrammar.hs b/src/GF/Devel/Compile/CheckGrammar.hs index 831d0b9b2..1baab392f 100644 --- a/src/GF/Devel/Compile/CheckGrammar.hs +++ b/src/GF/Devel/Compile/CheckGrammar.hs @@ -516,6 +516,8 @@ inferLType gr trm = case trm of Empty -> return (trm, typeStr) + EParam _ cos -> return (trm, typePType) ---- check cos + C s1 s2 -> check2 (flip justCheck typeStr) C s1 s2 typeStr diff --git a/src/GF/Devel/Grammar/Construct.hs b/src/GF/Devel/Grammar/Construct.hs index bd480cbe1..eb4ce857d 100644 --- a/src/GF/Devel/Grammar/Construct.hs +++ b/src/GF/Devel/Grammar/Construct.hs @@ -114,7 +114,7 @@ resOverload tts = resOperDef (Overload tts) -- param p = ci gi is encoded as p : ((ci : gi) -> p) -> Type -- we use EData instead of p to make circularity check easier resParam :: Ident -> [(Ident,Context)] -> Judgement -resParam p cos = addJDef (EParam cos) (emptyJudgement JParam) +resParam p cos = addJDef (EParam (Con p) cos) (addJType typePType (emptyJudgement JParam)) -- to enable constructor type lookup: -- create an oper for each constructor p = c g, as c : g -> p = EData diff --git a/src/GF/Devel/Grammar/GFtoSource.hs b/src/GF/Devel/Grammar/GFtoSource.hs index 318974f5d..292f5b826 100644 --- a/src/GF/Devel/Grammar/GFtoSource.hs +++ b/src/GF/Devel/Grammar/GFtoSource.hs @@ -71,7 +71,7 @@ trAnyDef (i,ju) = let ---- JFun ty EData -> [P.DefFunData [P.FunDef [i'] (trt ty)]] JParam -> [P.DefPar [ P.ParDefDir i0 [ - P.ParConstr (tri c) (map trDecl co) | let EParam cos = jdef ju, (c,co) <- cos] + P.ParConstr (tri c) (map trDecl co) | let EParam _ cos = jdef ju, (c,co) <- cos] ]] JOper -> case jdef ju of Overload tysts -> @@ -160,6 +160,8 @@ trt trm = case trm of Alts (t, tt) -> P.EPre (trt t) [P.Alt (trt v) (trt c) | (v,c) <- tt] FV ts -> P.EVariants $ map trt ts EData -> P.EData + EParam t _ -> trt t + _ -> error $ "not yet" +++ show trm ---- trp :: Patt -> P.Patt diff --git a/src/GF/Devel/Grammar/Grammar.hs b/src/GF/Devel/Grammar/Grammar.hs index 600f74095..374d9b2f2 100644 --- a/src/GF/Devel/Grammar/Grammar.hs +++ b/src/GF/Devel/Grammar/Grammar.hs @@ -109,7 +109,7 @@ data Term = | EPatt Patt | EPattType Term - | EParam [(Ident,Context)] -- to encode parameter constructor sets + | EParam Term [(Ident,Context)] -- to encode parameter constructor sets | FV [Term] -- ^ free variation: @variants { s ; ... }@ diff --git a/src/GF/Devel/Grammar/Lookup.hs b/src/GF/Devel/Grammar/Lookup.hs index 0d2b343cb..0a8452dcb 100644 --- a/src/GF/Devel/Grammar/Lookup.hs +++ b/src/GF/Devel/Grammar/Lookup.hs @@ -61,20 +61,16 @@ lookupOverload gr m c = do lookupParams :: GF -> Ident -> Ident -> Err [(Ident,Context)] lookupParams gf m c = do - ty <- lookupJField jtype gf m c - return [(k,contextOfType t) | (k,t) <- contextOfType ty] + EParam _ ty <- lookupJField jdef gf m c + return ty lookupParamConstructor :: GF -> Ident -> Ident -> Err Type lookupParamConstructor = lookupJField jtype lookupParamValues :: GF -> Ident -> Ident -> Err [Term] lookupParamValues gf m c = do - d <- lookupJField jdef gf m c - case d of - ---- V _ ts -> return ts - _ -> do - ps <- lookupParams gf m c - liftM concat $ mapM mkPar ps + ps <- lookupParams gf m c + liftM concat $ mapM mkPar ps where mkPar (f,co) = do vs <- liftM combinations $ mapM (\ (_,ty) -> allParamValues gf ty) co diff --git a/src/GF/Devel/Grammar/Macros.hs b/src/GF/Devel/Grammar/Macros.hs index f08c28a0b..1a7a3582c 100644 --- a/src/GF/Devel/Grammar/Macros.hs +++ b/src/GF/Devel/Grammar/Macros.hs @@ -259,9 +259,10 @@ composOp co trm = case trm of Eqs cc -> do cc' <- mapPairListM (co . snd) cc return (Eqs cc') - EParam cos -> - do cos' <- mapPairListM (mapPairListM (co . snd) . snd) cos - return (EParam cos') + EParam ty cos -> + do ty' <- co ty + cos' <- mapPairListM (mapPairListM (co . snd) . snd) cos + return (EParam ty' cos') V ty vs -> do ty' <- co ty vs' <- mapM co vs