[linear and pairwise comparison of ctor symbols in arguments for matching, pass UI settings to Igor
martin.hofmann@uni-bamberg.de**20090519132811] hunk ./src/Data/IOData.hs 9
-    IOData,background, initIOData, getAll, breakup, fuse, insertRules 
+    IOData,initIOData, getAll, breakup, fuse, insertRules 
hunk ./src/Data/IOData.hs 46
-    , background   :: [Name]
hunk ./src/Data/IOData.hs 63
-initIOData = let e = emptyIOData 
-             in (foldr (\(n,r) -> insertUnsafe n r)) =<<
-                (\ds -> e{background = map fst ds})
+initIOData = foldr (\(n,r) -> insertUnsafe n r) emptyIOData
hunk ./src/Data/IOData.hs 72
-    , background   = []
hunk ./src/Data/IOData.hs 246
-                        text "Background :" <$> pretty (background iod) <$>
hunk ./src/Data/IgorMonad.hs 9
-    tick, loopCount, hypoCount, addIO, breakupM, fuseM, coverAll,
+    tick, loopCount, hypoCount, isDebug, maxLoops, recArgComp, background, 
+    targets, addIO, breakupM, fuseM, coverAll,
hunk ./src/Data/IgorMonad.hs 23
-
+import Data.GlobalConfig
hunk ./src/Data/IgorMonad.hs 28
+import Data.Maybe (fromMaybe)
hunk ./src/Data/IgorMonad.hs 33
-    { iodata :: !IOData, searchSpace :: !HSpace, loopcount :: [(Name,Int)]}
+    { iodata :: !IOData
+    , searchSpace :: !HSpace
+    , loopcount :: [(Name,Int)]
+    , config :: Config
+    }
hunk ./src/Data/IgorMonad.hs 40
+
+   
hunk ./src/Data/IgorMonad.hs 59
+
+--------------------------------------------------------------------------------
+-- Non-Monadic operations on 'Igor'
+--------------------------------------------------------------------------------
+
+-- | Set the target for the given 'Igor' to a function with name 'Name'. If no 
+--   evidence for such a function exists in 'Igor' an error is thrown. 
+setupTarget :: Name -> Igor -> Igor
+setupTarget n ( Igor iod _ lc cf) = 
+    Igor iod (initHSpace (fuse . (getAll n) $ iod)) ((n,0):lc) cf  
+    
+
+-- | Initialise an 'Igor' (data object) with '[(Name,Rules)]' as evidence for 
+--   the target function and background knowledge. Each '(Name,Rules)' is the
+--   the evidence of a function with 'Name' and IO examples 'Rules' 
+initIgor :: [(Name,Rules)] -> Config -> Igor
+initIgor nr = Igor (initIOData nr) emptyHSpace []
+
+
+--------------------------------------------------------------------------------
+-- Monadic operations on 'Config'
+--------------------------------------------------------------------------------
+isDebug :: IM Bool
+isDebug = gets $ cnf_debug.config
+
+maxLoops :: IM Integer
+maxLoops = gets $ cnf_maxLoops.config
+
+recArgComp :: IM RecArgComp
+recArgComp = gets $ cnf_recArgComp.config
+
+targets :: IM [Name]
+targets = gets $ cnf_tgts.config
+
+background :: IM [Name]
+background = gets $ cnf_bgks.config
+
hunk ./src/Data/IgorMonad.hs 107
-    modify $ \igor@(Igor _ sp _) ->
+    modify $ \igor@(Igor _ sp _ _) ->
hunk ./src/Data/IgorMonad.hs 109
+      
hunk ./src/Data/IgorMonad.hs 118
-    modify $ \igor@(Igor io _ _) ->
+    modify $ \igor@(Igor io _ _ _) ->
hunk ./src/Data/IgorMonad.hs 122
-tick = get >>= \i@(Igor _ _ ((n,lc):lcs)) ->
+tick = get >>= \i@(Igor _ _ ((n,lc):lcs) _) ->
hunk ./src/Data/IgorMonad.hs 136
-    i@(Igor iod _ _) <- get
+    i@(Igor iod _ _ _) <- get
hunk ./src/Data/IgorMonad.hs 151
---------------------------------------------------------------------------------
--- Non-Monadic operations on 'Igor'
---------------------------------------------------------------------------------
-
--- | Set the target for the given 'Igor' to a function with name 'Name'. If no 
---   evidence for such a function exists in 'Igor' an error is thrown. 
-setupTarget :: Name -> Igor -> Igor
-setupTarget n ( Igor iod _ lc) = 
-    Igor iod (initHSpace (fuse . (getAll n) $ iod)) ((n,0):lc)  
-    
-
-
-
-
--- | Initialise an 'Igor' (data object) with '[(Name,Rules)]' as evidence for 
---   the target function and background knowledge. Each '(Name,Rules)' is the
---   the evidence of a function with 'Name' and IO examples 'Rules' 
-initIgor :: [(Name,Rules)] -> Igor
-initIgor nr = Igor (initIOData nr) emptyHSpace []
-
-
hunk ./src/Data/IgorMonad.hs 153
--- Instamnce declarations
+-- Instance declarations
hunk ./src/RuleDevelopment/Matching.hs 12
-import Data.IOData
-import Data.Rules 
+import Data.Rules
+import Data.GlobalConfig 
hunk ./src/RuleDevelopment/Matching.hs 24
+    bknames  <- background
hunk ./src/RuleDevelopment/Matching.hs 27
-    let bckgcalls i = map (flip (,) (Just GT)) (background i)
+    let bckgcalls   = map (flip (,) (Just GT)) bknames
hunk ./src/RuleDevelopment/Matching.hs 29
-    let allowdCs i  =  M.toList $ foldl (flip $ uncurry M.insert) subcalls ((bckgcalls i)++[selfcall])
+    let allowdCs    =  M.toList $ foldl (flip $ uncurry M.insert) subcalls (bckgcalls ++[selfcall])
hunk ./src/RuleDevelopment/Matching.hs 33
-    llogIN ( text "Trying calls to:" <^> (pretty $ allowdCs iod))
-    liftM concat $ mapM (computeMatchings cr) (allowdCs iod)
+    llogIN ( text "Trying calls to:" <^> pretty allowdCs )
+    liftM concat $ mapM (computeMatchings cr) allowdCs
hunk ./src/RuleDevelopment/Matching.hs 88
-    let callrel = on compareSizeLinear (lhs.crul) tgt cll
+    howCompare <- recArgComp
+    let callrel = case howCompare of 
+                    Linear   -> on compareSizeLinear   (lhs.crul) tgt cll
+                    Pairwise -> on compareSizePairwise (lhs.crul) tgt cll
hunk ./src/SynthesisEngine.hs 10
+import Data.GlobalConfig
hunk ./src/SynthesisEngine.hs 14
-import Language.Haskell.TH
hunk ./src/SynthesisEngine.hs 16
---import Data.Initialiser
+
hunk ./src/SynthesisEngine.hs 19
+import Syntax.IFTemplateHaskell
hunk ./src/SynthesisEngine.hs 22
--- stop after @_MaxLoopCount@ iterations, if < 0 loop count has no effect.
-_MaxLoopCount = 50
-
hunk ./src/SynthesisEngine.hs 28
--} 
+-}
hunk ./src/SynthesisEngine.hs 30
-startSynthesis :: [(Name,Rules)] -> [(Name,Rules)] -> (Either String [[Dec]],Log)
-startSynthesis tgt bgk = runLM  (synthesise tgt bgk) 
+startSynthesis :: Config -> [(Name,Rules)] -> [(Name,Rules)] -> (Either String [[Dec]],Log)
+startSynthesis conf tgt bgk = runLM  (synthesise conf tgt bgk) 
hunk ./src/SynthesisEngine.hs 33
-synthesise :: [(Name,Rules)] -> [(Name,Rules)] -> LM [[Dec]]
-synthesise tgts bgks = do
-    let tnms     =  (map fst) tgts
-    let allrs    =  (++) tgts bgks
-    let igordata = initIgor allrs
+synthesise :: Config -> [(Name,Rules)] -> [(Name,Rules)] -> LM [[Dec]]
+synthesise conf tgts bgks = do
+    let allrs    = (++) tgts bgks
+    let igordata = initIgor allrs conf
hunk ./src/SynthesisEngine.hs 38
-    logIN (text "SYNTHESISING" <+> hsep (map (squotes.pretty) tnms) <$>
-           text "USING       " <+> hsep (map (squotes.pretty.fst) bgks) <$> 
-           linebreak <>
-           text "IGOR initialised to:" <$>
-           indent 2 (pretty igordata))
+    logIN ( pretty conf <$> 
+            linebreak <>
+            text "IGOR initialised to:" <$>
+            indent 2 (pretty igordata))
hunk ./src/SynthesisEngine.hs 43
-    result <- (runIM ( synthesiseTargets tnms) igordata)
+    result <- (runIM ( synthesiseTargets (cnf_tgts conf)) igordata)
hunk ./src/SynthesisEngine.hs 80
-    if nocandidates  -- || maxloopcount
+    if nocandidates  || maxloopcount
hunk ./src/SynthesisEngine.hs 98
-stopAtMaxLoopCount = 
-    if _MaxLoopCount < 0 then return False
-      else liftM2 (==) loopCount (return _MaxLoopCount)
+stopAtMaxLoopCount = do 
+    d <- isDebug
+    if not d then return False 
+       else liftM2 ((==).fromInteger) maxLoops loopCount
hunk ./src/UI/UIStarter.hs 28
---import UI.IOTypeCheck
+import Data.GlobalConfig
hunk ./src/UI/UIStarter.hs 50
-    { noBanner :: Bool
-    , verbose  :: Bool
-    , debug    :: Bool
-    , dumpLog  :: Bool
-    , dumpDir  :: String
-    , maxHypos :: Integer
-    , colWidth :: Integer
-    , context  :: !ModuleCtx
-    , history  :: M.Map ([Name],[Name]) [String]  
+    { noBanner  :: Bool
+    , verbose   :: Bool
+    , debug     :: Bool
+    , dumpLog   :: Bool
+    , dumpDir   :: String
+    , maxLoops  :: Integer
+    , cmpRecArg :: RecArgComp
+    , colWidth  :: Integer
+    , context   :: !ModuleCtx
+    , history   :: M.Map ([Name],[Name]) [String]  
hunk ./src/UI/UIStarter.hs 78
-    , maxHypos  = 5
+    , maxLoops  = 20
+    , cmpRecArg = Linear
hunk ./src/UI/UIStarter.hs 136
-runCmd s Info                   = displayIO stdout ((render s) $ getSettings s) >> return (False,s)
+runCmd s Info                   = display s (getSettings s) >> return (False,s)
hunk ./src/UI/UIStarter.hs 148
-    if q then
-        return qs
-     else
-        foldUntil f state' ls
+    if q then return qs
+     else foldUntil f state' ls
hunk ./src/UI/UIStarter.hs 251
-            (t,res) <- time (return $ startSynthesis ts bs)
+            (t,res) <- time (return $ startSynthesis newConfig ts bs)
hunk ./src/UI/UIStarter.hs 255
+    where
+    newConfig = Conf (debug s) (maxLoops s) (cmpRecArg s) tgts bgks
hunk ./src/UI/UIStarter.hs 400
-            colWidth,  \ v s -> s { colWidth = v})
+            colWidth,  \ v s -> s { colWidth = v}),
+      ("maxLoops",          "stop synthesis after 'n' cylces (debug only)",
+            maxLoops,  \ v s -> s { maxLoops = v})
hunk ./src/UI/UIStarter.hs 408
-            dumpDir,  \ v s -> s { dumpDir = v})
+            dumpDir,  \ v s -> s { dumpDir = v}),
+      ("recArgCmp",        "How to compare recursive arguments to to ensure termination",
+            show.cmpRecArg,  \ v s -> s { cmpRecArg = read v})
hunk ./src/UI/UIStarter.hs 415
-getSettings s =  
+getSettings s = 
hunk ./src/UI/UIStarter.hs 434
-        fill 25 ((fill 15 (text name) <> text " = ") <> 
+        hang 30 $ fill 30 ((fill 15 (text name) <> text " = ") <> 
hunk ./src/UI/UIStarter.hs 436
-                      text descr 
+                        fillSep (map text (words descr)) 
hunk ./src/UI/UIStarter.hs 441
-        fill 25 ((fill 15 (pretty n) <+> text "|->") <+> 
+        fill 30 ((fill 15 (pretty n) <+> text "|->") <+> 