etc

ejconlon · Feb 13, 2024 · c795248 · c795248
1 parent be07162
commit c795248
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 8 deletions.
diff --git a/minipat/src/Minipat/Ast.hs b/minipat/src/Minipat/Ast.hs
@@ -144,7 +144,11 @@ instance Pretty Factor where
 
 -- | Make a 'Factor' representing the given 'Rational'
 factorFromRational :: Rational -> Factor
-factorFromRational = FactorRational RationalPresDec
+factorFromRational f =
+  let (q, r) = quotRem (numerator f) (denominator f)
+  in  if r == 0
+        then FactorInteger q
+        else FactorRational RationalPresDec f
 
 factorUnary :: (forall a. (Num a) => a -> a) -> Factor -> Factor
 factorUnary f = \case

diff --git a/minipat/src/Minipat/Pattern.hs b/minipat/src/Minipat/Pattern.hs
@@ -34,7 +34,7 @@ mkPatGroup :: GroupType -> Seq (Pat b a) -> Reader b (Pat b a)
 mkPatGroup gt = \case
   Empty -> mkPat PatSilence
   x :<| Empty -> pure x
-  xs -> mkPat (PatGroup (Group 0 gt (fmap unPat xs)))
+  xs -> mkPat (PatGroup (Group 1 gt (fmap unPat xs)))
 
 mkPatMod :: ModType b -> Pat b a -> Reader b (Pat b a)
 mkPatMod mt (Pat pa) = mkPat (PatMod (Mod pa mt))
@@ -54,8 +54,8 @@ mkPatSeq = \case
   (x, _) :<| Empty -> pure x
   xs ->
     let w = sum (fmap snd (toList xs))
-        adjust (x, t) = unPat (patFastBy (t / w) x)
-    in  mkPat (PatGroup (Group 0 (GroupTypeSeq SeqPresSpace) (fmap adjust xs)))
+        adjust (x, _) = unPat x
+    in  mkPat (PatGroup (Group 1 (GroupTypeSeq SeqPresSpace) (fmap adjust xs)))
 
 -- | 'Pat' and 'Stream' can be constructed abstractly with this
 class (Functor f, Monad (PatM f), Default (PatA f)) => Pattern f where

diff --git a/minipat/test/Main.hs b/minipat/test/Main.hs
@@ -705,9 +705,33 @@ testPatReprCases =
         , Nothing
         )
       ,
-        ( "seq"
+        ( "seq 1"
+        , "[x]"
+        , Just (mkTPat (PatPure "x"))
+        , Just "x"
+        )
+      ,
+        ( "seq 2"
         , "[x y]"
-        , Nothing -- Just (mkTPat (PatPure "x"))
+        , Nothing
+        , Nothing
+        )
+      ,
+        ( "fast"
+        , "x*2"
+        , Nothing
+        , Nothing
+        )
+      ,
+        ( "slow"
+        , "x/2"
+        , Nothing
+        , Nothing
+        )
+      ,
+        ( "seq fast"
+        , "[x*2 y]"
+        , Nothing
         , Nothing
         )
       ]
@@ -739,7 +763,7 @@ main = do
       [ testParseCases
       , testPatNormCases
       , testPatInterpCases
-      -- TODO fix these
+      , testPatReprCases
+      -- TODO fix this
       -- , testUr
-      -- , testPatReprCases
       ]