diff options
| -rw-r--r-- | src/compiler/GF/Compile/Compute/AppPredefined.hs | 3 | ||||
| -rw-r--r-- | src/compiler/GF/Grammar/Predef.hs | 4 |
2 files changed, 7 insertions, 0 deletions
diff --git a/src/compiler/GF/Compile/Compute/AppPredefined.hs b/src/compiler/GF/Compile/Compute/AppPredefined.hs index 514b471c4..be1008a47 100644 --- a/src/compiler/GF/Compile/Compute/AppPredefined.hs +++ b/src/compiler/GF/Compile/Compute/AppPredefined.hs @@ -77,6 +77,8 @@ primitives = Map.fromList [(Explicit,varP,typePType),(Explicit,identW,typeStr)] (Vr varP) []))) Nothing) , (cShow , ResOper (Just (noLoc (mkProd -- (P : PType) -> P -> Tok [(Explicit,varP,typePType),(Explicit,identW,Vr varP)] typeStr []))) Nothing) + , (cEqVal , ResOper (Just (noLoc (mkProd -- (P : PType) -> P -> P -> PBool + [(Explicit,varP,typePType),(Explicit,identW,Vr varP),(Explicit,identW,Vr varP)] typePBool []))) Nothing) , (cToStr , ResOper (Just (noLoc (mkProd -- (L : Type) -> L -> Str [(Explicit,varL,typeType),(Explicit,identW,Vr varL)] typeStr []))) Nothing) , (cMapStr , ResOper (Just (noLoc (mkProd -- (L : Type) -> (Str -> Str) -> L -> L @@ -135,6 +137,7 @@ appPredefined t = case t of (z,_) <- appPredefined z0 case (z, y, x) of (ty,op,t) | f == cMapStr -> retf $ mapStr ty op t + _ | f == cEqVal -> retb $ if y==x then predefTrue else predefFalse _ -> retb t ---- prtBad "cannot compute predefined" t _ -> retb t ---- prtBad "cannot compute predefined" t diff --git a/src/compiler/GF/Grammar/Predef.hs b/src/compiler/GF/Grammar/Predef.hs index b77aea40e..44cc060ec 100644 --- a/src/compiler/GF/Grammar/Predef.hs +++ b/src/compiler/GF/Grammar/Predef.hs @@ -33,6 +33,7 @@ module GF.Grammar.Predef , cOccurs, cEqInt, cLessInt, cPlus, cShow, cRead , cToStr, cMapStr, cError , cToUpper, cToLower, cIsUpper + , cEqVal -- hacks , cMeta, cAs, cChar, cChars, cSeq, cAlt, cRep @@ -129,6 +130,9 @@ cIsUpper = identC (BS.pack "isUpper") cEqStr :: Ident cEqStr = identC (BS.pack "eqStr") +cEqVal :: Ident +cEqVal = identC (BS.pack "eqVal") + cOccur :: Ident cOccur = identC (BS.pack "occur") |