From f8b73d593ca147e48a723d3dceda7c5977d21ae6 Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Thu, 9 Oct 2014 19:34:12 +0000 Subject: [PATCH] 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 | 3 ++- src/compiler/GF/Compile/Compute/Value.hs | 2 +- src/compiler/GF/Compile/GeneratePMCFG.hs | 2 ++ src/compiler/GF/Compile/PGFtoJS.hs | 1 + src/compiler/GF/Compile/PGFtoPython.hs | 1 + src/compiler/GF/Compile/TypeCheck/Primitives.hs | 2 ++ src/compiler/GF/Grammar/Predef.hs | 1 + src/compiler/GF/Speech/PGFToCFG.hs | 1 + src/runtime/c/pgf/data.h | 4 ++++ src/runtime/c/pgf/linearizer.c | 2 ++ src/runtime/c/pgf/parser.c | 8 ++++++++ src/runtime/c/pgf/printer.c | 4 ++++ src/runtime/c/pgf/reader.c | 7 +++++++ src/runtime/haskell/PGF/Binary.hs | 6 ++++-- src/runtime/haskell/PGF/Data.hs | 1 + src/runtime/haskell/PGF/Macros.hs | 2 ++ src/runtime/haskell/PGF/Optimize.hs | 1 + src/runtime/haskell/PGF/Parse.hs | 3 +++ src/runtime/haskell/PGF/Printer.hs | 1 + 19 files changed, 48 insertions(+), 4 deletions(-) diff --git a/src/compiler/GF/Compile/Compute/Predef.hs b/src/compiler/GF/Compile/Compute/Predef.hs index b9bb01ce8..74697a89b 100644 --- a/src/compiler/GF/Compile/Compute/Predef.hs +++ b/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 diff --git a/src/compiler/GF/Compile/Compute/Value.hs b/src/compiler/GF/Compile/Compute/Value.hs index 64683a3de..f076e47ba 100644 --- a/src/compiler/GF/Compile/Compute/Value.hs +++ b/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) diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index aa22ea412..40872170c 100644 --- a/src/compiler/GF/Compile/GeneratePMCFG.hs +++ b/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 diff --git a/src/compiler/GF/Compile/PGFtoJS.hs b/src/compiler/GF/Compile/PGFtoJS.hs index 1a3d81a89..6c391f717 100644 --- a/src/compiler/GF/Compile/PGFtoJS.hs +++ b/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)] diff --git a/src/compiler/GF/Compile/PGFtoPython.hs b/src/compiler/GF/Compile/PGFtoPython.hs index 72b4f1ff8..01b6437ac 100644 --- a/src/compiler/GF/Compile/PGFtoPython.hs +++ b/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 [])] ---------------------------------------------------------------------- diff --git a/src/compiler/GF/Compile/TypeCheck/Primitives.hs b/src/compiler/GF/Compile/TypeCheck/Primitives.hs index bf3d92b24..a318e74b0 100644 --- a/src/compiler/GF/Compile/TypeCheck/Primitives.hs +++ b/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) diff --git a/src/compiler/GF/Grammar/Predef.hs b/src/compiler/GF/Grammar/Predef.hs index 8ffd17b74..633ced494 100644 --- a/src/compiler/GF/Grammar/Predef.hs +++ b/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] diff --git a/src/compiler/GF/Speech/PGFToCFG.hs b/src/compiler/GF/Speech/PGFToCFG.hs index 49744f22e..e5090fa0f 100644 --- a/src/compiler/GF/Speech/PGFToCFG.hs +++ b/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 diff --git a/src/runtime/c/pgf/data.h b/src/runtime/c/pgf/data.h index dd482f372..e734434cd 100644 --- a/src/runtime/c/pgf/data.h +++ b/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 { diff --git a/src/runtime/c/pgf/linearizer.c b/src/runtime/c/pgf/linearizer.c index f70aa405a..1b02e1b38 100644 --- a/src/runtime/c/pgf/linearizer.c +++ b/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(); } diff --git a/src/runtime/c/pgf/parser.c b/src/runtime/c/pgf/parser.c index 8d725a48a..abd8ff521 100644 --- a/src/runtime/c/pgf/parser.c +++ b/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(); } diff --git a/src/runtime/c/pgf/printer.c b/src/runtime/c/pgf/printer.c index 10a9858c1..e3e014c4b 100644 --- a/src/runtime/c/pgf/printer.c +++ b/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(); } diff --git a/src/runtime/c/pgf/reader.c b/src/runtime/c/pgf/reader.c index 8ff80a67c..8314fef5f 100644 --- a/src/runtime/c/pgf/reader.c +++ b/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); } 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)