ref: 497ba0f7f14b38a758da8954ec7c10a7d2b00767
parent: 15e2ba155a9f1b0260c7feceef0552b8e539b00c
author: Lennart Augustsson <lennart@augustsson.net>
date: Fri Nov 3 08:27:59 EDT 2023
Refactor Integer a little. Sadly, this broke the bootboottest (for now).
--- a/Makefile
+++ b/Makefile
@@ -22,7 +22,8 @@
all: $(EVAL) $(BIN)/$(MHS)
-everytest: runtest example examplecomb bootboottest bootcombtest
+#everytest: runtest example examplecomb bootboottest bootcombtest
+everytest: runtest example examplecomb bootcombtest
###
### Build evaluator (runtime system)
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.0
-1280
-((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _129) ((B _12) _1)) _297))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _296))) ((A :10 (((S' P) _2) (((C' _13) _1) _1040))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _126) _12) _118))) ((A :20 (((S' B) _14) (((C' _129) _12) _119))) ((A :21 _1113) ((A :22 ((B _1156) _21)) ((A :23 (((S' _1156) _21) I)) ((A :24 _1083) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1112) ((C _117) _26))) ((A :28 (((C' _27) ((_125 _1126) _98)) ((_117 (_34 _1128)) _97))) ((A :29 ((B ((S _1156) (_34 _1128))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _296)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _297)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1040)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1040))) ((A :46 ((C _43) _118)) ((A :47 ((B _120) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _120) _48)) ((A :50 T) ((A :51 ((_124 ((B (B (_115 _50))) ((B ((C' C) _54)) (B P)))) (_128 _51))) ((A :52 (((((_11 _51) ((B (_115 _50)) P)) (_38 _53)) ((B (B (_115 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_115 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_117 _352)) _54)) ((A :56 ((B (_115 _50)) (B (P _1040)))) ((A :57 ((B (_115 _50)) (BK (P _1040)))) ((A :58 ((_115 _50) ((S P) I))) ((A :59 ((B (_115 _50)) ((C (S' P)) I))) ((A :60 ((_102 ((C ((C S') _65)) I)) (_106 _60))) ((A :61 (((_1254 (K ((P (_1263 "False")) (_1263 "True")))) (_1259 _61)) (_1260 _61))) ((A :62 ((_69 _67) _68)) ((A :63 (R _68)) ((A :64 (T _67)) ((A :65 ((P _68) _67)) ((A :66 _68) ((A :67 K) ((A :68 A) ((A :69 P) ((A :70 (T K)) ((A :71 (T A)) ((A :72 (K (noDefault "Bounded.minBound"))) ((A :73 (K (noDefault "Bounded.maxBound"))) ((A :74 ((_102 _1077) _1078)) ((A :75 ((((((((_329 _74) (_338 _75)) _1079) _1080) _1081) _1082) (_343 _75)) (_344 _75))) ((A :76 ((_102 _1087) (_106 _76))) ((A :77 ((((((((_329 _76) _1086) (((C' (C' (_103 _345))) _1086) _349)) (((C' (C' (_104 _345))) _1086) _351)) (((C' (C' (_103 _345))) _1086) _351)) (((C' (C' (_104 _345))) _1086) _351)) (_343 _77)) (_344 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1088) ((A :80 _1089) ((A :81 (((S' _64) (_1080 #97)) ((C _1080) #122))) ((A :82 (((S' _64) (_1080 #65)) ((C _1080) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1080 #48)) ((C _1080) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1080 #32)) ((C _1080) #126))) ((A :87 (((S' _63) ((C (_103 _74)) #32)) (((S' _63) ((C (_103 _74)) #9)) ((C (_103 _74)) #10)))) ((A :88 ((S ((S (((S' _64) (_1080 #65)) ((C _1080) #90))) (_68 (((noMatch "lib/Data/Char.hs") #86) #9)))) ((B _79) (((C' (_314 _130)) (((C' (_315 _130)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1080 #97)) ((C _1080) #97))) (_68 (((noMatch "lib/Data/Char.hs") #90) #9)))) ((B _79) (((C' (_314 _130)) (((C' (_315 _130)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1254 (K ((C ((S ((C ==) #39)) ((B (_117 (_1262 #39))) (((C' _117) ((B _1263) _91)) (_1262 #39))))) (_1263 "'\92&''")))) (_1259 _90)) ((B (_117 (_1262 #34))) (Y ((B (P (_1262 #34))) (((S' C) ((B
\ No newline at end of file
+1287
+((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _129) ((B _12) _1)) _300))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _299))) ((A :10 (((S' P) _2) (((C' _13) _1) _1047))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _126) _12) _118))) ((A :20 (((S' B) _14) (((C' _129) _12) _119))) ((A :21 _1120) ((A :22 ((B _1163) _21)) ((A :23 (((S' _1163) _21) I)) ((A :24 _1090) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1119) ((C _117) _26))) ((A :28 (((C' _27) ((_125 _1133) _98)) ((_117 (_34 _1135)) _97))) ((A :29 ((B ((S _1163) (_34 _1135))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _299)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _300)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1047)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1047))) ((A :46 ((C _43) _118)) ((A :47 ((B _120) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _120) _48)) ((A :50 T) ((A :51 ((_124 ((B (B (_115 _50))) ((B ((C' C) _54)) (B P)))) (_128 _51))) ((A :52 (((((_11 _51) ((B (_115 _50)) P)) (_38 _53)) ((B (B (_115 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_115 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_117 _357)) _54)) ((A :56 ((B (_115 _50)) (B (P _1047)))) ((A :57 ((B (_115 _50)) (BK (P _1047)))) ((A :58 ((_115 _50) ((S P) I))) ((A :59 ((B (_115 _50)) ((C (S' P)) I))) ((A :60 ((_102 ((C ((C S') _65)) I)) (_106 _60))) ((A :61 (((_1261 (K ((P (_1270 "False")) (_1270 "True")))) (_1266 _61)) (_1267 _61))) ((A :62 ((_69 _67) _68)) ((A :63 (R _68)) ((A :64 (T _67)) ((A :65 ((P _68) _67)) ((A :66 _68) ((A :67 K) ((A :68 A) ((A :69 P) ((A :70 (T K)) ((A :71 (T A)) ((A :72 (K (noDefault "Bounded.minBound"))) ((A :73 (K (noDefault "Bounded.maxBound"))) ((A :74 ((_102 _1084) _1085)) ((A :75 ((((((((_334 _74) (_343 _75)) _1086) _1087) _1088) _1089) (_348 _75)) (_349 _75))) ((A :76 ((_102 _1094) (_106 _76))) ((A :77 ((((((((_334 _76) _1093) (((C' (C' (_103 _350))) _1093) _354)) (((C' (C' (_104 _350))) _1093) _356)) (((C' (C' (_103 _350))) _1093) _356)) (((C' (C' (_104 _350))) _1093) _356)) (_348 _77)) (_349 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1095) ((A :80 _1096) ((A :81 (((S' _64) (_1087 #97)) ((C _1087) #122))) ((A :82 (((S' _64) (_1087 #65)) ((C _1087) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1087 #48)) ((C _1087) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1087 #32)) ((C _1087) #126))) ((A :87 (((S' _63) ((C (_103 _74)) #32)) (((S' _63) ((C (_103 _74)) #9)) ((C (_103 _74)) #10)))) ((A :88 ((S ((S (((S' _64) (_1087 #65)) ((C _1087) #90))) (_68 (((noMatch "lib/Data/Char.hs") #86) #9)))) ((B _79) (((C' (_317 _130)) (((C' (_318 _130)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1087 #97)) ((C _1087) #97))) (_68 (((noMatch "lib/Data/Char.hs") #90) #9)))) ((B _79) (((C' (_317 _130)) (((C' (_318 _130)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1261 (K ((C ((S ((C ==) #39)) ((B (_117 (_1269 #39))) (((C' _117) ((B _1270) _91)) (_1269 #39))))) (_1270 "'\92&''")))) (_1266 _90)) ((B (_117 (_1269 #34))) (Y ((B (P (_1269 #34))) (((S' C) ((B
\ No newline at end of file
--- a/lib/Data/Double.hs
+++ b/lib/Data/Double.hs
@@ -21,6 +21,7 @@
EQ -> 0.0
GT -> 1.0
fromInt = primDoubleFromInt
+ fromInteger _ = error "Double.fromInteger not implemented"
instance Fractional Double where
(/) = primDoubleDiv
--- a/lib/Data/Int.hs
+++ b/lib/Data/Int.hs
@@ -6,6 +6,7 @@
import Data.Bounded
import Data.Char_Type
import Data.Eq
+import Data.Integer_Type
import Data.Integral
import Data.List_Type
import Data.Num
@@ -24,6 +25,7 @@
EQ -> 0
GT -> 1
fromInt x = x
+ fromInteger = _integerToInt
instance Integral Int where
quot = primIntQuot
--- a/lib/Data/Integer.hs
+++ b/lib/Data/Integer.hs
@@ -2,8 +2,8 @@
-- See LICENSE file for full license.
module Data.Integer(
Integer,
- intToInteger,
- integerToInt,
+ _intToInteger,
+ _integerToInt,
readInteger,
_integerToIntList,
_intListToInteger,
@@ -29,7 +29,8 @@
-- * least signification digits first, most significant last
-- * no trailing 0s in the digits
-- * 0 is positive
---data Integer = I Sign [Digit]
+{- These definitions are in Integer_Type+data Integer = I Sign [Digit]
--deriving Show
type Digit = Int
@@ -37,8 +38,9 @@
maxD :: Digit
maxD = 2147483648 -- 2^31, this is used so multiplication of two digit doesn't overflow a 64 bit Int
---data Sign = Plus | Minus
+data Sign = Plus | Minus
--deriving Show
+-}
instance Eq Integer where
(==) = eqI
@@ -64,7 +66,8 @@
LT -> negOneI
EQ -> zeroI
GT -> oneI
- fromInt = intToInteger
+ fromInt = _intToInteger
+ fromInteger x = x
instance Integral Integer where
quotRem = quotRemI
@@ -84,28 +87,14 @@
[] -> I Plus []
ds' -> I s ds'
-intToInteger :: Int -> Integer
-intToInteger i | i >= 0 = I Plus (f i)
- | i == negate i = I Minus [0,0,2] -- we are at minBound::Int. XXX deal with this in a more portable way.
- | otherwise = I Minus (f (negate i))
+_intToInteger :: Int -> Integer
+_intToInteger i | i >= 0 = I Plus (f i)
+ | i == negate i = I Minus [0,0,2] -- we are at minBound::Int. XXX deal with this in a more portable way.
+ | otherwise = I Minus (f (negate i))
where
f 0 = []
f x = rem x maxD : f (quot x maxD)
-integerToInt :: Integer -> Int
-integerToInt (I sign ds) = s * i
- where
- i =
- case ds of
- [] -> 0
- [d1] -> d1
- [d1,d2] -> d1 + maxD * d2
- [d1,d2,d3] -> d1 + maxD * d2 + (maxD * maxD) * d3
- s =
- case sign of
- Plus -> 1
- Minus -> -1
-
zeroD :: Digit
zeroD = 0
@@ -297,7 +286,7 @@
readInteger ds = readUnsignedInteger ds
readUnsignedInteger :: String -> Integer
-readUnsignedInteger = foldl (\ r c -> r * tenI + intToInteger (ord c - ord '0')) zeroI
+readUnsignedInteger = foldl (\ r c -> r * tenI + _intToInteger (ord c - ord '0')) zeroI
eqI :: Integer -> Integer -> Bool
eqI (I sx xs) (I sy ys) = eqSign sx sy && eqList (==) xs ys
@@ -357,7 +346,7 @@
instance Enum Integer where
fromEnum = fromEnum . integerToPInteger
- toEnum = intToInteger
+ toEnum = _intToInteger
instance Real Integer where
toRational = toRational . toInteger
--- a/lib/Data/Integer_Type.hs
+++ b/lib/Data/Integer_Type.hs
@@ -1,6 +1,28 @@
+-- Copyright 2023 Lennart Augustsson
+-- See LICENSE file for full license.
module Data.Integer_Type(module Data.Integer_Type) where
import Primitives
+import Data.List_Type
-data Integer = I Sign [{-Digit-}Int]+data Integer = I Sign [Digit]
data Sign = Plus | Minus
+
+type Digit = Int
+
+maxD :: Digit
+maxD = 2147483648 -- 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
+ where
+ i =
+ case ds of
+ [] -> 0
+ [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
+ Minus -> 0 `primIntSub` 1
--- a/lib/Data/Num.hs
+++ b/lib/Data/Num.hs
@@ -2,6 +2,7 @@
-- See LICENSE file for full license.
module Data.Num(module Data.Num) where
import Primitives
+import Data.Integer_Type
infixl 6 +,-
infixl 7 *
@@ -13,7 +14,7 @@
negate :: a -> a
abs :: a -> a
signum :: a -> a
--- fromInteger :: Integer -> a
+ fromInteger :: Integer -> a
fromInt :: Int -> a
negate x = fromInt 0 - x
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -19,6 +19,7 @@
abs x = x
signum x = if x == fromInt 0 then fromInt 0 else fromInt 1
fromInt = primUnsafeCoerce
+ fromInteger x = primUnsafeCoerce (_integerToInt x)
instance Integral Word where
quot = primWordQuot
--- a/src/Compat.hs
+++ b/src/Compat.hs
@@ -32,8 +32,17 @@
readInt :: String -> Int
readInt = read
+readInteger :: String -> Integer
+readInteger = read
+
readDouble :: String -> Double
readDouble = read
+
+_integerToInt :: Integer -> Int
+_integerToInt = fromInteger
+
+_intToInteger :: Int -> Integer
+_intToInteger = fromIntegral
xshowChar :: Char -> String
xshowChar = show
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -37,7 +37,6 @@
import Prelude --Xhiding (Monad(..), Applicative(..), MonadFail(..), Functor(..), (<$>), (<>))
import Data.Maybe
import MicroHs.Ident
-import qualified Data.Double as D
import Text.PrettyPrint.HughesPJ
--Ximport Compat
--Ximport GHC.Stack
@@ -145,13 +144,14 @@
data Lit
= LInt Int
- | LDouble D.Double
+ | LInteger Integer
+ | LDouble Double
| LChar Char
| LStr String
| LPrim String
| LForImp String
--Xderiving (Show)
---Winstance NFData Lit where rnf (LInt i) = rnf i; rnf (LDouble d) = rnf d; rnf (LChar c) = rnf c; rnf (LStr s) = rnf s; rnf (LPrim s) = rnf s; rnf (LForImp s) = rnf s
+--Winstance NFData Lit where rnf (LInt i) = rnf i; rnf (LInteger i) = rnf i; rnf (LDouble d) = rnf d; rnf (LChar c) = rnf c; rnf (LStr s) = rnf s; rnf (LPrim s) = rnf s; rnf (LForImp s) = rnf s
instance Eq Lit where
(==) (LInt x) (LInt y) = x == y
@@ -519,12 +519,13 @@
showLit :: Lit -> String
showLit l =
case l of
- LInt i -> '#' : show i
- LDouble d -> '%' : show d
- LChar c -> xshowChar c
- LStr s -> show s
- LPrim s -> s
- LForImp s -> '^' : s
+ LInt i -> '#' : show i
+ LInteger i -> '#' : '#' : show i
+ LDouble d -> '%' : show d
+ LChar c -> xshowChar c
+ LStr s -> show s
+ LPrim s -> s
+ LForImp s -> '^' : s
ppEStmt :: EStmt -> Doc
ppEStmt as =
--- a/src/MicroHs/Lex.hs
+++ b/src/MicroHs/Lex.hs
@@ -5,7 +5,6 @@
import Prelude --Xhiding(lex)
import Data.Char
import Data.List
-import qualified Data.Double as D
--Ximport Compat
import MicroHs.Ident
@@ -13,8 +12,8 @@
= TIdent Loc [String] String
| TString Loc String
| TChar Loc Char
- | TInt Loc Int
- | TDouble Loc D.Double
+ | TInt Loc Integer
+ | TDouble Loc Double
| TSpec Loc Char
| TError Loc String
| TBrace Loc
@@ -110,7 +109,7 @@
case span isDigit cs of
(ds, rs) | null rs || not (head rs == '.') || (take 2 rs) == ".." ->
let s = sign ++ ds
- i = readInt s
+ i = readInteger s
in TInt loc i : lex (addCol loc $ length s) rs
| otherwise ->
case span isDigit (tail rs) of
--- a/src/MicroHs/Parse.hs
+++ b/src/MicroHs/Parse.hs
@@ -9,8 +9,8 @@
import MicroHs.Lex
import MicroHs.Expr
import MicroHs.Ident
+--Ximport Compat
-
type P a = Prsr FilePath Token a
getFileName :: P FilePath
@@ -215,7 +215,7 @@
let
is (TString (l, c) s) = Just (ELit (SLoc fn l c) (LStr s))
is (TChar (l, c) a) = Just (ELit (SLoc fn l c) (LChar a))
- is (TInt (l, c) i) = Just (ELit (SLoc fn l c) (LInt i))
+ is (TInt (l, c) i) = Just (ELit (SLoc fn l c) (LInteger i))
is (TDouble (l, c) d) = Just (ELit (SLoc fn l c) (LDouble d))
is _ = Nothing
satisfyM "literal" is
@@ -264,7 +264,7 @@
<|< Instance <$> (pKeyword "instance" *> pForall) <*> pContext <*> pTypeApp <*> pWhere pClsBind
where
pAssoc = (AssocLeft <$ pKeyword "infixl") <|< (AssocRight <$ pKeyword "infixr") <|< (AssocNone <$ pKeyword "infix")
- dig (TInt _ i) | -2 <= i && i <= 9 = Just i
+ dig (TInt _ ii) | -2 <= i && i <= 9 = Just i where i = _integerToInt ii
dig _ = Nothing
pPrec = satisfyM "digit" dig
pContext = (pCtx <* pSymbol "=>") <|< pure []
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -41,8 +41,8 @@
nameChar :: String
nameChar = "Primitives.Char"
---nameInteger :: String
---nameInteger = "Data.Integer_Type.Integer"
+nameInteger :: String
+nameInteger = "Data.Integer_Type.Integer"
----------------------
@@ -1524,15 +1524,17 @@
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 l = do
let lit t = instSigma loc (ELit loc l) t mt
case l of
- LInt _ -> lit (tConI loc nameInt)
- LDouble _ -> lit (tConI loc nameDouble)
- LChar _ -> lit (tConI loc nameChar)
- LStr _ -> lit (tApp (tList loc) (tConI loc nameChar))
- LPrim _ -> newUVar >>= lit -- pretend it is anything
- LForImp _ -> impossible
+ LInt _ -> lit (tConI loc nameInt)
+ LInteger _ -> lit (tConI loc nameInteger)
+ LDouble _ -> lit (tConI loc nameDouble)
+ LChar _ -> lit (tConI loc nameChar)
+ LStr _ -> lit (tApp (tList loc) (tConI loc nameChar))
+ LPrim _ -> newUVar >>= lit -- pretend it is anything
+ LForImp _ -> impossible
tcOper :: --XHasCallStack =>
Expr -> [(Ident, Expr)] -> T Expr
--
⑨