reorganize the directories under src, and rescue the JavaScript interpreter from deprecated

1 files changed, 0 insertions, 226 deletions

diff --git a/src/GF/Compile/Update.hs b/src/GF/Compile/Update.hs
deleted file mode 100644
index 1e39a2e03..000000000
--- a/src/GF/Compile/Update.hs
+++ /dev/null
@@ -1,226 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Update
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/30 18:39:44 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.8 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Compile.Update (buildAnyTree, extendModule, rebuildModule) where
-
-import GF.Infra.Ident
-import GF.Grammar.Grammar
-import GF.Grammar.Printer
-import GF.Grammar.Lookup
-import GF.Infra.Modules
-import GF.Infra.Option
-
-import GF.Data.Operations
-
-import Data.List
-import qualified Data.Map as Map
-import Control.Monad
-import Text.PrettyPrint
-
--- | combine a list of definitions into a balanced binary search tree
-buildAnyTree :: Ident -> [(Ident,Info)] -> Err (BinTree Ident Info)
-buildAnyTree m = go Map.empty
-  where
-    go map []         = return map
-    go map ((c,j):is) = do
-      case Map.lookup c map of
-        Just i  -> case unifyAnyInfo m i j of
-		     Ok k  -> go (Map.insert c k map) is
-		     Bad _ -> fail $ render (text "cannot unify the informations" $$ 
-		                             nest 4 (ppJudgement Qualified (c,i)) $$
-		                             text "and" $+$
-		                             nest 4 (ppJudgement Qualified (c,j)) $$
-		                             text "in module" <+> ppIdent m)
-        Nothing -> go (Map.insert c j map) is
-
-extendModule :: SourceGrammar -> SourceModule -> Err SourceModule
-extendModule gr (name,m)
-  ---- Just to allow inheritance in incomplete concrete (which are not
-  ---- compiled anyway), extensions are not built for them.
-  ---- Should be replaced by real control. AR 4/2/2005
-  | mstatus m == MSIncomplete && isModCnc m = return (name,m)
-  | otherwise                               = do m' <- foldM extOne m (extend m) 
-                                                 return (name,m')
- where
-   extOne mo (n,cond) = do
-     m0 <- lookupModule gr n
-
-     -- test that the module types match, and find out if the old is complete
-     testErr (sameMType (mtype m) (mtype mo)) 
-             ("illegal extension type to module" +++ showIdent name)
-
-     let isCompl = isCompleteModule m0
-
-     -- build extension in a way depending on whether the old module is complete
-     js1 <- extendMod gr isCompl (n, isInherited cond) name (jments m0) (jments mo)
-
-     -- if incomplete, throw away extension information
-     return $ 
-          if isCompl
-            then mo {jments = js1}
-            else mo {extend = filter ((/=n) . fst) (extend mo)
-                    ,mexdeps= nub (n : mexdeps mo)
-                    ,jments = js1
-                    }
-
--- | rebuilding instance + interface, and "with" modules, prior to renaming. 
--- AR 24/10/2003
-rebuildModule :: SourceGrammar -> SourceModule -> Err SourceModule
-rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ js_ ps_)) = do
-----  deps <- moduleDeps ms
-----  is   <- openInterfaces deps i
-  let is = [] ---- the method above is buggy: try "i -src" for two grs. AR 8/3/2005
-  mi'  <- case mw of
-
-    -- add the information given in interface into an instance module
-    Nothing -> do
-      testErr (null is || mstatus mi == MSIncomplete) 
-              ("module" +++ showIdent i +++ 
-               "has open interfaces and must therefore be declared incomplete") 
-      case mt of
-        MTInstance i0 -> do
-          m1 <- lookupModule gr i0
-          testErr (isModRes m1) ("interface expected instead of" +++ showIdent i0)
-          js' <- extendMod gr False (i0,const True) i (jments m1) (jments mi)
-          --- to avoid double inclusions, in instance I of I0 = J0 ** ...
-          case extends mi of
-            []  -> return $ replaceJudgements mi js'
-            j0s -> do
-                m0s <- mapM (lookupModule gr) j0s
-                let notInM0 c _  = all (not . isInBinTree c . jments) m0s
-                let js2 = filterBinTree notInM0 js'
-                return $ (replaceJudgements mi js2) 
-                  {positions = Map.union (positions m1) (positions mi)}
-        _ -> return mi
-
-    -- add the instance opens to an incomplete module "with" instances
-    Just (ext,incl,ops) -> do
-      let (infs,insts) = unzip ops
-      let stat' = ifNull MSComplete (const MSIncomplete)
-                    [i | i <- is, notElem i infs]
-      testErr (stat' == MSComplete || stat == MSIncomplete) 
-              ("module" +++ showIdent i +++ "remains incomplete")
-      ModInfo mt0 _ fs me' _ ops0 _ js ps0 <- lookupModule gr ext
-      let ops1 = nub $
-                   ops_ ++ -- N.B. js has been name-resolved already
-                   [OQualif i j | (i,j) <- ops] ++
-                   [o | o <- ops0, notElem (openedModule o) infs] ++
-                   [OQualif i i | i <- insts] ++
-                   [OSimple i   | i <- insts]
-
-      --- check if me is incomplete
-      let fs1 = fs `addOptions` fs_                           -- new flags have priority
-      let js0 = [ci | ci@(c,_) <- tree2list js, isInherited incl c]
-      let js1 = buildTree (tree2list js_ ++ js0)
-      let ps1 = Map.union ps_ ps0
-      let med1= nub (ext : infs ++ insts ++ med_)
-      return $ ModInfo mt0 stat' fs1 me Nothing ops1 med1 js1 ps1
-
-  return (i,mi')
-
--- | When extending a complete module: new information is inserted,
--- and the process is interrupted if unification fails.
--- If the extended module is incomplete, its judgements are just copied.
-extendMod :: SourceGrammar ->
-             Bool -> (Ident,Ident -> Bool) -> Ident -> 
-             BinTree Ident Info -> BinTree Ident Info -> 
-             Err (BinTree Ident Info)
-extendMod gr isCompl (name,cond) base old new = foldM try new $ Map.toList old 
-  where
-    try new (c,i)
-      | not (cond c) = return new
-      | otherwise    = case Map.lookup c new of
-                         Just j -> case unifyAnyInfo name i j of
-		                     Ok k  -> return $ updateTree (c,k) new
-		                     Bad _ -> do (base,j) <- case j of 
-		                                               AnyInd _ m -> lookupOrigInfo gr m c
-		                                               _          -> return (base,j)
-		                                 (name,i) <- case i of 
-                                                               AnyInd _ m -> lookupOrigInfo gr m c
-                                                               _          -> return (name,i)
-		                                 fail $ render (text "cannot unify the information" $$ 
-		                                                nest 4 (ppJudgement Qualified (c,i)) $$
-		                                                text "in module" <+> ppIdent name <+> text "with" $$
-		                                                nest 4 (ppJudgement Qualified (c,j)) $$
-		                                                text "in module" <+> ppIdent base)
-                         Nothing-> if isCompl
-                                     then return $ updateTree (c,indirInfo name i) new
-                                     else return $ updateTree (c,i) new
-
-    indirInfo :: Ident -> Info -> Info
-    indirInfo n info = AnyInd b n' where 
-      (b,n') = case info of
-        ResValue _ -> (True,n)
-        ResParam _ _ -> (True,n)
-        AbsFun _ _ Nothing -> (True,n) 
-        AnyInd b k -> (b,k)
-        _ -> (False,n) ---- canonical in Abs
-
-unifyAnyInfo :: Ident -> Info -> Info -> Err Info
-unifyAnyInfo m i j = case (i,j) of
-  (AbsCat mc1 mf1, AbsCat mc2 mf2) -> 
-    liftM2 AbsCat (unifMaybe mc1 mc2) (unifConstrs mf1 mf2) -- adding constrs
-  (AbsFun mt1 ma1 md1, AbsFun mt2 ma2 md2) -> 
-    liftM3 AbsFun (unifMaybe mt1 mt2) (unifAbsArrity ma1 ma2) (unifAbsDefs md1 md2) -- adding defs
-
-  (ResParam mt1 mv1, ResParam mt2 mv2) ->
-    liftM2 ResParam (unifMaybe mt1 mt2) (unifMaybe mv1 mv2)
-  (ResValue t1, ResValue t2) 
-      | t1==t2    -> return (ResValue t1)
-      | otherwise -> fail ""
-  (_, ResOverload ms t) | elem m ms ->
-    return $ ResOverload ms t
-  (ResOper mt1 m1, ResOper mt2 m2) -> 
-    liftM2 ResOper (unifMaybe mt1 mt2) (unifMaybe m1 m2)
-
-  (CncCat mc1 mf1 mp1, CncCat mc2 mf2 mp2) -> 
-    liftM3 CncCat (unifMaybe mc1 mc2) (unifMaybe mf1 mf2) (unifMaybe mp1 mp2)
-  (CncFun m mt1 md1, CncFun _ mt2 md2) -> 
-    liftM2 (CncFun m) (unifMaybe mt1 mt2) (unifMaybe md1 md2) ---- adding defs
-
-  (AnyInd b1 m1, AnyInd b2 m2) -> do
-    testErr (b1 == b2) $ "indirection status"
-    testErr (m1 == m2) $ "different sources of indirection"
-    return i
-
-  _ -> fail "informations"
-
--- | this is what happens when matching two values in the same module
-unifMaybe :: Eq a => Maybe a -> Maybe a -> Err (Maybe a)
-unifMaybe Nothing   Nothing   = return Nothing
-unifMaybe (Just p1) Nothing   = return (Just p1)
-unifMaybe Nothing   (Just p2) = return (Just p2)
-unifMaybe (Just p1) (Just p2)
-  | p1==p2                    = return (Just p1)
-  | otherwise                 = fail ""
-
-unifAbsArrity :: Maybe Int -> Maybe Int -> Err (Maybe Int)
-unifAbsArrity Nothing   Nothing   = return Nothing
-unifAbsArrity (Just a ) Nothing   = return (Just a )
-unifAbsArrity Nothing   (Just a ) = return (Just a )
-unifAbsArrity (Just a1) (Just a2)
-  | a1==a2                        = return (Just a1)
-  | otherwise                     = fail ""
-
-unifAbsDefs :: Maybe [Equation] -> Maybe [Equation] -> Err (Maybe [Equation])
-unifAbsDefs Nothing   Nothing   = return Nothing
-unifAbsDefs (Just _ ) Nothing   = fail ""
-unifAbsDefs Nothing   (Just _ ) = fail ""
-unifAbsDefs (Just xs) (Just ys) = return (Just (xs ++ ys))
-
-unifConstrs :: Maybe [Term] -> Maybe [Term] -> Err (Maybe [Term])
-unifConstrs p1 p2 = case (p1,p2) of
-  (Nothing, _)  -> return p2
-  (_, Nothing)  -> return p1
-  (Just bs, Just ds) -> return $ Just $ bs ++ ds