msyds/gf-rgl
1
0
Fork 0
forked from GitHub/gf-rgl
Code Pull Requests Activity

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

Browse Source
This commit is contained in:
Krasimir Angelov
2018-08-07 11:48:34 +02:00
parent c41015523f faf66b4a88
commit e6f924d597
8 changed files with 481 additions and 290 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

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

102
Make.bat
View File

@@ -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%

454
Make.hs
View File

@@ -1,20 +1,20 @@
import Data.List (find,intersect,isPrefixOf)
import Data.Maybe (fromJust,isJust,catMaybes)
import Data.List (find,isPrefixOf,isSuffixOf,(\\),unfoldr)
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.FilePath ((</>),(<.>))
import System.Directory (createDirectoryIfMissing,copyFile,getDirectoryContents,removeDirectoryRecursive)
import Control.Monad (unless,when)
import System.Process (rawSystem)
import System.FilePath ((</>)) -- ,takeFileName,addExtension,dropExtension)
import System.Directory (createDirectoryIfMissing,copyFile,getDirectoryContents,removeDirectoryRecursive,findFile)
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
putStrLn $ "Compiling [prelude]"
[ RGLCommand "prelude" True $ \modes args bi -> do
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 ->
parallel_ [
do let dir = getRGLBuildDir bi mode
createDirectoryIfMissing True dir
sequence_ [run_gfc bi ["-s","-make","-name=Lang"++la,
dir ++ "/Lang" ++ la ++ ".gfo"]
| l <- optl langsPGF args, let la = langCode l]
run_gfc bi (["-s","-make","-name=Lang"]++
["Lang" ++ langCode l ++ ".pgf"|l <- optl langsPGF args])
| mode <- modes]
-- Special command, invoked when command ends in .gf
, RGLCommand "modules" False $ \modes args bi -> do
let modules = getOptModules args
flip mapM_ modules $ \m -> do
mex <- findModule m
case mex of
Nothing -> die $ "Cannot find module: " ++ m
Just mfull -> flip mapM_ modes $ \mode -> do
let dst = getRGLBuildDir bi mode
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' bi mode args cs = gfcn bi mode (unwords ss) (concat fss)
where (ss,fss) = unzip [(summary f,map f as)|c<-cs,let (f,as)=c mode args]
gfcp' :: Info -> Mode -> [String] -> [Mode -> [String] -> (LangInfo -> FilePath,[LangInfo] -> [LangInfo])] -> IO ()
gfcp' bi mode args cs = do
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 f = f (LangInfo "*" "*" Nothing Nothing)
summary :: (LangInfo -> FilePath) -> [LangInfo] -> String
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)
s mode args = (symbol,optml mode langsAPI args)
c mode args = (compat,optl langsCompat args)
t mode args = (try,optml mode langsAPI args)
sc mode args = (symbolic,optml mode langsSymbolic args)
l mode args = (lang,optml mode langAll args)
s mode args = (symbol,optml mode langTry args)
c mode args = (compat,optml AllTenses langCompatibility args)
t mode args = (try,optml mode langTry args)
sc mode args = (symbolic,optml mode langSymbolic args)
optl :: [LangInfo] -> [String] -> [LangInfo]
optl = optml AllTenses
optml :: Mode -> [LangInfo] -> [String] -> [LangInfo]
optml mode ls args = getOptLangs (shrink ls) 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
optml :: Mode -> (LangInfo -> Bool) -> [String] -> ([LangInfo] -> [LangInfo])
optml mode pred args =
\langsAll ->
let langsDefault = filter (if mode == Present then langPresent else const True) (filter pred langsAll)
in getOptLangs langsAll langsDefault args
-------------------------------------------------------------------------------
-- 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
unlexer :: String -> [LangInfo] -> String
unlexer abstr ls =
"-unlexer=\\\"" ++ unwords
[ abstr ++ langCode lang ++ "=" ++ fromJust unl
| lang <- ls
, let unl = langUnlexer lang
, isJust unl] ++ "\\\""
-- | Check arguments are valid, failing on error
checkArgs :: [String] -> IO ()
checkArgs args = do
let args'' = args \\ (getOptModules args)
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
|| 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
run_gfc bi (["-s", "-no-pmcfg", preproc, "--gfo-dir="++dir] ++ files)
putStrLn $ "Building [" ++ show mode ++ "] " ++ summary
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'

60
Make.sh
View File

@@ -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
for file in "${src}"/*/${mod}???.gf; do
[[ ! -e $file ]] && continue
modules="${modules} ${file}"
modules_present=
modules_alltenses=
for lang in $langs; do
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"
# ${gfc} -no-pmcfg --gfo-dir="${dist}"/present -preproc=mkPresent "${modules}"
for module in $modules; do
${gfc} --no-pmcfg --gfo-dir="${dist}"/present -preproc=mkPresent "${module}"
echo "Building [present]"
if [ $verbose = true ]; then echo $modules_present; fi
for module in $modules_present; do
${gfc} --no-pmcfg --gfo-dir="${dist}"/present --preproc=mkPresent "${module}"
done
# Build: alltenses
echo "Building alltenses"
# ${gfc} -no-pmcfg --gfo-dir="${dist}"/alltenses "${modules}"
for module in $modules; do
echo "Building [alltenses]"
if [ $verbose = true ]; then echo $modules_alltenses; fi
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}"

54
README.md
View File

@@ -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=...]
copy [--dest=...]
install [CMD] [MODE] [--langs=[+|-]LANG,LANG,...] [--gf=...] [--dest=...]
build [CMDS] [MODE] [--langs=[+|-]LANG,LANG,...] [--gf=...] [--verbose|-v]
copy [MODE] [--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`,
`parse`
(default is `all`)
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`).
- `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 `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`.
- 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`.
## 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

45
languages.csv Normal file
View File

@@ -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,,,,,,
1 Code Directory Functor Unlexer Present All Try Symbolic Compatibility
2 Afr afrikaans n
3 Amh amharic n n
4 Ara arabic n n
5 Eus basque
6 Bul bulgarian y
7 Cat catalan Romance y y
8 Chi chinese
9 Dan danish Scand y
10 Dut dutch y
11 Eng english y y
12 Est estonian
13 Fin finnish y y
14 Fre french Romance y y
15 Grc ancient_greek y n n
16 Gre greek
17 Heb hebrew n n
18 Hin hindi Hindustani to_devanagari y
19 Hun hungarian y n n n
20 Ger german
21 Ice icelandic n
22 Ina interlingua y n n
23 Ita italian Romance y y
24 Jpn japanese
25 Lat latin y n n
26 Lav latvian y
27 Mlt maltese
28 Mon mongolian n
29 Nep nepali n
30 Nor norwegian Scand y
31 Nno nynorsk y
32 Pes persian
33 Pol polish
34 Por portuguese Romance y y
35 Pnb punjabi y
36 Ron romanian y
37 Rus russian y
38 Snd sindhi
39 Spa spanish Romance y y
40 Swa swahili n n n y
41 Swe swedish Scand y y
42 Tel telugu y n n n
43 Tha thai to_thai
44 Tur turkish n n
45 Urd urdu Hindustani

32
src/Clone.hs
View File

@@ -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

11
src/english/CompatibilityCat.gf
View File

@@ -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 ++ "."} ; ---
}