diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..e07465c --- /dev/null +++ b/flake.lock @@ -0,0 +1,88 @@ +{ + "nodes": { + "basepkgs": { + "inputs": { + "basepkgs": "basepkgs_2", + "nixpkgs": "nixpkgs", + "nixpkgs-darwin": "nixpkgs-darwin" + }, + "locked": { + "lastModified": 1764227617, + "narHash": "sha256-6ufcKQRBK41hzBQPQKHTUqdB5TXYyx4QD3TwaXymHwg=", + "ref": "refs/heads/master", + "rev": "5c3c31fa35f9f75a52e2fd68f7d1d47f7622ce33", + "revCount": 108, + "type": "git", + "url": "ssh://git@github.com/composewell/streamly-packages" + }, + "original": { + "rev": "5c3c31fa35f9f75a52e2fd68f7d1d47f7622ce33", + "type": "git", + "url": "ssh://git@github.com/composewell/streamly-packages" + } + }, + "basepkgs_2": { + "locked": { + "lastModified": 1764227406, + "narHash": "sha256-aLI1AFkYWoJAWftnnQwLRiUaZnVIzNY3kkjW5ITigew=", + "owner": "composewell", + "repo": "nixpack", + "rev": "b00feebadac4b09a4670c7d68a567dc957f6cb82", + "type": "github" + }, + "original": { + "owner": "composewell", + "repo": "nixpack", + "rev": "b00feebadac4b09a4670c7d68a567dc957f6cb82", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1761440988, + "narHash": "sha256-2qsow3cQIgZB2g8Cy8cW+L9eXDHP6a1PsvOschk5y+E=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "de69d2ba6c70e747320df9c096523b623d3a4c35", + "type": "github" + }, + "original": { + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "de69d2ba6c70e747320df9c096523b623d3a4c35", + "type": "github" + } + }, + "nixpkgs-darwin": { + "locked": { + "lastModified": 1761430225, + "narHash": "sha256-rwI/YwAAByROAXkGbQNsxgUl/UM5eG5N6XIUzBKOIOw=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "08478b816182dc3cc208210b996294411690111d", + "type": "github" + }, + "original": { + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "08478b816182dc3cc208210b996294411690111d", + "type": "github" + } + }, + "root": { + "inputs": { + "basepkgs": "basepkgs", + "nixpkgs": [ + "basepkgs", + "nixpkgs" + ], + "nixpkgs-darwin": [ + "basepkgs", + "nixpkgs-darwin" + ] + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..c0f7860 --- /dev/null +++ b/flake.nix @@ -0,0 +1,17 @@ +{ + description = "fusion-plugin"; + + inputs = { + basepkgs.url = "git+ssh://git@github.com/composewell/streamly-packages?rev=5c3c31fa35f9f75a52e2fd68f7d1d47f7622ce33"; + nixpkgs.follows = "basepkgs/nixpkgs"; + nixpkgs-darwin.follows = "basepkgs/nixpkgs-darwin"; + }; + + outputs = { self, nixpkgs, nixpkgs-darwin, basepkgs }: + basepkgs.nixpack.mkOutputs { + inherit nixpkgs nixpkgs-darwin basepkgs; + name = "fusion-plugin"; + sources = basepkgs.nixpack.lib.localSource "fusion-plugin" ./.; + packages = basepkgs.nixpack.lib.devPackage "fusion-plugin"; + }; +} diff --git a/src/Fusion/Plugin.hs b/src/Fusion/Plugin.hs index 22ea6ab..9b79fbf 100644 --- a/src/Fusion/Plugin.hs +++ b/src/Fusion/Plugin.hs @@ -424,10 +424,10 @@ letBndrsThatAreCases dflags anns bind = goLet [] bind -- annotated with "Fuse" and traverse the Alt expressions to discover more -- let bindings. go parents True (Case _ _ _ alts) = - let binders = alts >>= (\(ALT_CONSTR(_,_,expr1)) -> go parents False expr1) + let result = alts >>= (\(ALT_CONSTR(_,_,expr1)) -> go parents False expr1) in case needInlineCaseAlt dflags parents anns alts of - Just x -> (parents, x) : binders - Nothing -> binders + Just x -> (parents, x) : result + Nothing -> result -- Only traverse the Alt expressions of the case to discover new let -- bindings. Do not match for annotated constructors in the Alts. @@ -755,13 +755,18 @@ fusionSimplify _hsc_env dflags = fusionReport :: String -> ReportMode -> ModGuts -> CoreM ModGuts fusionReport mesg reportMode guts = do - putMsgS $ "fusion-plugin: " ++ mesg ++ "..." - dflags <- getDynFlags - anns <- FMAP_SND getAnnotations deserializeWithData guts - when (anyUFM (any (== Fuse)) anns) $ - mapM_ (transformBind dflags anns) $ mg_binds guts - return guts - where + case reportMode of + ReportSilent -> return guts + _ -> do + putMsgS $ "fusion-plugin: " ++ mesg ++ "..." + dflags <- getDynFlags + anns <- FMAP_SND getAnnotations deserializeWithData guts + when (anyUFM (any (== Fuse)) anns) $ + mapM_ (transformBind dflags anns) $ mg_binds guts + return guts + + where + transformBind :: DynFlags -> UNIQ_FM -> CoreBind -> CoreM () transformBind dflags anns bind@(NonRec b _) = do let results = containsAnns dflags anns bind