Skip to content
Open
Show file tree
Hide file tree
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions build.sh
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,7 @@ run . cabal_install --ghcjs ./codeworld-prediction \
./codeworld-error-sanitizer \
./codeworld-api \
./codeworld-base \
./codeworld-requirements \
./codeworld-game-api \
QuickCheck \
linear
Expand Down
7 changes: 0 additions & 7 deletions codeworld-compiler/codeworld-compiler.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -33,12 +33,6 @@ Library

Other-modules:
CodeWorld.Compile.Framework
CodeWorld.Compile.Requirements
CodeWorld.Compile.Requirements.Eval
CodeWorld.Compile.Requirements.Language
CodeWorld.Compile.Requirements.LegacyLanguage
CodeWorld.Compile.Requirements.Matcher
CodeWorld.Compile.Requirements.Types
CodeWorld.Compile.Stages

Build-depends:
Expand All @@ -54,7 +48,6 @@ Library
directory,
exceptions,
filepath,
ghc-lib-parser < 8.8,
hashable,
haskell-src-exts >= 1.20,
megaparsec,
Expand Down
12 changes: 9 additions & 3 deletions codeworld-compiler/src/CodeWorld/Compile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -86,8 +86,7 @@ compileSource stage src err mode verbose = fromMaybe CompileAborted <$>
compileStatus = CompileSuccess,
compileErrors = [],
compileReadSource = Nothing,
compileParsedSource = Nothing,
compileGHCParsedSource = Nothing
compileParsedSource = Nothing
}
timeout = case stage of
GenBase _ _ _ _ -> maxBound :: Int
Expand All @@ -101,7 +100,6 @@ build = do
checkDangerousSource
ifSucceeding checkCodeConventions
ifSucceeding compileCode
ifSucceeding checkRequirements

errPath <- gets compileOutputPath
diags <- sort <$> gets compileErrors
Expand Down Expand Up @@ -152,6 +150,10 @@ buildArgs "codeworld" =
, "base"
, "-package"
, "codeworld-base"
, "-package"
, "codeworld-requirements"
, "-fplugin"
, "CodeWorld.Requirements.RequirementsChecker"
, "-Wall"
, "-Wdeferred-type-errors"
, "-Wdeferred-out-of-scope-variables"
Expand Down Expand Up @@ -200,6 +202,10 @@ buildArgs "haskell" =
, "codeworld-api"
, "-package"
, "QuickCheck"
, "-package"
, "codeworld-requirements"
, "-fplugin"
, "CodeWorld.Requirements.RequirementsChecker"
]

runCompiler :: FilePath -> Int -> [String] -> Bool -> IO (ExitCode, Text)
Expand Down
98 changes: 1 addition & 97 deletions codeworld-compiler/src/CodeWorld/Compile/Framework.hs
Original file line number Diff line number Diff line change
Expand Up @@ -50,23 +50,6 @@ import System.IO
import System.IO.Temp (withSystemTempDirectory)
import System.Process

import qualified "ghc-lib-parser" Config as GHCParse
import qualified "ghc-lib-parser" DynFlags as GHCParse
import qualified "ghc-lib-parser" FastString as GHCParse
import qualified "ghc-lib-parser" Fingerprint as GHCParse
import qualified "ghc-lib-parser" GHC.LanguageExtensions.Type as GHCParse
import qualified "ghc-lib-parser" HeaderInfo as GHCParse
import qualified "ghc-lib-parser" HsExtension as GHCParse
import qualified "ghc-lib-parser" HsSyn as GHCParse
import qualified "ghc-lib-parser" HscTypes as GHCParse
import qualified "ghc-lib-parser" Lexer as GHCParse
import qualified "ghc-lib-parser" Panic as GHCParse
import qualified "ghc-lib-parser" Parser as GHCParse
import qualified "ghc-lib-parser" Platform as GHCParse
import qualified "ghc-lib-parser" SrcLoc as GHCParse
import qualified "ghc-lib-parser" StringBuffer as GHCParse
import qualified "ghc-lib-parser" ToolSettings as GHCParse

data Stage
= ErrorCheck
| FullBuild FilePath -- ^ Output file location
Expand Down Expand Up @@ -95,8 +78,7 @@ data CompileState = CompileState {
compileStatus :: CompileStatus,
compileErrors :: [Diagnostic],
compileReadSource :: Maybe ByteString,
compileParsedSource :: Maybe ParsedCode,
compileGHCParsedSource :: Maybe GHCParsedCode
compileParsedSource :: Maybe ParsedCode
}

type MonadCompile m = (MonadState CompileState m, MonadIO m, MonadMask m)
Expand All @@ -107,8 +89,6 @@ type Diagnostic = (SrcSpanInfo, CompileStatus, String)

data ParsedCode = Parsed (Module SrcSpanInfo) | NoParse deriving Show

data GHCParsedCode = GHCParsed (GHCParse.HsModule GHCParse.GhcPs) | GHCNoParse

getSourceCode :: MonadCompile m => m ByteString
getSourceCode = do
cached <- gets compileReadSource
Expand All @@ -131,17 +111,6 @@ getParsedCode = do
modify $ \state -> state { compileParsedSource = Just parsed }
return parsed

getGHCParsedCode :: MonadCompile m => m GHCParsedCode
getGHCParsedCode = do
cached <- gets compileGHCParsedSource
case cached of
Just parsed -> return parsed
Nothing -> do
source <- getSourceCode
parsed <- ghcParseCode ["TupleSections"] (decodeUtf8 source)
modify $ \state -> state { compileGHCParsedSource = Just parsed }
return parsed

getDiagnostics :: MonadCompile m => m [Diagnostic]
getDiagnostics = do
diags <- gets compileErrors
Expand Down Expand Up @@ -187,71 +156,6 @@ parseCode extraExts src = do
ParseOk mod -> Parsed mod
ParseFailed _ _ -> NoParse

ghcExtensionsByName :: Map String GHCParse.Extension
ghcExtensionsByName = M.fromList [
(GHCParse.flagSpecName spec, GHCParse.flagSpecFlag spec)
| spec <- GHCParse.xFlags ]

applyExtensionToFlags :: GHCParse.DynFlags -> String -> GHCParse.DynFlags
applyExtensionToFlags dflags name
| "No" `isPrefixOf` name =
GHCParse.xopt_unset dflags $ fromJust $ M.lookup (drop 2 name) ghcExtensionsByName
| otherwise =
GHCParse.xopt_set dflags $ fromJust $ M.lookup name ghcExtensionsByName

ghcParseCode :: MonadCompile m => [String] -> Text -> m GHCParsedCode
ghcParseCode extraExts src = do
sourceMode <- gets compileMode
let buffer = GHCParse.stringToStringBuffer (T.unpack src)
exts | sourceMode == "codeworld" = codeworldModeExts ++ extraExts
| otherwise = extraExts
defaultFlags = GHCParse.defaultDynFlags fakeSettings fakeLlvmConfig
dflags = foldl' applyExtensionToFlags defaultFlags exts
dflagsWithPragmas <- liftIO $
fromMaybe dflags <$> parsePragmasIntoDynFlags dflags "program.hs" buffer
let location = GHCParse.mkRealSrcLoc (GHCParse.mkFastString "program.hs") 1 1
state = GHCParse.mkPState dflagsWithPragmas buffer location
return $ case GHCParse.unP GHCParse.parseModule state of
GHCParse.POk _ (GHCParse.L _ mod) -> GHCParsed mod
GHCParse.PFailed _ -> GHCNoParse

fakeSettings :: GHCParse.Settings
fakeSettings =
GHCParse.Settings {
GHCParse.sGhcNameVersion = GHCParse.GhcNameVersion {
GHCParse.ghcNameVersion_programName = "ghcjs",
GHCParse.ghcNameVersion_projectVersion = GHCParse.cProjectVersion
},
GHCParse.sFileSettings = GHCParse.FileSettings {},
GHCParse.sTargetPlatform = GHCParse.Platform {
GHCParse.platformWordSize = 8,
GHCParse.platformOS = GHCParse.OSUnknown,
GHCParse.platformUnregisterised = True
},
GHCParse.sPlatformMisc = GHCParse.PlatformMisc {},
GHCParse.sPlatformConstants = GHCParse.PlatformConstants {
GHCParse.pc_DYNAMIC_BY_DEFAULT = False,
GHCParse.pc_WORD_SIZE = 8
},
GHCParse.sToolSettings = GHCParse.ToolSettings {
GHCParse.toolSettings_opt_P_fingerprint = GHCParse.fingerprint0
}
}

fakeLlvmConfig :: (GHCParse.LlvmTargets, GHCParse.LlvmPasses)
fakeLlvmConfig = ([], [])

parsePragmasIntoDynFlags :: GHCParse.DynFlags
-> FilePath
-> GHCParse.StringBuffer
-> IO (Maybe GHCParse.DynFlags)
parsePragmasIntoDynFlags dflags f src =
GHCParse.handleGhcException (const $ return Nothing) $
GHCParse.handleSourceError (const $ return Nothing) $ do
let opts = GHCParse.getOptions dflags src f
(dflagsWithPragmas, _, _) <- GHCParse.parseDynamicFilePragma dflags opts
return $ Just dflagsWithPragmas

addDiagnostics :: MonadCompile m => [Diagnostic] -> m ()
addDiagnostics diags = modify $ \state -> state {
compileErrors = compileErrors state ++ diags,
Expand Down
128 changes: 0 additions & 128 deletions codeworld-compiler/src/CodeWorld/Compile/Requirements.hs

This file was deleted.

Loading