Prelude.CAPIT is now a built-in primitive. It still generates &| in the Haskell runtime but will be intepreted in the C runtime

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

@@ -79,7 +79,7 @@ predefList =
      -- Canonical values:
      (cPBool,PBool),(cPFalse,PFalse),(cPTrue,PTrue),(cInt,Int),
      (cInts,Ints),(cNonExist,NonExist)
-     ,(cBIND,BIND),(cSOFT_BIND,SOFT_BIND)]
+     ,(cBIND,BIND),(cSOFT_BIND,SOFT_BIND),(cCAPIT,CAPIT)]
     --- add more functions!!!
 
 delta f vs =
@@ -109,6 +109,7 @@ delta f vs =
       NonExist-> canonical
       BIND    -> canonical
       SOFT_BIND->canonical
+      CAPIT   -> canonical
   where
     canonical = delay
     delay = return (VApp f vs) -- wrong number of arguments

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

@@ -52,5 +52,5 @@ data Predefined = Drop | Take | Tk | Dp | EqStr | Occur | Occurs | ToUpper
                 | Error
                 -- Canonical values below:
                 | PBool | PFalse | PTrue | Int | Ints | NonExist 
-                | BIND | SOFT_BIND
+                | BIND | SOFT_BIND | CAPIT
                 deriving (Show,Eq,Ord,Ix,Bounded,Enum)

src/compiler/GF/Compile/GeneratePMCFG.hs

@@ -443,6 +443,8 @@ convertTerm opts sel ctype (Q (m,f))
     f == cBIND                          = return (CStr [SymBIND])
   | m == cPredef &&
     f == cSOFT_BIND                     = return (CStr [SymSOFT_BIND])
+  | m == cPredef &&
+    f == cCAPIT                         = return (CStr [SymCAPIT])
 
 convertTerm opts sel@(CProj l _) ctype (ExtR t1 t2@(R rs2))
                     | l `elem` map fst rs2 = convertTerm opts sel ctype t2

src/compiler/GF/Compile/PGFtoJS.hs

@@ -89,6 +89,7 @@ sym2js (SymKP ts alts) = new "SymKP"  [JS.EArray (map sym2js ts), JS.EArray (map
 sym2js SymNE           = new "SymNE"  []
 sym2js SymBIND         = new "SymKS"  [JS.EStr "&+"]
 sym2js SymSOFT_BIND    = new "SymKS"  [JS.EStr "&+"]
+sym2js SymCAPIT        = new "SymKS"  [JS.EStr "&|"]
 
 alt2js (ps,ts) = new "Alt" [JS.EArray (map sym2js ps), JS.EArray (map JS.EStr ts)]
 

src/compiler/GF/Compile/PGFtoPython.hs

@@ -79,6 +79,7 @@ pySymbol (SymKP ts alts) = pyDict 0 pyStr id [("pre", pyList 0 pySymbol ts), ("a
     where alt2py (ps,ts) = pyTuple 0 (pyList 0 pyStr) [map pySymbol ps, ts]
 pySymbol SymBIND         = pyStr "&+"
 pySymbol SymSOFT_BIND    = pyStr "&+"
+pySymbol SymCAPIT        = pyStr "&|"
 pySymbol SymNE           = pyDict 0 pyStr id [("nonExist", pyTuple 0 id [])]
 
 ----------------------------------------------------------------------

src/compiler/GF/Compile/TypeCheck/Primitives.hs

@@ -53,6 +53,8 @@ primitives = Map.fromList
                                          [] typeStr []))) Nothing)
   , (cSOFT_BIND, ResOper (Just (noLoc (mkProd -- Str
                                          [] typeStr []))) Nothing)
+  , (cCAPIT    , ResOper (Just (noLoc (mkProd -- Str
+                                         [] typeStr []))) Nothing)
   ]
   where
     fun from to = oper (mkFunType from to)

src/compiler/GF/Grammar/Predef.hs

@@ -32,6 +32,7 @@ cUndefinedType = identS "UndefinedType"
 cNonExist = identS "nonExist"
 cBIND = identS "BIND"
 cSOFT_BIND = identS "SOFT_BIND"
+cCAPIT = identS "CAPIT"
 
 isPredefCat :: Ident -> Bool
 isPredefCat c = elem c [cInt,cString,cFloat]

src/compiler/GF/Speech/PGFToCFG.hs

@@ -97,6 +97,7 @@ pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ co
                                            ---- AR 3/6/2010
         symbolToCFSymbol SymBIND         = [Terminal "&+"]
         symbolToCFSymbol SymSOFT_BIND    = []
+        symbolToCFSymbol SymCAPIT        = [Terminal "&|"]
         symbolToCFSymbol SymNE           = []
 
         fixProfile :: Array DotPos Symbol -> Int -> Profile

src/runtime/c/pgf/data.h

@@ -204,6 +204,7 @@ typedef enum {
 	PGF_SYMBOL_KP,
 	PGF_SYMBOL_BIND,
 	PGF_SYMBOL_SOFT_BIND,
+	PGF_SYMBOL_CAPIT,
 	PGF_SYMBOL_NE
 } PgfSymbolTag;
 
@@ -238,6 +239,9 @@ typedef struct {
 typedef struct {
 } PgfSymbolBIND;
 
+typedef struct {
+} PgfSymbolCAPIT;
+
 typedef GuBuf PgfProductionIdx;
 
 typedef struct {

src/runtime/c/pgf/linearizer.c

@@ -904,6 +904,8 @@ pgf_lzr_linearize_symbols(PgfLzr* lzr, PgfCncTreeApp* fapp,
 			}
 			break;
 		}
+		case PGF_SYMBOL_CAPIT:
+			break;
 		default:
 			gu_impossible(); 
 		}

src/runtime/c/pgf/parser.c

@@ -137,6 +137,8 @@ pgf_prev_extern_sym(PgfSymbol sym)
 	case PGF_SYMBOL_BIND:
 	case PGF_SYMBOL_SOFT_BIND:
 		return *((PgfSymbol*) (((PgfSymbolBIND*) i.data)+1));
+	case PGF_SYMBOL_CAPIT:
+		return *((PgfSymbol*) (((PgfSymbolCAPIT*) i.data)+1));
 	case PGF_SYMBOL_NE:
 		return *((PgfSymbol*) (((PgfSymbolNE*) i.data)+1));
 	default:
@@ -1147,6 +1149,9 @@ pgf_symbols_cmp(GuString* psent, size_t sent_len, BIND_TYPE* pbind, PgfSymbols*
 			*pbind = BIND_SOFT;
 			break;
 		}
+		case PGF_SYMBOL_CAPIT: {
+			break;
+		}
 		case PGF_SYMBOL_NE: {
 			return -2;
 		}
@@ -1719,6 +1724,9 @@ pgf_parsing_symbol(PgfParsing* ps, PgfItem* item, PgfSymbol sym)
 		}
 		break;
 	}
+	case PGF_SYMBOL_CAPIT: {
+		break;
+	}
 	default:
 		gu_impossible();
 	}

src/runtime/c/pgf/printer.c

@@ -276,6 +276,10 @@ pgf_print_symbol(PgfSymbol sym, GuOut *out, GuExn *err)
 		gu_puts("SOFT_BIND", out, err);
 		break;
 	}
+	case PGF_SYMBOL_CAPIT: {
+		gu_puts("CAPIT", out, err);
+		break;
+	}
 	default:
 		gu_impossible();
 	}

src/runtime/c/pgf/reader.c

@@ -709,6 +709,13 @@ pgf_read_symbol(PgfReader* rdr)
 		gu_return_on_exn(rdr->err, gu_null_variant);
 		break;
 	}
+	case PGF_SYMBOL_CAPIT: {
+		gu_new_variant(PGF_SYMBOL_CAPIT,
+		               PgfSymbolCAPIT,
+		               &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

@@ -201,7 +201,8 @@ instance Binary Symbol where
   put (SymKP d vs)       = putWord8 4 >> put (d,vs)
   put SymBIND            = putWord8 5
   put SymSOFT_BIND       = putWord8 6
-  put SymNE              = putWord8 7
+  put SymCAPIT           = putWord8 7
+  put SymNE              = putWord8 8
   get = do tag <- getWord8
            case tag of
              0 -> liftM2 SymCat get get
@@ -211,7 +212,8 @@ instance Binary Symbol where
              4 -> liftM2 (\d vs -> SymKP d vs) get get
              5 -> return SymBIND
              6 -> return SymSOFT_BIND
-             7 -> return SymNE
+             7 -> return SymCAPIT
+             8 -> return SymNE
              _ -> decodingError
 
 instance Binary PArg where

src/runtime/haskell/PGF/Data.hs

@@ -62,6 +62,7 @@ data Symbol
   | SymKP [Symbol] [([Symbol],[String])]
   | SymBIND                         -- the special BIND token
   | SymSOFT_BIND                    -- the special SOFT_BIND token
+  | SymCAPIT                        -- the special CAPIT token
   | SymNE                           -- non exist (this should be last constructor to simplify the binary search in the runtime)
   deriving (Eq,Ord,Show)
 data Production

src/runtime/haskell/PGF/Macros.hs

@@ -156,6 +156,7 @@ data BracketedTokn
   | LeafNE
   | LeafBIND
   | LeafSOFT_BIND
+  | LeafCAPIT
   | LeafKP [BracketedTokn] [([BracketedTokn],[String])]
   deriving Eq
 
@@ -219,6 +220,7 @@ computeSeq filter seq args = concatMap compute seq
     compute SymNE             = [LeafNE]
     compute SymBIND           = [LeafKS "&+"]
     compute SymSOFT_BIND      = []
+    compute SymCAPIT          = [LeafKS "&|"]
     compute (SymKP syms alts) = [LeafKP (concatMap compute syms) [(concatMap compute syms,cs) | (syms,cs) <- alts]]
 
     getArg d r

src/runtime/haskell/PGF/Optimize.hs

@@ -240,6 +240,7 @@ splitLexicalRules cnc p_prods =
         seq2prefix (SymNE           :syms) = TrieMap.empty
         seq2prefix (SymBIND         :syms) = TrieMap.fromList [wf ["&+"]]
         seq2prefix (SymSOFT_BIND    :syms) = TrieMap.fromList [wf []]
+        seq2prefix (SymCAPIT        :syms) = TrieMap.fromList [wf ["&|"]]
 
 updateConcrete abs cnc = 
   let p_prods0      = filterProductions IntMap.empty IntSet.empty (productions cnc)

src/runtime/haskell/PGF/Parse.hs

@@ -311,10 +311,13 @@ process flit ftok cnc (item@(Active j ppos funid seqid args key0):items) acc cha
       	SymBIND    -> let !acc' = ftok_ ["&+"] (Active j (ppos+1) funid seqid args key0) acc
       	              in process flit ftok cnc items acc' chart
       	SymSOFT_BIND->process flit ftok cnc ((Active j (ppos+1) funid seqid args key0):items) acc chart
+      	SymCAPIT   -> let !acc' = ftok_ ["&|"] (Active j (ppos+1) funid seqid args key0) acc
+      	              in process flit ftok cnc items acc' chart
       	SymKP syms vars
       	           -> let to_tok (SymKS t)    = [t]
       	                  to_tok SymBIND      = ["&+"]
       	                  to_tok SymSOFT_BIND = []
+      	                  to_tok SymCAPIT     = ["&|"]
       	                  to_tok _            = []
 
       	                  !acc' = foldl (\acc syms -> ftok_ (concatMap to_tok syms) (Active j (ppos+1) funid seqid args key0) acc) acc

src/runtime/haskell/PGF/Printer.hs

@@ -94,6 +94,7 @@ ppSymbol (SymKS t)    = doubleQuotes (text t)
 ppSymbol SymNE        = text "nonExist"
 ppSymbol SymBIND      = text "BIND"
 ppSymbol SymSOFT_BIND = text "SOFT_BIND"
+ppSymbol SymCAPIT     = text "CAPIT"
 ppSymbol (SymKP syms alts) = text "pre" <+> braces (hsep (punctuate semi (hsep (map ppSymbol syms) : map ppAlt alts)))
 
 ppAlt (syms,ps) = hsep (map ppSymbol syms) <+> char '/' <+> hsep (map (doubleQuotes . text) ps)