GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-16 22:52:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

manually copy the "c-runtime" branch from the old repository.

Browse Source
This commit is contained in:
Krasimir Angelov
2018-11-02 14:38:44 +01:00
parent bf5abe2948
commit 5a2b200948
80 changed files with 2618 additions and 1527 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
src/compiler/GF/Infra/CheckM.hs
View File

@@ -18,7 +18,6 @@ module GF.Infra.CheckM
checkIn, checkInModule, checkMap, checkMapRecover,
parallelCheck, accumulateError, commitCheck,
) where
import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
import GF.Data.Operations
--import GF.Infra.Ident

24
src/compiler/GF/Infra/Ident.hs
View File

@@ -13,17 +13,17 @@
-----------------------------------------------------------------------------
module GF.Infra.Ident (-- ** Identifiers
ModuleName(..), moduleNameS,
Ident, ident2utf8, showIdent, prefixIdent,
-- *** Normal identifiers (returned by the parser)
identS, identC, identW,
-- *** Special identifiers for internal use
identV, identA, identAV,
argIdent, isArgIdent, getArgIndex,
varStr, varX, isWildIdent, varIndex,
-- *** Raw identifiers
RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,
isPrefixOf, showRawIdent
ModuleName(..), moduleNameS,
Ident, ident2utf8, showIdent, prefixIdent,
-- *** Normal identifiers (returned by the parser)
identS, identC, identW,
-- *** Special identifiers for internal use
identV, identA, identAV,
argIdent, isArgIdent, getArgIndex,
varStr, varX, isWildIdent, varIndex,
-- *** Raw identifiers
RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,
isPrefixOf, showRawIdent
) where
import qualified Data.ByteString.UTF8 as UTF8
@@ -31,7 +31,7 @@ import qualified Data.ByteString.Char8 as BS(append,isPrefixOf)
-- Limit use of BS functions to the ones that work correctly on
-- UTF-8-encoded bytestrings!
import Data.Char(isDigit)
import PGF.Internal(Binary(..))
import Data.Binary(Binary(..))
import GF.Text.Pretty

1
src/compiler/GF/Infra/Location.hs
View File

@@ -1,6 +1,5 @@
-- | Source locations
module GF.Infra.Location where
import Prelude hiding ((<>)) -- GHC 8.4.1 clash with Text.PrettyPrint
import GF.Text.Pretty
-- ** Source locations

17
src/compiler/GF/Infra/Option.hs
View File

@@ -34,17 +34,14 @@ import Data.Maybe
import GF.Infra.Ident
import GF.Infra.GetOpt
import GF.Grammar.Predef
--import System.Console.GetOpt
import System.FilePath
--import System.IO
import PGF.Internal(Literal(..))
import GF.Data.Operations(Err,ErrorMonad(..),liftErr)
import Data.Set (Set)
import qualified Data.Set as Set
import PGF.Internal(Literal(..))
usageHeader :: String
usageHeader = unlines
["Usage: gf [OPTIONS] [FILE [...]]",
@@ -75,7 +72,6 @@ errors = raise . unlines
data Mode = ModeVersion | ModeHelp
| ModeInteractive | ModeRun
| ModeInteractive2 | ModeRun2
| ModeCompiler
| ModeServer {-port::-}Int
deriving (Show,Eq,Ord)
@@ -153,7 +149,7 @@ data Flags = Flags {
optLiteralCats :: Set Ident,
optGFODir :: Maybe FilePath,
optOutputDir :: Maybe FilePath,
optGFLibPath :: Maybe [FilePath],
optGFLibPath :: Maybe FilePath,
optDocumentRoot :: Maybe FilePath, -- For --server mode
optRecomp :: Recomp,
optProbsFile :: Maybe FilePath,
@@ -208,10 +204,9 @@ parseModuleOptions args = do
then return opts
else errors $ map ("Non-option among module options: " ++) nonopts
fixRelativeLibPaths curr_dir lib_dirs (Options o) = Options (fixPathFlags . o)
fixRelativeLibPaths curr_dir lib_dir (Options o) = Options (fixPathFlags . o)
where
fixPathFlags f@(Flags{optLibraryPath=path}) = f{optLibraryPath=concatMap (\dir -> [parent </> dir
| parent <- curr_dir : lib_dirs]) path}
fixPathFlags f@(Flags{optLibraryPath=path}) = f{optLibraryPath=concatMap (\dir -> [curr_dir </> dir, lib_dir </> dir]) path}
-- Showing options
@@ -307,8 +302,6 @@ optDescr =
Option ['j'] ["jobs"] (OptArg jobs "N") "Compile N modules in parallel with -batch (default 1).",
Option [] ["interactive"] (NoArg (mode ModeInteractive)) "Run in interactive mode (default).",
Option [] ["run"] (NoArg (mode ModeRun)) "Run in interactive mode, showing output only (no other messages).",
Option [] ["cshell"] (NoArg (mode ModeInteractive2)) "Start the C run-time shell.",
Option [] ["crun"] (NoArg (mode ModeRun2)) "Start the C run-time shell, showing output only (no other messages).",
Option [] ["server"] (OptArg modeServer "port") $
"Run in HTTP server mode on given port (default "++show defaultPort++").",
Option [] ["document-root"] (ReqArg gfDocuRoot "DIR")
@@ -424,7 +417,7 @@ optDescr =
literalCat x = set $ \o -> o { optLiteralCats = foldr Set.insert (optLiteralCats o) ((map identS . splitBy (==',')) x) }
lexicalCat x = set $ \o -> o { optLexicalCats = foldr Set.insert (optLexicalCats o) (splitBy (==',') x) }
outDir x = set $ \o -> o { optOutputDir = Just x }
gfLibPath x = set $ \o -> o { optGFLibPath = Just $ splitInModuleSearchPath x }
gfLibPath x = set $ \o -> o { optGFLibPath = Just x }
gfDocuRoot x = set $ \o -> o { optDocumentRoot = Just x }
recomp x = set $ \o -> o { optRecomp = x }
probsFile x = set $ \o -> o { optProbsFile = Just x }

37
src/compiler/GF/Infra/UseIO.hs
View File

@@ -38,7 +38,6 @@ import Control.Monad(when,liftM,foldM)
import Control.Monad.Trans(MonadIO(..))
import Control.Monad.State(StateT,lift)
import Control.Exception(evaluate)
import Data.List (nub)
--putIfVerb :: MonadIO io => Options -> String -> io ()
putIfVerb opts msg = when (verbAtLeast opts Verbose) $ putStrLnE msg
@@ -52,32 +51,28 @@ type FullPath = String
gfLibraryPath = "GF_LIB_PATH"
gfGrammarPathVar = "GF_GRAMMAR_PATH"
getLibraryDirectory :: MonadIO io => Options -> io [FilePath]
getLibraryDirectory :: MonadIO io => Options -> io FilePath
getLibraryDirectory opts =
case flag optGFLibPath opts of
Just path -> return path
Nothing -> liftM splitSearchPath $ liftIO (catch (getEnv gfLibraryPath)
(\ex -> fmap (</> "lib") getDataDir))
Nothing -> liftIO $ catch (getEnv gfLibraryPath)
(\ex -> fmap (</> "lib") getDataDir)
getGrammarPath :: MonadIO io => [FilePath] -> io [FilePath]
getGrammarPath lib_dirs = liftIO $ do
getGrammarPath :: MonadIO io => FilePath -> io [FilePath]
getGrammarPath lib_dir = liftIO $ do
catch (fmap splitSearchPath $ getEnv gfGrammarPathVar)
(\_ -> return $ concat [[lib_dir </> "alltenses", lib_dir </> "prelude"]
| lib_dir <- lib_dirs ]) -- e.g. GF_GRAMMAR_PATH
(\_ -> return [lib_dir </> "alltenses",lib_dir </> "prelude"]) -- e.g. GF_GRAMMAR_PATH
-- | extends the search path with the
-- 'gfLibraryPath' and 'gfGrammarPathVar'
-- environment variables. Returns only existing paths.
extendPathEnv :: MonadIO io => Options -> io [FilePath]
extendPathEnv opts = liftIO $ do
let opt_path = nub $ flag optLibraryPath opts -- e.g. paths given as options
lib_dirs <- getLibraryDirectory opts -- e.g. GF_LIB_PATH
grm_path <- getGrammarPath lib_dirs -- e.g. GF_GRAMMAR_PATH
let paths = opt_path ++ lib_dirs ++ grm_path
when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: opt_path is "++ show opt_path)
when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: lib_dirs is "++ show lib_dirs)
when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: grm_path is "++ show grm_path)
ps <- liftM (nub . concat) $ mapM allSubdirs (nub paths)
let opt_path = flag optLibraryPath opts -- e.g. paths given as options
lib_dir <- getLibraryDirectory opts -- e.g. GF_LIB_PATH
grm_path <- getGrammarPath lib_dir -- e.g. GF_GRAMMAR_PATH
let paths = opt_path ++ [lib_dir] ++ grm_path
ps <- liftM concat $ mapM allSubdirs paths
mapM canonicalizePath ps
where
allSubdirs :: FilePath -> IO [FilePath]
@@ -85,15 +80,11 @@ extendPathEnv opts = liftIO $ do
allSubdirs p = case last p of
'*' -> do let path = init p
fs <- getSubdirs path
let starpaths = [path </> f | f <- fs]
when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: * found "++show starpaths)
return starpaths
return [path </> f | f <- fs]
_ -> do exists <- doesDirectoryExist p
if exists
then do
when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: found path "++show p)
return [p]
else do when (verbAtLeast opts Verbose) $ putStrLn ("extendPathEnv: allSubdirs: ignore path "++ show p)
then return [p]
else do when (verbAtLeast opts Verbose) $ putStrLn ("ignore path "++p)
return []
getSubdirs :: FilePath -> IO [FilePath]