dunham/newt
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

More porting. Parser is working now. Some improvements have been made to auto resolution

Browse Source
This commit is contained in:
Steve Dunham
2025-01-03 21:57:15 -08:00
parent 5a6dcdb92b
commit b87999a64d
9 changed files with 96 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
done/Lib/Parser/Impl.newt
View File

@@ -139,7 +139,11 @@ commit = P $ \toks com ops col => OK MkUnit toks True ops
some : ∀ a. Parser a -> Parser (List a)
many : ∀ a. Parser a -> Parser (List a)
some p = _::_ <$> p <*> many p
some p = do
x <- p
xs <- many p
pure (x :: xs)
many p = some p <|> pure Nil
-- one or more `a` seperated by `s`

7
done/Lib/Syntax.newt
View File

@@ -115,8 +115,8 @@ data Decl
| PFunc FC Name (List String) Raw String
| PMixFix FC (List Name) Int Fixity
| Class FC Name Telescope (List Decl)
| Instance FC Raw (List Decl)
| Record FC Name Telescope (Maybe Name) (Maybe (List Decl))
| Instance FC Raw (Maybe (List Decl))
| Record FC Name Telescope (Maybe Name) (List Decl)
instance HasFC Decl where
@@ -277,8 +277,7 @@ instance Pretty Decl where
pretty (PFunc _ nm Nil ty src) = text "pfunc" <+> text nm <+> text ":" <+> nest 2 (pretty ty <+> text ":=" <+/> text (show src))
pretty (PFunc _ nm used ty src) = text "pfunc" <+> text nm <+> text "uses" <+> spread (map text used) <+> text ":" <+> nest 2 (pretty ty <+> text ":=" <+/> text (show src))
pretty (PMixFix _ names prec fix) = text (show fix) <+> text (show prec) <+> spread (map text names)
pretty (Record _ nm tele cname Nothing) = text "record" <+> text nm <+> text ":" <+> spread (map prettyBind tele)
pretty (Record _ nm tele cname (Just decls)) = text "record" <+> text nm <+> text ":" <+> spread (map prettyBind tele)
pretty (Record _ nm tele cname decls) = text "record" <+> text nm <+> text ":" <+> spread (map prettyBind tele)
<+> (nest 2 $ text "where" </> stack (maybe empty (\ nm' => text "constructor" <+> text nm') cname :: map pretty decls))
pretty (Class _ nm tele decls) = text "class" <+> text nm <+> text ":" <+> spread (map prettyBind tele)
<+> (nest 2 $ text "where" </> stack (map pretty decls))

32
done/Lib/Types.newt
View File

@@ -403,23 +403,26 @@ record M a where
runM : TopContext -> IO (Either Error (TopContext × a))
instance Functor M where
map f (MkM run) = MkM $ \tc => bind {IO} (run tc) $ \case
Left err => pure $ Left err
Right (tc', a) => pure $ Right (tc', f a)
map f (MkM run) = MkM $ \tc => do
(Right (tc', a)) <- (run tc)
| Left err => pure $ Left err
pure $ Right (tc', f a)
instance Applicative M where
return x = MkM $ \tc => pure $ Right (tc, x)
(MkM f) <*> (MkM x) = MkM $ \tc => bind {IO} (f tc) $ \case
Left err => pure $ Left err
Right (tc', f') => bind {IO} (x tc') $ \case
Left err => pure $ Left err
Right (tc'', x') => pure $ Right (tc'', f' x')
(MkM f) <*> (MkM x) = MkM $ \tc => do
Right (tc', f') <- f tc
| Left err => pure $ Left err
Right (tc'', x') <- x tc'
| Left err => pure $ Left err
pure $ Right (tc'', f' x')
instance Monad M where
pure = return
bind (MkM x) f = MkM $ \tc => bind {IO} (x tc) $ \case
Left err => pure $ Left err
Right (tc', a) => runM (f a) tc'
bind (MkM x) f = MkM $ \tc => do
(Right (tc', a)) <- x tc
| Left err => pure $ Left err
.runM (f a) tc'
instance HasIO M where
liftIO io = MkM $ \tc => do
@@ -430,9 +433,10 @@ throwError : ∀ a. Error -> M a
throwError err = MkM $ \_ => pure $ Left err
catchError : ∀ a. M a -> (Error -> M a) -> M a
catchError (MkM ma) handler = MkM $ \tc => bind {IO} (ma tc) $ \case
Left err => runM (handler err) tc
Right (tc', a) => pure $ Right (tc', a)
catchError (MkM ma) handler = MkM $ \tc => do
(Right (tc', a)) <- ma tc
| Left err => .runM (handler err) tc
pure $ Right (tc', a)
tryError : ∀ a. M a -> M (Either Error a)
tryError ma = catchError (map Right ma) (pure ∘ Left)