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

6 files changed, 12 insertions, 2 deletions

diff --git a/src/runtime/haskell/PGF/Binary.hs b/src/runtime/haskell/PGF/Binary.hs
index aef894e2b..ca2784da2 100644
--- a/src/runtime/haskell/PGF/Binary.hs
+++ b/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

diff --git a/src/runtime/haskell/PGF/Data.hs b/src/runtime/haskell/PGF/Data.hs
index e9263cc1c..7d4750b13 100644
--- a/src/runtime/haskell/PGF/Data.hs
+++ b/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
diff --git a/src/runtime/haskell/PGF/Macros.hs b/src/runtime/haskell/PGF/Macros.hs
index 7cf2661cc..8ca2a4f29 100644
--- a/src/runtime/haskell/PGF/Macros.hs
+++ b/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
diff --git a/src/runtime/haskell/PGF/Optimize.hs b/src/runtime/haskell/PGF/Optimize.hs
index 6944eb209..dd876baaf 100644
--- a/src/runtime/haskell/PGF/Optimize.hs
+++ b/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)
diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs
index 40abb78fd..11705f326 100644
--- a/src/runtime/haskell/PGF/Parse.hs
+++ b/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

diff --git a/src/runtime/haskell/PGF/Printer.hs b/src/runtime/haskell/PGF/Printer.hs
index a9985cdeb..2013a3c9c 100644
--- a/src/runtime/haskell/PGF/Printer.hs
+++ b/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)