From 5ef279345d2b1a69a77d39c7212bcb6d0d142b20 Mon Sep 17 00:00:00 2001 From: Eric Conlon <37287+ejconlon@users.noreply.github.com> Date: Fri, 9 Feb 2024 10:40:38 -0800 Subject: [PATCH] ur --- minipat/src/Minipat/Ur.hs | 43 ++++++++++++++++++++++++++++++--------- 1 file changed, 33 insertions(+), 10 deletions(-) diff --git a/minipat/src/Minipat/Ur.hs b/minipat/src/Minipat/Ur.hs index 77cd6c9..98c641a 100644 --- a/minipat/src/Minipat/Ur.hs +++ b/minipat/src/Minipat/Ur.hs @@ -1,22 +1,45 @@ module Minipat.Ur where +import Bowtie.Rewrite (AnnoErr) +import Control.Exception (Exception) +import Data.Typeable (Typeable) import Data.Map.Strict qualified as Map -import Minipat.Ast (Ident, Pat, Pattern, Select) +import Minipat.Ast (Ident, Pat, Pattern (..), Select (..)) +import Minipat.Interp (InterpErr, customInterpPat) +import Minipat.Time (CycleDelta (..)) + +data UrErr k = + UrErrPat !k + | UrErrXform !Ident + deriving stock (Eq, Ord, Show) + +instance (Show k, Typeable k) => Exception (UrErr k) --- TODO figure this out ur :: (Pattern f, Ord k) - => Pat b (Select k Ident) + => CycleDelta + -> Pat b (Select Ident k) -> [(k, f a)] -> [(Ident, f a -> f a)] - -> f a -ur p0 (Map.fromList -> xs) (Map.fromList -> ys) = - ur' p0 (`Map.lookup` xs) (`Map.lookup` ys) + -> Either (AnnoErr b (InterpErr (UrErr k))) (f a) +ur del pat (Map.fromList -> xs) (Map.fromList -> ys) = + ur' del pat (`Map.lookup` xs) (`Map.lookup` ys) + +urUse :: (k -> Maybe (f a)) -> (Ident -> Maybe (f a -> f a)) -> Select Ident k -> Either (UrErr k) (f a) +urUse findPat findXform (Select k mx) = + case findPat k of + Nothing -> Left (UrErrPat k) + Just p -> case mx of + Nothing -> Right p + Just x -> case findXform x of + Nothing -> Left (UrErrXform x) + Just f -> Right (f p) ur' - :: (Pattern f, Ord k) - => Pat b (Select k Ident) + :: (Pattern f) + => CycleDelta + -> Pat b (Select Ident k) -> (k -> Maybe (f a)) -> (Ident -> Maybe (f a -> f a)) - -> f a -ur' = error "TODO" + -> Either (AnnoErr b (InterpErr (UrErr k))) (f a) +ur' del pat findPat findXform = fmap (patSlowBy (unCycleDelta del)) (customInterpPat (urUse findPat findXform) pat)