ref: b11dd3b27e83885cc6758eea53f9e175025ed7f4
parent: 497ba0f7f14b38a758da8954ec7c10a7d2b00767
author: Lennart Augustsson <lennart@augustsson.net>
date: Fri Nov 3 12:28:51 EDT 2023
Temp
--- a/lib/Data/Either.hs
+++ b/lib/Data/Either.hs
@@ -21,5 +21,5 @@
either _ f (Right b) = f b
instance forall a b . (Show a, Show b) => Show (Either a b) where
- showsPrec p (Left a) = showParen (p>=11) (showString "Left " . showsPrec 11 a)
- showsPrec p (Right b) = showParen (p>=11) (showString "Right " . showsPrec 11 b)
+ showsPrec p (Left a) = showParen (p>=appPrec1) (showString "Left " . showsPrec appPrec1 a)
+ showsPrec p (Right b) = showParen (p>=appPrec1) (showString "Right " . showsPrec appPrec1 b)
--- a/lib/Data/Integer_Type.hs
+++ b/lib/Data/Integer_Type.hs
@@ -11,7 +11,7 @@
type Digit = Int
maxD :: Digit
-maxD = 2147483648 -- 2^31, this is used so multiplication of two digit doesn't overflow a 64 bit Int
+maxD = (2147483648::Int) -- 2^31, this is used so multiplication of two digit doesn't overflow a 64 bit Int
_integerToInt :: Integer -> Int
_integerToInt (I sign ds) = s `primIntMul` i
@@ -18,11 +18,11 @@
where
i =
case ds of
- [] -> 0
+ [] -> 0::Int
[d1] -> d1
[d1,d2] -> d1 `primIntAdd` (maxD `primIntMul` d2)
[d1,d2,d3] -> d1 `primIntAdd` (maxD `primIntMul` (d2 `primIntAdd` (maxD `primIntMul` d3)))
s =
case sign of
- Plus -> 1
+ Plus -> 1::Int
Minus -> 0 `primIntSub` 1
--- a/lib/Text/Show.hs
+++ b/lib/Text/Show.hs
@@ -34,3 +34,8 @@
where
shl [] = ']' : s
shl (y:ys) = ',' : sh y (shl ys)
+
+appPrec :: Int
+appPrec = 10
+appPrec1 :: Int
+appPrec1 = 11
--- a/src/MicroHs/Exp.hs
+++ b/src/MicroHs/Exp.hs
@@ -139,6 +139,7 @@
(quoteString s ++)
else
toStringP (encodeString s)
+ Lit (LInteger _) -> error "LInteger"
Lit l -> (showLit l ++)
Lam x e -> (("(\\" ++ showIdent x ++ " ") ++) . toStringP e . (")" ++) App f a -> ("(" ++) . toStringP f . (" " ++) . toStringP a . (")" ++)--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -777,7 +777,10 @@
env <- gets valueTable
case stLookup msg i env of
Right (Entry e s) -> return (setSLocExpr (getSLocIdent i) e, s)
- Left e -> tcError (getSLocIdent i) e
+ Left e -> do
+-- let SymTab m _ = env
+-- traceM (showListS showIdent (map fst (M.toList m)))
+ tcError (getSLocIdent i) e
tLookupV :: --XHasCallStack =>
Ident -> T (Expr, EType)
@@ -1406,7 +1409,26 @@
EOper e ies -> do e' <- tcOper e ies; tcExpr mt e'
ELam qs -> tcExprLam mt qs
- ELit loc' l -> tcLit mt loc' l
+ ELit loc' l -> do
+ case l of
+ LInteger i -> do
+ let getExpected (Infer _) = pure Nothing
+ getExpected (Check t) = do
+ t' <- derefUVar t >>= expandSyn
+ case t' of
+ EVar i -> pure (Just i)
+ _ -> pure Nothing
+ mex <- getExpected mt
+ case mex of
+ -- Convert to Int in the compiler, that way (99::Int) will never involve fromInteger
+ -- (which is not always in scope).
+ Just v | v == mkIdent nameInt -> tcLit mt loc' (LInt (fromInteger i))
+ _ -> do
+ (f, ft) <- tInferExpr (EVar (mkIdentSLoc loc' "fromInteger")) -- XXX should have this qualified somehow
+ (_at, rt) <- unArrow loc ft
+ -- We don't need to check that _at is Integer, it's part of the fromInteger type.
+ instSigma loc (EApp f ae) rt mt
+ _ -> tcLit mt loc' l
ECase a arms -> do
(ea, ta) <- tInferExpr a
tt <- tGetExpType mt
@@ -1524,7 +1546,7 @@
enum loc f = foldl EApp (EVar (mkIdentSLoc loc ("enum" ++ f)))tcLit :: Expected -> SLoc -> Lit -> T Expr
-tcLit mt loc (LInteger i) = tcLit mt loc (LInt (fromInteger i))
+--tcLit mt loc (LInteger i) = tcLit mt loc (LInt (fromInteger i))
tcLit mt loc l = do
let lit t = instSigma loc (ELit loc l) t mt
case l of
--
⑨