carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-11-04 19:26:10 +03:00
Code Issues Projects Releases Wiki Activity

compiler: apply hlint fixes

Browse Source
This commit is contained in:
hellerve 2019-10-30 12:16:14 +01:00
parent 4181d8139e
commit 5b50584aac
5 changed files with 14 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Commands.hs
View File

@ -805,7 +805,7 @@ commandReadFile :: CommandCallback
commandReadFile [filename] =
case filename of
XObj (Str fname) _ _ -> do
exceptional <- liftIO $ ((try $ slurp fname) :: (IO (Either IOException String)))
exceptional <- liftIO ((try $ slurp fname) :: (IO (Either IOException String)))
case exceptional of
Right contents ->
return (Right (XObj (Str contents) (Just dummyInfo) (Just StringTy)))
@ -817,10 +817,10 @@ commandReadFile [filename] =
commandWriteFile :: CommandCallback
commandWriteFile [filename, contents] =
case filename of
XObj (Str fname) _ _ -> do
XObj (Str fname) _ _ ->
case contents of
XObj (Str s) _ _ -> do
exceptional <- liftIO $ ((try $ writeFile fname s) :: (IO (Either IOException ())))
exceptional <- liftIO ((try $ writeFile fname s) :: (IO (Either IOException ())))
case exceptional of
Right () -> return dynamicNil
Left _ ->

2
src/Concretize.hs
View File

@ -110,7 +110,7 @@ concretizeXObj allowAmbiguityRoot typeEnv rootEnv visitedDefinitions root =
-- Its name will contain the name of the (normal, non-lambda) function it's contained within,
-- plus the identifier of the particular s-expression that defines the lambda.
SymPath path name = rootDefinitionPath
lambdaPath = SymPath path ("_Lambda_" ++ (lambdaToCName name (envFunctionNestingLevel envWithArgs)) ++ "_" ++ show (infoIdentifier ii))
lambdaPath = SymPath path ("_Lambda_" ++ lambdaToCName name (envFunctionNestingLevel envWithArgs) ++ "_" ++ show (infoIdentifier ii))
lambdaNameSymbol = XObj (Sym lambdaPath Symbol) (Just dummyInfo) Nothing
extendedArgs = if null capturedVars
then args

9
src/Emit.hs
View File

@ -315,12 +315,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
appendToSrc (addIndent indent' ++ tyToCLambdaFix exprTy ++ " " ++
tempVarToAvoidClash ++ " = " ++ exprVar ++ ";\n")
zipWithM_ (emitCaseMatcher (removeSuffix caseName)) caseMatchers [0..]
caseExprRetVal <- visit indent' caseExpr
when isNotVoid $
appendToSrc (addIndent indent' ++ retVar ++ " = " ++ caseExprRetVal ++ ";\n")
let Just caseLhsInfo' = caseLhsInfo
delete indent' caseLhsInfo'
appendToSrc (addIndent indent ++ "}\n")
emitCaseEnd caseLhsInfo caseExpr
emitCase exprVar isFirst (XObj (Sym firstPath _) caseLhsInfo _, caseExpr) =
-- Single variable
do appendToSrc (addIndent indent)
@ -330,6 +325,8 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
tempVarToAvoidClash ++ " = " ++ exprVar ++ ";\n")
appendToSrc (addIndent indent' ++ tyToCLambdaFix exprTy ++ " " ++
pathToC firstPath ++ " = " ++ tempVarToAvoidClash ++ ";\n") -- Store the whole expr in a variable
emitCaseEnd caseLhsInfo caseExpr
emitCaseEnd caseLhsInfo caseExpr = do
caseExprRetVal <- visit indent' caseExpr
when isNotVoid $
appendToSrc (addIndent indent' ++ retVar ++ " = " ++ caseExprRetVal ++ ";\n")

6
src/Eval.hs
View File

@ -260,7 +260,7 @@ eval env xobj =
XObj (Sym (SymPath [] "type") _) _ _ : _ ->
return (makeEvalError ctx Nothing ("Invalid args to `type`: " ++ pretty xobj) (info xobj))
[XObj (Sym (SymPath [] "meta-set!") _) _ _, target@(XObj (Sym path @(SymPath _ name) _) _ _), XObj (Str key) _ _, value] -> do
[XObj (Sym (SymPath [] "meta-set!") _) _ _, target@(XObj (Sym path @(SymPath _ name) _) _ _), XObj (Str key) _ _, value] ->
specialCommandMetaSet path key value
XObj (Sym (SymPath [] "meta-set!") _) _ _ : _ ->
return (makeEvalError ctx Nothing ("Invalid args to `meta-set!`: " ++ pretty xobj) (info xobj))
@ -846,7 +846,7 @@ specialCommandDefmodule xobj moduleName innerExpressions =
ctxAfterModuleAdditions <- liftIO $ foldM folder ctx' innerExpressions
put (popModulePath ctxAfterModuleAdditions)
return dynamicNil -- TODO: propagate errors...
Just (_, Binder existingMeta (XObj (Lst [(XObj DocStub _ _), _]) _ _)) ->
Just (_, Binder existingMeta (XObj (Lst [XObj DocStub _ _, _]) _ _)) ->
defineIt existingMeta
Just (_, Binder _ x) ->
return (makeEvalError ctx Nothing ("Can't redefine '" ++ moduleName ++ "' as module") (info xobj))
@ -1159,7 +1159,7 @@ commandLoad [xobj@(XObj (Str path) i _)] =
cur <- liftIO getCurrentDirectory
pathExists <- liftIO $ doesPathExist fpath
let cleanup = not pathExists
_ <- liftIO $ createDirectoryIfMissing True $ fpath
_ <- liftIO $ createDirectoryIfMissing True fpath
_ <- liftIO $ setCurrentDirectory fpath
(_, txt, _) <- liftIO $ readProcessWithExitCode "git" ["rev-parse", "--abbrev-ref=loose", "HEAD"] ""
if txt == "HEAD\n"

8
src/Template.hs
View File

@ -16,7 +16,7 @@ import ToTemplate
instanceBinder :: SymPath -> Ty -> Template -> String -> (String, Binder)
instanceBinder path@(SymPath _ name) actualType template docs =
let (x, _) = instantiateTemplate path actualType template
docObj = (XObj (Str docs) (Just dummyInfo) Nothing)
docObj = XObj (Str docs) (Just dummyInfo) Nothing
meta = MetaData (Map.insert "doc" docObj Map.empty)
in (name, Binder meta x)
@ -24,7 +24,7 @@ instanceBinder path@(SymPath _ name) actualType template docs =
instanceBinderWithDeps :: SymPath -> Ty -> Template -> String -> ((String, Binder), [XObj])
instanceBinderWithDeps path@(SymPath _ name) actualType template docs =
let (x, deps) = instantiateTemplate path actualType template
docObj = (XObj (Str docs) (Just dummyInfo) Nothing)
docObj = XObj (Str docs) (Just dummyInfo) Nothing
meta = MetaData (Map.insert "doc" docObj Map.empty)
in ((name, Binder meta x), deps)
@ -45,7 +45,7 @@ defineTemplate path t docs declaration definition depsFunc =
template = Template t (const declaration) (const definition) depsFunc
i = Info 0 0 (show path ++ ".template") Set.empty 0
defLst = [XObj (Deftemplate (TemplateCreator (\_ _ -> template))) Nothing Nothing, XObj (Sym path Symbol) Nothing Nothing]
docObj = (XObj (Str docs) (Just dummyInfo) Nothing)
docObj = XObj (Str docs) (Just dummyInfo) Nothing
meta = MetaData (Map.insert "doc" docObj Map.empty)
in (name, Binder meta (XObj (Lst defLst) (Just i) (Just t)))
@ -55,7 +55,7 @@ defineTypeParameterizedTemplate templateCreator path t docs =
let (SymPath _ name) = path
i = Info 0 0 (show path ++ ".parameterizedTemplate") Set.empty 0
defLst = [XObj (Deftemplate templateCreator) Nothing Nothing, XObj (Sym path Symbol) Nothing Nothing]
docObj = (XObj (Str docs) (Just dummyInfo) Nothing)
docObj = XObj (Str docs) (Just dummyInfo) Nothing
meta = MetaData (Map.insert "doc" docObj Map.empty)
in (name, Binder meta (XObj (Lst defLst) (Just i) (Just t)))