1
1
mirror of https://github.com/github/semantic.git synced 2024-11-29 02:44:36 +03:00

Address Josh's comments.

This commit is contained in:
Patrick Thomson 2018-04-30 16:53:22 -04:00
parent 2067fb7459
commit ed4ef49b70
2 changed files with 5 additions and 3 deletions

View File

@ -42,6 +42,7 @@ data TypeError resume where
NumOpError :: Type -> Type -> TypeError Type
BitOpError :: Type -> Type -> TypeError Type
UnificationError :: Type -> Type -> TypeError Type
SubscriptError :: Type -> Type -> TypeError Type
deriving instance Show (TypeError resume)
@ -49,6 +50,7 @@ instance Show1 TypeError where
liftShowsPrec _ _ _ (NumOpError l r) = showString "NumOpError " . shows [l, r]
liftShowsPrec _ _ _ (BitOpError l r) = showString "BitOpError " . shows [l, r]
liftShowsPrec _ _ _ (UnificationError l r) = showString "UnificationError " . shows [l, r]
liftShowsPrec _ _ _ (SubscriptError l r) = showString "SubscriptError " . shows [l, r]
instance Eq1 TypeError where
liftEq _ (BitOpError a b) (BitOpError c d) = a == c && b == d
@ -124,7 +126,7 @@ instance ( Alternative (m effects)
isHole ty = pure (ty == Hole)
index (Array (mem:_)) Int = pure mem
index _ _ = pure Hole
index a b = throwResumable (SubscriptError a b)
ifthenelse cond if' else' = unify cond Bool *> (if' <|> else')

View File

@ -267,12 +267,12 @@ instance ( Monad (m effects)
index = go where
tryIdx list ii
| ii > genericLength list = throwResumable @(ValueError location (Value location)) (BoundsError list ii)
| ii > genericLength list = throwValueError (BoundsError list ii)
| otherwise = pure (genericIndex list ii)
go arr idx
| (Just (Array arr, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx arr i
| (Just (Tuple tup, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx tup i
| otherwise = throwResumable @(ValueError location (Value location)) (IndexError arr idx)
| otherwise = throwValueError (IndexError arr idx)
liftNumeric f arg
| Just (Integer (Number.Integer i)) <- prjValue arg = integer $ f i