mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-21 10:49:33 -06:00
changed names of resource-1.3; added a note on homepage on release
This commit is contained in:
75
src/Transfer/CompilerAPI.hs
Normal file
75
src/Transfer/CompilerAPI.hs
Normal file
@@ -0,0 +1,75 @@
|
||||
module Transfer.CompilerAPI where
|
||||
|
||||
import Transfer.Syntax.Lex
|
||||
import Transfer.Syntax.Par
|
||||
import Transfer.Syntax.Print
|
||||
import Transfer.Syntax.Abs
|
||||
import Transfer.Syntax.Layout
|
||||
|
||||
import Transfer.ErrM
|
||||
import Transfer.SyntaxToCore
|
||||
|
||||
import Transfer.PathUtil
|
||||
|
||||
import Data.List
|
||||
import System.Directory
|
||||
|
||||
|
||||
-- | Compile a source module file to a a code file.
|
||||
compileFile :: [FilePath] -- ^ directories to look for imported modules in
|
||||
-> FilePath -- ^ source module file
|
||||
-> IO FilePath -- ^ path to the core file that was written
|
||||
compileFile path f = do
|
||||
ds <- loadModule path f
|
||||
s <- compile ds
|
||||
writeFile coreFile s
|
||||
return coreFile
|
||||
where coreFile = replaceFilenameSuffix f "trc"
|
||||
|
||||
-- | Compile a self-contained list of declarations to a core program.
|
||||
compile :: Monad m => [Decl] -> m String
|
||||
compile m = return (printTree $ declsToCore m)
|
||||
|
||||
-- | Load a source module file and all its dependencies.
|
||||
loadModule :: [FilePath] -- ^ directories to look for imported modules in
|
||||
-> FilePath -- ^ source module file
|
||||
-> IO [Decl]
|
||||
loadModule = loadModule_ []
|
||||
where
|
||||
loadModule_ ms path f =
|
||||
do
|
||||
s <- readFile f
|
||||
Module is ds <- case pModule (myLLexer s) of
|
||||
Bad e -> fail $ "Parse error in " ++ f ++ ": " ++ e
|
||||
Ok m -> return m
|
||||
let load = [ i | Import (Ident i) <- is ] \\ ms
|
||||
let path' = directoryOf f : path
|
||||
files <- mapM (findFile path' . (++".tra")) load
|
||||
dss <- mapM (loadModule_ (load++ms) path) files
|
||||
return $ concat (dss++[ds])
|
||||
|
||||
myLLexer :: String -> [Token]
|
||||
myLLexer = resolveLayout True . myLexer
|
||||
|
||||
-- | Find a file in one of the given directories.
|
||||
-- Fails if the file was not found.
|
||||
findFile :: [FilePath] -- ^ directories to look in
|
||||
-> FilePath -- ^ file name to find
|
||||
-> IO FilePath
|
||||
findFile path f =
|
||||
do
|
||||
mf <- findFileM path f
|
||||
case mf of
|
||||
Nothing -> fail $ f ++ " not found in path: " ++ show path
|
||||
Just f' -> return f'
|
||||
|
||||
-- | Find a file in one of the given directories.
|
||||
findFileM :: [FilePath] -- ^ directories to look in
|
||||
-> FilePath -- ^ file name to find
|
||||
-> IO (Maybe FilePath)
|
||||
findFileM [] _ = return Nothing
|
||||
findFileM (p:ps) f =
|
||||
do
|
||||
let f' = p ++ "/" ++ f
|
||||
e <- doesFileExist f'
|
||||
if e then return (Just f') else findFileM ps f
|
||||
Reference in New Issue
Block a user