shuffle 0.1.2.0 → 0.1.3.0
raw patch · 5 files changed
+75/−33 lines, 5 files
Files
- shuffle.cabal +1/−1
- src/UHC/Shuffle/ChunkParser.hs +1/−1
- src/UHC/Shuffle/Common.hs +30/−9
- src/UHC/Shuffle/MainAG.ag +42/−21
- src/UHC/Shuffle/Version.hs +1/−1
shuffle.cabal view
@@ -1,5 +1,5 @@ Name: shuffle-Version: 0.1.2.0+Version: 0.1.3.0 Copyright: Utrecht University, Department of Information and Computing Sciences, Software Technology group Description: Shuffle tool used by UHC (Utrecht Haskell Compiler) Synopsis: Shuffle tool for UHC
src/UHC/Shuffle/ChunkParser.hs view
@@ -28,7 +28,7 @@ type ScanOptsMp = Map.Map ScState ScanOpts chKindMp = Map.fromList- [ ("hs",ChHS), ("ag",ChAG), ("plain",ChPlain), ("haddock",ChHaddock) ]+ [ ("hs",ChHS), ("ag",ChAG), ("plain",ChPlain), ("haddock",ChHaddock), ("lhs2tex",ChLhs2TeX) ] `Map.union` Map.fromList [ (v,k) | (k,v) <- Map.toList t2tChKinds ] chDestMp = Map.fromList [ ("here",ChHere), ("hide",ChHide) ] chWrapMp = Map.fromList [ ("hsbox",ChWrapHsBox), ("code",ChWrapCode), ("safecode",ChWrapBoxCode Nothing), ("tt",ChWrapTT), ("tttiny",ChWrapTTtiny) , ("verbatim",ChWrapVerbatim), ("verbatimsmall",ChWrapVerbatimSmall) ]
src/UHC/Shuffle/Common.hs view
@@ -22,11 +22,15 @@ , ChKind(..), ChDest(..), ChWrap(..) , VariantRef(..)+ , variantRefIsPre , AspectRefs(..) , variantReqmRef, mbVariantReqmRef , variantRefFromTop , variantReqmUpdRef- , VariantOffer(..), VariantReqm(..)+ , VariantOffer(..)+ , variantOfferIsPre+ , VariantReqm(..)+ , variantReqmIsPre , variantOfferFromRef, variantReqmFromRef , variantOfferFromTop , variantOfferRef, variantOfferRefTop@@ -220,6 +224,7 @@ | ChHS | ChPlain | ChDocLaTeX -- restricted LaTeX for documentation+ | ChLhs2TeX -- lhs2tex -- | ChTexInfo -- | ChHtml -- | ChTwiki@@ -263,6 +268,11 @@ = VarRef {vrefRefs :: ![Int]} deriving (Show,Eq,Ord) +variantRefIsPre :: VariantRef -> Bool+variantRefIsPre (VarRef (0:_)) = True+variantRefIsPre _ = False++ instance NM VariantRef where mkNm (VarRef l) = nmApdL $ map mkNm l @@ -299,10 +309,15 @@ data VariantOffer = VOfferAll- | VOfferPre+ | VOfferPre { vofferAspect :: !AspectRefs} | VOfferRef {vofferVariant :: !VariantRef, vofferAspect :: !AspectRefs} deriving (Show,Eq,Ord) +variantOfferIsPre :: VariantOffer -> Bool+variantOfferIsPre o = case o of+ VOfferPre _ -> True+ _ -> False+ {- instance Ord VariantOffer where VOfferAll `compare` VOfferAll = EQ@@ -321,18 +336,19 @@ type VariantRefOrderMp = Map.Map VariantRef Int variantOfferFromRef :: VariantRef -> VariantOffer-variantOfferFromRef (VarRef (0:_ )) = VOfferPre-variantOfferFromRef r@(VarRef (i:is)) = VOfferRef r AspectAll+variantOfferFromRef r+ | variantRefIsPre r = VOfferPre AspectAll+ | otherwise = VOfferRef r AspectAll variantOfferFromTop :: Int -> VariantOffer variantOfferFromTop i = variantOfferFromRef (variantRefFromTop i) variantOfferRef :: VariantOffer -> VariantRef-variantOfferRef VOfferPre = VarRef [0]+variantOfferRef (VOfferPre _) = VarRef [0] variantOfferRef (VOfferRef r _) = r variantOfferAsp :: VariantOffer -> AspectRefs-variantOfferAsp VOfferPre = AspectAll+variantOfferAsp (VOfferPre a) = a variantOfferAsp (VOfferRef _ a) = a variantOfferRefTop :: VariantOffer -> Int@@ -366,8 +382,8 @@ ] instance NM VariantOffer where- mkNm VOfferPre = mkNm "pre"- mkNm VOfferAll = mkNm "*"+ mkNm (VOfferPre _) = mkNm "pre"+ mkNm VOfferAll = mkNm "*" mkNm (VOfferRef r _) = mkNm r -------------------------------------------------------------------------@@ -380,6 +396,10 @@ | VReqmRef { vreqmVariant :: !VariantRef, vreqmAspects :: !AspectRefs } deriving (Show,Eq,Ord) +variantReqmIsPre :: VariantReqm -> Bool+variantReqmIsPre (VReqmRef r _) = variantRefIsPre r+variantReqmIsPre _ = False+ -- type VariantReqm = VariantOffer variantReqmFromRef :: VariantRef -> VariantReqm@@ -392,7 +412,7 @@ variantReqmRef :: VariantReqm -> VariantRef variantReqmRef = maybe (error "variantReqmRef") id . mbVariantReqmRef -variantReqmUpdRef :: VariantReqm -> VariantRef-> VariantReqm+variantReqmUpdRef :: VariantReqm -> VariantRef -> VariantReqm variantReqmUpdRef v@(VReqmRef _ _) r = v {vreqmVariant = r} variantReqmUpdRef v _ = v @@ -402,6 +422,7 @@ variantReqmMatchOffer _ _ VOfferAll = True variantReqmMatchOffer Nothing (VReqmRef rr ra) (VOfferRef or oa) = rr == or && aspectRefsMatch oa ra variantReqmMatchOffer (Just m) (VReqmRef rr ra) (VOfferRef or oa) = Map.member or m && aspectRefsMatch oa ra+variantReqmMatchOffer _ (VReqmRef rr ra) (VOfferPre oa) = variantRefIsPre rr && aspectRefsMatch oa ra instance NM VariantReqm where mkNm VReqmAll = mkNm "*"
src/UHC/Shuffle/MainAG.ag view
@@ -478,7 +478,7 @@ vciHasImpExp i = not (null (vciImps i) && null (vciExps i)) vciIsPre :: VariantChunkInfo -> Bool-vciIsPre = (==VOfferPre) . vciVariantOffer+vciIsPre = variantOfferIsPre . vciVariantOffer vciIsHS :: VariantChunkInfo -> Bool vciIsHS = (==ChHS) . vciChKind@@ -492,31 +492,47 @@ vciSplitPre :: [VariantChunkInfo] -> ([VariantChunkInfo],[VariantChunkInfo]) vciSplitPre = partition vciIsPre +-- | Take the (possibly absent) Pre stuff, filtering the chunks+vciTakeFilterPre :: (VariantChunkInfo -> Bool) -> VariantChunkInfoM -> ([VariantChunkInfo],VariantChunkInfoM)+vciTakeFilterPre pred is+ = case span (variantOfferIsPre . fst) is of+ (pre,nonPre) -> (concatMap (filter pred . snd) pre, nonPre)+{-+ ((VOfferPre _,p):r) -> (filter pred p,r)+ _ -> ([],is)+-}+ vciTakePre :: VariantChunkInfoM -> ([VariantChunkInfo],VariantChunkInfoM)+vciTakePre = vciTakeFilterPre (const True)+{- vciTakePre is = case is of ((VOfferPre,p):r) -> (p,r)- _ -> ([],is)+ _ -> ([],is)+-} selectChunks :: Bool -> VariantReqm -> VariantRefOrderMp -> [VariantChunkInfo] -> [(VariantOffer,[VariantChunkInfo])] selectChunks appMinus variantReqm allowedVariants agl- = let (pre,nonPre) = vciSplitPre agl- vAndVciL = map (\v -> let vreqm = variantReqmUpdRef variantReqm (variantOfferRef v)- in ( v- , vciSortBySeqNr- $ vciVariantOfferFilter- (\offer -> variantReqmMatchOffer Nothing vreqm offer)- nonPre- ) )- [variantOfferFromRef r | r <- Map.keys allowedVariants]+ = filter+ ( not . null . snd )+ ( vAndVciPreL+ ++ map (\(v,vciL) -> (v,filter isNotMinused vciL)) vAndVciL+ )+ where (pre,nonPre) = vciSplitPre agl+ filterAllowed allowedVariants vciL+ = [ ( v+ , vciSortBySeqNr $ vciVariantOfferFilter+ (\offer -> variantReqmMatchOffer Nothing vreqm offer)+ vciL+ )+ | v <- allowedVariants+ , let vreqm = variantReqmUpdRef variantReqm (variantOfferRef v)+ ]+ vAndVciPreL = filterAllowed [VOfferPre AspectAll] pre+ vAndVciL = filterAllowed (map variantOfferFromRef $ Map.keys allowedVariants) nonPre isNotMinused = let minuses = if appMinus then [ m | (_,vciL) <- vAndVciL, ml <- map vciMinusL vciL, m <- ml ] else [] in \i -> vciChunkRef i `notElem` minuses- in filter- ( not.null.snd )- ( (VOfferPre,pre)- : map (\(v,vciL) -> (v,filter isNotMinused vciL)) vAndVciL- ) data Build = Build@@ -670,7 +686,7 @@ ish = filter vciIsHS noPre' buildImpExp = if optAGModHeader opts then buildAGHSModImpExp fileBase ish- else h (buildHSModImpExp fileBase ish)+ else h (buildHSModImpExp (\_ -> id) fileBase [] ish) pph = if any vciHasImpExp ish then wrap True buildImpExp else CDoc_Emp@@ -787,6 +803,9 @@ mkModNm :: [CDoc] -> CDoc mkModNm = cdHor +buildHSPre :: (Bool -> CDoc -> CDoc) -> [VariantChunkInfo] -> CDoc+buildHSPre wrap pre = cdVer [ wrap False $ vciCD p | p <- pre ]+ buildHSImps :: [VariantChunkInfo] -> CDoc buildHSImps = cdVer . map (cdVer . map ("import" .#.) . vciImps) @@ -802,8 +821,9 @@ modNm = if null m then fileBase else head m in "module" .#. modNm .-. {- indent 2 -} (exps .-. "where") -buildHSModImpExp :: String -> [VariantChunkInfo] -> CDoc-buildHSModImpExp fileBase is = buildHSModuleHead fileBase is .-. buildHSImps is+buildHSModImpExp :: (Bool -> CDoc -> CDoc) -> String -> [VariantChunkInfo] -> [VariantChunkInfo] -> CDoc+buildHSModImpExp wrap fileBase preHS is+ = buildHSPre wrap preHS .-. buildHSModuleHead fileBase is .-. buildHSImps is buildHS :: Opts -> (Bool -> CDoc -> CDoc) -> String -> VariantChunkInfoM -> CDoc buildHS opts wrap fileBase is@@ -811,8 +831,9 @@ ChHaddock -> haddockize (vciCD i) _ -> vciCD i (pre,noPre) = vciTakePre is+ (preHS, preOther) = partition vciIsHS pre noPre' = vciMToL noPre- ppMod = buildHSModImpExp fileBase (vciMToL is)+ ppMod = buildHSModImpExp wrap fileBase preHS (vciMToL is) ppNoPreL = map ( cdVer . (map (\i@@ -828,7 +849,7 @@ then CDoc_Emp else if optPlain opts then ppNoPre- else (if optPreamble opts then cdVer (map (wrap False . vciCD) pre) else CDoc_Emp)+ else (if optPreamble opts then buildHSPre wrap preOther else CDoc_Emp) .-. wrap True ppMod .-. ppNoPre }
src/UHC/Shuffle/Version.hs view
@@ -1,2 +1,2 @@ module UHC.Shuffle.Version where-version = "0.1.2.0"+version = "0.1.3.0"