shithub: MicroHs

Download patch

ref: b6ad2fabec6bb804c3c71c6e126cb45e3c8515be
parent: b588d78bedc0b22397a6d0b49aaf766af8ce7115
author: Lennart Augustsson <lennart@augustsson.net>
date: Fri Sep 1 12:35:33 EDT 2023

Better error messages.

--- a/Tools/Addcombs.hs
+++ b/Tools/Addcombs.hs
@@ -10,7 +10,7 @@
   in  as : chunkify n bs
 
 showChunk :: [Char] -> String
-showChunk = concatMap (\ c -> show (ord c) ++ ",")
+showChunk = concatMap (\ c -> showInt (ord c) ++ ",")
 
 main :: IO ()
 main = do
@@ -18,7 +18,7 @@
   file <- readFile (head args)
   let size = length file
       chunks = chunkify 20 file
-  putStrLn $ "struct { size_t b_size; size_t b_pos; uint8_t b_buffer[]; } combs = { " ++ show size ++ ", 0, {"
+  putStrLn $ "struct { size_t b_size; size_t b_pos; uint8_t b_buffer[]; } combs = { " ++ showInt size ++ ", 0, {"
   mapM_ (putStrLn . showChunk) chunks
   putStrLn "}};"
   putStrLn "BFILE *comb_internal = (BFILE*)&combs;"
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v3.2
-739
-(($A :0 ((_549 _503) ((($S' ($C ((($C' ($S' _549)) (($B ($C _2)) _491)) (($B ($B (_549 _577))) ((($C' ($S' $C)) ((($C' ($C' $C)) ((($C' ($C' ($C' $S'))) (($B ($B ($B $C))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($S' $B))))) ((($C' ($C' ($C' ($C' ($C' $S))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' ($C' $B)))))) ((($C' ($C' ($C' ($S' ($C' $B))))) (($B ($B ($B ($B $B')))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) ($B' ($B' (($B $C') (($B ($S' _550)) ((($C' $B) (($B _638) (($B _567) ((($C' _676) _8) 0)))) (($B (_638 _570)) (($B (_583 "top level defns: ")) _531)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _550)) ((($C' $B) (($B _638) (($B _567) ((($C' _676) _8) 1)))) (_566 ($T (($B ($B (_638 _570))) ((($C' $B) (($B _583) _494)) (($B (_583 " = ")) _350))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _550))) ((($C' $B) ($B' (($B _638) (($B _572) _11)))) (($B ($B (_583 _1))) (($B (($C' _583) _531)) (_583 (($O 10) $K))))))) (($B ($B (_549 _577))) ((($C' $B) ($B' (($B _638) (($B _567) ((($C' _676) _8) 0))))) (($B ($B (_638 _570))) (($B ($B (_583 "final pass            "))) ((($C' ($C' _583)) (($B ($B (_544 6))) (($B ($B _531)) _670))) "ms")))))))) _3)))) _528))) (($B (($C' $C) (($B ($C _588)) _350))) (($C _601) (_618 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B ($B ($B (_583 "(($A :"))))) (($B ($B (($C' $B) (($B _583) _531)))) (($B ($B ($B (_583 (($O 32) $K))))) ((($C' $B) (($B ($C' _583)) ($B _350))) (($B (_583 ") ")) (($C _583) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _327)) $I))) ($BK $K))) $K))))) $T)) (($B (($S' _638) (($B _635) (($B (_638 _685)) (($B (_583 "main: findIdent: ")) _494))))) (($C' _521) _493)))) (($B ($B _525)) (($B (($C' _585) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _493))) $K)))))) (($C _601) (_618 0)))))) (($B (_638 _326)) (($B (_638 _491)) (($B (_583 (($O 95) $K))) _531)))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _600) (_587 (_542 "-v")))) ((_617 _542) "-r"))) (($B (_581 (($O 46) $K))) (($B _637) (_586 ((_605 _661) "-i")))))) (($B (_638 _612)) ((($C' _583) (($B _637) (_586 ((_605 _661) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _672) _600) 1)) (_685 "Usage: uhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _612)) (_587 ((_639 _681) ((_639 (_542 (($O 45) $K))) (_598 1)))))))) (($A :1 "v3.2\10&") (($A :2 ((($S' ($S' _549)) _16) (($B ($B ($B (_549 _577)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _550) (($B (_638 _568)) (($B (_638 (_599 1000000))) _189)))))) (($B ($B ($B ($B (_549 _577))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _550))) ((($C' $B) ($B' (($B _638) (($B _567) ((($C' _676) _8) 0))))) (($B ($B (_638 _570))) (($B ($B (_583 "combinator conversion "))) ((($C' ($C' _583)) (($B ($B (_544 6))) (($B ($B _531)) _670))) "ms"))))))) (($B ($B _551)) (($B $P) (($C _496) (_491 "main")))))))) (_585 ($T ((($C' ($C' $O)) ((($C' $B) $P) _353)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_638 _6)))) ($C $C))) (($B ($B $Y)) (($B ($B ($B _482))) (($C' ($C' _585)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _638) (($B _635) (($B (_638 _685)) (($B (_583 "not found ")) _494))))) ($C _483))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _352))) (($B (_638 (_635 (_685 "primlookup")))) (($C (_621 _542)) _5))))) (_685 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67) $K)) $C)) (($O (($P (($O 65) $K)) $A)) (($O (($P "S'") $S')) (($O (($P (($O 80) $K)) $P)) (($O (($P (($O 73) $K)) $I)) (($O (($P (($O 83) $K)) $S)) (($O (($P (($O 84) $K)) $T)) (($O (($P (($O 89) $K)) $Y)) (($O (($P "B'") $B')) (($O (($P "BK") $BK)) (($O
\ No newline at end of file
+740
+(($A :0 ((_550 _504) ((($S' ($C ((($C' ($S' _550)) (($B ($C _2)) _491)) (($B ($B (_550 _578))) ((($C' ($S' $C)) ((($C' ($C' $C)) ((($C' ($C' ($C' $S'))) (($B ($B ($B $C))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($S' $B))))) ((($C' ($C' ($C' ($C' ($C' $S))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' ($C' $B)))))) ((($C' ($C' ($C' ($S' ($C' $B))))) (($B ($B ($B ($B $B')))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) ($B' ($B' (($B $C') (($B ($S' _551)) ((($C' $B) (($B _639) (($B _568) ((($C' _677) _8) 0)))) (($B (_639 _571)) (($B (_584 "top level defns: ")) _532)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _551)) ((($C' $B) (($B _639) (($B _568) ((($C' _677) _8) 1)))) (_567 ($T (($B ($B (_639 _571))) ((($C' $B) (($B _584) _495)) (($B (_584 " = ")) _350))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _551))) ((($C' $B) ($B' (($B _639) (($B _573) _11)))) (($B ($B (_584 _1))) (($B (($C' _584) _532)) (_584 (($O 10) $K))))))) (($B ($B (_550 _578))) ((($C' $B) ($B' (($B _639) (($B _568) ((($C' _677) _8) 0))))) (($B ($B (_639 _571))) (($B ($B (_584 "final pass            "))) ((($C' ($C' _584)) (($B ($B (_545 6))) (($B ($B _532)) _671))) "ms")))))))) _3)))) _529))) (($B (($C' $C) (($B ($C _589)) _350))) (($C _602) (_619 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B ($B ($B (_584 "(($A :"))))) (($B ($B (($C' $B) (($B _584) _532)))) (($B ($B ($B (_584 (($O 32) $K))))) ((($C' $B) (($B ($C' _584)) ($B _350))) (($B (_584 ") ")) (($C _584) (($O 41) $K))))))))))))) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _327)) $I))) ($BK $K))) $K))))) $T)) (($B (($S' _639) (($B _636) (($B (_639 _686)) (($B (_584 "main: findIdent: ")) _495))))) (($C' _522) _493)))) (($B ($B _526)) (($B (($C' _586) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _493))) $K)))))) (($C _602) (_619 0)))))) (($B (_639 _326)) (($B (_639 _491)) (($B (_584 (($O 95) $K))) _532)))))) ($T $A))) ($T $K))) (($B $Y) $K)))))) (($S (($S ((($S' _7) (($B _601) (_588 (_543 "-v")))) ((_618 _543) "-r"))) (($B (_582 (($O 46) $K))) (($B _638) (_587 ((_606 _662) "-i")))))) (($B (_639 _613)) ((($C' _584) (($B _638) (_587 ((_606 _662) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _673) _601) 1)) (_686 "Usage: uhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _613)) (_588 ((_640 _682) ((_640 (_543 (($O 45) $K))) (_599 1)))))))) (($A :1 "v3.2\10&") (($A :2 ((($S' ($S' _550)) _16) (($B ($B ($B (_550 _578)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _551) (($B (_639 _569)) (($B (_639 (_600 1000000))) _189)))))) (($B ($B ($B ($B (_550 _578))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _551))) ((($C' $B) ($B' (($B _639) (($B _568) ((($C' _677) _8) 0))))) (($B ($B (_639 _571))) (($B ($B (_584 "combinator conversion "))) ((($C' ($C' _584)) (($B ($B (_545 6))) (($B ($B _532)) _671))) "ms"))))))) (($B ($B _552)) (($B $P) (($C _497) (_491 "main")))))))) (_586 ($T ((($C' ($C' $O)) ((($C' $B) $P) _353)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_639 _6)))) ($C $C))) (($B ($B $Y)) (($B ($B ($B _482))) (($C' ($C' _586)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _639) (($B _636) (($B (_639 _686)) (($B (_584 "not found ")) _495))))) ($C _483))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _352))) (($B (_639 (_636 (_686 "primlookup")))) (($C (_622 _543)) _5))))) (_686 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67) $K)) $C)) (($O (($P (($O 65) $K)) $A)) (($O (($P "S'") $S')) (($O (($P (($O 80) $K)) $P)) (($O (($P (($O 73) $K)) $I)) (($O (($P (($O 83) $K)) $S)) (($O (($P (($O 84) $K)) $T)) (($O (($P (($O 89) $K)) $Y)) (($O (($P "B'") $B')) (($O (($P "BK") $BK)) (($O
\ No newline at end of file
--- a/src/MicroHs/Ident.hs
+++ b/src/MicroHs/Ident.hs
@@ -1,7 +1,7 @@
 module MicroHs.Ident(
   Line, Col, Loc,
   Ident(..),
-  mkIdent, mkIdentLoc, unIdent, eqIdent, qualIdent, showIdent,
+  mkIdent, mkIdentLoc, unIdent, eqIdent, qualIdent, showIdent, getSLocIdent,
   isLower_, isIdentChar, isOperChar, isConIdent,
   unQualString,
   SLoc(..), noSLoc, showSLoc
@@ -31,6 +31,9 @@
 
 unIdent :: Ident -> String
 unIdent (Ident _ s) = s
+
+getSLocIdent :: Ident -> SLoc
+getSLocIdent (Ident loc _) = loc
 
 showIdent :: Ident -> String
 showIdent (Ident _ i) = i
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -436,7 +436,8 @@
 tLookup msg i = T.do
   env <- gets valueTable
   case M.lookup i env of
-    Nothing -> error $ "undefined, " ++ msg ++ ": " ++ showIdent i -- ++ "\n" ++ show env ;
+    Nothing -> error $ showSLoc (getSLocIdent i) ++ ": undefined " ++ msg ++ ": " ++ showIdent i
+               -- ++ "\n" ++ show env ;
     Just aes ->
       case aes of
         [] -> impossible
--