diff --git a/src/compiler/api/GF/Compile/Compute/Concrete2.hs b/src/compiler/api/GF/Compile/Compute/Concrete2.hs index 3cfb3f772..c7c7daf42 100644 --- a/src/compiler/api/GF/Compile/Compute/Concrete2.hs +++ b/src/compiler/api/GF/Compile/Compute/Concrete2.hs @@ -973,6 +973,16 @@ value2termM flat xs (VReset ctl mb_cv v mb_qid) = do _ -> evalError (pp "The term must be a record") select n (t:ts) = select (n-1) ts _ -> evalError (pp "[select: .. | ..] requires an integer constant") + | ctl == cFilter = + let filter [] = mzero + filter (t:ts) = + case t of + R rs -> case (lookup (ident2label cp1) rs, lookup (ident2label cp2) rs) of + (Just (_,t), Just (_,Q q)) + | q == (cPredef,cTrue) -> pure t `mplus` filter ts + _ -> filter ts + _ -> evalError (pp "The term must be a record") + in filter ts | ctl == cDefault = case (ts,mb_cv) of ([] ,Nothing) -> mzero diff --git a/src/compiler/api/GF/Compile/TypeCheck/Concrete.hs b/src/compiler/api/GF/Compile/TypeCheck/Concrete.hs index d85972e95..0c609e2bb 100644 --- a/src/compiler/api/GF/Compile/TypeCheck/Concrete.hs +++ b/src/compiler/api/GF/Compile/TypeCheck/Concrete.hs @@ -487,6 +487,19 @@ tcRho scope c (Reset ctl mb_ct t qid) mb_ty Nothing -> evalError (pp "[select: .. | ..] requires an integer argument") (t,_) <- tcRho scope c1 t (Just rec_ty) return (Reset ctl mb_ct t qid,ty) + | ctl == cFilter = do + ty <- case mb_ty of + Just ty -> return ty + Nothing -> do i <- newResiduation scope + return (VMeta i []) + let rec_ty = VRecType [ (ident2label cp1, True, ty) + , (ident2label cp2, True, VApp poison (cPredef,cBool) []) + ] False + case mb_ct of + Just ct -> evalError (pp "[filter | ..] cannot take an argument") + Nothing -> return () + (t,_) <- tcRho scope c t (Just rec_ty) + return (Reset ctl mb_ct t qid,ty) | ctl == cDefault = do let (c1,c2) = split c (t,ty) <- tcRho scope c1 t mb_ty diff --git a/src/compiler/api/GF/Grammar/Predef.hs b/src/compiler/api/GF/Grammar/Predef.hs index f807d762a..c284d9033 100644 --- a/src/compiler/api/GF/Grammar/Predef.hs +++ b/src/compiler/api/GF/Grammar/Predef.hs @@ -25,6 +25,7 @@ cFloat = identS "Float" cString = identS "String" cInts = identS "Ints" cPBool = identS "PBool" +cBool = identS "Bool" cErrorType = identS "Error" cOverload = identS "overload" cNonExist = identS "nonExist" @@ -40,6 +41,8 @@ isPredefCat c = elem c [cInt,cString,cFloat] cPTrue = identS "PTrue" cPFalse = identS "PFalse" +cTrue = identS "True" +cFalse = identS "False" cLength = identS "length" cDrop = identS "drop" cTake = identS "take" @@ -66,6 +69,7 @@ cConcat = identS "concat" cConcat' = identS "concat'" cOne = identS "one" cSelect = identS "select" +cFilter = identS "filter" cDefault = identS "default" cList = identS "list" cLen = identS "len"