summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile/Compute
diff options
context:
space:
mode:
authorInari Listenmaa <inari.listenmaa@gmail.com>2025-08-02 18:59:07 +0200
committerGitHub <noreply@github.com>2025-08-02 18:59:07 +0200
commit65e85c5a3cba4df82547a018b4135ac63551d8df (patch)
tree33a842b24b9e3851c6b6cf095f11f562b0fd6b7f /src/compiler/GF/Compile/Compute
parent981d6b9bddacee6a204ac48f2a4e27f4cca1bd47 (diff)
parent01c4f82e077b93cb2318830c56070c0ec15a20e6 (diff)
Merge pull request #175 from inariksit/new-ghc
Changes to make it work with newer stack/GHC: - unix library changed API in 2.8 - Monad of no return & Semigroup as a superclass of Monoid - import Control.Monad (join, when, (<=<)) - fixed CI issues
Diffstat (limited to 'src/compiler/GF/Compile/Compute')
-rw-r--r--src/compiler/GF/Compile/Compute/Concrete.hs18
1 files changed, 9 insertions, 9 deletions
diff --git a/src/compiler/GF/Compile/Compute/Concrete.hs b/src/compiler/GF/Compile/Compute/Concrete.hs
index 47e2f5cde..2f4504ef5 100644
--- a/src/compiler/GF/Compile/Compute/Concrete.hs
+++ b/src/compiler/GF/Compile/Compute/Concrete.hs
@@ -172,11 +172,11 @@ value env t0 =
ImplArg t -> (VImplArg.) # value env t
Table p res -> liftM2 VTblType # value env p <# value env res
RecType rs -> do lovs <- mapPairsM (value env) rs
- return $ \vs->VRecType $ mapSnd ($vs) lovs
+ return $ \vs->VRecType $ mapSnd ($ vs) lovs
t@(ExtR t1 t2) -> ((extR t.)# both id) # both (value env) (t1,t2)
FV ts -> ((vfv .) # sequence) # mapM (value env) ts
R as -> do lovs <- mapPairsM (value env.snd) as
- return $ \ vs->VRec $ mapSnd ($vs) lovs
+ return $ \ vs->VRec $ mapSnd ($ vs) lovs
T i cs -> valueTable env i cs
V ty ts -> do pvs <- paramValues env ty
((VV ty pvs .) . sequence) # mapM (value env) ts
@@ -376,10 +376,10 @@ valueTable env i cs =
where
dynamic cs' ty _ = cases cs' # value env ty
- cases cs' vty vs = err keep ($vs) (convertv cs' (vty vs))
+ cases cs' vty vs = err keep ($ vs) (convertv cs' (vty vs))
where
keep msg = --trace (msg++"\n"++render (ppTerm Unqualified 0 (T i cs))) $
- VT wild (vty vs) (mapSnd ($vs) cs')
+ VT wild (vty vs) (mapSnd ($ vs) cs')
wild = case i of TWild _ -> True; _ -> False
@@ -392,7 +392,7 @@ valueTable env i cs =
convert' cs' ((pty,vs),pvs) =
do sts <- mapM (matchPattern cs') vs
return $ \ vs -> VV pty pvs $ map (err bug id . valueMatch env)
- (mapFst ($vs) sts)
+ (mapFst ($ vs) sts)
valueCase (p,t) = do p' <- measurePatt # inlinePattMacro p
pvs <- linPattVars p'
@@ -430,19 +430,19 @@ apply' :: CompleteEnv -> Term -> [OpenValue] -> Err OpenValue
apply' env t [] = value env t
apply' env t vs =
case t of
- QC x -> return $ \ svs -> VCApp x (map ($svs) vs)
+ QC x -> return $ \ svs -> VCApp x (map ($ svs) vs)
{-
Q x@(m,f) | m==cPredef -> return $
let constr = --trace ("predef "++show x) .
VApp x
in \ svs -> maybe constr id (Map.lookup f predefs)
- $ map ($svs) vs
+ $ map ($ svs) vs
| otherwise -> do r <- resource env x
- return $ \ svs -> vapply (gloc env) r (map ($svs) vs)
+ return $ \ svs -> vapply (gloc env) r (map ($ svs) vs)
-}
App t1 t2 -> apply' env t1 . (:vs) =<< value env t2
_ -> do fv <- value env t
- return $ \ svs -> vapply (gloc env) (fv svs) (map ($svs) vs)
+ return $ \ svs -> vapply (gloc env) (fv svs) (map ($ svs) vs)
vapply :: GLocation -> Value -> [Value] -> Value
vapply loc v [] = v