------------------------------------------------------------------------}}}
-- Experimental Detritus {{{
+-- | Return all plans for each functor/arity
+--
-- XXX This belongs elsewhere.
--
- -- XXX This guy wants span information.
+ -- XXX This guy wants span information; he's got it now use it.
--
-- timv: might want to fuse these into one circuit
+ --
combinePlans :: [(FRule,[(DFunctAr, Maybe (Cost,Action))])] ->
- Either String (M.Map DFunctAr [(FRule, Cost, Action)]) -- all plans for functor/arity
+ M.Map DFunctAr [(FRule, Cost, Action)]
combinePlans = go (M.empty)
where
- go m [] = Right m
+ go m [] = m
go m ((fr,cmca):xs) = go' xs fr cmca m
go' xs _ [] m = go m xs
go' xs fr ((fa,mca):ys) m =
case mca of
- Nothing -> Left $ "No plan for " ++ (show fa) -- timv: throw error here?
- ++ " in " ++ (show fr)
- Just (c,a) -> go' xs fr ys $ iora fa (fr,c,a) m
-
- -- Insert OR Append
- iora :: (Ord k) => k -> v -> M.Map k [v] -> M.Map k [v]
- iora k v m = M.alter (\mv -> Just $ v:nel mv) k m
- where
- nel Nothing = []
- nel (Just x) = x
-
-
-py (cruxf,cruxa) (FRule h _ _ r span _) dope =
- "@register" <> (parens $ dquotes $ pretty cruxf <> "/" <> (text $ show cruxa))
- `above` "def _(_h, _v):"
- `above` (indent 4 $ go dope)
+ Nothing -> throw $ TLENoUpdPlan fr fa
+ Just (c,a) -> go' xs fr ys $ mapInOrApp fa (fr,c,a) m
+
- -- timv: consider flattening FRUle and ANFState
-
+py (f,a) mu (FRule h _ _ r span _) dope =
+ case mu of
+ Just (hv,v) ->
+ "@register"
+ <> pfsa
+ `above` "def" <+> char '_'
+ <+> tupled (map pretty [hv,v])
+ <+> colon
+ Nothing -> "@initializer" <> pfsa
+ `above` "def _():"
+ `above` (indent 4 $ go dope emit)
where
- go [x] = pdope x `above` emit
+ pfsa = (parens $ dquotes $
+ pretty f <> "/" <> (text $ show a))
+
+ go [] = id
go (x:xs) = let px = pdope x
- pxstr = (show $ px)
- indents = ((pxstr !! (length pxstr - 1)) == ':')
+ indents = case x of OPIter _ _ _ -> True ; _ -> False
in
- px `above` (if indents then indent 4 $ go xs else go xs)
+ above px . (if indents then indent 4 else id) . go xs
emit = "emit" <> tupled [pretty h, pretty r]