nonExist now does the expected thing

lib/src/prelude/Predef.gf

@@ -36,6 +36,6 @@ resource Predef = {
   oper toStr  : (L : Type) -> L -> Str = variants {} ; -- find the "first" string
   oper mapStr : (L : Type) -> (Str -> Str) -> L -> L = variants {} ; 
                -- map all strings in a data structure; experimental ---
+  oper nonExist : Str = variants {} ;  -- a placeholder for non-existant morphological forms
 
 } ;
-

lib/src/prelude/Prelude.gf

@@ -35,7 +35,7 @@ oper
 
 -- Missing form.
 
-  nonExist : Str = variants {} ;
+  nonExist : Str = Predef.nonExist;
 
 -- Optional string with preference on the string vs. empty.
  

src/compiler/GF/Compile/Compute/AppPredefined.hs

@@ -83,6 +83,8 @@ primitives = Map.fromList
                                          [(Explicit,varL,typeType),(Explicit,identW,Vr varL)] typeStr []))) Nothing)
   , (cMapStr   , ResOper (Just (noLoc (mkProd -- (L : Type)  -> (Str -> Str) -> L -> L
                                          [(Explicit,varL,typeType),(Explicit,identW,mkFunType [typeStr] typeStr),(Explicit,identW,Vr varL)] (Vr varL) []))) Nothing)
+  , (cNonExist , ResOper (Just (noLoc (mkProd -- Str
+                                         [] typeStr []))) Nothing)
   ]
   where
     fun from to = oper (mkFunType from to)

src/compiler/GF/Compile/Compute/ConcreteNew.hs

@@ -10,7 +10,7 @@ import GF.Grammar.Lookup(lookupResDefLoc,allParamValues)
 import GF.Grammar.Predef(cPredef,cErrorType,cTok,cStr)
 import GF.Grammar.PatternMatch(matchPattern,measurePatt)
 import GF.Grammar.Lockfield(unlockRecord,lockLabel,isLockLabel,lockRecType)
-import GF.Compile.Compute.Value hiding (Predefined(..))
+import GF.Compile.Compute.Value hiding (Error)
 import GF.Compile.Compute.Predef(predef,predefName,delta)
 import GF.Data.Str(Str,glueStr,str2strings,str,sstr,plusStr,strTok)
 import GF.Data.Operations(Err,err,errIn,maybeErr,combinations,mapPairsM)
@@ -169,6 +169,8 @@ vconcat vv@(v1,v2) =
     case vv of
       (VString "",_) -> v2
       (_,VString "") -> v1
+      (VApp NonExist _,_) -> v1
+      (_,VApp NonExist _) -> v2
       _ -> VC v1 v2
 
 proj l v | isLockLabel l = return (VRec [])
@@ -243,6 +245,8 @@ glue env (v1,v2) = glu v1 v2
           (v1,VC va vb) -> VC (glu v1 va) vb
           (VS (VV ty pvs vs) vb,v2) -> VS (VV ty pvs [glu v v2|v<-vs]) vb
           (v1,VS (VV ty pvs vs) vb) -> VS (VV ty pvs [glu v1 v|v<-vs]) vb
+          (v1@(VApp NonExist _),_) -> v1
+          (_,v2@(VApp NonExist _)) -> v2
 --        (v1,v2) -> ok2 VGlue v1 v2
           (v1,v2) -> error . render $
                      ppL loc (hang (text "unsupported token gluing:") 4

src/compiler/GF/Compile/Compute/Predef.hs

@@ -39,6 +39,13 @@ instance Predef String where
 instance Predef Value where
   toValue = id
   fromValue = return
+
+instance Predef Predefined where
+  toValue p = VApp p []
+  fromValue v = case v of
+                  VApp p _ -> return p
+                  _        -> fail $ "Expected a predefined constant, got something else"
+
 {-
 instance (Predef a,Predef b) => Predef (a->b) where
   toValue f = VAbs Explicit (varX 0) $ Bind $ err bug (toValue . f) . fromValue
@@ -70,22 +77,23 @@ predefList =
      -- cShow, cRead, cMapStr, cEqVal
      (cError,Error),
      -- Canonical values:
-     (cPBool,PBool),(cPFalse,PFalse),(cPTrue,PTrue),(cInt,Int),(cInts,Ints)]
+     (cPBool,PBool),(cPFalse,PFalse),(cPTrue,PTrue),(cInt,Int),
+     (cInts,Ints),(cNonExist,NonExist)]
     --- add more functions!!!
 
 delta f vs =
     case f of
-      Drop    -> ap2 (drop::Int->String->String)
+      Drop    -> fromNonExist vs NonExist (ap2 (drop::Int->String->String))
-      Take    -> ap2 (take::Int->String->String)
+      Take    -> fromNonExist vs NonExist (ap2 (take::Int->String->String))
-      Tk      -> ap2 tk
+      Tk      -> fromNonExist vs NonExist (ap2 tk)
-      Dp      -> ap2 dp
+      Dp      -> fromNonExist vs NonExist (ap2 dp)
-      EqStr   -> ap2 ((==)::String->String->Bool)
+      EqStr   -> fromNonExist vs PFalse   (ap2 ((==)::String->String->Bool))
-      Occur   -> ap2 occur
+      Occur   -> fromNonExist vs PFalse   (ap2 occur)
-      Occurs  -> ap2 occurs
+      Occurs  -> fromNonExist vs PFalse   (ap2 occurs)
-      ToUpper -> ap1 (map toUpper)
+      ToUpper -> fromNonExist vs NonExist (ap1 (map toUpper))
-      ToLower -> ap1 (map toLower)
+      ToLower -> fromNonExist vs NonExist (ap1 (map toLower))
-      IsUpper -> ap1 (all isUpper)
+      IsUpper -> fromNonExist vs PFalse   (ap1 (all isUpper))
-      Length  -> ap1 (length::String->Int)
+      Length  -> fromNonExist vs (0::Int) (ap1 (length::String->Int))
       Plus    -> ap2 ((+)::Int->Int->Int)
       EqInt   -> ap2 ((==)::Int->Int->Bool)
       LessInt -> ap2 ((<)::Int->Int->Bool)
@@ -97,6 +105,7 @@ delta f vs =
       Ints    -> canonical
       PFalse  -> canonical
       PTrue   -> canonical
+      NonExist-> canonical
   where
     canonical = delay
     delay = return (VApp f vs) -- wrong number of arguments
@@ -109,6 +118,10 @@ delta f vs =
              [v1,v2] -> toValue `fmap` (f `fmap` fromValue v1 `ap` fromValue v2)
              _ -> delay
 
+    fromNonExist vs a b
+      | null [v | v@(VApp NonExist _) <- vs] = b
+      | otherwise                            = return (toValue a)
+
 --  unimpl id = bug $ "unimplemented predefined function: "++showIdent id
 --  problem id vs = bug $ "unexpected arguments: Predef."++showIdent id++" "++show vs
 

src/compiler/GF/Compile/Compute/Value.hs

@@ -51,5 +51,5 @@ data Predefined = Drop | Take | Tk | Dp | EqStr | Occur | Occurs | ToUpper
              {- | Show | Read | ToStr | MapStr | EqVal -}
                 | Error
                 -- Canonical values below:
-                | PBool | PFalse | PTrue | Int | Ints
+                | PBool | PFalse | PTrue | Int | Ints | NonExist
                 deriving (Show,Eq,Ord,Ix,Bounded,Enum)

src/compiler/GF/Compile/GeneratePMCFG.hs

@@ -391,6 +391,10 @@ convertTerm opts sel ctype (Alts s alts)
                                    4
                                    (ppPatt Unqualified 0 p)
 
+convertTerm opts sel ctype (Q (m,f))
+  | m == cPredef &&
+    f == cNonExist                      = return (CStr [SymNE])
+
 convertTerm opts sel@(CProj l _) ctype (ExtR t1 t2@(R rs2))
                     | l `elem` map fst rs2 = convertTerm opts sel ctype t2
                     | otherwise            = convertTerm opts sel ctype t1

src/compiler/GF/Grammar/Predef.hs

@@ -21,6 +21,7 @@ module GF.Grammar.Predef
           , cString
           , cVar
           , cInts
+          , cNonExist
           , cPBool
           , cErrorType
           , cOverload
@@ -94,6 +95,9 @@ cOverload = identC (BS.pack "overload")
 cUndefinedType :: Ident
 cUndefinedType = identC (BS.pack "UndefinedType")
 
+cNonExist :: Ident
+cNonExist = identC (BS.pack "nonExist")
+
 isPredefCat :: Ident -> Bool
 isPredefCat c = elem c [cInt,cString,cFloat]
 

src/runtime/c/pgf/data.h

@@ -180,7 +180,8 @@ typedef enum {
 	PGF_SYMBOL_LIT,
 	PGF_SYMBOL_VAR,
 	PGF_SYMBOL_KS,
-	PGF_SYMBOL_KP
+	PGF_SYMBOL_KP,
+	PGF_SYMBOL_NE
 } PgfSymbolTag;
 
 typedef struct {
@@ -208,6 +209,8 @@ typedef struct PgfSymbolKP
 	 * symbol. */
 } PgfSymbolKP;
 
+typedef struct {
+} PgfSymbolNE;
 
 typedef GuSeq PgfSequence; // -> PgfSymbol
 typedef GuList(PgfSequence) PgfSequences;

src/runtime/c/pgf/linearizer.c

@@ -532,6 +532,10 @@ pgf_lzr_linearize(PgfConcr* concr, PgfCncTree ctree, size_t lin_idx, PgfLinFuncs
 				}
 				break;
 			}
+			case PGF_SYMBOL_NE: {
+				// Nothing to be done here
+				break;
+			}
 			default:
 				gu_impossible(); 
 			}

src/runtime/c/pgf/parser.c

@@ -163,6 +163,8 @@ pgf_prev_extern_sym(PgfSymbol sym)
 		return *((PgfSymbol*) (((PgfSymbolLit*) i.data)+1));
 	case PGF_SYMBOL_VAR:
 		return *((PgfSymbol*) (((PgfSymbolVar*) i.data)+1));
+	case PGF_SYMBOL_NE:
+		return *((PgfSymbol*) (((PgfSymbolNE*) i.data)+1));
 	default:
 		gu_impossible();
 		return gu_null_variant;
@@ -1410,6 +1412,10 @@ pgf_parsing_symbol(PgfParseState* before, PgfParseState* after,
 	case PGF_SYMBOL_VAR:
 		// XXX TODO proper support
 		break;
+	case PGF_SYMBOL_NE: {
+		// Nothing to be done here
+		break;
+	}
 	default:
 		gu_impossible();
 	}
@@ -2743,6 +2749,7 @@ pgf_parser_leftcorner_item(PgfLeftcornerFn* clo, PgfItem* item)
 				break;
 			}
 			case PGF_SYMBOL_LIT:
+			case PGF_SYMBOL_NE:
 				// Nothing to be done here
 				break;
 			case PGF_SYMBOL_VAR:

src/runtime/c/pgf/printer.c

@@ -258,6 +258,10 @@ pgf_print_symbol(PgfSymbol sym, GuWriter *wtr, GuExn *err)
 		gu_printf(wtr, err, "<%d,$%d>", svar->d, svar->r);
 		break;
 	}
+	case PGF_SYMBOL_NE: {
+		gu_puts("nonExist", wtr, err);
+		break;
+	}
 	default:
 		gu_impossible();
 	}

src/runtime/c/pgf/reader.c

@@ -717,6 +717,13 @@ pgf_read_symbol(PgfReader* rdr)
 		}
 		break;
 	}
+	case PGF_SYMBOL_NE: {
+		gu_new_variant(PGF_SYMBOL_NE,
+		               PgfSymbolNE,
+		               &sym, rdr->opool);
+		gu_return_on_exn(rdr->err, gu_null_variant);
+		break;
+	}
 	default:
 		pgf_read_tag_error(rdr);
 	}

src/runtime/haskell/PGF/Binary.hs

@@ -152,6 +152,7 @@ instance Binary Symbol where
   put (SymVar n l)       = putWord8 2 >> put (n,l)
   put (SymKS ts)         = putWord8 3 >> put ts
   put (SymKP d vs)       = putWord8 4 >> put (d,vs)
+  put SymNE              = putWord8 5
   get = do tag <- getWord8
            case tag of
              0 -> liftM2 SymCat get get
@@ -159,6 +160,7 @@ instance Binary Symbol where
              2 -> liftM2 SymVar get get
              3 -> liftM  SymKS  get
              4 -> liftM2 (\d vs -> SymKP d vs) get get
+             5 -> return SymNE
              _ -> decodingError
 
 instance Binary PArg where

src/runtime/haskell/PGF/Data.hs

@@ -60,6 +60,7 @@ data Symbol
   | SymVar {-# UNPACK #-} !Int {-# UNPACK #-} !Int
   | SymKS [Token]
   | SymKP [Token] [Alternative]
+  | SymNE                           -- non exist
   deriving (Eq,Ord,Show)
 data Production
   = PApply  {-# UNPACK #-} !FunId [PArg]