From 617ce3cce67acca54a1ef3127da91bcd3e6a12ab Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Wed, 22 Sep 2010 15:49:16 +0000
Subject: the first revision of exhaustive and random generation with dependent
 types. Still not quite stable.

---
 src/compiler/GF/Command/Commands.hs | 15 ++++++++++-----
 src/compiler/GF/Quiz.hs             | 14 ++++++++++++--
 2 files changed, 22 insertions(+), 7 deletions(-)

(limited to 'src/compiler/GF')

diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index a9a472552..63e3208b5 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -312,8 +312,12 @@ allCommands env@(pgf, mos) = Map.fromList [
        let pgfr = optRestricted opts
        gen <- newStdGen
        mprobs <- optProbs opts pgfr
-       let mt = mexp xs
-       ts <- return $ generateRandomFrom mt mprobs gen pgfr (optType opts)
+       let sel = case mprobs of
+                   Just probs -> WeightSel gen probs
+                   Nothing    -> RandSel   gen
+       let ts  = case mexp xs of
+                   Just ex -> generateRandomFrom sel pgfr ex
+                   Nothing -> generateRandom     sel pgfr (optType opts)
        returnFromExprs $ take (optNum opts) ts
      }),
   ("gt", emptyCommandInfo {
@@ -339,9 +343,10 @@ allCommands env@(pgf, mos) = Map.fromList [
        ],
      exec = \opts xs -> do
        let pgfr = optRestricted opts
-       let dp = return $ valIntOpts "depth" 4 opts
-       let mt = mexp xs
-       let ts = generateAllDepth mt pgfr (optType opts) dp
+       let dp = valIntOpts "depth" 4 opts
+       let ts = case mexp xs of
+                  Just ex -> generateFromDepth pgfr ex (Just dp)
+                  Nothing -> generateAllDepth pgfr (optType opts) (Just dp)
        returnFromExprs $ take (optNumInf opts) ts
      }),
   ("h", emptyCommandInfo {
diff --git a/src/compiler/GF/Quiz.hs b/src/compiler/GF/Quiz.hs
index 0c48ea67d..1a221c21d 100644
--- a/src/compiler/GF/Quiz.hs
+++ b/src/compiler/GF/Quiz.hs
@@ -42,7 +42,12 @@ translationList ::
   PGF -> Language -> Language -> Type -> Int -> IO [(String,[String])]
 translationList mex mprobs pgf ig og typ number = do
   gen <- newStdGen
-  let ts = take number $ generateRandomFrom mex mprobs gen pgf typ
+  let sel = case mprobs of
+              Just probs -> WeightSel gen probs
+              Nothing    -> RandSel   gen
+  let ts  = take number $ case mex of
+                            Just ex -> generateRandomFrom sel pgf ex
+                            Nothing -> generateRandom     sel pgf typ
   return $ map mkOne $ ts
  where
    mkOne t = (norml (linearize pgf ig t), map (norml . linearize pgf og) (homonyms t))
@@ -53,7 +58,12 @@ morphologyList ::
   PGF -> Language -> Type -> Int -> IO [(String,[String])]
 morphologyList mex mprobs pgf ig typ number = do
   gen <- newStdGen
-  let ts = take (max 1 number) $ generateRandomFrom mex mprobs gen pgf typ 
+  let sel = case mprobs of
+              Just probs -> WeightSel gen probs
+              Nothing    -> RandSel   gen
+  let ts = take (max 1 number) $ case mex of
+                                   Just ex -> generateRandomFrom sel pgf ex
+                                   Nothing -> generateRandom     sel pgf typ
   let ss    = map (tabularLinearizes pgf ig) ts
   let size  = length (head (head ss))
   let forms = take number $ randomRs (0,size-1) gen
-- 
cgit v1.2.3