diff options
Diffstat (limited to 'src/runtime')
| -rw-r--r-- | src/runtime/c/configure.ac | 1 | ||||
| -rw-r--r-- | src/runtime/c/gu/fun.h | 6 | ||||
| -rw-r--r-- | src/runtime/haskell/Data/Binary/Builder.hs | 2 | ||||
| -rw-r--r-- | src/runtime/haskell/Data/Binary/Get.hs | 4 | ||||
| -rw-r--r-- | src/runtime/haskell/Data/Binary/Put.hs | 14 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/Expr.hs | 2 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/TypeCheck.hs | 4 |
7 files changed, 18 insertions, 15 deletions
diff --git a/src/runtime/c/configure.ac b/src/runtime/c/configure.ac index 2af669fe2..4e86e5251 100644 --- a/src/runtime/c/configure.ac +++ b/src/runtime/c/configure.ac @@ -30,6 +30,7 @@ AM_PROG_CC_C_O -Wall\ -Wextra\ -Wno-missing-field-initializers\ + -fpermissive\ -Wno-unused-parameter\ -Wno-unused-value" fi] diff --git a/src/runtime/c/gu/fun.h b/src/runtime/c/gu/fun.h index f4c1a5a38..5c14de6e9 100644 --- a/src/runtime/c/gu/fun.h +++ b/src/runtime/c/gu/fun.h @@ -12,17 +12,17 @@ typedef void (*GuFn2)(GuFn* clo, void* arg1, void* arg2); static inline void gu_apply0(GuFn* fn) { - (*fn)(fn); + ((GuFn0)(*fn))(fn); } static inline void gu_apply1(GuFn* fn, void* arg1) { - (*fn)(fn, arg1); + ((GuFn1)(*fn))(fn, arg1); } static inline void gu_apply2(GuFn* fn, void* arg1, void* arg2) { - (*fn)(fn, arg1, arg2); + ((GuFn2)(*fn))(fn, arg1, arg2); } #define gu_apply(fn_, ...) \ diff --git a/src/runtime/haskell/Data/Binary/Builder.hs b/src/runtime/haskell/Data/Binary/Builder.hs index 8dc46f816..e22fa4a4c 100644 --- a/src/runtime/haskell/Data/Binary/Builder.hs +++ b/src/runtime/haskell/Data/Binary/Builder.hs @@ -114,7 +114,7 @@ instance Semigroup Builder where instance Monoid Builder where mempty = empty {-# INLINE mempty #-} - mappend = append + mappend = (<>) {-# INLINE mappend #-} ------------------------------------------------------------------------ diff --git a/src/runtime/haskell/Data/Binary/Get.hs b/src/runtime/haskell/Data/Binary/Get.hs index a33c5c5a3..ec6309fae 100644 --- a/src/runtime/haskell/Data/Binary/Get.hs +++ b/src/runtime/haskell/Data/Binary/Get.hs @@ -127,11 +127,11 @@ instance Functor Get where {-# INLINE fmap #-} instance Applicative Get where - pure = return + pure a = Get (\s -> (a, s)) (<*>) = ap instance Monad Get where - return a = Get (\s -> (a, s)) + return = pure {-# INLINE return #-} m >>= k = Get (\s -> case unGet m s of diff --git a/src/runtime/haskell/Data/Binary/Put.hs b/src/runtime/haskell/Data/Binary/Put.hs index 189cf806f..05d23fba6 100644 --- a/src/runtime/haskell/Data/Binary/Put.hs +++ b/src/runtime/haskell/Data/Binary/Put.hs @@ -77,15 +77,20 @@ instance Functor PutM where {-# INLINE fmap #-} instance Applicative PutM where - pure = return + pure a = Put $ PairS a mempty m <*> k = Put $ let PairS f w = unPut m PairS x w' = unPut k in PairS (f x) (w `mappend` w') + m *> k = Put $ + let PairS _ w = unPut m + PairS b w' = unPut k + in PairS b (w `mappend` w') + {-# INLINE (*>) #-} -- Standard Writer monad, with aggressive inlining instance Monad PutM where - return a = Put $ PairS a mempty + return = pure {-# INLINE return #-} m >>= k = Put $ @@ -94,10 +99,7 @@ instance Monad PutM where in PairS b (w `mappend` w') {-# INLINE (>>=) #-} - m >> k = Put $ - let PairS _ w = unPut m - PairS b w' = unPut k - in PairS b (w `mappend` w') + (>>) = (*>) {-# INLINE (>>) #-} tell :: Builder -> Put diff --git a/src/runtime/haskell/PGF/Expr.hs b/src/runtime/haskell/PGF/Expr.hs index ff1114235..42c0df14e 100644 --- a/src/runtime/haskell/PGF/Expr.hs +++ b/src/runtime/haskell/PGF/Expr.hs @@ -408,7 +408,7 @@ match sig f eqs as0 = tryMatch (p ) (VMeta i envi vs ) env = VSusp i envi vs (\v -> tryMatch p v env)
tryMatch (p ) (VGen i vs ) env = VConst f as0
tryMatch (p ) (VSusp i envi vs k) env = VSusp i envi vs (\v -> tryMatch p (k v) env)
- tryMatch (p ) v@(VConst _ _ ) env = VConst f as0
+ tryMatch (p ) v@(VConst _ _ ) env = match sig f eqs as0
tryMatch (PApp f1 ps1) (VApp f2 vs2 ) env | f1 == f2 = tryMatches eqs (ps1++ps) (vs2++as) res env
tryMatch (PLit l1 ) (VLit l2 ) env | l1 == l2 = tryMatches eqs ps as res env
tryMatch (PImplArg p ) (VImplArg v ) env = tryMatch p v env
diff --git a/src/runtime/haskell/PGF/TypeCheck.hs b/src/runtime/haskell/PGF/TypeCheck.hs index 82bd47b7a..f02986fc0 100644 --- a/src/runtime/haskell/PGF/TypeCheck.hs +++ b/src/runtime/haskell/PGF/TypeCheck.hs @@ -94,11 +94,11 @@ class Selector s where select :: CId -> Scope -> Maybe Int -> TcM s (Expr,TType) instance Applicative (TcM s) where - pure = return + pure x = TcM (\abstr k h -> k x) (<*>) = ap instance Monad (TcM s) where - return x = TcM (\abstr k h -> k x) + return = pure f >>= g = TcM (\abstr k h -> unTcM f abstr (\x -> unTcM (g x) abstr k h) h) instance Selector s => Alternative (TcM s) where |