diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index 7ee1117bb..fb3cc24ec 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -185,9 +185,10 @@ pgfCommands = Map.fromList [ exec = needPGF $ \opts arg pgf -> do gen <- newStdGen let dp = valIntOpts "depth" 4 opts + langs = optLangs pgf opts es = case mexp (toExprs arg) of - Just ex -> generateRandomFromDepth gen pgf ex dp - Nothing -> generateRandomDepth gen pgf (optType pgf opts) dp + Just ex -> generateRandomFromExt gen pgf ex dp langs + Nothing -> generateRandomExt gen pgf (optType pgf opts) dp langs returnFromExprs (isOpt "show_probs" opts) $ take (optNum opts) es }), @@ -207,7 +208,7 @@ pgfCommands = Map.fromList [ flags = [ ("cat","the generation category"), ("depth","the maximum generation depth, default 4"), - ("lang","excludes functions that have no linearization in this language"), + ("lang","uses only functions that have linearizations in all these languages"), ("number","the number of trees generated") ], examples = [ @@ -218,9 +219,10 @@ pgfCommands = Map.fromList [ ], exec = needPGF $ \opts arg pgf -> do let dp = valIntOpts "depth" 4 opts + langs = optLangs pgf opts es = case mexp (toExprs arg) of - Just ex -> generateAllFromDepth pgf ex dp - Nothing -> generateAllDepth pgf (optType pgf opts) dp + Just ex -> generateAllFromExt pgf ex dp langs + Nothing -> generateAllExt pgf (optType pgf opts) dp langs returnFromExprs (isOpt "show_probs" opts) $ takeOptNum opts es }), @@ -831,8 +833,9 @@ pgfCommands = Map.fromList [ optLangsFlag flag pgf opts = case valStrOpts flag "" opts of - "" -> Map.elems langs - str -> mapMaybe (completeLang pgf) (chunks ',' str) + "no" -> [] + "" -> Map.elems langs + str -> mapMaybe (completeLang pgf) (chunks ',' str) where langs = languages pgf diff --git a/src/runtime/c/pgf/generator.cxx b/src/runtime/c/pgf/generator.cxx index 0e864b0b8..f7e81ae9d 100644 --- a/src/runtime/c/pgf/generator.cxx +++ b/src/runtime/c/pgf/generator.cxx @@ -2,6 +2,21 @@ #include "data.h" #include "generator.h" +bool PgfGenerator::function_has_lins(PgfText *name) +{ + for (ref concr : concrs) { + ref lin = + namespace_lookup(concr->lins, name); + if (lin == 0) + return false; + } + return true; +} + +void PgfGenerator::addConcr(ref concr) { + concrs.push_back(concr); +} + PgfExpr PgfGenerator::eabs(PgfBindType btype, PgfText *name, PgfExpr body) { body = m->match_expr(this, body); @@ -206,6 +221,10 @@ again: { prob_t rand_value = rand(); ref fun = probspace_random(pgf->abstract.funs_by_cat, cat, rand_value); + + if (!function_has_lins(&fun->name)) + fun = 0; + if (fun == 0) { if (var_expr != 0) { prob += -log(VAR_PROB/(1-VAR_PROB)); @@ -392,6 +411,9 @@ bool PgfExhaustiveGenerator::State0::process(PgfExhaustiveGenerator *gen) gen->push_left_states(space->right, &(*space->value.cat), res, outside_prob); + if (!gen->function_has_lins(&fun->name)) + return true; + PgfExpr expr = gen->u->efun(&fun->name); res->ref_count++; diff --git a/src/runtime/c/pgf/generator.h b/src/runtime/c/pgf/generator.h index fb01aa95d..d99f87015 100644 --- a/src/runtime/c/pgf/generator.h +++ b/src/runtime/c/pgf/generator.h @@ -20,6 +20,7 @@ protected: PgfMarshaller *m; PgfInternalMarshaller i_m; PgfUnmarshaller *u; + std::vector> concrs; PgfGenerator(ref pgf, size_t depth, @@ -31,7 +32,11 @@ protected: this->u = u; } + bool function_has_lins(PgfText *); + public: + void addConcr(ref concr); + virtual PgfExpr eabs(PgfBindType btype, PgfText *name, PgfExpr body); virtual PgfExpr eapp(PgfExpr fun, PgfExpr arg); virtual PgfExpr elit(PgfLiteral lit); diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index 16fc140d0..d4d8ff130 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -1194,6 +1194,7 @@ void pgf_check_type(PgfDB *db, PgfRevision revision, PGF_API PgfExpr pgf_generate_random(PgfDB *db, PgfRevision revision, + PgfConcrRevision *concr_revisions, size_t n_concr_revisions, PgfType type, size_t depth, uint64_t *seed, prob_t *prob, PgfMarshaller *m, PgfUnmarshaller *u, @@ -1208,6 +1209,9 @@ PgfExpr pgf_generate_random(PgfDB *db, PgfRevision revision, // for others. We try 10 time to increase the chance of succeess. for (size_t i = 0; i < 10; i++) { PgfRandomGenerator gen(pgf, depth, seed, m, u); + for (size_t i = 0; i < n_concr_revisions; i++) { + gen.addConcr(db->revision2concr(concr_revisions[i])); + } PgfExpr expr = m->match_type(&gen, type); if (expr != 0) { *prob = gen.getProb(); @@ -1222,6 +1226,7 @@ PgfExpr pgf_generate_random(PgfDB *db, PgfRevision revision, PGF_API PgfExpr pgf_generate_random_from (PgfDB *db, PgfRevision revision, + PgfConcrRevision *concr_revisions, size_t n_concr_revisions, PgfExpr expr, size_t depth, uint64_t *seed, prob_t *prob, PgfMarshaller *m, PgfUnmarshaller *u, @@ -1236,6 +1241,9 @@ PgfExpr pgf_generate_random_from // for others. We try 10 time to increase the chance of succeess. for (size_t i = 0; i < 10; i++) { PgfRandomGenerator gen(pgf, depth, seed, m, u); + for (size_t i = 0; i < n_concr_revisions; i++) { + gen.addConcr(db->revision2concr(concr_revisions[i])); + } PgfExpr new_expr = m->match_expr(&gen, expr); if (new_expr != 0) { *prob = gen.getProb(); @@ -1249,6 +1257,7 @@ PgfExpr pgf_generate_random_from PGF_API PgfExprEnum *pgf_generate_all(PgfDB *db, PgfRevision revision, + PgfConcrRevision *concr_revisions, size_t n_concr_revisions, PgfType type, size_t depth, PgfMarshaller *m, PgfUnmarshaller *u, PgfExn *err) @@ -1259,6 +1268,9 @@ PgfExprEnum *pgf_generate_all(PgfDB *db, PgfRevision revision, ref pgf = db->revision2pgf(revision); PgfExhaustiveGenerator *gen = new PgfExhaustiveGenerator(pgf, depth, m, u); + for (size_t i = 0; i < n_concr_revisions; i++) { + gen->addConcr(db->revision2concr(concr_revisions[i])); + } m->match_type(gen, type); return gen; } PGF_API_END diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h index a358411e0..0191b5dab 100644 --- a/src/runtime/c/pgf/pgf.h +++ b/src/runtime/c/pgf/pgf.h @@ -511,6 +511,7 @@ void pgf_check_type(PgfDB *db, PgfRevision revision, PGF_API_DECL PgfExpr pgf_generate_random(PgfDB *db, PgfRevision revision, + PgfConcrRevision *concr_revisions, size_t n_concr_revisions, PgfType type, size_t depth, uint64_t *seed, prob_t *prob, PgfMarshaller *m, PgfUnmarshaller *u, @@ -519,6 +520,7 @@ PgfExpr pgf_generate_random(PgfDB *db, PgfRevision revision, PGF_API_DECL PgfExpr pgf_generate_random_from (PgfDB *db, PgfRevision revision, + PgfConcrRevision *concr_revisions, size_t n_concr_revisions, PgfExpr expr, size_t depth, uint64_t *seed, prob_t *prob, PgfMarshaller *m, PgfUnmarshaller *u, @@ -542,6 +544,7 @@ struct PgfExprEnum { PGF_API_DECL PgfExprEnum *pgf_generate_all(PgfDB *db, PgfRevision revision, + PgfConcrRevision *concr_revisions, size_t n_concr_revisions, PgfType type, size_t depth, PgfMarshaller *m, PgfUnmarshaller *u, PgfExn *err); diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index 0edb87fd7..e22a8f5f5 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/src/runtime/haskell/PGF2.hsc @@ -55,10 +55,10 @@ module PGF2 (-- * PGF compute, -- ** Generation - generateAll, generateAllDepth, - generateAllFrom, generateAllFromDepth, - generateRandom, generateRandomDepth, - generateRandomFrom, generateRandomFromDepth, + generateAll, generateAllDepth, generateAllExt, + generateAllFrom, generateAllFromDepth, generateAllFromExt, + generateRandom, generateRandomDepth, generateRandomExt, + generateRandomFrom, generateRandomFromDepth, generateRandomFromExt, -- ** Morphological Analysis MorphoAnalysis, lookupMorpho, lookupCohorts, fullFormLexicon, @@ -999,43 +999,54 @@ bracketedLinearizeAll c e = unsafePerformIO $ do else writeIORef ref (False,[],[],reverse bs:all) generateAll :: PGF -> Type -> [(Expr,Float)] -generateAll p ty = generateAllDepth p ty maxBound +generateAll p ty = generateAllExt p ty maxBound [] generateAllDepth :: PGF -> Type -> Int -> [(Expr,Float)] -generateAllDepth p ty dp = +generateAllDepth p ty dp = generateAllExt p ty dp [] + +generateAllExt :: PGF -> Type -> Int -> [Concr] -> [(Expr,Float)] +generateAllExt p ty dp cs = unsafePerformIO $ bracket (newStablePtr ty) freeStablePtr $ \c_ty -> - withForeignPtr (a_revision p) $ \c_revision -> + withForeignPtr (a_revision p) $ \a_revision -> + withPgfConcrs cs $ \c_db c_revisions n_revisions -> mask_ $ do - c_enum <- withPgfExn "generateAllDepth" (pgf_generate_all (a_db p) c_revision c_ty (fromIntegral dp) marshaller unmarshaller) + c_enum <- withPgfExn "generateAllExt" (pgf_generate_all (a_db p) a_revision c_revisions n_revisions c_ty (fromIntegral dp) marshaller unmarshaller) enumerateExprs (a_db p) c_enum generateAllFrom :: PGF -> Expr -> [(Expr,Float)] -generateAllFrom p ty = generateAllFromDepth p ty maxBound +generateAllFrom p ty = generateAllFromExt p ty maxBound [] generateAllFromDepth :: PGF -> Expr -> Int -> [(Expr,Float)] -generateAllFromDepth p ty = error "TODO: generateFromDepth" +generateAllFromDepth p ty dp = generateAllFromExt p ty dp [] + +generateAllFromExt :: PGF -> Expr -> Int -> [Concr] -> [(Expr,Float)] +generateAllFromExt p ty dp concrs = error "TODO: generateAllFromEx" -- | Generates a potentially infinite list of random -- abstract syntax expressions. This is usefull for tree bank generation -- which after that can be used for grammar testing. generateRandom :: RandomGen g => g -> PGF -> Type -> [(Expr,Float)] -generateRandom g pgf ty = generateRandomDepth g pgf ty maxBound +generateRandom g pgf ty = generateRandomExt g pgf ty maxBound [] generateRandomDepth :: RandomGen g => g -> PGF -> Type -> Int -> [(Expr,Float)] -generateRandomDepth g p ty dp = +generateRandomDepth g p ty dp = generateRandomExt g p ty dp [] + +generateRandomExt :: RandomGen g => g -> PGF -> Type -> Int -> [Concr] -> [(Expr,Float)] +generateRandomExt g p ty dp cs = let (seed,_) = random g in generate seed where generate seed = unsafePerformIO $ bracket (newStablePtr ty) freeStablePtr $ \c_ty -> - withForeignPtr (a_revision p) $ \c_revision -> + withForeignPtr (a_revision p) $ \a_revision -> + withPgfConcrs cs $ \c_db c_revisions n_revisions -> alloca $ \p_seed -> alloca $ \p_prob -> mask_ $ do poke p_seed seed - c_expr <- withPgfExn "generateRandomDepth" (pgf_generate_random (a_db p) c_revision c_ty (fromIntegral dp) p_seed p_prob marshaller unmarshaller) + c_expr <- withPgfExn "generateRandomExt" (pgf_generate_random (a_db p) a_revision c_revisions n_revisions c_ty (fromIntegral dp) p_seed p_prob marshaller unmarshaller) if castStablePtrToPtr c_expr == nullPtr then return [] else do expr <- deRefStablePtr c_expr @@ -1045,22 +1056,26 @@ generateRandomDepth g p ty dp = return ((expr,prob):generate seed) generateRandomFrom :: RandomGen g => g -> PGF -> Expr -> [(Expr,Float)] -generateRandomFrom g p e = generateRandomFromDepth g p e maxBound +generateRandomFrom g p e = generateRandomFromExt g p e maxBound [] generateRandomFromDepth :: RandomGen g => g -> PGF -> Expr -> Int -> [(Expr,Float)] -generateRandomFromDepth g p e dp = +generateRandomFromDepth g p e dp = generateRandomFromExt g p e dp [] + +generateRandomFromExt :: RandomGen g => g -> PGF -> Expr -> Int -> [Concr] -> [(Expr,Float)] +generateRandomFromExt g p e dp cs = let (seed,_) = random g in generate seed where generate seed = unsafePerformIO $ bracket (newStablePtr e) freeStablePtr $ \c_e -> - withForeignPtr (a_revision p) $ \c_revision -> + withForeignPtr (a_revision p) $ \a_revision -> + withPgfConcrs cs $ \c_db c_revisions n_revisions -> alloca $ \p_seed -> alloca $ \p_prob -> mask_ $ do poke p_seed seed - c_expr <- withPgfExn "generateRandomFromDepth" (pgf_generate_random_from (a_db p) c_revision c_e (fromIntegral dp) p_seed p_prob marshaller unmarshaller) + c_expr <- withPgfExn "generateRandomFromExt" (pgf_generate_random_from (a_db p) a_revision c_revisions n_revisions c_e (fromIntegral dp) p_seed p_prob marshaller unmarshaller) if castStablePtrToPtr c_expr == nullPtr then return [] else do expr <- deRefStablePtr c_expr @@ -1276,22 +1291,6 @@ graphvizWordAlignment cs opts e = if c_text == nullPtr then return "" else peekText c_text - where - withPgfConcrs cs f = - allocaArray len $ \array -> - pokeAll array nullPtr array cs - where - len = length cs - - pokeAll ptr c_db0 array [] = f c_db0 array (fromIntegral len) - pokeAll ptr c_db0 array (c:cs) - | c_db0 /= nullPtr && c_db0 /= c_db c = - throwIO (PGFError "graphvizWordAlignment" "The concrete languages must be from the same grammar") - | otherwise = - withForeignPtr (c_revision c) $ \c_revision -> do - poke ptr c_revision - pokeAll (ptr `plusPtr` (#size PgfConcrRevision)) (c_db c) array cs - type Labels = Map.Map Fun [String] diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index 9c20a0bf8..974bba87c 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -195,11 +195,11 @@ foreign import ccall pgf_infer_expr :: Ptr PgfDB -> Ptr PGF -> Ptr (StablePtr Ex foreign import ccall pgf_check_type :: Ptr PgfDB -> Ptr PGF -> Ptr (StablePtr Type) -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO () -foreign import ccall pgf_generate_random :: Ptr PgfDB -> Ptr PGF -> StablePtr Type -> CSize -> Ptr Word64 -> Ptr (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Expr) +foreign import ccall pgf_generate_random :: Ptr PgfDB -> Ptr PGF -> Ptr (Ptr Concr) -> CSize -> StablePtr Type -> CSize -> Ptr Word64 -> Ptr (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Expr) -foreign import ccall pgf_generate_random_from :: Ptr PgfDB -> Ptr PGF -> StablePtr Expr -> CSize -> Ptr Word64 -> Ptr (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Expr) +foreign import ccall pgf_generate_random_from :: Ptr PgfDB -> Ptr PGF -> Ptr (Ptr Concr) -> CSize -> StablePtr Expr -> CSize -> Ptr Word64 -> Ptr (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Expr) -foreign import ccall pgf_generate_all :: Ptr PgfDB -> Ptr PGF -> StablePtr Type -> CSize -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (Ptr PgfExprEnum) +foreign import ccall pgf_generate_all :: Ptr PgfDB -> Ptr PGF -> Ptr (Ptr Concr) -> CSize -> StablePtr Type -> CSize -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (Ptr PgfExprEnum) foreign import ccall pgf_start_transaction :: Ptr PgfDB -> Ptr PgfExn -> IO (Ptr PGF) @@ -408,6 +408,21 @@ withPgfExn loc f = throwIO (PGFError loc msg) _ -> throwIO (PGFError loc "An unidentified error occurred") +withPgfConcrs cs f = + allocaArray len $ \array -> + pokeAll array nullPtr array cs + where + len = length cs + + pokeAll ptr c_db0 array [] = f c_db0 array (fromIntegral len) + pokeAll ptr c_db0 array (c:cs) + | c_db0 /= nullPtr && c_db0 /= c_db c = + throwIO (PGFError "graphvizWordAlignment" "The concrete languages must be from the same grammar") + | otherwise = + withForeignPtr (c_revision c) $ \c_revision -> do + poke ptr c_revision + pokeAll (ptr `plusPtr` (#size PgfConcrRevision)) (c_db c) array cs + ----------------------------------------------------------------------- -- Marshalling