shithub: MicroHs

Download patch

ref: e45faf9ac47edd49cc084382afced2758d9c70dd
parent: 69e3899f0464a4c76914e1988a6255ad3c0c1b10
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Wed Feb 21 06:29:54 EST 2024

Make it work again after headerless module change

--- a/src/MicroHs/Interactive.hs
+++ b/src/MicroHs/Interactive.hs
@@ -185,7 +185,7 @@
           Right m -> evalExpr m
           Left  e -> liftIO $ err e
   -- First try to parse as a definition,
-  tryParse pTop lls def $ \ _ ->
+  tryParse pTopModule lls def $ \ _ ->
     -- if that fails, parse as an expression.
     tryParse pExprTop line expr $
       liftIO . err'
--- 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(P, pTop, parseDie, parse, pExprTop) where
+module MicroHs.Parse(P, pTop, pTopModule, parseDie, parse, pExprTop) where
 import Prelude
 import Data.Char
 import Data.List
@@ -46,10 +46,13 @@
     _    -> fail "eof"
 
 pTop :: P EModule
-pTop = pModule <* eof
+pTop = (pModule <|< pModuleEmpty) <* eof
 
+pTopModule :: P EModule
+pTopModule = pModule <* eof
+
 pExprTop :: P Expr
-pExprTop = pExpr <* eof
+pExprTop = pBraces pExpr <* eof
 
 pModule :: P EModule
 pModule = do
@@ -60,7 +63,9 @@
   pKeyword "where"
   defs <- pBlock pDef
   pure $ EModule mn exps defs
- <|< do
+
+pModuleEmpty :: P EModule
+pModuleEmpty = do
   defs <- pBlock pDef
   --let loc = getSLoc defs
   pure $ EModule (mkIdent "Main") [ExpValue $ mkIdent "main"] defs
@@ -277,17 +282,17 @@
     is (TIdent _ [] s) = kw == s
     is _ = False
 
-pBlock :: forall a . P a -> P [a]
-pBlock p =
+pBraces :: forall a . P a -> P a
+pBraces p =
   do
     pSpec '{'
-    as <- body
+    as <- p
     pSpec '}'
     pure as
  <|>
   do
     pSpec '<'
-    as <- body
+    as <- p
     -- If we are at a '>' token (i.e., synthetic '}') then
     -- all is well, if not then there is a parse error and we try
     -- recovering by popping they layout stack.
@@ -298,6 +303,9 @@
       TSpec _ '>' -> pSpec '>'
       _           -> mapTokenState popLayout
     pure as
+
+pBlock :: forall a . P a -> P [a]
+pBlock p = pBraces body
   where body = esepBy p (esome (pSpec ';')) <* eoptional (pSpec ';')
 
 
--- a/tests/errmsg.test
+++ b/tests/errmsg.test
@@ -1,8 +1,8 @@
-amodule M() where
+module M() awhere
 -----
-mhs: "../tmp/E.hs": line 2, col 1:
-  found:    amodule
-  expected: module
+mhs: "../tmp/E.hs": line 2, col 12:
+  found:    awhere
+  expected: where
 
 =====
 module M() where
--