remove the example-based folder. The code is still in the archive

5 files changed, 0 insertions, 741 deletions

diff --git a/src/example-based/ExampleDemo.hs b/src/example-based/ExampleDemo.hs
deleted file mode 100644
index fe4eb501d..000000000
--- a/src/example-based/ExampleDemo.hs
+++ /dev/null
@@ -1,553 +0,0 @@
-module ExampleDemo (Environ,initial,getNext, provideExample, testThis,mkFuncWithArg,searchGoodTree,isMeta)
-  where
-
-import PGF
---import System.IO
-import Data.List
---import Control.Monad
-import qualified Data.Map as Map
---import qualified Data.IntMap as IntMap
-import qualified Data.Set as Set
-import Data.Maybe
---import System.Environment (getArgs)
-import System.Random (RandomGen) --newStdGen
-
-
-type MyType = CId                                -- name of the categories from the program
-type ConcType = CId                              -- categories from the resource grammar, that we parse on
-type MyFunc = CId                                -- functions that we need to implement
---type FuncWithArg = ((MyFunc, MyType), Expr)    -- function with arguments  
-type InterInstr = [String]                       -- lincats that were generated but not written to the file
-
-
-
-data FuncWithArg = FuncWithArg 
-                      {getName :: MyFunc,        -- name of the function to generate
-                       getType :: MyType,        -- return type of the function
-                       getTypeArgs :: [MyType]  -- types of arguments 
-                       }
-       deriving (Show,Eq,Ord)
-
--- we assume that it's for English for the moment
-
-
-type TypeMap = Map.Map MyType ConcType           -- mapping found from a file
-
-type ConcMap = Map.Map MyFunc Expr               -- concrete expression after parsing
-
-data Environ = Env {getTypeMap :: TypeMap,                  -- mapping between a category in the grammar and a concrete type from RGL
-                    getConcMap :: ConcMap,                  -- concrete expression after parsing          
-                    getSigs :: Map.Map MyType [FuncWithArg], -- functions for which we have the concrete syntax already with args 
-                    getAll :: [FuncWithArg]           -- all the functions with arguments  
-                    }
-
-
-getNext :: Environ -> Environ -> ([MyFunc],[MyFunc])
-getNext env example_env = 
-  let sgs = getSigs env
-      allfuncs  = getAll env
-      names = Set.fromList $ map getName $ concat $ Map.elems sgs
-      exampleable = filter (\x -> (isJust $ getNameExpr x env) 
-                               &&
-                               (not $ Set.member x names) -- maybe drop this if you want to also rewrite from examples...
-                            ) $ map getName allfuncs
-      testeable = filter (\x -> (isJust $ getNameExpr x env ) 
-                              && 
-                               (Set.member x names)
-                          ) $ map getName allfuncs    
-
-     in (exampleable,testeable)
-
-
-provideExample :: RandomGen gen => gen -> Environ -> MyFunc -> PGF -> PGF -> Language -> Maybe (Expr,String)
-provideExample gen env myfunc parsePGF pgfFile lang = 
-      fmap giveExample $ getNameExpr myfunc env
- where 
-   giveExample e_ = 
-     let newexpr = head $ generateRandomFromDepth gen pgfFile e_ (Just 5) -- change here with the new random generator
-         ty = getType $ head $ filter (\x -> getName x == myfunc) $ getAll env
-         embeddedExpr = maybe "" (\x -> ", as in: " ++ q (linearize pgfFile lang x)) (embedInStart (getAll env) (Map.fromList [(ty,e_)]))
-         lexpr = linearize pgfFile lang newexpr  
-         q s = sq++s++sq
-         sq = "\""
-       in (newexpr,q lexpr ++ embeddedExpr)
--- question, you need the IO monad for the random generator, how to do otherwise ??
--- question can you make the expression bold/italic - somehow distinguishable from the rest ?
-
-
-
-testThis :: Environ -> MyFunc -> PGF -> Language -> Maybe String  
-testThis env myfunc parsePGF lang = 
-    fmap (linearize parsePGF lang . mapToResource env . llin env) $
-    getNameExpr myfunc env  
-
-
--- we assume that even the functions linearized by the user will still be in getSigs along with their linearization 
-
-
--- fill in the blancs of an expression that we want to linearize for testing purposes
----------------------------------------------------------------------------
-
-llin :: Environ -> Expr -> Expr 
-llin env expr = 
-     let 
-         (id,args) = fromJust $ unApp expr
-       --cexpr = fromJust $ Map.lookup id (getConcMap env)
-     in 
-         if any isMeta args 
-              then let 
-                       sigs = concat $ Map.elems $ getSigs env
-                       tys = findExprWhich sigs id
-                    in  replaceConcArg 1 tys expr env 
-           else mkApp id $ map (llin env) args
-
-
--- argument of the meta variable to replace, list of arguments left, expression to replace, environment, current replace expression 
-replaceConcArg :: Int -> [MyType] -> Expr -> Environ -> Expr
-replaceConcArg i [] expr env = expr
-replaceConcArg i (t:ts) expr env =      -- TO DO : insert randomness here !!
-   let ss = fromJust $ Map.lookup t $ getSigs env 
-       args = filter (null . getTypeArgs) ss 
-       finArg = if null args then let l = last ss in llin env (mkApp (getName l) [mkMeta j | j <- [1..(length $ getTypeArgs l)]]) 
-                   else mkApp (getName $ last args) [] 
-    in   
-                     let newe = replaceOne i finArg expr
-                               in replaceConcArg (i+1) ts newe env       
-                   
--- replace a certain metavariable with a certain expression in another expression - return updated expression
-replaceOne :: Int -> Expr -> Expr -> Expr                               
-replaceOne i erep expr = 
-      if isMeta expr && ((fromJust $ unMeta expr) == i) 
-               then erep
-        else if isMeta expr then expr
-              else let (id,args) = fromJust $ unApp expr
-                       in  
-                        mkApp id $ map (replaceOne i erep) args
-
-
-findExprWhich :: [FuncWithArg] -> MyFunc -> [MyType]
-findExprWhich lst f = getTypeArgs $ head $ filter (\x -> getName x == f) lst 
-
-
-mapToResource :: Environ -> Expr -> Expr 
-mapToResource env expr = 
-      let (id,args) =  maybe (error $ "tried to unwrap " ++ showExpr [] expr) (\x -> x) (unApp expr)
-          cmap      = getConcMap env
-          cexp      = maybe (error $ "didn't find " ++ showCId id ++ " in  "++ show cmap) (\x -> x)  (Map.lookup id cmap)
-        in 
-        if null args then cexp
-             else let newargs = map (mapToResource env) args
-                   in replaceAllArgs cexp 1 newargs
-      where 
-      replaceAllArgs expr i []     = expr 
-      replaceAllArgs expr i (x:xs) = replaceAllArgs (replaceOne i x expr) (i+1) xs 
-   
-         
-
------------------------------------------------
-
--- embed expression in another one from the start category
-
-embedInStart :: [FuncWithArg] -> Map.Map MyType Expr -> Maybe Expr 
-embedInStart fss cs =
-  let currset = Map.toList cs 
-      nextset = Map.fromList $ concat [ if elem myt (getTypeArgs farg) 
-                     then connectWithArg (myt,exp) farg else [] 
-                        | (myt,exp) <- currset, farg <- fss]
-      nextmap = Map.union cs nextset
-      maybeExpr = Map.lookup startCateg nextset
-     in if isNothing maybeExpr then 
-               if Map.size nextmap == Map.size cs then Nothing --error $ "could't build " ++ show startCateg ++ "with " ++ show fss 
-                  else embedInStart fss nextmap
-       else return $ fromJust maybeExpr
-   where 
-      connectWithArg (myt,exp) farg = 
-             let ind = head $ elemIndices myt (getTypeArgs farg)
-              in [(getType farg, mkApp (getName farg) $ [mkMeta i | i <- [1..ind]] ++ [exp] ++ [mkMeta i | i <- [(ind + 1)..((length $ getTypeArgs farg) - 1)]])]
-               
-
-
-
-
------------------------------------------------
-{-
-updateConcMap :: Environ -> MyFunc -> Expr -> Environ
-updateConcMap env myf expr = 
-     Env (getTypeMap env) (Map.insert myf expr (getConcMap env)) (getSigs env) (getAll env)
-
- 
-updateInterInstr :: Environ -> MyType -> FuncWithArg -> Environ
-updateInterInstr env myt myf  = 
-  let  ii = getSigs env
-       newInterInstr = 
-         maybe (Map.insert myt [myf] ii) (\x -> Map.insert myt (myf:x) ii) $ Map.lookup myt ii
-      in Env (getTypeMap env) (getConcMap env) newInterInstr (getAll env)
-
-
-putSignatures :: Environ -> [FuncWithArg] -> Environ
-putSignatures env fss = 
-     Env (getTypeMap env) (getConcMap env) (mkSigs fss) (getAll env)
-      
-      
-updateEnv :: Environ -> FuncWithArg -> MyType -> Expr -> Environ 
-updateEnv env myf myt expr =  
-  let  ii = getSigs env
-       nn = getName myf
-       newInterInstr = 
-         maybe (Map.insert myt [myf] ii) (\x -> Map.insert myt (myf:x) ii) $ Map.lookup myt ii
-      in Env (getTypeMap env) (Map.insert nn expr (getConcMap env)) newInterInstr (getAll env)
--}
-
-mkSigs :: [FuncWithArg] -> Map.Map MyType [FuncWithArg]
-mkSigs fss = Map.fromListWith (++) $ zip (map getType fss) (map (\x -> [x]) fss)
-
-
-
-{------------------------------------
-lang :: String 
-lang = "Eng"
-
-
-parseLang :: Language
-parseLang = fromJust $ readLanguage "ParseEng"
-
-
-parsePGFfile :: String
-parsePGFfile = "ParseEngAbs.pgf"
-------------------------------------}
-
-
-
-
-                 
-searchGoodTree :: Environ -> Expr -> [Expr] -> IO (Maybe (Expr,Expr))
-searchGoodTree env expr [] = return Nothing
-searchGoodTree env expr (e:es) = 
-     do val <- debugReplaceArgs expr e env
-        maybe (searchGoodTree env expr es) (\x -> return $ Just (x,e)) val 
-
-
-
-getNameExpr :: MyFunc -> Environ -> Maybe Expr
-getNameExpr myfunc env = 
-    let allfunc = filter (\x -> getName x == myfunc) $ getAll env
-            in 
-        if null allfunc then Nothing
-            else getExpr (head allfunc) env
-
--- find an expression to generate where we have all the other elements available
-getExpr :: FuncWithArg -> Environ -> Maybe Expr 
-getExpr farg env =  
-  let tys = getTypeArgs farg
-      ctx = getSigs env 
-      lst = getConcTypes ctx tys 1
-    in if (all isJust lst) then  Just $ mkApp (getName farg) (map fromJust lst)
-            else  Nothing    
-     where getConcTypes context [] i = []
-           getConcTypes context (ty:types) i =  
-                let pos = Map.lookup ty context
-                   in 
-                    if isNothing pos  || (null $ fromJust pos) then [Nothing]                                                
-                          else  
-                             let mm = last $ fromJust pos
-                                 mmargs = getTypeArgs mm
-                                 newi = i + length mmargs - 1  
-                                 lst = getConcTypes (Map.insert ty (init $ (fromJust pos)) context) types (newi+1)
-                                  in                      
-                                  if (all isJust lst) then                     -- i..newi
-                                         (Just $ mkApp (getName mm) [mkMeta j | j <- [1..(length mmargs)]]) : lst 
-                                       else  [Nothing]
-      
-
-
-
-
--- only covers simple expressions with meta variables, not the rest...
-isGeneralizationOf :: Expr -> Expr -> Bool
-isGeneralizationOf genExpr testExpr = 
-  if isMeta genExpr then True
-   else if isMeta testExpr then False
-    else let genUnwrap = unApp genExpr 
-             testUnwrap = unApp testExpr
-       in if isNothing genUnwrap || isNothing testUnwrap then False -- see if you can generalize here
-           else let (gencid, genargs) = fromJust genUnwrap 
-                    (testcid, testargs) = fromJust testUnwrap
-                in 
-                   (gencid == testcid) && (length genargs == length testargs)       
-                       && (and [isGeneralizationOf g t | (g,t) <- (zip genargs testargs)])
-
-{-do lst <- getConcTypes context types (i+1)
-     return $ mkMeta i : lst -} 
-
-debugReplaceArgs :: Expr -> Expr -> Environ -> IO (Maybe Expr)
-debugReplaceArgs aexpr cexpr env = 
-  if isNothing $ unApp aexpr then return Nothing
-       else if any isNothing $ map unApp $ snd $ fromJust $ unApp aexpr then return Nothing
-     else
-       let args = map (fst.fromJust.unApp) $ snd $ fromJust $ unApp aexpr
-           concExprs = map (\x -> fromJust $ Map.lookup x $ getConcMap env) args
-         in startReplace 1 cexpr concExprs
-        where 
-          startReplace i cex []        = return $ Just cex
-          startReplace i cex (a:as)    = do val <- debugReplaceConc cex i a
-                                            maybe ( --do putStrLn $ "didn't find "++ showExpr [] a ++ " in " ++showExpr [] cexpr
-                                                       return Nothing) 
-                                                  (\x -> --do putStrLn $ "found it, the current expression is "++ showExpr [] x
-                                                            startReplace (i+1) x as) 
-                                                     val 
-                      
-debugReplaceConc :: Expr -> Int -> Expr -> IO (Maybe Expr)
-debugReplaceConc expr i e = 
-       let (newe,isThere) = searchArg expr 
-          in if isThere then return $ Just newe else return $ Nothing 
-     where   
-      searchArg e_  =  
-            if isGeneralizationOf e e_ then (mkMeta i, True)
-              else maybe (e_,False) (\(cid,args) -> let repargs = map searchArg args
-                                         in (mkApp cid (map  fst repargs), or $ map snd repargs)) $ unApp e_  
- 
-
-{-
--- replaceArgs : Original expression to parse (from abstract syntax) -> Concrete expression (parsed) 
-replaceArgs :: Expr -> Expr -> Environ -> Maybe Expr
-replaceArgs aexpr cexpr env =
-  if isNothing $ unApp aexpr then error $ "could't unwrap this "++ show aexpr 
-      else if any isNothing $ map unApp $ snd $ fromJust $ unApp aexpr then error $ "couldn't unwrap more this : "++ show aexpr
-  else 
-   let  args = map (fst.fromJust.unApp) $ snd $ fromJust $ unApp aexpr
-        concExprs = map (\x -> fromJust $ Map.lookup x $ getConcMap env) args
-          in startReplace 1 cexpr concExprs
-    where 
-      startReplace i cex []       = return cex 
-      startReplace i cex (a:as)   = maybe Nothing (\x -> startReplace (i+1) x as) $ replaceConc cex i a
-
-
-
-replaceConc :: Expr -> Int -> Expr -> Maybe Expr
-replaceConc expr i e = 
-       let (newe,isThere) = searchArg expr 
-          in if isThere then return newe else Nothing 
-     where   
-      searchArg e_  =  
-            if isGeneralizationOf e e_ then (mkMeta i, True)
-              else maybe (e_,False) (\(cid,args) -> let repargs = map searchArg args
-                                         in (mkApp cid (map  fst repargs), or $ map snd repargs)) $ unApp e_  
-
-
-
-writeResults :: Environ -> String -> IO ()
-writeResults env fileName = 
-   let cmap = getConcMap env
-       lincats = unlines $ map (\(x,y) -> "lincat " ++ showCId x ++ " = " ++ showCId y ++ " ; " ) $ Map.toList $ getTypeMap env 
-       sigs = unlines $ map 
-                  (\x -> let n = getName x 
-                             no = length $ getTypeArgs x
-                             oargs = unwords $ ("lin " ++ showCId n) : ["o"++show i | i <- [1..no]]     
-                         in (oargs ++ " = " ++ (simpleReplace $ showExpr [] $ fromJust $ Map.lookup n cmap) ++ " ; ")) $ concat $ Map.elems $ getSigs env
-    in 
-          writeFile fileName ("\n" ++ lincats ++ "\n\n" ++  sigs)  
-         
-
-simpleReplace :: String -> String 
-simpleReplace [] = []
-simpleReplace ('?':xs) = 'o' : simpleReplace xs
-simpleReplace (x:xs) = x : simpleReplace xs
--}
-
-isMeta :: Expr -> Bool
-isMeta = isJust.unMeta 
-
--- works with utf-8 characters also, as it seems
-
-
-mkFuncWithArg ::  ((CId,CId),[CId]) -> FuncWithArg
-mkFuncWithArg ((c1,c2),cids) = FuncWithArg c1 c2 cids
-
-
----------------------------------------------------------------------------------
-
-initial :: TypeMap -> ConcMap -> [FuncWithArg] -> [FuncWithArg] -> Environ
-initial tm cm fss allfs = Env tm cm (mkSigs fss) allfs
-{-
-testInit :: [FuncWithArg] -> Environ
-testInit allfs = initial lTypes Map.empty [] allfs
-
-lTypes = Map.fromList [(mkCId "Comment", mkCId "S"),(mkCId "Item", mkCId "NP"), (mkCId "Kind", mkCId "CN"), (mkCId "Quality", mkCId "AP")]
--}
-startCateg = mkCId "Comment"
--- question about either to give the startcat or not ...
-
-
-
-
-
-----------------------------------------------------------------------------------------------------------
-{-
-main = 
- do args <- getArgs
-    case args of 
-      [pgfFile] -> 
-         do pgf <- readPGF pgfFile
-            parsePGF <- readPGF parsePGFfile
-            fsWithArg <- forExample pgf
-            let funcsWithArg = map (map mkFuncWithArg) fsWithArg
-            let morpho = buildMorpho parsePGF parseLang
-            let fss = concat funcsWithArg
-            let fileName = takeWhile (/='.') pgfFile ++ lang ++ ".gf"
-            env <- start parsePGF pgf morpho (testInit fss) fss
-            putStrLn $ "Should I write the results to a file ? yes/no"
-            ans <-getLine 
-            if ans == "yes" then do writeResults env fileName
-                                    putStrLn $ "Wrote file " ++ fileName
-             else return ()  
-      _ ->  fail "usage : Testing <path-to-pgf> "
-
-
-  
-start :: PGF -> PGF -> Morpho -> Environ -> [FuncWithArg] -> IO Environ
-start parsePGF pgfFile morpho env lst = 
-  do putStrLn "Do you want examples from another language ? (no/concrete syntax name otherwise)"
-     ans1 <- getLine
-     putStrLn "Do you want testing mode ? (yes/no)"
-     ans2 <- getLine
-     case (ans1,ans2) of
-       ("no","no")    -> do putStrLn "no extra language, just the abstract syntax tree"
-                            interact env lst False Nothing 
-       (_,"no")       -> interact env lst False (readLanguage ans1)
-       ("no","yes")   -> do putStrLn "no extra language, just the abstract syntax tree"
-                            interact env lst True Nothing
-       (_,"yes")    -> interact env lst True (readLanguage ans1)
-       ("no",_)       -> do putStrLn "no extra language, just the abstract syntax tree"
-                            putStrLn $ "I assume you don't want the testing mode ... " 
-                            interact env lst False Nothing
-       (_,_)          -> do putStrLn $ "I assume you don't want the testing mode ... " 
-                            interact env lst False (readLanguage ans1)             
-  where 
-
-   interact environ [] func _ = return environ
-   interact environ (farg:fargs) boo otherLang = 
-             do 
-                maybeEnv <- basicInter farg otherLang environ boo
-                if isNothing maybeEnv then return environ
-                 else interact (fromJust maybeEnv) fargs boo otherLang                
-
-   basicInter farg js environ False = 
-       let e_ = getExpr farg environ in 
-        if isNothing e_ then return $ Just environ
-             else parseAndBuild farg js environ (getType farg) e_ Nothing 
-   basicInter farg js environ True = 
-        let (e_,e_test) = get2Expr farg environ in 
-         if isNothing e_ then return $ Just environ 
-          else if isNothing e_test then do putStrLn $ "not enough arguments "++ (showCId $ getName farg)
-                                           parseAndBuild farg js environ (getType farg) e_ Nothing  
-                    else parseAndBuild farg js environ (getType farg) e_ e_test
-
--- . head . generateRandomFrom gen2 pgfFile
-   parseAndBuild farg js environ ty e_ e_test =
-           do let expr = fromJust e_
-              gen1 <- newStdGen
-              gen2 <- newStdGen
-              let newexpr = head $ generateRandomFrom gen1 pgfFile expr
-              let embeddedExpr = maybe "***" (showExpr [] ) (embedInStart (getAll environ) (Map.fromList [(ty,expr)])) 
-              let lexpr = if isNothing js then "" else "\n-- " ++ linearize pgfFile (fromJust js) newexpr ++ " --" 
-              putStrLn $ "Give an example for " ++ (showExpr [] expr)    
-                               ++ lexpr ++ "and now"
-                               ++ "\n\nas in " ++ embeddedExpr ++ "\n\n"
-              --
-              ex <- getLine 
-              if (ex == ":q") then return Nothing  
-                    else 
-                      let ctype = fromJust $ Map.lookup (getType farg) (getTypeMap environ) in
-                         do env' <- decypher farg ex expr environ (fromJust $ readType $ showCId ctype) e_test
-                            return (Just env')
-       
-   decypher farg ex expr environ ty e_test =  
-     --do putStrLn $ "We need to parse " ++ ex ++ " as " ++ show ctype
-        let pTrees = parse parsePGF (fromJust $ readLanguage "ParseEng") ty ex  in 
-             pickTree farg expr environ ex e_test pTrees 
-             
- --  putStrLn $ "And now for testing, \n is this also correct yes/no \n ## " ++  (linearize parsePGF parseLang $ mapToResource newenv $ llin newenv e_test) ++ " ##"
-                                               
-   -- select the right tree among the options given by the parser 
-   pickTree farg expr environ ex e_test [] =  
-                let miswords = morphoMissing morpho (words ex) 
-                   in 
-                if null miswords then do putStrLn $ "all words known, but some syntactic construction is not covered by the grammar..."
-                                         return environ
-                    else do putStrLn $ "the following words are unknown, please add them to the lexicon: " ++ show miswords
-                            return environ
-   pickTree farg expr environ ex e_test [tree] = 
-                do val <- searchGoodTree environ expr [tree]  -- maybe order here after the probabilities for better precision
-                   maybe (do putStrLn $ "none of the trees is consistent with the rest of the grammar, please check arguments "
-                             return environ) 
-                         (\(x,newtree) -> let newenv = updateEnv environ farg (getType farg) x in
-                                              do putStrLn $ "the result is "++showExpr [] x
-                                                 newtestenv <- testTest newenv e_test -- question ? should it belong there - there is just one possibility of a tree... 
-                                                 return newenv) val
-   pickTree farg expr environ ex e_test parseTrees = 
-                do putStrLn $ "There is more than one possibility, do you want to choose the right tree yourself ? yes/no "
-                   putStr "  >"
-                   ans <- getLine
-                   if ans == "yes" then do pTree <- chooseRightTree parseTrees
-                                           processTree farg environ expr pTree e_test
-                     else processTree farg environ expr parseTrees e_test
-
-   -- introduce testing function, if it doesn't work, then reparse, take that tree
-   testTree envv e_test = return envv -- TO DO - add testing here
-   
-   testTest envv Nothing = return envv
-   testTest envv (Just exxpr) = testTree envv exxpr   
- 
-
-   -- allows the user to pick his own tree
-   chooseRightTree trees = return trees -- TO DO - add something clever here     
-   
-   -- selects the tree from where one can abstract over the original arguments 
-   processTree farg environ expr lsTrees e_test =
-     let trmes = if length lsTrees == 1 then "the tree is not consistent " else "none of the trees is consistent " in
-     do val <- searchGoodTree environ expr lsTrees
-        maybe (do putStrLn $ trmes ++ "with the rest of the grammar, please check arguments! "
-                  return environ) 
-                         (\(x,newtree) -> let newenv = updateEnv environ farg (getType farg) x in
-                                              do putStrLn $ "the result is "++showExpr [] x
-                                                 newtestenv <- testTest newenv e_test 
-                                                 return newenv) val
-
-
-
--------------------------------
-
-get2Expr :: FuncWithArg -> Environ -> (Maybe Expr, Maybe Expr)
-get2Expr farg env =
-  let tys = getTypeArgs farg
-      ctx = getSigs env
-      (lst1,lst2) = getConcTypes2 ctx tys 1
-      arg1 = if (all isJust lst1) then Just $ mkApp (getName farg) (map fromJust lst1) else Nothing
-      arg2 = if (all isJust lst2) then Just $ mkApp (getName farg) (map fromJust lst2) else Nothing
-   in if arg1 == arg2 then (arg1, Nothing)
-         else (arg1,arg2)
-  where 
-           getConcTypes2 context [] i = ([],[])
-           getConcTypes2 context (ty:types) i =  
-                let pos = Map.lookup ty context
-                   in 
-                    if isNothing pos  || (null $ fromJust pos) then ([Nothing],[Nothing])                                                
-                          else  
-                             let (mm,tt) = (last $ fromJust pos, head $ fromJust pos)
-                                 mmargs = getTypeArgs mm
-                                 newi = i + length mmargs - 1  
-                                 (lst1,lst2) = getConcTypes2 (Map.insert ty (init (fromJust pos)) context) types (newi+1)
-                                 ttargs = getTypeArgs tt
-                                 newtti = i + length ttargs - 1
-                                 fstArg = if (all isJust lst1) then               -- i..newi  
-                                             (Just $ mkApp (getName mm) [mkMeta j | j <- [1..(length mmargs)]]) : lst1 
-                                            else [Nothing]
-                                 sndArg = if (all isJust lst2) then 
-                                             (Just $ mkApp (getName tt) [mkMeta j | j <- [1..(length ttargs)]]) : lst2
-                                            else [Nothing]
-                              in 
-                                (fstArg,sndArg)   
-
-
--}
- 
\ No newline at end of file
diff --git a/src/example-based/ExampleService.hs b/src/example-based/ExampleService.hs
deleted file mode 100644
index e6312bf96..000000000
--- a/src/example-based/ExampleService.hs
+++ /dev/null
@@ -1,128 +0,0 @@
-module ExampleService(cgiMain,cgiMain',newPGFCache) where
-import System.Random(newStdGen)
-import System.FilePath((</>),makeRelative)
-import Data.Map(fromList)
-import Data.Char(isDigit)
-import Data.Maybe(fromJust)
-import qualified Codec.Binary.UTF8.String as UTF8 (decodeString)
-import PGF
-import GF.Compile.ToAPI
-import Network.CGI
-import Text.JSON
-import CGIUtils
-import Cache
-import qualified ExampleDemo as E
-
-newPGFCache = newCache readPGF
-
-
-cgiMain :: Cache PGF -> CGI CGIResult
-cgiMain = handleErrors . handleCGIErrors . cgiMain' "." "."
-
-cgiMain' root cwd cache =
-  do command <- getInp "command"
-     environ <- parseEnviron =<< getInp "state"
-     case command of
-       "possibilities"    -> doPossibilities environ
-       "provide_example"  -> doProvideExample root cwd cache environ
-       "abstract_example" -> doAbstractExample cwd cache environ
-       "test_function"    -> doTestFunction cwd cache environ
-       _ -> throwCGIError 400 ("Unknown command: "++command) []
-
-doPossibilities environ =
-  do example_environ <- parseEnviron =<< getInp "example_state"
-     outputJSONP (E.getNext environ example_environ)
-
-doProvideExample root cwd cache environ =
-  do Just lang <- readInput "lang"
-     fun <- getCId "fun"
-     parsePGF <- readParsePGF cwd cache
-     let adjpath path = root</>makeRelative "/" (makeRelative root cwd</>path)
-     pgf <- liftIO . readCache cache . adjpath =<< getInp "grammar"
-     gen <- liftIO newStdGen
-     let Just (e,s) = E.provideExample gen environ fun parsePGF pgf lang
-         res = (showExpr [] e,s)
-     liftIO $ logError $ "proveExample ... = "++show res
-     outputJSONP res
-
-doAbstractExample cwd cache environ =
-  do example <- getInp "input"
-     Just params <- readInput "params"
-     absstr <- getInp "abstract"
-     Just abs <- return $ readExpr absstr
-     liftIO $ logError $ "abstract = "++showExpr [] abs
-     Just cat <- readInput "cat"
-     let t = mkType [] cat []
-     parsePGF <- readParsePGF cwd cache
-     let lang:_ = languages parsePGF
-     ae <- liftIO $ abstractExample parsePGF environ lang t abs example
-     outputJSONP (fmap (\(e,_)->(exprToAPI (instExpMeta params e),e)) ae)
-
-abstractExample parsePGF env lang cat abs example =
-    E.searchGoodTree env abs (parse parsePGF lang cat example)
-
-doTestFunction cwd cache environ =
-  do fun <- getCId "fun"
-     parsePGF <- readParsePGF cwd cache
-     let lang:_ = languages parsePGF
-     Just txt <- return (E.testThis environ fun parsePGF lang)
-     outputJSONP txt
-
-getCId :: String -> CGI CId
-getCId name = maybe err return =<< fmap readCId (getInp name)
-  where err = throwCGIError 400 ("Bad "++name) []
-{-
-getLimit :: CGI Int
-getLimit = maybe err return =<< readInput "limit"
-  where err = throwCGIError 400 "Missing/bad limit" []
--}
-
-readParsePGF cwd cache =
-    do parsepgf <- getInp "parser"
-       liftIO $ readCache cache (cwd</>parsepgf)
-
-parseEnviron s = do state <- liftIO $ readIO s
-                    return $ environ state
-
-getInp name = maybe err (return . UTF8.decodeString) =<< getInput name
-  where err = throwCGIError 400 ("Missing parameter: "++name) []
-
-
-instance JSON CId where
-    showJSON = showJSON . show
-    readJSON = (readResult =<<) . readJSON
-
-instance JSON Expr where
-   showJSON = showJSON . showExpr []
-   readJSON = (m2r . readExpr =<<) . readJSON
-
-m2r = maybe (Error "read failed") Ok
-
-readResult s = case reads s of
-                 (x,r):_ | lex r==[("","")] -> Ok x
-                 _ -> Error "read failed"
-
---------------------------------------------------------------------------------
---            cat  lincat  fun  lin       fun  cat    cat
-environ :: ([(CId, CId)],[(CId, Expr)],[((CId, CId), [CId])]) -> E.Environ
-environ (lincats,lins0,funs) =
-    E.initial (fromList lincats) concmap fs allfs
-  where
-    concmap = fromList lins
-    allfs = map E.mkFuncWithArg funs
-    fs = [E.mkFuncWithArg f | f@((fn,_),_)<-funs, fn `elem` cns]
-    cns = map fst lins
-    lins = filter (not . E.isMeta .snd) lins0
-
-
-instExpMeta :: [CId] -> Expr -> Expr
-instExpMeta ps = fromJust . readExpr . instMeta ps . showExpr []
-
-instMeta :: [CId] -> String -> String
-instMeta ps s =
-  case break (=='?') s of
-    (s1,'?':s2) ->
-       case span isDigit s2 of
-         (s21@(_:_),s22) -> s1++show (ps!!(read s21-1))++instMeta ps s22
-         ("",s22) -> s1++'?':instMeta ps s22
-    (_,_) -> s
diff --git a/src/example-based/exb-fcgi.hs b/src/example-based/exb-fcgi.hs
deleted file mode 100644
index 54f1872d0..000000000
--- a/src/example-based/exb-fcgi.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-{-# LANGUAGE CPP #-}
-import Control.Concurrent(forkIO)
-import Network.FastCGI(runFastCGI,runFastCGIConcurrent')
-import ExampleService(cgiMain,newPGFCache)
-
-main = do --stderrToFile logFile
-          fcgiMain =<< newPGFCache
-
-
-fcgiMain cache =
-#ifndef mingw32_HOST_OS
-          runFastCGIConcurrent' forkIO 100 (cgiMain cache)
-#else
-          runFastCGI (cgiMain cache)
-#endif
diff --git a/src/example-based/gf-exb.cabal b/src/example-based/gf-exb.cabal
deleted file mode 100644
index 1366e75da..000000000
--- a/src/example-based/gf-exb.cabal
+++ /dev/null
@@ -1,25 +0,0 @@
-Name: gf-exb
-Version: 1.0
-Cabal-version: >= 1.8
-Build-type: Simple
-License: GPL
-Synopsis: Example-based grammar writing for the Grammatical Framework
-
-executable exb.fcgi
-  main-is: exb-fcgi.hs
-  Hs-source-dirs: . ../server ../compiler ../runtime/haskell
-  other-modules: ExampleService ExampleDemo
-                 FastCGIUtils Cache GF.Compile.ToAPI
-                 -- and a lot more...
-  ghc-options: -threaded
-  if impl(ghc>=7.0)
-    ghc-options: -rtsopts
-
-  build-depends: base >=4.2 && <5, json, cgi, fastcgi, random,
-                 containers, old-time, directory, bytestring, utf8-string,
-                 pretty, array, mtl, fst, filepath
-
-  if os(windows)
-    ghc-options: -optl-mwindows
-  else
-    build-depends: unix
diff --git a/src/example-based/todo.txt b/src/example-based/todo.txt
deleted file mode 100644
index 196dbc097..000000000
--- a/src/example-based/todo.txt
+++ /dev/null
@@ -1,20 +0,0 @@
-
-Editor improvements for example-based grammar writing:
-+ Remove the same language from the example language menu
-+ Send the other language environment to getNext
-- Compile a new .pgf automatically when needed
-- Update buttons automatically when functions are added or removed
-- Switch over to using AbsParadigmsEng.pgf instead of the old exprToAPI function
-
-Editor support for guided construction of linearization functions
-- enter api expressions by parsing them with AbsParadigmsEng.pgf in minibar
-- replace simpleParseInput with one that accepts quoted string literals
-- use lexcode/unlexcode in minibar
-- better support for literals in minibar (completion info from the PGF
-  library should indicate if literals are acceptable)
-
-Server support for example-based grammar writing:
-- Change getNext to use info from the example language
-- Random generator restricted to defined functions
-
-- More testing