shithub: MicroHs

Download patch

ref: a8308e68a3bc58aa85203174b241630c107e1604
parent: 5c52ede1d072a5b65f7a8dd135e4346c1c56c466
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Wed Sep 20 13:11:18 EDT 2023 

Refactor a little


--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v3.4
-852
-(($A :0 ((_647 _596) (($B ((($S' ($C ((($C' ($S' _647)) (($B ($C _2)) _579)) (($B ($B (_647 _676))) ((($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 _648)) ((($C' $B) (($B _745) (($B _666) ((($C' _781) _9) 0)))) (($B (_745 _669)) (($B (_682 "top level defns: ")) _627)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _648)) ((($C' $B) (($B _745) (($B _666) ((($C' _781) _9) 1)))) (_665 ($T (($B ($B (_745 _669))) ((($C' $B) (($B _682) ((($C' _682) _585) " = "))) (($C _405) $K))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _10))) ((($S' $B) (($B ($C' ($C' _648))) ((($C' $B) ($B' (($B _745) (($B _671) _12)))) (($B _682) ((($C' _682) (($B (_682 _1)) _627)) (($O 10) $K)))))) (($B ($B (_647 _676))) ((($C' $B) ($B' (($B _745) (($B _666) ((($C' _781) _9) 0))))) (($B ($B (_745 _669))) ((($C' ($C' _682)) (($B ($B (_682 "final pass            "))) (($B ($B (_641 6))) (($B ($B _627)) _775)))) "ms"))))))) _3))))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($C _687)) _405))) (($C _700) (_716 0)))) $K))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B (($C' $B) (($B _746) (($B _682) ((($C' _682) (($B (_682 "(($A :")) _627)) (($O 32) $K))))))) ((($C' $B) (($B ($C' _746)) ($B _405))) (($B (_746 (_682 ") "))) (($C _746) (_682 (($O 41) $K)))))))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _380)) $I))) ($BK $K))) $K))))) (($B (($S' _745) (($B _742) (($B (_745 _790)) (($B (_682 "main: findIdent: ")) _585))))) (($C' _615) _582)))) _622))) (($B ($B _619)) ((($C' $B) (($B _684) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _582))) $K)))))) (($C _700) (_716 0))))))) ($T $A))) ($T $K))) $I)) (($B (_745 _379)) (($B (_745 _579)) (($B (_682 (($O 95) $K))) _627)))))))) (($S (($S ((($S' _8) (($B _699) (_686 (_639 "-v")))) ((_715 _639) "-r"))) (($B (_680 (($O 46) $K))) (($B _744) (_685 ((_704 _766) "-i")))))) (($B (_745 _711)) ((($C' _682) (($B _744) (_685 ((_704 _766) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _777) _699) 1)) (_790 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _711)) (_686 ((_746 _786) ((_746 (_639 (($O 45) $K))) (_697 1))))))) (_707 ((_746 _786) (_639 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _647)) _17) (($B ($B ($B (_647 _676)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _647) (($B _649) (_738 _223)))))) (($B ($B ($B ($B $T)))) (($B ($B ($B ($B (_647 _676))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _648))) ((($C' $B) ($B' (($B _745) (($B _666) ((($C' _781) _9) 0))))) (($B ($B (_745 _669))) ((($C' ($C' _682)) (($B ($B (_682 "combinator conversion "))) (($B ($B (_641 6))) (($B ($B _627)) _775)))) "ms")))))) (($B ($B _649)) (($B $P) (($C _588) (_579 "main"))))))))) (_684 ($T ((($C' ($C' $O)) ((($C' $B) $P) _408)) $K))))))) (($A :3 (($B (_647 _596)) (($B (($C' _597) ((($C' _770) (($B _699) (_707 ((_746 _786) (_639 "--"))))) 1))) (($B (_745 _7)) _4)))) (($A :4 ($T (($C ((($C' $C') (($B $S) ($C $C))) (($B ($B $Y)) (($B ($B ($B _569))) (($C' ($C' _684)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _5))) $K))))))) (($B (($S' _745) (($B _742) (($B (_745 _790)) (($B (_682 "not found ")) _585))))) ($C _570))))) (($A :5 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _7)) _5)) _5))) ($BK $K))) ((($C' ($S' $C)) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _7)) $K))) ((($C' $B) _5) _407))) ((($S' _745) (($B _742) (($B (_745 _790)) (_682 "primlookup: ")))) (($C (_721 _639)) _6)))) $K))) (_790 "trans: impossible"))) (($A :6 (($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)
\ No newline at end of file
+854
+(($A :0 ((_649 _598) (($B ((($S' ($C ((($C' ($S' _649)) (($B ($C _2)) _581)) (($B ($B (_649 _678))) ((($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 _650)) ((($C' $B) (($B _747) (($B _668) ((($C' _783) _9) 0)))) (($B (_747 _671)) (($B (_684 "top level defns: ")) _629)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _650)) ((($C' $B) (($B _747) (($B _668) ((($C' _783) _9) 1)))) (_667 ($T (($B ($B (_747 _671))) ((($C' $B) (($B _684) ((($C' _684) _587) " = "))) (($C _407) $K))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _10))) ((($S' $B) (($B ($C' ($C' _650))) ((($C' $B) ($B' (($B _747) (($B _673) _12)))) (($B _684) ((($C' _684) (($B (_684 _1)) _629)) (($O 10) $K)))))) (($B ($B (_649 _678))) ((($C' $B) ($B' (($B _747) (($B _668) ((($C' _783) _9) 0))))) (($B ($B (_747 _671))) ((($C' ($C' _684)) (($B ($B (_684 "final pass            "))) (($B ($B (_643 6))) (($B ($B _629)) _777)))) "ms"))))))) _3))))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($C _689)) _407))) (($C _702) (_718 0)))) $K))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B (($C' $B) (($B _748) (($B _684) ((($C' _684) (($B (_684 "(($A :")) _629)) (($O 32) $K))))))) ((($C' $B) (($B ($C' _748)) ($B _407))) (($B (_748 (_684 ") "))) (($C _748) (_684 (($O 41) $K)))))))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _382)) $I))) ($BK $K))) $K))))) (($B (($S' _747) (($B _744) (($B (_747 _792)) (($B (_684 "main: findIdent: ")) _587))))) (($C' _617) _584)))) _624))) (($B ($B _621)) ((($C' $B) (($B _686) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _584))) $K)))))) (($C _702) (_718 0))))))) ($T $A))) ($T $K))) $I)) (($B (_747 _381)) (($B (_747 _581)) (($B (_684 (($O 95) $K))) _629)))))))) (($S (($S ((($S' _8) (($B _701) (_688 (_641 "-v")))) ((_717 _641) "-r"))) (($B (_682 (($O 46) $K))) (($B _746) (_687 ((_706 _768) "-i")))))) (($B (_747 _713)) ((($C' _684) (($B _746) (_687 ((_706 _768) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _779) _701) 1)) (_792 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _713)) (_688 ((_748 _788) ((_748 (_641 (($O 45) $K))) (_699 1))))))) (_709 ((_748 _788) (_641 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _649)) _17) (($B ($B ($B (_649 _678)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _649) (($B _651) (_740 _225)))))) (($B ($B ($B ($B $T)))) (($B ($B ($B ($B (_649 _678))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _650))) ((($C' $B) ($B' (($B _747) (($B _668) ((($C' _783) _9) 0))))) (($B ($B (_747 _671))) ((($C' ($C' _684)) (($B ($B (_684 "combinator conversion "))) (($B ($B (_643 6))) (($B ($B _629)) _777)))) "ms")))))) (($B ($B _651)) (($B $P) (($C _590) (_581 "main"))))))))) (_686 ($T ((($C' ($C' $O)) ((($C' $B) $P) _410)) $K))))))) (($A :3 (($B (_649 _598)) (($B (($C' _599) ((($C' _772) (($B _701) (_709 ((_748 _788) (_641 "--"))))) 1))) (($B (_747 _7)) _4)))) (($A :4 ($T (($C ((($C' $C') (($B $S) ($C $C))) (($B ($B $Y)) (($B ($B ($B _571))) (($C' ($C' _686)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _5))) $K))))))) (($B (($S' _747) (($B _744) (($B (_747 _792)) (($B (_684 "not found ")) _587))))) ($C _572))))) (($A :5 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _7)) _5)) _5))) ($BK $K))) ((($C' ($S' $C)) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _7)) $K))) ((($C' $B) _5) _409))) ((($S' _747) (($B _744) (($B (_747 _792)) (_684 "primlookup: ")))) (($C (_723 _641)) _6)))) $K))) (_792 "trans: impossible"))) (($A :6 (($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)
\ No newline at end of file
--- a/src/MicroHs/Parse.hs
+++ b/src/MicroHs/Parse.hs
@@ -1,7 +1,7 @@
 -- Copyright 2023 Lennart Augustsson
 -- See LICENSE file for full license.
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-unused-do-bind #-}
-module MicroHs.Parse(pTop, parseDie) where
+module MicroHs.Parse(pTop, parseDie, parse, pExprTop) where
 import Prelude --Xhiding (Monad(..), Applicative(..), MonadFail(..), Functor(..), (<$>), showString, showChar, showList)
 import Data.Char
 import Data.List
@@ -20,12 +20,18 @@
 parseDie :: forall a . --X (Show a) =>
             P a -> FilePath -> String -> a
 parseDie p fn file =
+  case parse p fn file of
+    Left msg -> error msg
+    Right a -> a
+
+parse :: forall a . --X (Show a) =>
+         P a -> FilePath -> String -> Either String a
+parse p fn file =
   let { ts = lexTop file } in
---  trace (show ts) $
   case runPrsr fn p ts of
-    Left lf -> error $ formatFailed fn ts lf
-    Right [(a, _)] -> a
-    Right as -> error $ "Ambiguous:"
+    Left lf -> Left $ formatFailed fn ts lf
+    Right [(a, _)] -> Right a
+    Right as -> Left $ "Ambiguous:"
 --X                     ++ unlines (map (show . fst) as)
 
 getLoc :: P Loc
@@ -35,6 +41,9 @@
 
 pTop :: P EModule
 pTop = pModule <* eof
+
+pExprTop :: P Expr
+pExprTop = pExpr <* eof
 
 pModule :: P EModule
 pModule = EModule <$> (pKeyword "module" *> pUQIdentA) <*>
-- 
⑨