ref: dc47672c5d59ec63dcfa3a45a53682240911555d
parent: 66515a4461708c4fd54b90b6a8ba16317d6ff276
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Mon Sep 18 15:22:39 EDT 2023
Fix type checking bug. Improve locations.
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v3.4
-824
-(($A :0 ((_622 _575) (($B ((($S' ($C ((($C' ($S' _622)) (($B ($C _2)) _560)) (($B ($B (_622 _651))) ((($C' ($C' $C)) ((($C' ($S' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $S)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' $C))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' ($C' $S'))))) ((($C' ($C' ($C' ($C' ($C' $C'))))) ((($C' ($C' ($C' ($S' ($C' $C'))))) (($B ($B ($B ($B $B')))) ((($S' $B) ($B' ($B' (($B ($S' $B)) (($B ($B _623)) ((($C' $B) (($B _718) (($B _641) ((($C' _755) _8) 0)))) (($B (_718 _644)) (($B (_657 "top level defns: ")) _604)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _623)) ((($C' $B) (($B _718) (($B _641) ((($C' _755) _8) 1)))) (_640 ($T (($B ($B (_718 _644))) ((($C' $B) (($B _657) ((($C' _657) _565) " = "))) _392)))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _623))) ((($C' $B) ($B' (($B _718) (($B _646) _11)))) (($B _657) ((($C' _657) (($B (_657 _1)) _604)) (($O 10) $K)))))) (($B ($B (_622 _651))) ((($C' $B) ($B' (($B _718) (($B _641) ((($C' _755) _8) 0))))) (($B ($B (_718 _644))) ((($C' ($C' _657)) (($B ($B (_657 "final pass "))) (($B ($B (_617 6))) (($B ($B _604)) _749)))) "ms"))))))) _3))))) (($B (($C' $C) (($B ($C _662)) _392))) (($C _675) (_692 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) ((($C' ($C' ($C' ($C' _657)))) (($B ($C' ($C' _657))) ((($C' ($C' ($C' _657))) (($B (($C' $B) (($B _657) ((($C' _657) (($B (_657 "(($A :")) _604)) (($O 32) $K))))) ($B _392))) ") "))) (($O 41) $K)))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _368)) $I))) ($BK $K))) $K))))) (($B (($S' _718) (($B _715) (($B (_718 _762)) (($B (_657 "main: findIdent: ")) _565))))) (($C' _594) _562)))) _601))) (($B ($B _598)) ((($C' $B) (($B _659) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _562))) $K)))))) (($C _675) (_692 0))))))) ($T $A))) ($T $K))) $I)) (($B (_718 _367)) (($B (_718 _560)) (($B (_657 (($O 95) $K))) _604)))))))) (($S (($S ((($S' _7) (($B _674) (_661 (_615 "-v")))) ((_691 _615) "-r"))) (($B (_655 (($O 46) $K))) (($B _717) (_660 ((_679 _740) "-i")))))) (($B (_718 _686)) ((($C' _657) (($B _717) (_660 ((_679 _740) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _751) _674) 1)) (_762 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _686)) (_661 ((_719 _760) ((_719 (_615 (($O 45) $K))) (_672 1))))))) (_682 ((_719 _760) (_615 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _622)) _16) (($B ($B ($B (_622 _651)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _623) (($B (_718 _642)) (($B (_718 (_673 1000000))) _192)))))) (($B ($B ($B ($B (_622 _651))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _623))) ((($C' $B) ($B' (($B _718) (($B _641) ((($C' _755) _8) 0))))) (($B ($B (_718 _644))) ((($C' ($C' _657)) (($B ($B (_657 "combinator conversion "))) (($B ($B (_617 6))) (($B ($B _604)) _749)))) "ms")))))) (($B ($B _624)) (($B $P) (($C _568) (_560 "main")))))))) (_659 ($T ((($C' ($C' $O)) ((($C' $B) $P) _395)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_622 _575)))) (($B ($B ($B (($C' _576) ((($C' _744) (($B _674) (_682 ((_719 _760) (_615 "--"))))) 1))))) (($B ($B ($B (_718 _6)))) ($C $C))))) (($B ($B $Y)) (($B ($B ($B _551))) (($C' ($C' _659)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _718) (($B _715) (($B (_718 _762)) (($B (_657 "not found ")) _565))))) ($C _552))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($S' $C)) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _394))) (($B (_718 (_715 (_762 "primlookup")))) (($C (_697 _615)) _5)))) $K))) (_762 "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 "
\ No newline at end of file
+827
+(($A :0 ((_623 _575) (($B ((($S' ($C ((($C' ($S' _623)) (($B ($C _2)) _560)) (($B ($B (_623 _652))) ((($C' ($C' $C)) ((($C' ($S' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $S)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' $C))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' ($C' $S'))))) ((($C' ($C' ($C' ($C' ($C' $C'))))) ((($C' ($C' ($C' ($S' ($C' $C'))))) (($B ($B ($B ($B $B')))) ((($S' $B) ($B' ($B' (($B ($S' $B)) (($B ($B _624)) ((($C' $B) (($B _721) (($B _642) ((($C' _758) _8) 0)))) (($B (_721 _645)) (($B (_658 "top level defns: ")) _604)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _624)) ((($C' $B) (($B _721) (($B _642) ((($C' _758) _8) 1)))) (_641 ($T (($B ($B (_721 _645))) ((($C' $B) (($B _658) ((($C' _658) _565) " = "))) _392)))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _624))) ((($C' $B) ($B' (($B _721) (($B _647) _11)))) (($B _658) ((($C' _658) (($B (_658 _1)) _604)) (($O 10) $K)))))) (($B ($B (_623 _652))) ((($C' $B) ($B' (($B _721) (($B _642) ((($C' _758) _8) 0))))) (($B ($B (_721 _645))) ((($C' ($C' _658)) (($B ($B (_658 "final pass "))) (($B ($B (_618 6))) (($B ($B _604)) _752)))) "ms"))))))) _3))))) (($B (($C' $C) (($B ($C _663)) _392))) (($C _676) (_693 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) ((($C' ($C' ($C' ($C' _658)))) (($B ($C' ($C' _658))) ((($C' ($C' ($C' _658))) (($B (($C' $B) (($B _658) ((($C' _658) (($B (_658 "(($A :")) _604)) (($O 32) $K))))) ($B _392))) ") "))) (($O 41) $K)))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _368)) $I))) ($BK $K))) $K))))) (($B (($S' _721) (($B _718) (($B (_721 _765)) (($B (_658 "main: findIdent: ")) _565))))) (($C' _594) _562)))) _601))) (($B ($B _598)) ((($C' $B) (($B _660) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _562))) $K)))))) (($C _676) (_693 0))))))) ($T $A))) ($T $K))) $I)) (($B (_721 _367)) (($B (_721 _560)) (($B (_658 (($O 95) $K))) _604)))))))) (($S (($S ((($S' _7) (($B _675) (_662 (_616 "-v")))) ((_692 _616) "-r"))) (($B (_656 (($O 46) $K))) (($B _720) (_661 ((_680 _743) "-i")))))) (($B (_721 _687)) ((($C' _658) (($B _720) (_661 ((_680 _743) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _754) _675) 1)) (_765 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _687)) (_662 ((_722 _763) ((_722 (_616 (($O 45) $K))) (_673 1))))))) (_683 ((_722 _763) (_616 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _623)) _16) (($B ($B ($B (_623 _652)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _624) (($B (_721 _643)) (($B (_721 (_674 1000000))) _192)))))) (($B ($B ($B ($B (_623 _652))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _624))) ((($C' $B) ($B' (($B _721) (($B _642) ((($C' _758) _8) 0))))) (($B ($B (_721 _645))) ((($C' ($C' _658)) (($B ($B (_658 "combinator conversion "))) (($B ($B (_618 6))) (($B ($B _604)) _752)))) "ms")))))) (($B ($B _625)) (($B $P) (($C _568) (_560 "main")))))))) (_660 ($T ((($C' ($C' $O)) ((($C' $B) $P) _395)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_623 _575)))) (($B ($B ($B (($C' _576) ((($C' _747) (($B _675) (_683 ((_722 _763) (_616 "--"))))) 1))))) (($B ($B ($B (_721 _6)))) ($C $C))))) (($B ($B $Y)) (($B ($B ($B _551))) (($C' ($C' _660)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _721) (($B _718) (($B (_721 _765)) (($B (_658 "not found ")) _565))))) ($C _552))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($S' $C)) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _394))) (($B (_721 (_718 (_765 "primlookup")))) (($C (_698 _616)) _5)))) $K))) (_765 "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 "
\ No newline at end of file
--- a/src/MicroHs/Ident.hs
+++ b/src/MicroHs/Ident.hs
@@ -2,6 +2,7 @@
Line, Col, Loc,
Ident(..),
mkIdent, mkIdentLoc, unIdent, eqIdent, leIdent, qualIdent, showIdent, getSLocIdent, setSLocIdent,
+ mkIdentSLoc,
isLower_, isIdentChar, isOperChar, isConIdent,
unQualString,
SLoc(..), noSLoc, showSLoc
@@ -25,6 +26,9 @@
mkIdent :: String -> Ident
mkIdent = Ident noSLoc
+
+mkIdentSLoc :: SLoc -> String -> Ident
+mkIdentSLoc = Ident
mkIdentLoc :: FilePath -> Loc -> String -> Ident
mkIdentLoc fn (l, c) s = Ident (SLoc fn l c) s
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -412,8 +412,7 @@
-- tenv <- gets typeTable
-- senv <- gets synTable
let
- bad = tcError loc $ ": "
- ++ "Cannot unify " ++ showExpr a ++ " and " ++ showExpr b ++ "\n"
+ bad = tcError loc $ "Cannot unify " ++ showExpr a ++ " and " ++ showExpr b ++ "\n"
-- ++ show a ++ " - " ++ show b ++ "\n"
-- ++ show tenv ++ "\n"
-- ++ show senv
@@ -766,26 +765,26 @@
EDo mmn ass -> T.do
case ass of
[] -> impossible
- as : ss ->
- if null ss then
- case as of
- SThen a -> tcExpr mt a
- _ -> tcError (getSLocExpr ae) $ "bad do "
- --X++ show as
- else
- case as of
- SBind p a -> T.do
- let
- sbind = maybe (mkIdent ">>=") (\ mn -> qualIdent mn (mkIdent ">>=")) mmn
- tcExpr Nothing (EApp (EApp (EVar sbind) a)
- (ELam [eVarI "$x"] (ECase (eVarI "$x") [(p, EAlts [([], EDo mmn ss)] [])])))
- SThen a -> T.do
- let
- sthen = maybe (mkIdent ">>") (\ mn -> qualIdent mn (mkIdent ">>") ) mmn
- tcExpr Nothing (EApp (EApp (EVar sthen) a) (EDo mmn ss))
-
- SLet bs ->
- tcExpr Nothing (ELet bs (EDo mmn ss))
+ [as] ->
+ case as of
+ SThen a -> tcExpr mt a
+ _ -> tcError (getSLocExpr ae) $ "bad do "
+ as : ss -> T.do
+ let
+ loc = getSLocExpr ae
+ case as of
+ SBind p a -> T.do
+ let
+ sbind = maybe (mkIdentSLoc loc ">>=") (\ mn -> qualIdent mn (mkIdentSLoc loc ">>=")) mmn
+ tcExpr mt (EApp (EApp (EVar sbind) a)
+ (ELam [eVarI "$x"] (ECase (eVarI "$x") [(p, EAlts [([], EDo mmn ss)] [])])))
+ SThen a -> T.do
+ let
+ sthen = maybe (mkIdentSLoc loc ">>") (\ mn -> qualIdent mn (mkIdentSLoc loc ">>") ) mmn
+ tcExpr mt (EApp (EApp (EVar sthen) a) (EDo mmn ss))
+
+ SLet bs ->
+ tcExpr mt (ELet bs (EDo mmn ss))
ESectL e i -> tcExpr mt (EApp (EVar i) e)
ESectR i e ->
--
⑨