Merge branch 'master' of https://github.com/GrammaticalFramework/gf-rgl

.gitignore

@@ -3,3 +3,4 @@ dist/
 *.hi
 *.o
 *.pgf
+*.tmp

Make.bat

@@ -1,8 +1,102 @@
+@echo off
+Setlocal EnableDelayedExpansion
+
+REM ---
 REM Non-Haskell RGL build script for Windows machines
-@ECHO OFF
+REM ---
 
-REM Prelude
+REM Modules to compile for each language
+REM TODO read from languages.csv
+set langs=Afr Amh Ara Eus Bul Cat Chi Dan Dut Eng Est Fin Fre Grc Gre Heb Hin Ger Ice Ina Ita Jpn Lat Lav Mlt Mon Nep Nor Nno Pes Pol Por Pnb Ron Rus Snd Spa Swe Tha Tur Urd
+set modules_langs=All Symbol Compatibility
+set modules_api=Try Symbolic
 
-REM Present
+REM Defaults (may be overridden by options)
+set gf=gf-default
+set dest=
+set verbose=false
 
-REM All tenses
+REM Check command line options
+set arg_gf_next=false
+set arg_dest_next=false
+for %%i in (%*) do (
+  if !arg_gf_next!==true (
+    set gf=%%i
+    set arg_gf_next=false
+  )
+  if !arg_dest_next!==true (
+    set dest=%%i
+    set arg_dest_next=false
+  )
+  if %%i==-v set verbose=true
+  if %%i==--verbose set verbose=true
+  if %%i==--gf set arg_gf_next=true
+  if %%i==--dest set arg_dest_next=true
+)
+
+REM Try to determine install location
+if "%dest%"=="" (
+  set dest=%GF_LIB_PATH%
+)
+if "%dest%"=="" (
+  REM TODO Look in ../gf-core/DATA=DIR
+)
+if "%dest%"=="" (
+  echo Unable to determine where to install the RGL. Please do one of the following:
+  echo  - Pass the --dest=... flag to this script
+  echo  - Set the GF_LIB_PATH environment variable
+  REM echo  - Compile & install GF from the gf-core repository (must be in same directory as gf-rgl)
+  exit /b
+)
+
+REM A few more definitions before we get started
+set src=src
+set dist=dist
+set gfc=gf --batch --gf-lib-path=%src% --quiet
+
+REM Redirect stderr if not verbose
+if %verbose%==false (
+  set gfc=2>NUL !gfc!
+)
+
+REM Make directories if not present
+mkdir %dist%\prelude
+mkdir %dist%\present
+mkdir %dist%\alltenses
+
+REM Build: prelude
+echo Building [prelude]
+for /r %src%\prelude %%m in (*.gf) do (
+  %gfc% --gfo-dir=%dist%\prelude %%m
+)
+
+REM Gather all language modules for building
+set modules=
+for %%l in (%langs%) do (
+  for %%m in (%modules_langs%) do (
+    for /r %src% %%m in (*%%m%%l.gf) do (
+      set modules=!modules! %%m
+    )
+  )
+  for %%m in (%modules_api%) do (
+    for /r %src%\api %%m in (*%%m%%l.gf) do (
+      set modules=!modules! %%m
+    )
+  )
+)
+
+REM Build: present
+echo Building [present]
+for %%m in (%modules%) do (
+  %gfc% --no-pmcfg --gfo-dir=%dist%\present --preproc=mkPresent %%m
+)
+
+REM Build: alltenses
+echo Building [alltenses]
+for %%m in (%modules%) do (
+  %gfc% --no-pmcfg --gfo-dir=%dist%\alltenses %%m
+)
+
+REM Copy
+echo Copying to %dest%
+copy %dist% %dest%

Make.hs

@@ -1,20 +1,20 @@
-import Data.List (find,intersect,isPrefixOf)
+import Data.List (find,isPrefixOf,isSuffixOf,(\\),unfoldr)
-import Data.Maybe (fromJust,isJust,catMaybes)
+import Data.Maybe (catMaybes)
 import System.IO (hPutStrLn,stderr)
 import System.IO.Error (catchIOError)
 import System.Exit (ExitCode(..),die)
 import System.Environment (getArgs,lookupEnv)
-import System.Process (rawSystem,readProcess)
+import System.Process (rawSystem)
-import System.FilePath ((</>),(<.>))
+import System.FilePath ((</>)) -- ,takeFileName,addExtension,dropExtension)
-import System.Directory (createDirectoryIfMissing,copyFile,getDirectoryContents,removeDirectoryRecursive)
+import System.Directory (createDirectoryIfMissing,copyFile,getDirectoryContents,removeDirectoryRecursive,findFile)
-import Control.Monad (unless,when)
+import Control.Monad (when,unless)
 
 main :: IO ()
 main = do
   aargs <- getArgs
   case aargs of
     [] -> putStrLn $ "Must specify command, one of: " ++ unwords commands
-    a:_ | a `notElem` commands -> putStrLn $ "Unknown command: " ++ a ++ " (valid commands: " ++ unwords commands ++ ")"
+    a:_ | a `notElem` commands -> putStrLn $ "Unknown command: " ++ a ++ ". Valid commands: " ++ unwords commands
     "build":args -> buildRGL args
     "copy":args -> copyRGL args
     "install":args -> buildRGL args >> copyRGL args
@@ -26,18 +26,25 @@ main = do
 buildRGL :: [String] -> IO ()
 buildRGL args = do
   checkArgs args
-  let cmds = getRGLCommands args
+  let cmds = getCommands args
   let modes = getOptMode args
   info <- mkInfo
   mapM_ (\cmd -> cmdAction cmd modes args info) cmds
 
--- | Copy from dist to install location
+-- | Copy everything from dist to install location
 copyRGL :: [String] -> IO ()
 copyRGL args = do
   let modes = getOptMode args
   info <- mkInfo
   gf_lib_dir <- maybe (die errLocation) return (infoInstallDir info)
-  copyAll "prelude" (infoBuildDir info </> "prelude") (gf_lib_dir </> "prelude")
+  -- let files = getOptModules args
+  -- if not (null files)
+  -- then do
+  --   -- Copy single files
+  --   sequence_ [copyOne (flip addExtension "gfo" . dropExtension . takeFileName $ file) (getRGLBuildDir info mode) (gf_lib_dir </> getRGLBuildSubDir mode)|file<-files, mode<-modes]
+  -- else do
+    -- Copy everything
+  copyAll "Prelude" (infoBuildDir info </> "prelude") (gf_lib_dir </> "prelude")
   sequence_ [copyAll (show mode) (getRGLBuildDir info mode) (gf_lib_dir </> getRGLBuildSubDir mode)|mode<-modes]
 
 -- | Error message when install location cannot be determined
@@ -49,10 +56,17 @@ errLocation = unlines $
   , " - Compile & install GF from the gf-core repository (must be in same directory as gf-rgl)"
   ]
 
+-- | Copy single file between directories
+copyOne :: String -> FilePath -> FilePath -> IO ()
+copyOne file from to = do
+  putStrLn $ "Copying [" ++ file ++ "] " ++ to
+  createDirectoryIfMissing True to
+  copyFile (from </> file) (to </> file)
+
 -- | Copy all files between directories
 copyAll :: String -> FilePath -> FilePath -> IO ()
 copyAll msg from to = do
-  putStrLn $ "Installing [" ++ msg ++ "] " ++ to
+  putStrLn $ "Copying [" ++ msg ++ "] " ++ to
   createDirectoryIfMissing True to
   mapM_ (\file -> when (file /= "." && file /= "..") $ copyFile (from </> file) (to </> file)) =<< getDirectoryContents from
 
@@ -62,54 +76,6 @@ clean = do
   info <- mkInfo
   removeDirectoryRecursive (infoBuildDir info)
 
--- | Flag for specifying languages
--- '=' can optionally be followed by '+' or '-' to alter the default languages
-lang_flag :: String
-lang_flag = "--langs="
-
--- | Flag for specifying gf location
-gf_flag :: String
-gf_flag = "--gf="
-
--- | Flag for specifying RGL install location
-destination_flag :: String
-destination_flag = "--dest="
-
--- | Check arguments are valid
-checkArgs :: [String] -> IO ()
-checkArgs args = do
-  let args' = flip filter args (\arg -> not
-        (  arg `elem` (map cmdName rglCommands)
-        || arg `elem` all_modes
-        || lang_flag `isPrefixOf` arg
-        || gf_flag `isPrefixOf` arg
-        || destination_flag `isPrefixOf` arg
-        ))
-  unless (null args') $ die $ "Unrecognised flags: " ++ unwords args'
-  return ()
-
--- | List of languages overriding the definitions below
-getOptLangs :: [LangInfo] -> [String] -> [LangInfo]
-getOptLangs defaultLangs args =
-    case [ls | arg <- args,
-               let (f,ls) = splitAt (length lang_flag) arg,
-               f==lang_flag] of
-      ('+':ls):_ -> foldr addLang defaultLangs (seps ls)
-      ('-':ls):_ -> foldr removeLang defaultLangs (seps ls)
-      ls:_ -> findLangs langs (seps ls)
-      _    -> defaultLangs
-  where
-    seps = words . map (\c -> if c==',' then ' ' else c)
-    findLangs langs ls = [lang | lang <- langs, langCode lang `elem` ls]
-    removeLang l ls = [lang | lang <- ls, langCode lang /= l]
-    addLang l ls = if null (findLangs ls [l])
-                   then findLangs langs [l]++ls
-                   else ls
-
--- | Get flag value from list of args
-getFlag :: String -> [String] -> Maybe String
-getFlag flag args = fmap (drop (length flag)) $ find (isPrefixOf flag) args
-
 -------------------------------------------------------------------------------
 -- Paths and directories
 
@@ -117,18 +83,23 @@ getFlag flag args = fmap (drop (length flag)) $ find (isPrefixOf flag) args
 sourceDir :: FilePath
 sourceDir = "src"
 
+-- | Drop source directory prefix
+-- TODO use functions from System.FilePath
+dropSourceDir :: FilePath -> FilePath
+dropSourceDir = drop (length sourceDir + 1)
+
 -- | Information needed in build
 data Info = Info
   { infoBuildDir :: FilePath -- ^ where to put built RGL modules (fixed)
   , infoInstallDir :: Maybe FilePath -- ^ install directory (found dynamically)
   , infoGFPath :: FilePath -- ^ path to GF
-  }
+  , infoVerbose :: Bool
+  } deriving (Show)
 
 -- | Build info object from command line args
 mkInfo :: IO Info
 mkInfo = do
   args <- getArgs
-
   -- Look for install location in a few different places
   let mflag = getFlag destination_flag args
   mbuilt <- catchIOError (readFile "../gf-core/DATA_DIR" >>= \d -> return (Just (d </> "lib"))) (\e -> return Nothing)
@@ -138,11 +109,12 @@ mkInfo = do
       case catMaybes [mflag,menvar,mbuilt] of
         [] -> Nothing
         p:_ -> Just p
-
+  let verbose = verbose_switch `elem` args || verbose_switch_short `elem` args
   return $ Info
     { infoBuildDir = "dist"
     , infoInstallDir = inst_dir
     , infoGFPath = maybe default_gf id (getFlag gf_flag args)
+    , infoVerbose = verbose
     }
   where
     default_gf = "gf"
@@ -160,7 +132,7 @@ getRGLBuildSubDir mode =
 -- Build modes
 
 data Mode = AllTenses | Present
-  deriving (Show)
+  deriving (Show,Eq)
 
 all_modes :: [String]
 all_modes = ["alltenses","present"]
@@ -178,182 +150,70 @@ data RGLCommand = RGLCommand
 -- | Possible build commands
 rglCommands :: [RGLCommand]
 rglCommands =
-  [ RGLCommand "prelude" True  $ \mode args bi -> do
+  [ RGLCommand "prelude" True  $ \modes args bi -> do
-       putStrLn $ "Compiling [prelude]"
       let prelude_src_dir = sourceDir       </> "prelude"
           prelude_dst_dir = infoBuildDir bi </> "prelude"
       createDirectoryIfMissing True prelude_dst_dir
       files <- getDirectoryContents prelude_src_dir
-       run_gfc bi (["-s", "--gfo-dir="++prelude_dst_dir] ++ [prelude_src_dir </> file | file <- files, file /= "." && file /= ".."])
+      let modules = [prelude_src_dir </> file | file <- files, file /= "." && file /= ".."]
+      putStrLn $ "Building [Prelude] " ++ unwords (map dropSourceDir modules)
+      run_gfc bi ([if infoVerbose bi then "--verbose" else "--quiet", "--gfo-dir="++prelude_dst_dir] ++ modules)
 
   , RGLCommand "all"     True  $ gfcp [l,s,c,t,sc]
   , RGLCommand "lang"    False $ gfcp [l,s]
   , RGLCommand "api"     False $ gfcp [t,sc]
   , RGLCommand "compat"  False $ gfcp [c]
 
-  , RGLCommand "pgf"     False $ \modes args bi ->
+  -- Special command, invoked when command ends in .gf
-     parallel_ [
+  , RGLCommand "modules"  False $ \modes args bi ->  do
-       do let dir = getRGLBuildDir bi mode
+      let modules = getOptModules args
-          createDirectoryIfMissing True dir
+      flip mapM_ modules $ \m -> do
-          sequence_ [run_gfc bi ["-s","-make","-name=Lang"++la,
+        mex <- findModule m
-                                       dir ++ "/Lang" ++ la ++ ".gfo"]
+        case mex of
-                      | l <- optl langsPGF args, let la = langCode l]
+          Nothing -> die $ "Cannot find module: " ++ m
-          run_gfc bi (["-s","-make","-name=Lang"]++
+          Just mfull -> flip mapM_ modes $ \mode -> do
-                           ["Lang" ++ langCode l ++ ".pgf"|l <- optl langsPGF args])
+            let dst = getRGLBuildDir bi mode
-       | mode <- modes]
+            putStrLn $ "Building [" ++ show mode ++ "] " ++ dropSourceDir mfull
+            run_gfc bi [if infoVerbose bi then "--verbose" else "--quiet", "--gfo-dir="++dst, mfull]
 
-  , RGLCommand "parse"   False $ \modes args bi ->
-       gfc bi modes (summary parse) (map parse (optl langsParse args))
   ]
   where
-    gfcp :: [Mode -> [String] -> (LangInfo -> FilePath,[LangInfo])] -> [Mode] -> [String] -> Info -> IO ()
+    gfcp :: [Mode -> [String] -> (LangInfo -> FilePath,[LangInfo] -> [LangInfo])] -> [Mode] -> [String] -> Info -> IO ()
     gfcp cs modes args bi = parallel_ [gfcp' bi mode args cs | mode <- modes]
 
-    gfcp' :: Info -> Mode -> [String] -> [Mode -> [String] -> (LangInfo -> FilePath,[LangInfo])] -> IO ()
+    gfcp' :: Info -> Mode -> [String] -> [Mode -> [String] -> (LangInfo -> FilePath,[LangInfo] -> [LangInfo])] -> IO ()
-    gfcp' bi mode args cs = gfcn bi mode (unwords ss) (concat fss)
+    gfcp' bi mode args cs = do
-      where (ss,fss) = unzip [(summary f,map f as)|c<-cs,let (f,as)=c mode args]
+      langsAll <- loadLangs
+      let (ss,fss) = unzip [ (summary f langs,map f langs) | c<-cs, let (f,as) = c mode args, let langs = as langsAll]
+      gfcn bi mode (unwords ss) (concat fss)
 
-    summary :: (LangInfo -> FilePath) -> FilePath
+    summary :: (LangInfo -> FilePath) -> [LangInfo] -> String
-    summary f = f (LangInfo "*" "*" Nothing Nothing)
+    summary f langs = unwords (map (dropSourceDir . f) langs)
+    -- summary f _ = f (LangInfo "*" "*" Nothing Nothing False False False False)
 
-    l mode args = (lang,optml mode langsLang args)
+    l mode args = (lang,optml mode langAll args)
-    s mode args = (symbol,optml mode langsAPI args)
+    s mode args = (symbol,optml mode langTry args)
-    c mode args = (compat,optl langsCompat args)
+    c mode args = (compat,optml AllTenses langCompatibility args)
-    t mode args = (try,optml mode langsAPI args)
+    t mode args = (try,optml mode langTry args)
-    sc mode args = (symbolic,optml mode langsSymbolic args)
+    sc mode args = (symbolic,optml mode langSymbolic args)
 
-    optl :: [LangInfo] -> [String] -> [LangInfo]
+    optml :: Mode -> (LangInfo -> Bool) -> [String] -> ([LangInfo] -> [LangInfo])
-    optl = optml AllTenses
+    optml mode pred args =
-
+      \langsAll ->
-    optml :: Mode -> [LangInfo] -> [String] -> [LangInfo]
+        let langsDefault = filter (if mode == Present then langPresent else const True) (filter pred langsAll)
-    optml mode ls args = getOptLangs (shrink ls) args
+        in  getOptLangs langsAll langsDefault args
-      where
-        shrink = case mode of
-                   Present -> intersect langsPresent
-                   _ -> id
-
--- | Get mode from args (may be missing)
-getOptMode :: [String] -> [Mode]
-getOptMode args =
-    if null explicit_modes
-    then default_modes
-    else explicit_modes
-  where
-    explicit_modes =
-      [Present|have "present"]++
-      [AllTenses|have "alltenses"]
-    have mode = mode `elem` args
-
--- | Get RGL command from args
-getRGLCommands :: [String] -> [RGLCommand]
-getRGLCommands args =
-  let cmds0 = [cmd | arg <- args,
-                     cmd <- rglCommands,
-                     cmdName cmd == arg]
-  in if null cmds0
-       then [cmd | cmd <- rglCommands, cmdIsDef cmd]
-       else cmds0
-
--------------------------------------------------------------------------------
--- Languages of the RGL
-
--- | Information about a language
-data LangInfo = LangInfo
-  { langCode :: String -- ^ 3-letter ISO 639-2/B code
-  , langDir :: String -- ^ directory name
-  , langFunctor :: Maybe String -- ^ functor (not used)
-  , langUnlexer :: Maybe String -- ^ decoding for postprocessing linearizations
-  } deriving (Eq)
-
--- | List of all languages known to RGL
-langs :: [LangInfo]
-langs =
-  [ LangInfo "Afr" "afrikaans" Nothing Nothing
-  , LangInfo "Amh" "amharic" Nothing Nothing
-  , LangInfo "Ara" "arabic" Nothing Nothing
-  , LangInfo "Eus" "basque" Nothing Nothing
-  , LangInfo "Bul" "bulgarian" Nothing Nothing
-  , LangInfo "Cat" "catalan" (Just "Romance") Nothing
-  , LangInfo "Chi" "chinese" Nothing Nothing
-  , LangInfo "Dan" "danish" (Just "Scand") Nothing
-  , LangInfo "Dut" "dutch" Nothing Nothing
-  , LangInfo "Eng" "english" Nothing Nothing
-  , LangInfo "Est" "estonian" Nothing Nothing
-  , LangInfo "Fin" "finnish" Nothing Nothing
-  , LangInfo "Fre" "french" (Just "Romance") Nothing
-  , LangInfo "Grc" "ancient_greek" Nothing Nothing
-  , LangInfo "Gre" "greek" Nothing Nothing
-  , LangInfo "Heb" "hebrew" Nothing Nothing
-  , LangInfo "Hin" "hindi" (Just "Hindustani") (Just "to_devanagari")
-  , LangInfo "Ger" "german" Nothing Nothing
-  , LangInfo "Ice" "icelandic" Nothing Nothing
-  , LangInfo "Ina" "interlingua" Nothing Nothing
-  , LangInfo "Ita" "italian" (Just "Romance") Nothing
-  , LangInfo "Jpn" "japanese" Nothing Nothing
-  , LangInfo "Lat" "latin" Nothing Nothing
-  , LangInfo "Lav" "latvian" Nothing Nothing
-  , LangInfo "Mlt" "maltese" Nothing Nothing
-  , LangInfo "Mon" "mongolian" Nothing Nothing
-  , LangInfo "Nep" "nepali" Nothing Nothing
-  , LangInfo "Nor" "norwegian" (Just "Scand") Nothing
-  , LangInfo "Nno" "nynorsk" Nothing Nothing
-  , LangInfo "Pes" "persian" Nothing Nothing
-  , LangInfo "Pol" "polish" Nothing Nothing
-  , LangInfo "Por" "portuguese" (Just "Romance") Nothing
-  , LangInfo "Pnb" "punjabi" Nothing Nothing
-  , LangInfo "Ron" "romanian" Nothing Nothing
-  , LangInfo "Rus" "russian" Nothing Nothing
-  , LangInfo "Snd" "sindhi" Nothing Nothing
-  , LangInfo "Spa" "spanish" (Just "Romance") Nothing
-  , LangInfo "Swe" "swedish" (Just "Scand") Nothing
-  , LangInfo "Tha" "thai" Nothing (Just "to_thai")
-  , LangInfo "Tur" "turkish" Nothing Nothing
-  , LangInfo "Urd" "urdu" (Just "Hindustani") Nothing
-  ]
-
--- | Languagues for which to compile Lang
-langsLang :: [LangInfo]
-langsLang = langs
-
--- | Languages that have notpresent marked
-langsPresent :: [LangInfo]
-langsPresent = langsLang `except` ["Afr","Chi","Eus","Gre","Heb","Ice","Jpn","Mlt","Mon","Nep","Pes","Snd","Tha","Thb","Est"]
-
--- | Languages for which to compile Try
-langsAPI :: [LangInfo]
-langsAPI = langsLang `except` langsIncomplete
-
--- | Languages which compile but which are incomplete
-langsIncomplete :: [String]
-langsIncomplete = ["Amh","Ara","Grc","Heb","Ina","Lat","Tur"]
-
--- | Languages for which to compile Symbolic
-langsSymbolic :: [LangInfo]
-langsSymbolic  = langsAPI `except` ["Afr","Ice","Mon","Nep"]
-
--- | Languages for which to compile parsing grammars
-langsParse :: [LangInfo]
-langsParse = langs `only` ["Eng"]
-
--- | Languages for which langs.pgf is built
-langsPGF :: [LangInfo]
-langsPGF = langsLang `except` ["Ara","Hin","Ron","Tha"]
-
--- | Languages for which Compatibility exists (to be extended)
-langsCompat :: [LangInfo]
-langsCompat = langsLang `only` ["Cat","Eng","Fin","Fre","Ita","Lav","Spa","Swe"]
-
--- | Exclude langs from list by code
-except :: [LangInfo] -> [String] -> [LangInfo]
-except ls es = filter (flip notElem es . langCode) ls
-
--- | Only specified langs by code
-only ::  [LangInfo] -> [String] -> [LangInfo]
-only ls es = filter (flip elem es . langCode) ls
 
 -------------------------------------------------------------------------------
 -- Getting module paths/names
 
+-- | Search all language dirs for module name
+findModule :: String -> IO (Maybe FilePath)
+findModule file = do
+  langs <- loadLangs
+  let langdirs = map langDir langs
+  let searchdirs = map ((</>) sourceDir) langdirs
+  findFile searchdirs file
+
 lang :: LangInfo -> FilePath
 lang l = sourceDir </> langDir l </> ("All" ++ langCode l ++ ".gf")
 
@@ -372,17 +232,148 @@ syntax l = sourceDir </> "api" </> ("Syntax" ++ langCode l ++ ".gf")
 symbolic :: LangInfo -> FilePath
 symbolic l = sourceDir </> "api" </> ("Symbolic" ++ langCode l ++ ".gf")
 
-parse :: LangInfo -> FilePath
+-------------------------------------------------------------------------------
-parse l = sourceDir </> "parse" </> ("Parse" ++ langCode l ++ ".gf")
+-- Argument helpers
 
--- | Get unlexer flags for languages
+-- | Check arguments are valid, failing on error
-unlexer :: String -> [LangInfo] -> String
+checkArgs :: [String] -> IO ()
-unlexer abstr ls =
+checkArgs args = do
-  "-unlexer=\\\"" ++ unwords
+  let args'' = args \\ (getOptModules args)
-    [ abstr ++ langCode lang ++ "=" ++ fromJust unl
+  let args' = flip filter args'' (\arg -> not
-    | lang <- ls
+        (  arg `elem` (map cmdName rglCommands)
-    , let unl = langUnlexer lang
+        || arg `elem` all_modes
-    , isJust unl] ++ "\\\""
+        || lang_flag `isPrefixOf` arg
+        || gf_flag `isPrefixOf` arg
+        || destination_flag `isPrefixOf` arg
+        || arg `elem` [verbose_switch, verbose_switch_short]
+        ))
+  unless (null args') $ die $ "Unrecognised argument: " ++ unwords args'
+  return ()
+
+-- | Get commands from args
+getCommands :: [String] -> [RGLCommand]
+getCommands args =
+  let
+    cmdModules = head $ filter (\cmd -> cmdName cmd == "modules") rglCommands
+    cmds0 =
+      [ cmd
+      | arg <- args
+      , cmd <- rglCommands
+      , cmdName cmd == arg
+      , cmdName cmd `notElem` all_modes
+      ] ++ (if not (null (getOptModules args)) then [cmdModules] else [])
+  in if null cmds0
+       then [cmd | cmd <- rglCommands, cmdIsDef cmd]
+       else cmds0
+
+-- | Get mode from args (may be missing)
+getOptMode :: [String] -> [Mode]
+getOptMode args =
+    if null explicit_modes
+    then default_modes
+    else explicit_modes
+  where
+    explicit_modes =
+      [Present|have "present"]++
+      [AllTenses|have "alltenses"]
+    have mode = mode `elem` args
+
+-- | List of languages overriding the default definitions
+getOptLangs :: [LangInfo] -> [LangInfo] -> [String] -> [LangInfo]
+getOptLangs langs defaultLangs args =
+    case [ls | arg <- args,
+               let (f,ls) = splitAt (length lang_flag) arg,
+               f==lang_flag] of
+      ('+':ls):_ -> foldr addLang defaultLangs (seps ls)
+      ('-':ls):_ -> foldr removeLang defaultLangs (seps ls)
+      ls:_ -> findLangs langs (seps ls)
+      _    -> defaultLangs
+  where
+    seps = words . map (\c -> if c==',' then ' ' else c)
+    findLangs langs ls = [lang | lang <- langs, langCode lang `elem` ls]
+    removeLang l ls = [lang | lang <- ls, langCode lang /= l]
+    addLang l ls = if null (findLangs ls [l])
+                   then findLangs langs [l]++ls
+                   else ls
+
+-- | Get module names from arguments
+getOptModules :: [String] -> [FilePath]
+getOptModules = filter (isSuffixOf ".gf")
+
+-- | Flag for specifying languages
+-- '=' can optionally be followed by '+' or '-' to alter the default languages
+lang_flag :: String
+lang_flag = "--langs="
+
+-- | Flag for specifying gf location
+gf_flag :: String
+gf_flag = "--gf="
+
+-- | Flag for specifying RGL install location
+destination_flag :: String
+destination_flag = "--dest="
+
+-- | Switch for making verbose
+verbose_switch :: String
+verbose_switch = "--verbose"
+
+verbose_switch_short :: String
+verbose_switch_short = "-v"
+
+-- | Get flag value from list of args
+getFlag :: String -> [String] -> Maybe String
+getFlag flag args = fmap (drop (length flag)) $ find (isPrefixOf flag) args
+
+-------------------------------------------------------------------------------
+-- Languages of the RGL
+
+-- | Path to language config file
+configFile :: FilePath
+configFile = "languages.csv"
+
+-- | Information about a language
+data LangInfo = LangInfo
+  { langCode :: String -- ^ 3-letter ISO 639-2/B code
+  , langDir :: String -- ^ directory name
+  , langFunctor :: Maybe String -- ^ functor (not used)
+  , langUnlexer :: Maybe String -- ^ decoding for postprocessing linearizations
+  , langPresent :: Bool
+  , langAll :: Bool
+  , langTry :: Bool
+  , langSymbolic :: Bool
+  , langCompatibility :: Bool
+  } deriving (Show,Eq)
+
+-- | Load language information from config file
+loadLangs :: IO [LangInfo]
+loadLangs = do
+  lns <- readFile configFile >>= return . lines
+  mapM mkLangInfo (tail lns)
+  where
+    maybeBit bits n = if length bits >= (n+1) && length (bits !! n) > 0 then Just (bits !! n) else Nothing
+    boolBit bits n def = if length bits >= (n+1) && length (bits !! n) > 0 then (if def then bits !! n /= "n" else bits !! n == "y") else def
+    mkLangInfo s =
+      let bits = separateBy ',' s in
+      if length bits < 2
+      then die $ "Invalid entry in " ++ configFile ++ ": " ++ s
+      else return $ LangInfo
+            { langCode = bits !! 0
+            , langDir = bits !! 1
+            , langFunctor = maybeBit bits 2
+            , langUnlexer = maybeBit bits 3
+            , langPresent = boolBit bits 4 False
+            , langAll = boolBit bits 5 True
+            , langTry = boolBit bits 6 True
+            , langSymbolic = boolBit bits 7 True
+            , langCompatibility = boolBit bits 8 False
+            }
+
+-- | Separate a string on a character
+-- Source: https://stackoverflow.com/a/4978733/98600
+separateBy :: Eq a => a -> [a] -> [[a]]
+separateBy chr = unfoldr sep where
+  sep [] = Nothing
+  sep l  = Just . fmap (drop 1) . break (== chr) $ l
 
 -------------------------------------------------------------------------------
 -- Executing GF
@@ -392,20 +383,21 @@ gfc bi modes summary files =
   parallel_ [gfcn bi mode summary files | mode<-modes]
 
 gfcn :: Info -> Mode -> String -> [String] -> IO ()
+gfcn _ _ _ [] = die $ "No files specified.\nMake sure the language is in " ++ configFile ++ " and that it supports the modes/modules specified."
 gfcn bi mode summary files = do
   let dir = getRGLBuildDir bi mode
       preproc = case mode of
                   AllTenses -> ""
-                  Present   -> "-preproc=mkPresent"
+                  Present   -> "--preproc=mkPresent"
   createDirectoryIfMissing True dir
-  putStrLn $ "Compiling [" ++ show mode ++ "] " ++ summary
+  putStrLn $ "Building [" ++ show mode ++ "] " ++ summary
-  run_gfc bi (["-s", "-no-pmcfg", preproc, "--gfo-dir="++dir] ++ files)
+  run_gfc bi ([if infoVerbose bi then "--verbose" else "--quiet", "--no-pmcfg", preproc, "--gfo-dir="++dir] ++ files)
 
 -- | Runs the gf executable in compile mode with the given arguments
 run_gfc :: Info -> [String] -> IO ()
 run_gfc bi args = do
   let
-    args' = ["-batch","-gf-lib-path="++sourceDir] ++ filter (not . null) args
+    args' = ["--batch","--gf-lib-path="] ++ filter (not . null) args
     gf = infoGFPath bi
   execute gf args'
 

Make.sh

@@ -1,13 +1,24 @@
 #!/bin/sh
 
+# ---
 # Non-Haskell RGL build script for Unix-based machines
+# ---
 
+# Get languages from config
+langs=$(tail -n +2 languages.csv | awk -F ','  '{ if ($6 != "n") { print $1 } }')
+langs_present=$(tail -n +2 languages.csv | awk -F ','  '{ if ($5 == "y") { print $1 } }')
+langs_try=$(tail -n +2 languages.csv | awk -F ','  '{ if ($7 != "n") { print $1 } }')
+langs_symbolic=$(tail -n +2 languages.csv | awk -F ','  '{ if ($8 != "n") { print $1 } }')
+langs_compat=$(tail -n +2 languages.csv | awk -F ','  '{ if ($9 == "y") { print $1 } }')
+
+# Modules to compile for each language
 modules_langs="All Symbol Compatibility"
 modules_api="Try Symbolic"
 
 # Defaults (may be overridden by options)
 gf="gf"
 dest=""
+verbose="false"
 
 # Check command line options
 for arg in "$@"; do
@@ -16,6 +27,8 @@ for arg in "$@"; do
       gf="${arg#*=}"; shift ;;
     --dest=*)
       dest="${arg#*=}"; shift ;;
+    --verbose|-v)
+      verbose="true"; shift ;;
     *) echo "Unknown option: ${arg}" ; exit 1 ;;
   esac
 done
@@ -25,7 +38,7 @@ if [ -z "$dest" ]; then
   dest="$GF_LIB_PATH"
 fi
 if [ -z "$dest" ] && [ -f "../gf-core/DATA_DIR" ]; then
-  dest=`cat ../gf-core/DATA_DIR`
+  dest=$(cat ../gf-core/DATA_DIR)
   if [ -n "$dest" ]; then dest="${dest}/lib"; fi
 fi
 if [ -z "$dest" ]; then
@@ -39,7 +52,12 @@ fi
 # A few more definitions before we get started
 src="src"
 dist="dist"
-gfc="${gf} --batch --gf-lib-path=${src} --quiet "
+gfc="${gf} --batch --quiet"
+
+# Redirect stderr if not verbose
+if [ $verbose = false ]; then
+  exec 2> /dev/null
+fi
 
 # Make directories if not present
 mkdir -p "${dist}/prelude"
@@ -47,37 +65,39 @@ mkdir -p "${dist}/present"
 mkdir -p "${dist}/alltenses"
 
 # Build: prelude
-echo "Building prelude"
+echo "Building [prelude]"
+if [ $verbose = true ]; then echo "${src}"/prelude/*.gf; fi
 ${gfc} --gfo-dir="${dist}"/prelude "${src}"/prelude/*.gf
 
 # Gather all language modules for building
-for mod in $modules_langs; do
+modules_present=
-  for file in "${src}"/*/${mod}???.gf; do
+modules_alltenses=
-    [[ ! -e $file ]] && continue
+for lang in $langs; do
-    modules="${modules} ${file}"
+  for mod in $modules_langs $modules_api; do
+    if [ $mod == "Compatibility" ] && [[ "$langs_compat" != *"$lang"* ]]; then continue; fi
+    if [ $mod == "Try" ] && [[ "$langs_try" != *"$lang"* ]]; then continue; fi
+    if [ $mod == "Symbolic" ] && [[ "$langs_symbolic" != *"$lang"* ]]; then continue; fi
+    for file in "${src}"/*/"${mod}${lang}".gf; do
+      if [[ "$langs_present" = *"$lang"* ]]; then modules_present="${modules_present} ${file}"; fi
+      modules_alltenses="${modules_alltenses} ${file}"
     done
   done
-for mod in $modules_api; do
-  for file in "${src}"/api/${mod}???.gf; do
-    [[ ! -e $file ]] && continue
-    modules="${modules} ${file}"
-  done
 done
 
 # Build: present
-echo "Building present"
+echo "Building [present]"
-# ${gfc} -no-pmcfg --gfo-dir="${dist}"/present -preproc=mkPresent "${modules}"
+if [ $verbose = true ]; then echo $modules_present; fi
-for module in $modules; do
+for module in $modules_present; do
-  ${gfc} --no-pmcfg --gfo-dir="${dist}"/present -preproc=mkPresent "${module}"
+  ${gfc} --no-pmcfg --gfo-dir="${dist}"/present --preproc=mkPresent "${module}"
 done
 
 # Build: alltenses
-echo "Building alltenses"
+echo "Building [alltenses]"
-# ${gfc} -no-pmcfg --gfo-dir="${dist}"/alltenses "${modules}"
+if [ $verbose = true ]; then echo $modules_alltenses; fi
-for module in $modules; do
+for module in $modules_alltenses; do
   ${gfc} --no-pmcfg --gfo-dir="${dist}"/alltenses "${module}"
 done
 
 # Copy
 echo "Copying to ${dest}"
-cp -R ${dist}/* ${dest}
+cp -R "${dist}"/* "${dest}"

README.md

@@ -23,6 +23,25 @@ It will look for, in this order:
 - the file `../gf-core/DATA_DIR` (relative to this directory). This only works if you have the `gf-core` and `gf-rgl` repositories in the same top-level directory **and** you have already compiled GF from source.
 (This is considered a bit hacky and will probably disappear in the future).
 
+## Language config
+
+A list of all languages and their properties is maintained centrally in `languages.csv`.
+This file should be kept up-to-date and all build methods should read this config file.
+**If you see something wrong, please report/fix it.**
+
+Description of columns:
+- Code, e,g, `Eng`
+- Directory, e.g. `english`
+- Functor (not used)
+- Unlexer (not used)
+- Present: languages that have `--# notpresent` marked
+- All: languages for which to compile `All`
+- Try: languages for which to compile `Try`
+- Symbolic: languages for which to compile `Symbolic`
+- Compatibility: languages for which to complile `Compatibility`
+
+Columns can be a string, just `y`'s (where nothing means `n`) or just (`n`'s where nothing means `y`).
+
 ## Haskell script: `Make.hs`
 
 This build method gives you most options.
@@ -45,50 +64,55 @@ There is also `make clean` available.
 For more fine-grained control over the build process, you can run the build script directly:
 
 ```
-runghc Make.hs ...
+runghc Make ...
 ```
 
 Where `...` is one of:
 ```
-build   [CMD] [MODE] [--langs=[+|-]LANG,LANG,...] [--gf=...]
+build   [CMDS] [MODE] [--langs=[+|-]LANG,LANG,...] [--gf=...] [--verbose|-v]
-copy    [--dest=...]
+copy    [MODE] [--dest=...]
-install [CMD] [MODE] [--langs=[+|-]LANG,LANG,...] [--gf=...] [--dest=...]
+install [CMDS] [MODE] [--langs=[+|-]LANG,LANG,...] [--gf=...] [--dest=...] [--verbose|-v]
 clean
 ```
 
-- `CMD` is one of:
+- `CMDS` is one or more of:
 `prelude`,
-`all`,
+`all` (default),
 `lang`,
 `api`,
 `compat`,
-`pgf`,
+or an explicit module name (e.g. `ExtraEng.gf`. You don't need to specify to language subdirectory, but there is a restriction that the module must exist in a **direct** subdirectory of `src`).
-`parse`
-(default is `all`)
 - `MODE` is one of:
 `present`,
 `alltenses`
-(default is both)
+(default is both).
+- `LANG` is a 3-letter language code, e.g. `Eng`, `Swe` etc.
 - You can _override_ the default language list with `--langs=...`
 - You can _add_ languages to the default list with `--langs=+...`
 - You can _remove_ languages from the default list with `langs=-...`
-- `LANG` is a 3-letter language code, e.g. `Eng`, `Swe` etc.
+- The path to GF installed on your system can be specified via the `--gf` flag (default is that the `gf` executable is in the global system path).
-- The path to GF installed on your system can be specified via the `gf` flag (default is that the `gf` executable is in the global system path).
+- The `--dest` flag can be used to manually specify where the compiled RGL modules should be copied/installed. This is the same place as `GF_LIB_PATH`.
-- The `to` flag can be used to manually specify where the compiled RGL modules should be copied/installed. This is the same place as `GF_LIB_PATH`.
 
 ## Shell script: `Make.sh`
 
-This method is provided as an alternative for those who don't have Haskell installed. Simply run the script to build the entire RGL and install in the default location:
+This method is provided as an alternative for those who don't have Haskell installed.
+Simply run the script to build the entire RGL and install in the default location.
 
 You can pass the following flags:
 - `--dest=...` to manually specify the install location
 - `--gf=...` to specify the path to the `gf` executable, if not available on the system path
+- `--verbose` or `-v` to show all GF warnings and errors
 
 ## Windows batch file: `Make.bat`
 
+**This script is still untested.**
+
 This method is provided as an alternative for Windows users who don't have Haskell installed.
 
-**COMING SOON**
+It is supposed to be a port of Make.sh and works in largely the same way.
+In particular, it accepts the same flags (in the same format) as described above.
+
+However it currently tries to build all modules for all languages and doesn't consider the details of which modules should be compiled for each language (specified in `languages.csv`)
 
 ## About this repository
 

languages.csv

@@ -0,0 +1,45 @@
+Code,Directory,Functor,Unlexer,Present,All,Try,Symbolic,Compatibility
+Afr,afrikaans,,,,,,n,
+Amh,amharic,,,,,n,n,
+Ara,arabic,,,,,n,n,
+Eus,basque,,,,,,,
+Bul,bulgarian,,,y,,,,
+Cat,catalan,Romance,,y,,,,y
+Chi,chinese,,,,,,,
+Dan,danish,Scand,,y,,,,
+Dut,dutch,,,y,,,,
+Eng,english,,,y,,,,y
+Est,estonian,,,,,,,
+Fin,finnish,,,y,,,,y
+Fre,french,Romance,,y,,,,y
+Grc,ancient_greek,,,y,,n,n,
+Gre,greek,,,,,,,
+Heb,hebrew,,,,,n,n,
+Hin,hindi,Hindustani,to_devanagari,y,,,,
+Hun,hungarian,,,y,n,n,n,
+Ger,german,,,,,,,
+Ice,icelandic,,,,,,n,
+Ina,interlingua,,,y,,n,n,
+Ita,italian,Romance,,y,,,,y
+Jpn,japanese,,,,,,,
+Lat,latin,,,y,,n,n,
+Lav,latvian,,,,,,,y
+Mlt,maltese,,,,,,,
+Mon,mongolian,,,,,,n,
+Nep,nepali,,,,,,n,
+Nor,norwegian,Scand,,y,,,,
+Nno,nynorsk,,,y,,,,
+Pes,persian,,,,,,,
+Pol,polish,,,,,,,
+Por,portuguese,Romance,,y,,,,y
+Pnb,punjabi,,,y,,,,
+Ron,romanian,,,y,,,,
+Rus,russian,,,y,,,,
+Snd,sindhi,,,,,,,
+Spa,spanish,Romance,,y,,,,y
+Swa,swahili,,,,n,n,n,y
+Swe,swedish,Scand,,y,,,,y
+Tel,telugu,,,y,n,n,n,
+Tha,thai,,to_thai,,,,,
+Tur,turkish,,,,,n,n,
+Urd,urdu,Hindustani,,,,,,

src/Clone.hs

@@ -6,19 +6,24 @@ import Data.Char
 import Data.List
 import System.Process
 import System.Directory
+import System.FilePath
 import System.Environment (getArgs)
 import System.Exit
-
+import Text.Printf
 
 -- To clone a project from one language to another:
---   Clone fromdir todir fromlang tolang (--comment)
+--   Clone fromdir todir fromlang tolang
 --
 -- 1. for each Module in 'fromdir', copy Module(fromlang) to todir/Module(tolang) ; create todir if it doesn't exist
 -- 2. in each Module(tolang), replace substrings fromlang by tolang, if proper suffixes of identifiers
--- 3. If the option --comment is present, comment out every line in the body
+-- 3. repeat the above for api/Module(fromlang) to api/Module(tolang)
+-- 4. add the language to config file if not present
+-- - If the option --comment-body is present, comment out every line in the body
+-- - If the option --comment-body is present, comment out every line in the body
 --
 -- Example: runghc Clone swedish danish Swe Dan
 
+main :: IO ()
 main = do
   args <- getArgs
   if length args < 4
@@ -31,15 +36,32 @@ main = do
       createDirectoryIfMissing True todir
       mapM_ (clone options fromdir todir fromlang tolang) modules
 
+      mapM_ (\md -> clone options "api" "api" fromlang tolang (md,"")) apiModules
+      conf <- readFile configFile
+      if not (any (isPrefixOf tolang) (lines conf))
+      then do
+        appendFile configFile (printf "%s,%s\n" tolang todir)
+        printf "Language '%s' has been added to %s\n" tolang configFile
+      else return ()
+
+configFile :: FilePath
+configFile = ".." </> "languages.csv"
+
+apiModules :: [String]
+apiModules = ["Try","Symbolic","Syntax","Constructors","Combinators"]
+
+clone :: [String] -> String -> String -> String -> String -> (String, String) -> IO ()
 clone options fromdir todir from to (absname,absfx) = do
   s <- readFile (fromdir ++ "/" ++ absname ++ from ++ absfx ++ ".gf")
   writeAndReportFile (todir ++ "/" ++ absname ++ to ++ absfx ++ ".gf") (commentIf options (replaceLang from to s))
 
+getAbstractName :: String -> String -> (String, String)
 getAbstractName from file
   | isSuffixOf (from ++ "Abs.gf") file = (take (length file - (length from + 6)) file, "Abs") -- (NewDict, Abs)
   | isSuffixOf (from ++ ".gf") file = (take (length file - (length from + 3)) file, "") -- (NewDict, [])
   | otherwise = error ("Need suffix " ++ (from ++ ".gf") ++ " or " ++ (from ++ "Abs.gf") ++ " therefore cannot clone file name " ++ file)
 
+replaceLang :: String -> String -> String -> String
 replaceLang s1 s2 = repl where
   repl s = case s of
     c:cs -> case splitAt lgs s of
@@ -49,12 +71,14 @@ replaceLang s1 s2 = repl where
     _ -> s
   lgs = length s1
 
+commentIf :: [String] -> String -> String
 commentIf options =
   let commentbody  = if (elem "--comment-body" options) then commentBody else id
       dropcomments = if (elem "--drop-comments" options) then dropComments else id
   in
   unlines . commentbody . dropcomments . lines
 
+commentBody :: [String] -> [String]
 commentBody ss = header ++ map comment body ++ ["}"] where
   (header,body) = break (isJment . words) ss
   isJment ws = case ws of
@@ -65,12 +89,14 @@ commentBody ss = header ++ map comment body ++ ["}"] where
     _ | all isSpace l    -> l                -- empty line
     _ -> "--" ++ l
 
+dropComments :: [String] -> [String]
 dropComments = filter (not . isComment) where
   isComment line = case dropWhile isSpace line of
     '-':'-':'#':_ -> False
     '-':'-':_     -> True
     _             -> False
 
+writeAndReportFile :: FilePath -> String -> IO ()
 writeAndReportFile file s = do
   writeFile file s
   putStrLn $ "wrote " ++ file

src/english/CompatibilityCat.gf

@@ -1,11 +0,0 @@
---# -path=.:../romance:../abstract:../common
-
-concrete CompatibilityCat of Compatibility = CatCat ** open Prelude, CommonRomance in {
-
--- from Noun 19/4/2008
-
-lin
-    NumInt n = {s = \\_ => n.s ; isNum = True ; n = Pl} ;
-    OrdInt n = {s = \\_ => n.s ++ "."} ; ---
-
-}