ref: 14be7bff7656333ad3ac1e3a5fe927573988c311
parent: 2cf3c41c81f67d326e6f9b9fbbbff583e375afcb
author: Lennart Augustsson <lennart@augustsson.net>
date: Sun Nov 5 11:43:11 EST 2023
Better debug
--- a/TODO
+++ b/TODO
@@ -42,6 +42,8 @@
* instance Bits ...
* Split eval.c
* Implement defaulting
+* Add location to file not found
Bugs
* Removing [] from prim table
+ * :reload doesn't show error message
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.1
-1428
-((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' _212) ((B _12) _1)) _395))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _394))) ((A :10 (((S' P) _2) (((C' _13) _1) _1175))) ((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' _209) _12) _200))) ((A :20 (((S' B) _14) (((C' _212) _12) _201))) ((A :21 _1260) ((A :22 ((B _1301) _21)) ((A :23 (((S' _1301) _21) I)) ((A :24 _1230) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1259) ((C _199) _26))) ((A :28 (((C' _27) ((_208 _1271) _111)) ((_199 (_34 _1273)) _110))) ((A :29 ((B ((S _1301) (_34 _1273))) _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) _394)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _395)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1175)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1175))) ((A :46 ((C _43) _200)) ((A :47 ((B _202) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _202) _48)) ((A :50 T) ((A :51 ((_207 ((B (B (_197 _50))) ((B ((C' C) _54)) (B P)))) (_211 _51))) ((A :52 (((((_11 _51) ((B (_197 _50)) P)) (_38 _53)) ((B (B (_197 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_197 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_199 _467)) _54)) ((A :56 ((B (_197 _50)) (B (P _1175)))) ((A :57 ((B (_197 _50)) (BK (P _1175)))) ((A :58 ((_197 _50) ((S P) I))) ((A :59 ((B (_197 _50)) ((C (S' P)) I))) ((A :60 ((_137 ((C ((C S') _65)) I)) (_141 _60))) ((A :61 (((_1399 (K ((P (_1408 "False")) (_1408 "True")))) (_1404 _61)) (_1405 _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 ((_137 _1224) _1225)) ((A :75 ((((((((_427 _74) (_436 _75)) _1226) _1227) _1228) _1229) (_441 _75)) (_442 _75))) ((A :76 ((_137 _1234) (_141 _76))) ((A :77 ((((((((_427 _76) _1233) (((C' (C' (_138 _443))) _1233) _447)) (((C' (C' (_139 _443))) _1233) _449)) (((C' (C' (_138 _443))) _1233) _449)) (((C' (C' (_139 _443))) _1233) _449)) (_441 _77)) (_442 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1235) ((A :80 _1236) ((A :81 (((S' _64) (_1227 #97)) ((C _1227) #122))) ((A :82 (((S' _64) (_1227 #65)) ((C _1227) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1227 #48)) ((C _1227) #57))) ((A :85 (((S' _63) _84) (((S' _63) (((S' _64) (_1227 #97)) ((C _1227) #102))) (((S' _64) (_1227 #70)) ((C _1227) #70))))) ((A :86 (((S' _63) _83) _84)) ((A :87 (((S' _64) (_1227 #32)) ((C _1227) #126))) ((A :88 (((S' _63) ((C (_138 _74)) #32)) (((S' _63) ((C (_138 _74)) #9)) ((C (_138 _74)) #10)))) ((A :89 ((S ((S (((S' _64) (_1227 #48)) ((C _1227) #57))) ((S ((S (((S' _64) (_1227 #97)) ((C _1227) #102))) ((S ((C (((S' _64) (_1227 #65)) ((C _1227) #70))) (_24 "digitToInt"))) (((C' (_413 _213)) _80) (((_413 _213) (_80 #65)) #10))))) (((C' (_413 _213)) _80) (((_413 _213) (_80 #97)) #10))))) (((C' (_413 _213)) _80) (_80 #48)))) ((A :90 ((S ((S (((S' _64) (_1227 #65)) ((C _1227) #90))) (_68 (((noMatch "lib/Data/Char.hs") #82) #9)))) ((B _79) ((
\ No newline at end of file
+1437
+((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' _212) ((B _12) _1)) _395))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _394))) ((A :10 (((S' P) _2) (((C' _13) _1) _1179))) ((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' _209) _12) _200))) ((A :20 (((S' B) _14) (((C' _212) _12) _201))) ((A :21 _1264) ((A :22 ((B _1305) _21)) ((A :23 (((S' _1305) _21) I)) ((A :24 _1234) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1263) ((C _199) _26))) ((A :28 (((C' _27) ((_208 _1275) _111)) ((_199 (_34 _1277)) _110))) ((A :29 ((B ((S _1305) (_34 _1277))) _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) _394)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _395)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1179)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1179))) ((A :46 ((C _43) _200)) ((A :47 ((B _202) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _202) _48)) ((A :50 T) ((A :51 ((_207 ((B (B (_197 _50))) ((B ((C' C) _54)) (B P)))) (_211 _51))) ((A :52 (((((_11 _51) ((B (_197 _50)) P)) (_38 _53)) ((B (B (_197 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_197 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_199 _467)) _54)) ((A :56 ((B (_197 _50)) (B (P _1179)))) ((A :57 ((B (_197 _50)) (BK (P _1179)))) ((A :58 ((_197 _50) ((S P) I))) ((A :59 ((B (_197 _50)) ((C (S' P)) I))) ((A :60 ((_137 ((C ((C S') _65)) I)) (_141 _60))) ((A :61 (((_1408 (K ((P (_1417 "False")) (_1417 "True")))) (_1413 _61)) (_1414 _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 ((_137 _1228) _1229)) ((A :75 ((((((((_427 _74) (_436 _75)) _1230) _1231) _1232) _1233) (_441 _75)) (_442 _75))) ((A :76 ((_137 _1238) (_141 _76))) ((A :77 ((((((((_427 _76) _1237) (((C' (C' (_138 _443))) _1237) _447)) (((C' (C' (_139 _443))) _1237) _449)) (((C' (C' (_138 _443))) _1237) _449)) (((C' (C' (_139 _443))) _1237) _449)) (_441 _77)) (_442 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1239) ((A :80 _1240) ((A :81 (((S' _64) (_1231 #97)) ((C _1231) #122))) ((A :82 (((S' _64) (_1231 #65)) ((C _1231) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1231 #48)) ((C _1231) #57))) ((A :85 (((S' _63) _84) (((S' _63) (((S' _64) (_1231 #97)) ((C _1231) #102))) (((S' _64) (_1231 #70)) ((C _1231) #70))))) ((A :86 (((S' _63) _83) _84)) ((A :87 (((S' _64) (_1231 #32)) ((C _1231) #126))) ((A :88 (((S' _63) ((C (_138 _74)) #32)) (((S' _63) ((C (_138 _74)) #9)) ((C (_138 _74)) #10)))) ((A :89 ((S ((S (((S' _64) (_1231 #48)) ((C _1231) #57))) ((S ((S (((S' _64) (_1231 #97)) ((C _1231) #102))) ((S ((C (((S' _64) (_1231 #65)) ((C _1231) #70))) (_24 "digitToInt"))) (((C' (_413 _213)) _80) (((_413 _213) (_80 #65)) #10))))) (((C' (_413 _213)) _80) (((_413 _213) (_80 #97)) #10))))) (((C' (_413 _213)) _80) (_80 #48)))) ((A :90 ((S ((S (((S' _64) (_1231 #65)) ((C _1231) #90))) (_68 (((noMatch "lib/Data/Char.hs") #82) #9)))) ((B _79) ((
\ No newline at end of file
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -24,7 +24,7 @@
import MicroHs.Expr
--Ximport Compat
--Ximport GHC.Stack
---Ximport Debug.Trace
+--import Debug.Trace
boolPrefix :: String
boolPrefix = "Data.Bool_Type."
@@ -2051,20 +2051,20 @@
{-showInstInfo :: InstInfo -> String
-showInstInfo (InstInfo m ds) = "InstInfo " ++ showListS (showPair showIdent showExpr) (M.toList m) ++ " " ++ showList showInstDict ds
+showInstInfo (InstInfo m ds) = "InstInfo " ++ show (M.toList m) ++ " " ++ showListS showInstDict ds
showInstDict :: InstDict -> String
-showInstDict (e, iks, ctx, ts) = showExpr e ++ " :: " ++ showEType (eForall iks $ addConstraints ctx (tApps (mkIdent "X") ts))
+showInstDict (e, ctx, ts) = showExpr e ++ " :: " ++ show (addConstraints ctx (tApps (mkIdent "CCC") ts))
showInstDef :: InstDef -> String
-showInstDef (cls, InstInfo m ds) = "instDef " ++ showIdent cls ++ ": "
- ++ showListS (showPair showIdent showExpr) (M.toList m) ++ ", " ++ showList showInstDict ds
+showInstDef (cls, InstInfo m ds) = "instDef " ++ show cls ++ ": "
+ ++ show (M.toList m) ++ ", " ++ showListS showInstDict ds
showConstraint :: (Ident, EConstraint) -> String
-showConstraint (i, t) = showIdent i ++ " :: " ++ showEType t
+showConstraint (i, t) = show i ++ " :: " ++ show t
showMatch :: (Expr, [EConstraint]) -> String
-showMatch (e, ts) = showExpr e ++ " " ++ showListS showEType ts
+showMatch (e, ts) = show e ++ " " ++ show ts
-}
-- Solve as many constraints as possible.
@@ -2102,12 +2102,15 @@
case cts of
[EVar i] -> do
-- traceM ("solveSimple " ++ showIdent i ++ " -> " ++ showMaybe showExpr (M.lookup i atomMap))- solveSimple (M.lookup i atomMap) cns cnss uns sol
+ case M.lookup i atomMap of
+ Just e -> solveSimple e cns cnss uns sol
+ -- Not found, but there might be a generic instance
+ Nothing -> solveGen loc insts cns cnss uns sol
_ -> solveGen loc insts cns cnss uns sol
-- An instance of the form (C T)
- solveSimple Nothing cns cnss uns sol = solve cnss (cns : uns) sol -- no instance
- solveSimple (Just e) (di, _) cnss uns sol = solve cnss uns ((di, e) : sol) -- e is the dictionary expression
+-- solveSimple Nothing cns cnss uns sol = solve cnss (cns : uns) sol -- no instance
+ solveSimple e (di, _) cnss uns sol = solve cnss uns ((di, e) : sol) -- e is the dictionary expression
solveGen loc insts cns@(di, ct) cnss uns sol = do
-- traceM ("solveGen " ++ showEType ct)@@ -2144,7 +2147,7 @@
let rrr =
[ (length s, (de, map (substEUVar s) ctx))
| (de, ctx, ts) <- ds, Just s <- [matchTypes [] ts its] ]
- in --trace ("findMatches: " ++ showListS showInstDict ds ++ "; " ++ showEType ct ++ "; " ++ show rrr)+ in --trace ("findMatches: " ++ showListS showInstDict ds ++ "; " ++ showListS showEType its ++ "; " ++ show rrr)rrr
where
--
⑨