added the filter construction

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

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

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"