shithub: MicroHs

Download patch

ref: c6a6f85900770fd7f140ef273d63a14d86fa853b
parent: 8ca938fdab80f32b770ce009c2fdb441a41a0109
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Thu Sep 21 08:51:21 EDT 2023 

Use catch in Interactive.hs


--- a/Makefile
+++ b/Makefile
@@ -69,6 +69,7 @@
 	$(GHCC) -c lib/Control/Monad/State/Strict.hs
 #	$(GHCC) -c lib/Debug/Trace.hs
 	$(GHCC) -c lib/System/Console/SimpleReadline.hs
+	$(GHCC) -c lib/Control/Exception.hs
 	$(GHCC) -c src/Text/ParserComb.hs
 	$(GHCC) -c src/MicroHs/Ident.hs
 	$(GHCC) -c src/MicroHs/Expr.hs
--- a/TODO
+++ b/TODO
@@ -8,7 +8,6 @@
   - Add SHA checksumming to the C code
   - Use filename as the cache lookup key and SHA for validation
 * make an interactive version
-  - implement catch (and maybe throw) using setjmp & longjmp
   - make the runtime system catch ^C and stop execution
 * use pointer stack during GC instead of recursion.
 * add Double primitive type
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v3.4
-874
-(($A :0 ((_664 _613) (($B ((($S' ($C (($C (($C $S') _3)) ((($C' ($C' $P)) ((($C' $B) _1) _596)) ($K ($K (_809 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] [ModuleName]"))))))) (($S (($S ((($S' _21) (($B _718) (_705 (_656 "-v")))) ((_734 _656) "-r"))) (($B (_699 (($O 46) $K))) (($B _763) (_704 ((_723 _785) "-i")))))) (($B (_764 _730)) ((($C' _701) (($B _763) (_704 ((_723 _785) "-o")))) (($O "out.comb") $K))))) (_705 ((_765 _805) ((_765 (_656 (($O 45) $K))) (_716 1)))))) (_726 ((_765 _805) (_656 "--")))))) (($A :1 ((($S' ($S' _664)) _30) (($B ($B ($B (_664 _695)))) ((($C' ($C' ($C' $C))) ((($C' $B) (($B ($C' $C)) ((($C' ($S' ($C' $C'))) (($B ($B ($B $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($S' ($C' $S'))))) ((($C' ($C' ($C' ($C' ($C' $C'))))) ((($C' ($S' ($C' ($C' ($C' $C'))))) (($B ($B ($B ($B $B')))) ((($C' ($S' ($C' $B))) (($B ($B ($B $C))) ((($S' $B) ($B' (($B ($S' $C')) (($B $B') (($B ($B _665)) ((($C' $B) (($B _764) (($B _685) ((($C' _800) _22) 0)))) (($B (_764 _688)) (($B (_701 "top level defns: ")) _644)))))))) ((($S' ($C' $B)) (($B $B') (($B $B') (($B $B') (($B ($B _665)) ((($C' $B) (($B _764) (($B _685) ((($C' _800) _22) 1)))) (_684 ($T (($B ($B (_764 _688))) ((($C' $B) (($B _701) ((($C' _701) _602) " = "))) (($C _422) $K))))))))))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) ($B' ($B' _23))) ((($S' $B) (($B ($C' ($C' _665))) ((($C' $B) ($B' (($B _764) (($B _690) _25)))) (($B _701) ((($C' _701) (($B (_701 _2)) _644)) (($O 10) $K)))))) (($B ($B (_664 _695))) ((($C' $B) ($B' (($B _764) (($B _685) ((($C' _800) _22) 0))))) (($B ($B (_764 _688))) ((($C' ($C' _701)) (($B ($B (_701 "final pass            "))) (($B ($B (_658 6))) (($B ($B _644)) _794)))) "ms"))))))) _16))))) ($C $P)))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($C _706)) _422))) (($C _719) (_735 0)))) $K))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B (($C' $B) (($B _765) (($B _701) ((($C' _701) (($B (_701 "(($A :")) _644)) (($O 32) $K))))))) ((($C' $B) (($B ($C' _765)) ($B _422))) (($B (_765 (_701 ") "))) (($C _765) (_701 (($O 41) $K))))))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _397)) $I))) ($BK $K))) $K))))) (($B (($S' _764) (($B _761) (($B (_764 _809)) (($B (_701 "main: findIdent: ")) _602))))) (($C' _632) _599)))) _639))) (($B ($B _636)) (($B (($C' _703) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _599))) $K)))))) (($C _719) (_735 0))))))) (($C _605) (_596 "main")))) (($B (_764 _396)) (($B (_764 _596)) (($B (_701 (($O 95) $K))) _644))))))) (($A :2 "v3.4\10&") (($A :3 (($B (_665 (_688 "Type ':quit' to quit"))) ((($C' _664) (($B (_570 _5)) ($P _4))) ($K (_666 _811))))) (($A :4 ((_701 ((_701 ((_701 ((_701 "module ") _6)) "(module ")) _6)) ") where\10&import Prelude\10&import Unsafe.Coerce\10&")) (($A :5 ((_571 ((_764 _580) ((_13 ".mhsi") "> "))) (($P _5) (($C (($S (($C $equal) ":quit")) ((($C' _572) _9) _5))) ((_764 _580) (_688 "Bye")))))) (($A :6 "Interactive") (($A :7 "_it") (($A :8 ((($C' _701) (_701 ((_701 ((_701 ((_701 _7) " :: Any\10&")) _7)) " = unsafeCoerce ("))) ")\10&")) (($A :9 (($B (_571 _579)) (($B $T) ((($S' ($S' $B)) (($B ($B _571)) (($B ($B _10)) (($B (($C' _701) (($C _701) (($O 10) $K)))) _8)))) ((($C' ($C' ($C' $P))) (($B ($B $BK)) (($B ($B (($C' (($S' _571) _10)) (($B ($B ($P (($B (_764 _580)) _688)))) (($B $BK) (($B ($B _578)) ($C $P))))))) ((($C' ($C' _701)) ($C _701)) (($O 10) $K))))) _11))))) (($A :10 ((($C' _572) (($B (_764 _580)) (_690 ((_701 _6) ".hs")))) ((_571 (_575 _773)) ((($C' _571) (($B (_764 _580)) (($C _30) (_596 _6)))) (($B _573) _776))))) (($A :11 (($B (($B (_764 _580)) (($S (($S _870) (($S (($C _871) (_688 "Type must be Int or IO"))) _20))) (($B (_764 _688)) (($B (_764 _644)) _20))))) (($B _17) ($P (_596 ((_701 ((_701 _6) (($O 46) $K))) _7)))))) (($A :12 ((($C' _665) _686) ((_664 (((_15 (($P _698) _698)) $K) $K)) ($T ($K _666))))) (($A :13 ((($S' $B) (($B _664) (($C _678) _660))) (($B ($B (($C' _664) (($P (_666 _698)) ((($C' _664) _692) (($B ((($S' _6
\ No newline at end of file
+878
+(($A :0 ((_668 _617) (($B ((($S' ($C (($C (($C $S') _3)) ((($C' ($C' $P)) ((($C' $B) _1) _600)) ($K ($K (_813 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] [ModuleName]"))))))) (($S (($S ((($S' _25) (($B _722) (_709 (_660 "-v")))) ((_738 _660) "-r"))) (($B (_703 (($O 46) $K))) (($B _767) (_708 ((_727 _789) "-i")))))) (($B (_768 _734)) ((($C' _705) (($B _767) (_708 ((_727 _789) "-o")))) (($O "out.comb") $K))))) (_709 ((_769 _809) ((_769 (_660 (($O 45) $K))) (_720 1)))))) (_730 ((_769 _809) (_660 "--")))))) (($A :1 ((($S' ($S' _668)) _34) (($B ($B ($B (_668 _699)))) ((($C' ($C' ($C' $C))) ((($C' $B) (($B ($C' $C)) ((($C' ($S' ($C' $C'))) (($B ($B ($B $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($S' ($C' $S'))))) ((($C' ($C' ($C' ($C' ($C' $C'))))) ((($C' ($S' ($C' ($C' ($C' $C'))))) (($B ($B ($B ($B $B')))) ((($C' ($S' ($C' $B))) (($B ($B ($B $C))) ((($S' $B) ($B' (($B ($S' $C')) (($B $B') (($B ($B _669)) ((($C' $B) (($B _768) (($B _689) ((($C' _804) _26) 0)))) (($B (_768 _692)) (($B (_705 "top level defns: ")) _648)))))))) ((($S' ($C' $B)) (($B $B') (($B $B') (($B $B') (($B ($B _669)) ((($C' $B) (($B _768) (($B _689) ((($C' _804) _26) 1)))) (_688 ($T (($B ($B (_768 _692))) ((($C' $B) (($B _705) ((($C' _705) _606) " = "))) (($C _426) $K))))))))))) ((($C' ($C' ($C' ($C' $B)))) ((($S' $B) ($B' ($B' _27))) ((($S' $B) (($B ($C' ($C' _669))) ((($C' $B) ($B' (($B _768) (($B _694) _29)))) (($B _705) ((($C' _705) (($B (_705 _2)) _648)) (($O 10) $K)))))) (($B ($B (_668 _699))) ((($C' $B) ($B' (($B _768) (($B _689) ((($C' _804) _26) 0))))) (($B ($B (_768 _692))) ((($C' ($C' _705)) (($B ($B (_705 "final pass            "))) (($B ($B (_662 6))) (($B ($B _648)) _798)))) "ms"))))))) _20))))) ($C $P)))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($C _710)) _426))) (($C _723) (_739 0)))) $K))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B (($C' $B) (($B _769) (($B _705) ((($C' _705) (($B (_705 "(($A :")) _648)) (($O 32) $K))))))) ((($C' $B) (($B ($C' _769)) ($B _426))) (($B (_769 (_705 ") "))) (($C _769) (_705 (($O 41) $K))))))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _401)) $I))) ($BK $K))) $K))))) (($B (($S' _768) (($B _765) (($B (_768 _813)) (($B (_705 "main: findIdent: ")) _606))))) (($C' _636) _603)))) _643))) (($B ($B _640)) (($B (($C' _707) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _603))) $K)))))) (($C _723) (_739 0))))))) (($C _609) (_600 "main")))) (($B (_768 _400)) (($B (_768 _600)) (($B (_705 (($O 95) $K))) _648))))))) (($A :2 "v3.4\10&") (($A :3 (($B (_669 (_692 "Type ':quit' to quit"))) ((($C' _668) (($B (_574 _5)) ($P _4))) ($K (_670 _815))))) (($A :4 ((_705 ((_705 ((_705 ((_705 "module ") _6)) "(module ")) _6)) ") where\10&import Prelude\10&import Unsafe.Coerce\10&")) (($A :5 ((_575 ((_768 _584) ((_13 ".mhsi") "> "))) (($P _5) (($C (($S (($C $equal) ":quit")) ((($C' _576) _9) _5))) ((_768 _584) (_692 "Bye")))))) (($A :6 "Interactive") (($A :7 "_it") (($A :8 ((($C' _705) (_705 ((_705 ((_705 ((_705 _7) " :: Any\10&")) _7)) " = unsafeCoerce ("))) ")\10&")) (($A :9 (($B (_575 _583)) (($B $T) ((($S' ($S' $B)) (($B ($B _575)) (($B ($B _10)) (($B (($C' _705) (($C _705) (($O 10) $K)))) _8)))) ((($C' ($C' ($C' $P))) (($B ($B $BK)) (($B ($B (($C' (($S' _575) _10)) (($B ($B ($P (($B (_768 _584)) _692)))) (($B $BK) (($B ($B _582)) ($C $P))))))) ((($C' ($C' _705)) ($C _705)) (($O 10) $K))))) _11))))) (($A :10 ((($C' _576) (($B (_768 _584)) (_694 ((_705 _6) ".hs")))) ((_575 (_579 _777)) (($B (_768 _584)) (($B (_768 _18)) (($C _34) (_600 _6))))))) (($A :11 (($B (($C ((($C' $B) (($B _575) (($B (_768 _584)) (($B _18) (($S _701) _670))))) (($B ($B (_768 _584))) (($S $P) ((($C' $S) (($B ($S _874)) (($B ($S (($C _875) (_692 "Type must be Int or IO")))) (($B (($C' _668) (($B _18) _24))) (($C $P) ($K (_670 _815))))))) (($B (_768 _692)) (($B (_768 _648)) _24))))))) (($B (_768 _692)) (_705 "Error: ")))) (($B _21) ($P (_600 ((_705 ((_705 _6) (($O 46) $K))) _7)))))) (($A :12 ((($C' _66
\ No newline at end of file
--- a/src/Compat.hs
+++ b/src/Compat.hs
@@ -2,6 +2,7 @@
 -- See LICENSE file for full license.
 -- Functions for GHC that are defined in the UHS libs.
 module Compat(module Compat) where
+--import Control.Exception
 import qualified Data.Function as F
 import Data.Time
 import Data.Time.Clock.POSIX
@@ -181,3 +182,7 @@
 primIsInt         = error "isInt"
 primIsIO         :: Any -> Bool
 primIsIO          = error "isIO"
+
+newtype Exn = Exn String
+  deriving (Show)
+instance Exception Exn
--- a/src/MicroHs/Interactive.hs
+++ b/src/MicroHs/Interactive.hs
@@ -1,5 +1,6 @@
 module MicroHs.Interactive(module MicroHs.Interactive) where
 import Prelude
+import Control.Exception
 import qualified MicroHs.StateIO as S
 import MicroHs.Compile
 import MicroHs.Exp(Exp)
@@ -17,6 +18,7 @@
 
 mainInteractive :: Flags -> IO ()
 mainInteractive flags = do
+  putStrLn "Welcome to interactive MicroHs!"
   putStrLn "Type ':quit' to quit"
   _ <- S.runStateIO repl (preamble, flags)
   return ()
@@ -53,23 +55,30 @@
       let lls = ls ++ line ++ "\n"
       defTest <- tryCompile lls
       case defTest of
-        Right _ -> S.put (lls, flgs)
-        Left  s -> S.liftIO $ putStrLn s
+        Right      _ -> S.put (lls, flgs)
+        Left (Exn s) -> S.liftIO $ putStrLn s
 
-tryCompile :: String -> I (Either String [LDef])
+tryCompile :: String -> I (Either Exn [LDef])
 tryCompile file = S.do
   S.liftIO $ writeFile (interactiveName ++ ".hs") file
   flgs <- S.gets snd
-  cmdl <- S.liftIO $ compileTop flgs (mkIdent interactiveName)
-  S.return (Right cmdl)
+  S.liftIO $ try $ compileTop flgs (mkIdent interactiveName)
 
 evalExpr :: [LDef] -> I ()
 evalExpr cmdl = S.do
-  let val = translate (mkIdent (interactiveName ++ "." ++ itName), cmdl)
+  let res = translate (mkIdent (interactiveName ++ "." ++ itName), cmdl)
+      err s = putStrLn $ "Error: " ++ s
+  mval <- S.liftIO $ try (seq res (return res))
   S.liftIO $
-    if primIsInt val then
-      putStrLn $ showInt $ unsafeCoerce val
-    else if primIsIO val then
-      unsafeCoerce val
-    else
-      putStrLn "Type must be Int or IO"
+    case mval of
+      Left (Exn s) -> err s
+      Right val ->
+        if primIsInt val then
+          putStrLn $ showInt $ unsafeCoerce val
+        else if primIsIO val then do
+          mio <- try (unsafeCoerce val)
+          case mio of
+            Left (Exn s) -> err s
+            Right _ -> return ()
+        else
+          putStrLn "Type must be Int or IO"
-- 
⑨