msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

define default depths for shell and server only once

Browse Source
This commit is contained in:
Inari Listenmaa
2025-08-02 21:46:13 +02:00
parent af09351b66
commit 3e0c0fa463
3 changed files with 33 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
src/compiler/GF/Command/Commands.hs
View File

@@ -22,6 +22,7 @@ import GF.Infra.SIO
import GF.Command.Abstract
import GF.Command.CommandInfo
import GF.Command.CommonCommands
import qualified GF.Command.CommonCommands as Common
import GF.Text.Clitics
import GF.Quiz
@@ -166,14 +167,15 @@ pgfCommands = Map.fromList [
synopsis = "generate random trees in the current abstract syntax",
syntax = "gr [-cat=CAT] [-number=INT]",
examples = [
mkEx "gr -- one tree in the startcat of the current grammar",
mkEx "gr -cat=NP -number=16 -- 16 trees in the category NP",
mkEx "gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha",
mkEx "gr -probs=FILE -- generate with bias",
mkEx "gr (AdjCN ? (UseN ?)) -- generate trees of form (AdjCN ? (UseN ?))"
mkEx $ "gr -- one tree in the startcat of the current grammar, up to depth " ++ Common.default_depth_str,
mkEx "gr -cat=NP -number=16 -- 16 trees in the category NP",
mkEx "gr -cat=NP -depth=2 -- one tree in the category NP, up to depth 2",
mkEx "gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha",
mkEx "gr -probs=FILE -- generate with bias",
mkEx "gr (AdjCN ? (UseN ?)) -- generate trees of form (AdjCN ? (UseN ?))"
],
explanation = unlines [
"Generates a list of random trees, by default one tree.",
"Generates a list of random trees, by default one tree up to depth " ++ Common.default_depth_str ++ ".",
"If a tree argument is given, the command completes the Tree with values to",
"all metavariables in the tree. The generation can be biased by probabilities,",
"given in a file in the -probs flag."
@@ -182,13 +184,13 @@ pgfCommands = Map.fromList [
("cat","generation category"),
("lang","uses only functions that have linearizations in all these languages"),
("number","number of trees generated"),
("depth","the maximum generation depth"),
("depth","the maximum generation depth (default: " ++ Common.default_depth_str ++ ")"),
("probs", "file with biased probabilities (format 'f 0.4' one by line)")
],
exec = getEnv $ \ opts arg (Env pgf mos) -> do
pgf <- optProbs opts (optRestricted opts pgf)
gen <- newStdGen
let dp = valIntOpts "depth" 4 opts
let dp = valIntOpts "depth" Common.default_depth opts
let ts = case mexp (toExprs arg) of
Just ex -> generateRandomFromDepth gen pgf ex (Just dp)
Nothing -> generateRandomDepth gen pgf (optType pgf opts) (Just dp)
@@ -199,25 +201,25 @@ pgfCommands = Map.fromList [
synopsis = "generates a list of trees, by default exhaustive",
explanation = unlines [
"Generates all trees of a given category. By default, ",
"the depth is limited to 4, but this can be changed by a flag.",
"the depth is limited to " ++ Common.default_depth_str ++ ", but this can be changed by a flag.",
"If a Tree argument is given, the command completes the Tree with values",
"to all metavariables in the tree."
],
flags = [
("cat","the generation category"),
("depth","the maximum generation depth"),
("depth","the maximum generation depth (default: " ++ Common.default_depth_str ++ ")"),
("lang","excludes functions that have no linearization in this language"),
("number","the number of trees generated")
],
examples = [
mkEx "gt -- all trees in the startcat, to depth 4",
mkEx "gt -cat=NP -number=16 -- 16 trees in the category NP",
mkEx "gt -cat=NP -depth=2 -- trees in the category NP to depth 2",
mkEx "gt (AdjCN ? (UseN ?)) -- trees of form (AdjCN ? (UseN ?))"
mkEx $ "gt -- all trees in the startcat, to depth " ++ Common.default_depth_str,
mkEx "gt -cat=NP -number=16 -- 16 trees in the category NP",
mkEx "gt -cat=NP -depth=2 -- trees in the category NP to depth 2",
mkEx "gt (AdjCN ? (UseN ?)) -- trees of form (AdjCN ? (UseN ?))"
],
exec = getEnv $ \ opts arg (Env pgf mos) -> do
let pgfr = optRestricted opts pgf
let dp = valIntOpts "depth" 4 opts
let dp = valIntOpts "depth" Common.default_depth opts
let ts = case toExprs arg of
[] -> generateAllDepth pgfr (optType pgf opts) (Just dp)
es -> concat [generateFromDepth pgfr e (Just dp) | e <- es]
@@ -760,7 +762,7 @@ pgfCommands = Map.fromList [
[] -> [parse_ pgf lang (optType pgf opts) (Just dp) s | lang <- optLangs pgf opts]
open_typs -> [parseWithRecovery pgf lang (optType pgf opts) open_typs (Just dp) s | lang <- optLangs pgf opts]
where
dp = valIntOpts "depth" 4 opts
dp = valIntOpts "depth" Common.default_depth opts
fromParse opts = foldr (joinPiped . fromParse1 opts) void

6
src/compiler/GF/Command/CommonCommands.hs
View File

@@ -19,6 +19,12 @@ import Data.Char (isSpace)
import qualified PGF as H(showCId,showExpr,toATree,toTrie,Trie(..))
-- store default generation depth in a variable and use everywhere
default_depth :: Int
default_depth = 5
default_depth_str = show default_depth
extend old new = Map.union (Map.fromList new) old -- Map.union is left-biased
commonCommands :: (Monad m,MonadSIO m) => Map.Map String (CommandInfo m)

6
src/server/PGFService.hs
View File

@@ -571,6 +571,8 @@ limit, depth :: CGI (Maybe Int)
limit = readInput "limit"
depth = readInput "depth"
default_depth_server = 4
start :: CGI Int
start = maybe 0 id # readInput "start"
@@ -781,7 +783,7 @@ doRandom pgf mcat mdepth mlimit to =
| tree <- limit trees]
where cat = fromMaybe (PGF.startCat pgf) mcat
limit = take (fromMaybe 1 mlimit)
depth = fromMaybe 4 mdepth
depth = fromMaybe default_depth_server mdepth
doGenerate :: PGF -> Maybe PGF.Type -> Maybe Int -> Maybe Int -> To -> JSValue
doGenerate pgf mcat mdepth mlimit tos =
@@ -794,7 +796,7 @@ doGenerate pgf mcat mdepth mlimit tos =
trees = PGF.generateAllDepth pgf cat (Just depth)
cat = fromMaybe (PGF.startCat pgf) mcat
limit = take (fromMaybe 1 mlimit)
depth = fromMaybe 4 mdepth
depth = fromMaybe default_depth_server mdepth
doGrammar :: (UTCTime,PGF) -> Either IOError (UTCTime,l) -> Maybe (Accept Language) -> CGI CGIResult
doGrammar (t1,pgf) elbls macc = out t $ showJSON $ makeObj