gador/nixpkgs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

haskell.{compiler,packages}.microhs: init at 0.15.4.0 (#460845)

Browse Source
This commit is contained in:
sternenseemann
2026-04-09 21:40:20 +00:00
committed by GitHub
parent 0c50eff6f6 8fbef8091f
commit bc9ff3c831
23 changed files with 1889 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files
doc/release-notes/rl-2605.section.md
+2
View File
@@ -284,6 +284,8 @@
- the `autossh-ng` NixOS module was introduced as a simpler alternative to the existing `autossh` module.
- Added `haskell.packages.microhs`, a set of Haskell packages built with MicroHs.
- `gnuradio`: Overriding the `.pkgs` package set is now possible with a `packageOverrides` function, like with `python.pkgs` and other language-specific package sets.
Example:
maintainers/maintainer-list.nix
+14
View File
@@ -1192,6 +1192,20 @@
githubId = 49609151;
name = "Popa Ioan Alexandru";
};
AlexandreTunstall = {
name = "Alex Tunstall";
email = "alex@tunstall.xyz";
matrix = "@alex:tunstall.xyz";
github = "AlexandreTunstall";
githubId = 32900877;
keys = [
{
# Fetch with WKD (e.g. gpg --locate-external-keys alex@tunstall.xyz)
# The fetched key should have this fingerprint (please let me know if not)
fingerprint = "51A5 8478 068E B19D FD35 D542 F6CA 1AD5 54DC A5E4";
}
];
};
alexandru0-dev = {
email = "alexandru.italia32+nixpkgs@gmail.com";
github = "alexandru0-dev";
pkgs/by-name/mi/microhs/package.nix
-46
View File
@@ -1,46 +0,0 @@
{
callPackage,
stdenv,
fetchFromGitHub,
lib,
writableTmpDirAsHomeHook,
nix-update-script,
}:
stdenv.mkDerivation (finalAttrs: {
pname = "microhs";
version = "0.15.4.0";
src = fetchFromGitHub {
owner = "augustss";
repo = "MicroHs";
tag = "v${finalAttrs.version}";
hash = "sha256-V3Of72rpXvImV90sSoYz02H06o1J3FqHDQNbB+M6/8A=";
};
# mcabal doesn't seem to respect the make flag and fails with /homeless-shelter
# This works around the issue
nativeBuildInputs = [ writableTmpDirAsHomeHook ];
makeFlags = [ "MCABAL=$(out)" ];
buildFlags = [ "bootstrap" ];
# MicroCabal is a separate repository, which should be packaged separately
# The MicroCabal that is installed by `make install` is pregenerated, does not respect MCABAL above, and so is not useable
postInstall = "rm $out/bin/mcabal";
passthru = {
updateScript = nix-update-script { };
tests = {
hello-world = callPackage ./test-hello-world.nix { microhs = finalAttrs.finalPackage; };
};
};
meta = {
description = "Haskell implemented with combinators";
homepage = "https://github.com/augustss/MicroHs";
license = lib.licenses.asl20;
maintainers = [ lib.maintainers.steeleduncan ];
platforms = lib.platforms.all;
};
})
pkgs/development/compilers/microhs/0.15.4.0.nix
+4
View File
@@ -0,0 +1,4 @@
import ./common.nix {
version = "0.15.4.0";
hash = "sha256-FUr2EA3zbmt2Tr2F8zT1wHnB8GDlUVb2W1fP4IqNd80=";
}
pkgs/development/compilers/microhs/boot.nix
+40
View File
@@ -0,0 +1,40 @@
{
stdenvNoCC,
hugs,
makeWrapper,
microhs-src,
}:
stdenvNoCC.mkDerivation {
pname = "microhs";
version = "${microhs-src.version}-hugs";
inherit (microhs-src)
src
patches
postPatch
meta
;
nativeBuildInputs = [ makeWrapper ];
dontBuild = true;
installPhase = ''
runHook preInstall
mkdir -p "$out/bin" "$out/share/microhs-hugs"
s="$out/share/microhs-hugs/src"
cp -r . "$s"
makeWrapper ${hugs}/bin/runhugs "$out/bin/mhs" \
--add-flags "'+P$s/hugs:$s/src:$s/paths:{Hugs}/packages/*:hugs/obj' -98 +o +w -h100m '$s/hugs/Main.hs'"
runHook postInstall
'';
passthru = {
isMhs = true;
usesHugs = true;
};
}
pkgs/development/compilers/microhs/common.nix
+94
View File
@@ -0,0 +1,94 @@
{
version,
mcabalVersion ? "0.5.3.0-31f1b5dec81561a1b1d36b8e3065ce091dce2ec6",
rev ? "refs/tags/v${version}",
hash,
}:
{
lib,
buildPackages,
pkgsBuildBuild,
callPackage,
fetchFromGitHub,
fetchpatch,
microhs-boot,
stdenv,
versionCheckHook,
writeShellScript,
}:
let
args = finalAttrs: {
inherit version;
src = fetchFromGitHub {
owner = "augustss";
repo = "MicroHs";
fetchSubmodules = true;
inherit rev hash;
};
patches = [
patches/hugs.patch
patches/hugs-viewpatterns.patch
]
++ lib.optional stdenv.hostPlatform.isGnu patches/link-math.patch;
# The source contains pre-compiled files
# We delete them to be certain we are building from source
postPatch = ''
rm -r generated
'';
doInstallCheck = true;
nativeInstallCheckInputs = [
versionCheckHook
];
meta = {
description = "Small compiler for Haskell";
longDescription = ''
A compiler for an extended subset of Haskell 2010.
The compiler translates to combinators and can compile itself.
'';
homepage = "https://github.com/augustss/MicroHs";
license = lib.licensesSpdx."Apache-2.0";
mainProgram = "mhs";
maintainers = with lib.maintainers; [
AlexandreTunstall
steeleduncan
];
platforms = lib.platforms.all;
};
};
microhs-stage1-build = pkgsBuildBuild.callPackage ./stage1.nix {
inherit args microhs-boot;
};
microhs-stage1 = buildPackages.callPackage ./stage1.nix {
inherit args microhs-boot;
};
microhs-stage2 = callPackage ./stage2.nix {
inherit
args
microcabal-stage1
microhs-stage1
cpphs
;
};
microcabal-stage1 = buildPackages.callPackage ../../tools/haskell/microcabal/${mcabalVersion}.nix {
microhs = microhs-stage1-build;
};
cpphs = buildPackages.callPackage ./cpphs.nix {
inherit args;
microhs = microhs-stage2;
};
in
microhs-stage2
pkgs/development/compilers/microhs/cpphs.nix
+50
View File
@@ -0,0 +1,50 @@
{
args,
hugs,
microhs,
stdenv,
}:
stdenv.mkDerivation (
finalAttrs:
let
args' = args finalAttrs;
in
args'
// {
pname = "microhs-cpphs";
nativeBuildInputs = [ hugs ];
makeFlags = [ "USECPPHS=$(TMP)/cpphs-boot" ];
buildFlags = [
"bootstrapcpphs"
"bin/cpphs"
];
# Generate cpphs-boot and populate paths that the target uses
# We can't use cpphs-hugs directly because it's too primitive
preBuild = ''
mkdir -p $TMP/cpphs-hugs/src
cp -r hugs/* cpphscompat/* cpphssrc/malcolm-wallace-universe/{polyparse-*/src,cpphs-*}/* $TMP/cpphs-hugs/src/
find $TMP/cpphs-hugs/src -type f -name '*.hs' -exec ${hugs}/bin/cpphs-hugs --noline '{}' '-O{}.tmp' \;
find $TMP/cpphs-hugs/src -type f -name '*.hs' -exec mv '{}.tmp' '{}' \;
sed -i -e '/fail *= *Fail\.fail/d' $TMP/cpphs-hugs/src/Text/ParserCombinators/Poly/Parser.hs
${microhs}/bin/mhs -l -i$TMP/cpphs-hugs/src $TMP/cpphs-hugs/src/cpphs.hs -o$TMP/cpphs-boot
mkdir -p bin generated
touch cpphssrc/malcolm-wallace-universe/.git targets.conf
cp ${microhs}/bin/mhs bin/mhs
'';
installPhase = ''
runHook preInstall
install -m755 -d $out/bin
install -m755 bin/cpphs $out/bin/cpphs
runHook postInstall
'';
doInstallCheck = false;
}
)
pkgs/development/compilers/microhs/patches/hugs-viewpatterns.patch
+406
View File
@@ -0,0 +1,406 @@
If you need to update this patch, apply it to the old version, then use Git to
rebase it onto the new version.
diff --git a/src/MicroHs/ExpPrint.hs b/src/MicroHs/ExpPrint.hs
index 59afc0d0..bada27d2 100644
--- a/src/MicroHs/ExpPrint.hs
+++ b/src/MicroHs/ExpPrint.hs
@@ -30,7 +30,7 @@ removeUnused (ds, emain) = dfs roots M.empty
dMap = M.fromList ds
dfs :: [Ident] -> M.Map Exp -> [LDef]
dfs [] done = M.toList done
- dfs (i:is) done | Just _ <- M.lookup i done = dfs is done
+ dfs (i:is) done | isJust (M.lookup i done) = dfs is done
| otherwise = dfs (freeVars e ++ is) (M.insert i e done)
where e = fromMaybe (error $ "removeUnused: undef " ++ show i) $ M.lookup i dMap
@@ -81,7 +81,7 @@ toStringCMdl :: CMdl -> String
toStringCMdl (ds, emain) =
let
def :: (Ident, Exp) -> (String -> String) -> (String -> String)
- def (i, e) r | Just (e', _) <- getForExp e = def (i, e') r
+ def (i, e) r | isJust (getForExp e) = let Just (e', _) = getForExp e in def (i, e') r
def (i, e) r =
("A " ++) . toStringP e . ((":" ++ showIdent i ++ " @\n") ++) . r . ("@" ++)
diff --git a/src/MicroHs/Expr.hs b/src/MicroHs/Expr.hs
index bd05f1bc..14225927 100644
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -514,7 +514,7 @@ getTupleConstr i =
getExprTuple :: EType -> Maybe [EType]
getExprTuple = loop []
where loop ts (EApp f a) = loop (a:ts) f
- loop ts (EVar i) | Just n <- getTupleConstr i, length ts == n = Just ts
+ loop ts (EVar i) | isJust (getTupleConstr i) && length ts == fromJust (getTupleConstr i) = Just ts
loop _ _ = Nothing
-- Create a tuple selector, component i (0 based) of n
@@ -1015,13 +1015,13 @@ ppExprR raw = ppE
ppApp :: [Expr] -> Expr -> Doc
ppApp as (EApp f a) = ppApp (a:as) f
ppApp as f | raw = ppApply f as
- ppApp as (EVar i) | isOperChar cop, [a, b] <- as = parens $ ppE a <+> text op <+> ppExpr b
- | isOperChar cop, [a] <- as = parens $ ppE a <+> text op
- | cop == ',' && length op + 1 == length as
- = ppE (ETuple as)
- | op == "[]", length as == 1 = ppE (EListish (LList as))
- where op = unIdent (unQualIdent i)
- cop = head op
+ ppApp as (EVar i) = case as of
+ [a, b] | isOperChar cop -> parens $ ppE a <+> text op <+> ppExpr b
+ [a] | isOperChar cop -> parens $ ppE a <+> text op
+ _ | cop == ',' && length op + 1 == length as -> ppE (ETuple as)
+ | op == "[]" && length as == 1 -> ppE (EListish (LList as))
+ where op = unIdent (unQualIdent i)
+ cop = head op
ppApp as f = ppApply f as
ppApply f as = parens $ hsep (map ppE (f:as))
@@ -1212,5 +1212,5 @@ getImplies _ = Nothing
dropForallContext :: EType -> EType
dropForallContext (EForall _ _ t) = dropForallContext t
-dropForallContext t | Just (_, t') <- getImplies t = dropForallContext t'
+dropForallContext t | isJust (getImplies t) = let Just (_, t') = getImplies t in dropForallContext t'
| otherwise = t
diff --git a/src/MicroHs/FFI.hs b/src/MicroHs/FFI.hs
index 4e79ab18..292a28fb 100644
--- a/src/MicroHs/FFI.hs
+++ b/src/MicroHs/FFI.hs
@@ -1,6 +1,7 @@
module MicroHs.FFI(makeFFI) where
import qualified Prelude(); import MHSPrelude
import Data.List
+import Data.Maybe(fromJust, isJust)
import MicroHs.Desugar(LDef)
import MicroHs.Exp
import MicroHs.Expr
@@ -175,7 +176,8 @@ arity = length . fst . getArrows
cTypeHsName :: HasCallStack => EType -> String
cTypeHsName (EApp (EVar ptr) _t) | ptr == identPtr = "Ptr"
| ptr == identFunPtr = "FunPtr"
-cTypeHsName (EVar i) | Just c <- lookup (unIdent i) cHsTypes = c
+cTypeHsName (EVar i) | isJust mc = fromJust mc
+ where mc = lookup (unIdent i) cHsTypes
cTypeHsName t = errorMessage (getSLoc t) $ "Not a valid C type: " ++ showEType t
cHsTypes :: [(String, String)]
@@ -193,7 +195,8 @@ cHsTypes =
-- Use to construct 'foreign export ccall' signature.
cTypeName :: EType -> String
cTypeName (EApp (EVar ptr) _t) | ptr == identPtr = "void*"
-cTypeName (EVar i) | Just c <- lookup (unIdent i) cTypes = c
+cTypeName (EVar i) | isJust mc = fromJust mc
+ where mc = lookup (unIdent i) cTypes
cTypeName t = errorMessage (getSLoc t) $ "Not a valid C type: " ++ showEType t
cTypes :: [(String, String)]
@@ -211,7 +214,8 @@ cTypes =
-- Use to construct 'foreign import javascript' return value wrapper.
jsTypeNameR :: EType -> String
jsTypeNameR (EApp (EVar ptr) _) | ptr == identPtr = "PTR"
-jsTypeNameR (EVar i) | Just c <- lookup (unIdent i) jsTypesR = c
+jsTypeNameR (EVar i) | isJust mc = fromJust mc
+ where mc = lookup (unIdent i) jsTypesR
jsTypeNameR t = errorMessage (getSLoc t) $ "Not a valid Javascript return type: " ++ showEType t
jsTypesR :: [(String, String)]
@@ -224,7 +228,8 @@ jsTypesR =
-- Use to construct 'foreign import javascript' argument wrapper.
jsTypeName :: EType -> String
jsTypeName (EApp (EVar ptr) _) | ptr == identPtr = "Ptr"
-jsTypeName (EVar i) | Just c <- lookup (unIdent i) jsTypes = c
+jsTypeName (EVar i) | isJust mc = fromJust mc
+ where mc = lookup (unIdent i) jsTypes
jsTypeName t = errorMessage (getSLoc t) $ "Not a valid Javascript argument type: " ++ showEType t
jsTypes :: [(String, String)]
diff --git a/src/MicroHs/Lex.hs b/src/MicroHs/Lex.hs
index 12e0213f..ebe591df 100644
--- a/src/MicroHs/Lex.hs
+++ b/src/MicroHs/Lex.hs
@@ -8,7 +8,7 @@ module MicroHs.Lex(
import qualified Prelude(); import MHSPrelude hiding(lex)
import Data.Char
import Data.List
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, isJust)
import MicroHs.Ident
import Text.ParserComb(TokenMachine(..))
@@ -101,14 +101,14 @@ lex loc ('(':dcs@(d:cs)) | d == '#' = TSpec loc 'L' : lex (addCol loc 2) cs
| otherwise = TSpec loc '(' : lex (addCol loc 1) dcs
lex loc ('#':')':cs) = TSpec loc 'R' : lex (addCol loc 2) cs
-- Recognize #line 123 "file/name.hs"
-lex loc ('#':xcs) | (SLoc _ _ 1) <- loc, Just cs <- stripPrefix "line " xcs =
+lex (SLoc _ _ 1) ('#':'l':'i':'n':'e':' ':cs) =
case span (/= '\n') cs of
(line, rs) -> -- rs will contain the '\n', so subtract 1 below
let ws = words line
file = tail $ init $ ws!!1 -- strip the initial and final '"'
loc' = SLoc file (readInt (ws!!0) - 1) 1
in lex loc' rs
- | (SLoc _ 1 1) <- loc, take 1 xcs == "!" =
+lex loc@(SLoc _ 1 1) ('#':xcs@('!':cs)) =
-- It's a shebang (#!), ignore the rest of the line
skipLine loc xcs
lex loc ('!':' ':cs) = -- ! followed by a space is always an operator
@@ -231,7 +231,7 @@ tIndent ts = TIndent (tokensLoc ts) : ts
lexLitStr :: SLoc -> SLoc -> (String -> Token) -> (String -> Maybe Int) -> (String -> String) -> String -> [Token]
lexLitStr oloc loc mk end post acs = loop loc [] acs
- where loop l rs cs | Just k <- end cs = mk (decodeEscs $ post $ reverse rs) : lex (addCol l k) (drop k cs)
+ where loop l rs cs | isJust (end cs) = let Just k = end cs in mk (decodeEscs $ post $ reverse rs) : lex (addCol l k) (drop k cs)
loop l rs ('\\':c:cs) | isSpace c = remGap l rs cs
loop l rs ('\\':'^':'\\':cs) = loop (addCol l 3) ('\\':'^':'\\':rs) cs -- special hack for unescaped \
loop l rs ('\\':cs) = loop' (addCol l 1) ('\\':rs) cs
@@ -270,8 +270,10 @@ decodeEsc ('x':cs) = conv 16 0 cs
decodeEsc ('o':cs) = conv 8 0 cs
decodeEsc ('^':c:cs) | '@' <= c && c <= '_' = chr (ord c - ord '@') : decodeEscs cs
decodeEsc cs@(c:_) | isDigit c = conv 10 0 cs
-decodeEsc (c1:c2:c3:cs) | Just c <- lookup [c1,c2,c3] ctlCodes = c : decodeEscs cs
-decodeEsc (c1:c2:cs) | Just c <- lookup [c1,c2] ctlCodes = c : decodeEscs cs
+decodeEsc (c1:c2:c3:cs) | isJust mc = let Just c = mc in c : decodeEscs cs
+ where mc = lookup [c1,c2,c3] ctlCodes
+decodeEsc (c1:c2:cs) | isJust mc = let Just c = mc in c : decodeEscs cs
+ where mc = lookup [c1,c2] ctlCodes
decodeEsc (c :cs) = c : decodeEscs cs
decodeEsc [] = mhsError "Bad \\ escape"
@@ -417,7 +419,7 @@ pragma loc cs =
in case words cs of
p : _ | map toUpper p == "SOURCE" -> TPragma loc p : skip
-- hsc2hs generates LINE pragmas
- p : ln@(_:_) : fn : _ | map toUpper p == "LINE", all isDigit ln ->
+ p : ln@(_:_) : fn : _ | map toUpper p == "LINE" && all isDigit ln ->
let f = tail (init fn)
l = readInt ln - 1
in seq l $ skipNest (SLoc f l 1) 1 ('#':cs)
diff --git a/src/MicroHs/Main.hs b/src/MicroHs/Main.hs
index 913c197b..7f17e313 100644
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -141,16 +141,16 @@ decodeArgs f mdls (arg:args) =
"-z" -> decodeArgs f{compress = True} mdls args
"-b64" -> decodeArgs f{base64 = True} mdls args
"-Q" -> decodeArgs f{installPkg = True} mdls args
- "-o" | s : args' <- args
- -> decodeArgs f{output = s} mdls args'
- "-optc" | s : args' <- args
- -> decodeArgs f{cArgs = cArgs f ++ [s]} mdls args'
- "-optl" | s : args' <- args
- -> decodeArgs f{lArgs = lArgs f ++ [s]} mdls args'
- "-optF" | s : args' <- args
- -> decodeArgs f{fArgs = fArgs f ++ [s]} mdls args'
- "-pgmF" | s : args' <- args
- -> decodeArgs f{fPgm = Just s} mdls args'
+ "-o" | not (null args)
+ -> let s : args' = args in decodeArgs f{output = s} mdls args'
+ "-optc" | not (null args)
+ -> let s : args' = args in decodeArgs f{cArgs = cArgs f ++ [s]} mdls args'
+ "-optl" | not (null args)
+ -> let s : args' = args in decodeArgs f{lArgs = lArgs f ++ [s]} mdls args'
+ "-optF" | not (null args)
+ -> let s : args' = args in decodeArgs f{fArgs = fArgs f ++ [s]} mdls args'
+ "-pgmF" | not (null args)
+ -> let s : args' = args in decodeArgs f{fPgm = Just s} mdls args'
"-F" -> decodeArgs f{doF = True} mdls args
'-':'i':[] -> decodeArgs f{paths = []} mdls args
'-':'i':s -> decodeArgs f{paths = paths f ++ [s]} mdls args
@@ -163,7 +163,7 @@ decodeArgs f mdls (arg:args) =
'-':'a':s -> decodeArgs f{pkgPath = pkgPath f ++ [s]} mdls args
'-':'L':s -> decodeArgs f{listPkg = Just s} mdls args
'-':'p':s -> decodeArgs f{preload = preload f ++ [s]} mdls args
- '-':'d':'d':'u':'m':'p':'-':r | Just d <- lookup r dumpFlagTable ->
+ '-':'d':'d':'u':'m':'p':'-':r | isJust (lookup r dumpFlagTable) -> let Just d = lookup r dumpFlagTable in
decodeArgs f{dumpFlags = d : dumpFlags f} mdls args
"--stdin" -> decodeArgs f{useStdin = True} mdls args
'-':_ -> mhsError $ "Unknown flag: " ++ arg ++ "\n" ++ usage
diff --git a/src/MicroHs/TypeCheck.hs b/src/MicroHs/TypeCheck.hs
index db7f3527..b006e8f9 100644
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -824,7 +824,7 @@ tInst :: HasCallStack => Expr -> EType -> T (Expr, EType)
tInst ae (EForall _ vks t) = do
t' <- tInstForall vks t
tInst ae t'
-tInst ae at | Just (ctx, t) <- getImplies at = do
+tInst ae at | isJust (getImplies at) = let Just (ctx, t) = getImplies at in do
--tcTrace $ "tInst: addConstraint: " ++ show ae ++ ", " ++ show d ++ " :: " ++ show ctx
{-
if eqExpr ae eCannotHappen then
@@ -1326,7 +1326,7 @@ expandClass d = return [d]
-- Ignoring initial quantifiers and context, how many arrows does the type have?
countArrows :: EType -> Int
countArrows (EForall _ _ t) = countArrows t
-countArrows t | Just (_, t') <- getImplies t = countArrows t'
+countArrows t | isJust (getImplies t) = let Just (_, t') = getImplies t in countArrows t'
| otherwise = length . fst . getArrows $ t
simpleEqn :: Expr -> [Eqn]
@@ -1772,7 +1772,7 @@ tInferExpr = tInfer tcExpr
tCheckExpr :: HasCallStack =>
EType -> Expr -> T Expr
-tCheckExpr t e | Just (ctx, t') <- getImplies t = do
+tCheckExpr t e | isJust (getImplies t) = let Just (ctx, t') = getImplies t in do
-- tcTrace $ "tCheckExpr: " ++ show (e, ctx, t')
xt <- expandSyn t
unless (eqEType t xt) undefined
@@ -2125,7 +2125,7 @@ needDsCase ex lbls ae =
vt <- gets valueTable
case stLookupGlbUnqMany lbl vt of
-- check the return type of an unambiguous label
- Just [Entry _ t] | (t':_, _) <- getArrows (dropForallContext t) -> needT t'
+ Just [Entry _ t] | not $ null $ fst $ getArrows (dropForallContext t) -> needT $ head $ fst $ getArrows $ dropForallContext t
_ -> return Nothing
-- Do a record update using case.
@@ -2184,8 +2184,8 @@ tcExprAp mt ae args = do
EUVar r -> fmap (fromMaybe t) (getUVar r)
_ -> return t
-- tcTrace $ "exExprAp: EVar " ++ showIdent i ++ " :: " ++ showExpr t ++ " = " ++ showExpr t' ++ " mt=" ++ show mt
- case fn of
- EVar ii | ii == mkIdent "Data.Function.$", f:as <- args -> tcExprAp mt f as
+ case (fn, args) of
+ (EVar ii, f:as) | ii == mkIdent "Data.Function.$" -> tcExprAp mt f as
_ -> tcExprApFn mt fn t' args
EQVar f t -> -- already resolved
tcExprApFn mt f t args
@@ -2216,17 +2216,17 @@ tcExprApFn mt fn atfn aargs = do
let -- loop _ats aas ft | trace ("loop: " ++ show (aas, ft)) False = undefined
loop ats [] ft = final (reverse ats) ft
loop ats aas@(a:as) aft = do
- case nextArg aft of
- AReqd (IdKind i k) ft -> useType i k a ft
- AForall _ (IdKind i k:iks) ft | ETypeArg t <- a -> do
+ case (nextArg aft, a) of
+ (AReqd (IdKind i k) ft, _) -> useType i k a ft
+ (AForall _ (IdKind i k:iks) ft, ETypeArg t) -> do
-- traceM ("AForall " ++ show (i, t))
useType i k t (EForall QExpl iks ft)
- AForall _ iks ft -> do
+ (AForall _ iks ft, _) -> do
ft' <- tInstForall iks ft
loop ats aas ft'
- AConstaint ctx ft ->
+ (AConstaint ctx ft, _) ->
loop (ArgCtx ctx : ats) aas ft
- ARet aft' -> do
+ (ARet aft', _) -> do
(at, rt) <- unArrow loc aft'
--traceM ("ARet " ++ show (at, rt))
loop (ArgExpr a at : ats) as rt
@@ -2543,7 +2543,7 @@ nextArg :: EType -> Arg
nextArg (EForall _ [] t) = nextArg t
nextArg (EForall QReqd (ik:iks) t) = AReqd ik (EForall QReqd iks t)
nextArg (EForall q iks t) = AForall q iks t
-nextArg t | Just (ctx, t') <- getImplies t = AConstaint ctx t'
+nextArg t | isJust (getImplies t) = let Just (ctx, t') = getImplies t in AConstaint ctx t'
| otherwise = ARet t
tcExprLam :: HasCallStack => Expected -> SLoc -> [Eqn] -> T Expr
@@ -2559,7 +2559,7 @@ tcEqns' top at eqns =
case at of
EForall QExpl iks t -> withExtTyps iks $ tcEqns' top t eqns
EForall QImpl _ t -> tcEqns' top t eqns
- _ | Just (ctx, t') <- getImplies at -> do
+ _ | isJust (getImplies at) -> let Just (ctx, t') = getImplies at in do
let loc = getSLoc eqns
d <- newADictIdent loc
f <- newIdent loc "fcnD"
@@ -3109,7 +3109,7 @@ skolemise (EForall _ tvs ty) = do -- Rule PRPOLY
(sks1, ty') <- shallowSkolemise tvs ty
(sks2, ty'') <- skolemise ty'
return (sks1 ++ sks2, ty'')
-skolemise t@(EApp _ _) | Just (arg_ty, res_ty) <- getArrow t = do
+skolemise t@(EApp _ _) | isJust (getArrow t) = let Just (arg_ty, res_ty) = getArrow t in do
(sks, res_ty') <- skolemise res_ty
return (sks, arg_ty `tArrow` res_ty')
skolemise (EApp f a) = do
@@ -3178,13 +3178,13 @@ subsCheckRho loc exp1 (EForall _ vs1 t1) (EForall _ vs2 t2) | length vs1 == leng
subsCheckRho loc exp1 sigma1@EForall{} rho2 = do -- Rule SPEC
(exp1', rho1) <- tInst exp1 sigma1
subsCheckRho loc exp1' rho1 rho2
-subsCheckRho loc exp1 arho1 rho2 | Just _ <- getImplies arho1 = do
+subsCheckRho loc exp1 arho1 rho2 | isJust (getImplies arho1) = do
(exp1', rho1) <- tInst exp1 arho1
subsCheckRho loc exp1' rho1 rho2
-subsCheckRho loc exp1 rho1 rho2 | Just (a2, r2) <- getArrow rho2 = do -- Rule FUN
+subsCheckRho loc exp1 rho1 rho2 | isJust (getArrow rho2) = let Just (a2, r2) = getArrow rho2 in do -- Rule FUN
(a1, r1) <- unArrow loc rho1
subsCheckFun loc exp1 a1 r1 a2 r2
-subsCheckRho loc exp1 rho1 rho2 | Just (a1, r1) <- getArrow rho1 = do -- Rule FUN
+subsCheckRho loc exp1 rho1 rho2 | isJust (getArrow rho1) = let Just (a1, r1) = getArrow rho1 in do -- Rule FUN
(a2,r2) <- unArrow loc rho2
subsCheckFun loc exp1 a1 r1 a2 r2
subsCheckRho loc exp1 tau1 tau2 = do -- Rule MONO
@@ -3366,10 +3366,12 @@ canonPatSynType at = do
pure $ mkTyp [] emptyCtx [] emptyCtx ty
splitPatSynType :: EType -> ([IdKind], EConstraint, [IdKind], EConstraint, EType)
-splitPatSynType (EForall _ vks1 t0)
- | Just (ctx1, EForall _ vks2 t1) <- getImplies t0
- , Just (ctx2, ty) <- getImplies t1
- = (vks1, ctx1, vks2, ctx2, ty)
+splitPatSynType (EForall _ vks1 t0) | isJust x = fromJust x
+ where
+ x = do
+ (ctx1, EForall _ vks2 t1) <- getImplies t0
+ (ctx2, ty) <- getImplies t1
+ Just (vks1, ctx1, vks2, ctx2, ty)
splitPatSynType t = impossibleShow t
-----
@@ -3465,7 +3467,7 @@ defaultOneTyVar tv = do
-- traceM $ "defaultOneTyVar: cvs = " ++ show cvs
dvs <- getSuperClasses cvs -- add superclasses
-- traceM $ "defaultOneTyVar: dvs = " ++ show dvs
- let oneCls c | Just ts <- M.lookup c (defaults old) =
+ let oneCls c | isJust (M.lookup c $ defaults old) = let Just ts = M.lookup c (defaults old) in
take 1 $ filter (\ t -> all (\ cc -> soluble cc t) cvs) ts
| otherwise = []
soluble c t = fst $ flip tcRun old $ do
@@ -3571,7 +3573,7 @@ solvers =
-- Examine each goal, either solve it (possibly producing new goals) or let it remain unsolved.
solveMany :: [Goal] -> [UGoal] -> [(EType, Soln)] -> [Improve] -> T ([UGoal], [Soln], [Improve])
solveMany [] uns sol imp = return (uns, map snd sol, imp)
-solveMany ((di, ct) : cnss) uns sol imp | Just (_, (dd, _)) <- find (eqEType ct . fst) sol =
+solveMany ((di, ct) : cnss) uns sol imp | isJust (find (eqEType ct . fst) sol) = let Just (_, (dd, _)) = find (eqEType ct . fst) sol in
solveMany cnss uns ((ct, (di, EVar dd)) : sol) imp
-- Need to handle ct of the form C => T, and forall a . T
solveMany (cns@(di, ct) : cnss) uns sol imp = do
@@ -3889,7 +3891,7 @@ solveEq eqs t1 t2 | normTypeEq eqs t1 `eqEType` normTypeEq eqs t2 = Just []
-- XXX This guaranteed by how it's called, but I'm not sure it always works properly.
addTypeEq :: EType -> EType -> TypeEqTable -> TypeEqTable
addTypeEq t1 t2 aeqs =
- let deref (EVar i) | Just t <- lookup i aeqs = t
+ let deref (EVar i) | isJust (lookup i aeqs) = fromJust $ lookup i aeqs
deref (ESign t _) = t
deref t = t
t1' = deref t1
@@ -3990,7 +3992,7 @@ standaloneDeriving str narg act = do
-- traceM ("standaloneDeriving 1 " ++ show (_vks, _ctx, cc))
(cls, ts, tname) <-
case getAppM cc of
- Just (c, ts@(_:_)) | Just (n, _) <- getAppM (last ts) -> return (c, init ts, n)
+ Just (c, ts@(_:_)) | isJust (getAppM $ last ts) -> let Just (n, _) = getAppM (last ts) in return (c, init ts, n)
_ -> tcError (getSLoc act) "malformed standalone deriving"
-- traceM ("standaloneDeriving 2 " ++ show (act, cls, tname))
dtable <- gets dataTable
diff --git a/src/Text/ParserComb.hs b/src/Text/ParserComb.hs
index 6efd5a3f..8ab72759 100644
--- a/src/Text/ParserComb.hs
+++ b/src/Text/ParserComb.hs
@@ -127,7 +127,9 @@ satisfy msg f = P $ \ acs ->
satisfyM :: forall tm t a . TokenMachine tm t => String -> (t -> Maybe a) -> Prsr tm t a
satisfyM msg f = P $ \ acs ->
case tmNextToken acs of
- (c, cs) | Just a <- f c -> Success a cs noFail
+ (c, cs) -> case f c of
+ Just a -> Success a cs noFail
+ _ -> Failure (LastFail (tmLeft acs) (firstToken acs) [msg])
_ -> Failure (LastFail (tmLeft acs) (firstToken acs) [msg])
infixl 9 <?>
pkgs/development/compilers/microhs/patches/hugs.patch
+365
View File
@@ -0,0 +1,365 @@
This patch is based on https://github.com/augustss/MicroHs/pull/429
If you need to update it, rebase the above PR onto the new version's tag.
diff --git a/hugs/Data/Semigroup.hs b/hugs/Data/Semigroup.hs
index b7360013..eab8c48d 100644
--- a/hugs/Data/Semigroup.hs
+++ b/hugs/Data/Semigroup.hs
@@ -18,11 +18,11 @@ class Semigroup a where
| otherwise = f x0 y0
where
f x y
- | even y == 0 = f (x <> x) (y `quot` 2)
+ | even y = f (x <> x) (y `quot` 2)
| y == 1 = x
| otherwise = g (x <> x) (y `quot` 2) x
g x y z
- | even y == 0 = g (x <> x) (y `quot` 2) z
+ | even y = g (x <> x) (y `quot` 2) z
| y == 1 = x <> z
| otherwise = g (x <> x) (y `quot` 2) (x <> z)
diff --git a/hugs/Data/String.hs b/hugs/Data/String.hs
new file mode 100644
index 00000000..1de782d3
--- /dev/null
+++ b/hugs/Data/String.hs
@@ -0,0 +1,17 @@
+module Data.String(
+ IsString(..),
+ String,
+ lines, unlines,
+ words, unwords,
+ ) where
+
+import qualified Data.ByteString.Char8 as BS8
+
+class IsString a where
+ fromString :: String -> a
+
+instance IsString [Char] where
+ fromString s = s
+
+instance IsString BS8.ByteString where
+ fromString = BS8.pack
diff --git a/hugs/Data/Text.hs b/hugs/Data/Text.hs
index fbd1c731..75f8e829 100644
--- a/hugs/Data/Text.hs
+++ b/hugs/Data/Text.hs
@@ -8,6 +8,7 @@ module Data.Text(
null,
head,
tail,
+ cons,
uncons,
) where
import Prelude hiding(head, tail, null)
@@ -64,6 +65,9 @@ head (T t) = Prelude.head t
tail :: Text -> Text
tail (T t) = T (Prelude.tail t)
+cons :: Char -> Text -> Text
+cons c (T t) = T (c : t)
+
uncons :: Text -> Maybe (Char, Text)
uncons t | null t = Nothing
| otherwise = Just (head t, tail t)
diff --git a/hugs/MHSPrelude.hs b/hugs/MHSPrelude.hs
index cb6b36f6..cb47e041 100644
--- a/hugs/MHSPrelude.hs
+++ b/hugs/MHSPrelude.hs
@@ -4,10 +4,11 @@ module MHSPrelude(
module Prelude,
module MHSPrelude,
-- module Control.Monad.Fail,
- module Control.Arrow,
+ -- Exporting these with 'module Control.Arrow' does not work
+ first, second,
module Data.Monoid,
module Data.Semigroup,
- (<$>), Applicative(..), (*>),
+ (<$>), Applicative(..), (*>), (<*), (>=>), (<=<)
) where
import Hugs.Prelude()
import Prelude hiding(fail)
@@ -16,6 +17,7 @@ import Control.Arrow(first, second)
import Control.Applicative
import Control.Exception(Exception, try)
--import Control.Monad.Fail
+import Data.Int
import Data.List
import Data.Maybe
import Data.Monoid
@@ -55,6 +57,12 @@ spanEnd p xs = (dropWhileEnd p xs, takeWhileEnd p xs)
breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
breakEnd p = spanEnd (not . p)
+subsequences :: [a] -> [[a]]
+subsequences xs = [] : sub xs
+ where sub [] = []
+ sub (x:xs) = [x] : foldr f [] (sub xs)
+ where f ys r = ys : (x : ys) : r
+
------- Version --------
makeVersion :: [Int] -> Version
@@ -193,6 +201,7 @@ force :: (NFData a) => a -> a
force x = x `deepseq` x
instance NFData Int
+instance NFData Int64
instance NFData Word
instance NFData Float
instance NFData Double
@@ -229,3 +238,11 @@ instance NFData MD5CheckSum
class HasCallStack
instance HasCallStack
+
+(<=<) :: forall m a b c . Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
+f <=< g = \ a -> do
+ b <- g a
+ f b
+
+(>=>) :: forall m a b c . Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
+(>=>) = flip (<=<)
diff --git a/src/MicroHs/Compile.hs b/src/MicroHs/Compile.hs
index ddec7993..643319aa 100644
--- a/src/MicroHs/Compile.hs
+++ b/src/MicroHs/Compile.hs
@@ -123,12 +123,17 @@ compile flags nm ach = do
return ((tModuleName cm, concatMap tBindingsOf $ cachedModules ch), syms, ch)
-- Compile a module for the interactive system
-compileInteractive :: Flags -> EModule -> CM (TModule [LDef], Symbols, TCState)
-compileInteractive flags mdl = do
- ((dmdl, syms, _, _, _), tcstate) <- compileModuleP flags ImpNormal mdl
+compileInteractive :: Flags -> EModule -> Maybe TCState -> CM (TModule [LDef], Symbols, TCState)
+compileInteractive flags mdl mtcstate = do
+ ((dmdl, syms, _, _, _), tcstate') <- compile
+ flags ImpNormal mdl
loadBoots flags
loadDependencies flags
- return (dmdl, syms, tcstate)
+ return (dmdl, syms, tcstate')
+ where
+ compile = case mtcstate of
+ Nothing -> compileModuleP
+ Just tcstate -> compileModuleP' (\flags _ impt aimps mdl -> typeCheck' flags impt (map filterImports aimps) mdl tcstate)
-- Compile a module with the given name.
-- If the module has already been compiled, return the cached result.
@@ -233,7 +238,12 @@ compileModule flags impt mn pathfn file = do
return (cmdl, syms, tThis + tImp)
compileModuleP :: Flags -> ImpType -> EModule -> CM ((TModule [LDef], Symbols, [(ImpType, IdentModule)], Time, Time), TCState)
-compileModuleP flags impt mdl@(EModule _ _ defs) = do
+compileModuleP = compileModuleP' typeCheck
+
+compileModuleP'
+ :: (Flags -> GlobTables -> ImpType -> [(ImportSpec, TModule [LDef])] -> EModule -> (TModule [EDef], GlobTables, Symbols, TCState))
+ -> Flags -> ImpType -> EModule -> CM ((TModule [LDef], Symbols, [(ImpType, IdentModule)], Time, Time), TCState)
+compileModuleP' tc flags impt mdl@(EModule _ _ defs) = do
-- liftIO $ putStrLn $ showEModule mdl
-- liftIO $ putStrLn $ showEDefs defs
let
@@ -244,7 +254,7 @@ compileModuleP flags impt mdl@(EModule _ _ defs) = do
t3 <- liftIO getTimeMilli
glob <- gets getCacheTables
let
- (tmdl, glob', syms, tcstate) = typeCheck flags glob impt (zip specs impMdls) mdl
+ (tmdl, glob', syms, tcstate) = tc flags glob impt (zip specs impMdls) mdl
modify $ setCacheTables glob'
dumpIf flags Dtypecheck $
liftIO $ putStrLn $ "type checked:\n" ++ showTModule showEDefs tmdl ++ "-----\n"
@@ -258,9 +268,9 @@ compileModuleP flags impt mdl@(EModule _ _ defs) = do
return ((dmdl, syms, imported, tThis, tImp), tcstate)
compileToCombinators :: TModule [LDef] -> TModule [LDef]
-compileToCombinators dmdl = do
+compileToCombinators dmdl =
let cmdl = setBindings dmdl [ (i, compileOpt e) | (i, e) <- tBindingsOf dmdl ]
- seq (rnf cmdl) cmdl -- This makes execution slower, but speeds up GC
+ in seq (rnf cmdl) cmdl -- This makes execution slower, but speeds up GC
-- Add implicit imports:
-- import Prelude
diff --git a/src/MicroHs/Expr.hs b/src/MicroHs/Expr.hs
index 84578594..bd05f1bc 100644
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -57,11 +57,11 @@ module MicroHs.Expr(
dropForallContext,
) where
import qualified Prelude(); import MHSPrelude hiding ((<>))
+import Data.Int
import Data.List
import Data.Maybe
import MicroHs.Builtin
import MicroHs.Ident
-import {-# SOURCE #-} MicroHs.TCMonad(TCState)
import Text.PrettyPrint.HughesPJLite
type IdentModule = Ident
@@ -96,8 +96,6 @@ data EDef
| Pattern LHS EPat (Maybe [Eqn])
| StandDeriving DerStrategy Int EConstraint
| DfltSign Ident EType -- only in class declarations
- -- Only used by interactive system to load a cached TCState to avoid import processing
- | SetTCState TCState
--DEBUG deriving (Show)
instance NFData EDef where
@@ -118,7 +116,6 @@ instance NFData EDef where
rnf (Pattern a b c) = rnf a `seq` rnf b `seq` rnf c
rnf (StandDeriving a b c) = rnf a `seq` rnf b `seq` rnf c
rnf (DfltSign a b) = rnf a `seq` rnf b
- rnf (SetTCState a) = seq a ()
data ImpType = ImpNormal | ImpBoot
deriving (Eq)
@@ -900,7 +897,6 @@ ppEDef def =
Pattern lhs@(i,_) p meqns -> text "pattern" <+> ppLHS lhs <+> text "=" <+> ppExpr p <+> maybe empty (ppWhere (text ";") . (:[]) . Fcn i) meqns
StandDeriving _s _narg ct -> text "deriving instance" <+> ppEType ct
DfltSign i t -> text "default" <+> ppIdent i <+> text "::" <+> ppEType t
- SetTCState _ -> text "SetTCState ..."
ppDerivings :: [Deriving] -> Doc
ppDerivings = sep . map ppDeriving
diff --git a/src/MicroHs/Interactive.hs b/src/MicroHs/Interactive.hs
index ebb33b43..7b70064a 100644
--- a/src/MicroHs/Interactive.hs
+++ b/src/MicroHs/Interactive.hs
@@ -295,11 +295,11 @@ compile file = do
let mdl@(EModule mn es _) = parseDie pTopModule "" file
defs <- updateTCStateCache mdl
(_, tcstate, _) <- gets isCComp
- let mdl' = EModule mn es (SetTCState tcstate : defs)
+ let mdl' = EModule mn es defs
flgs <- gets isFlags
cash <- gets isCache
-- putStrLnI $ " tryCompile compile " ++ show mdl'
- ((dmdl, _, tcstate'), _) <- liftIO $ runStateIO (compileInteractive flgs mdl') cash
+ ((dmdl, _, tcstate'), _) <- liftIO $ runStateIO (compileInteractive flgs mdl' $ Just tcstate) cash
cmdl <- liftIO $ evaluate $ compileToCombinators dmdl
-- putStrLnI $ " tryCompile dmdl = " ++ (show $ tBindingsOf dmdl)
return (tBindingsOf cmdl, tcstate')
@@ -398,7 +398,7 @@ updateTCStateCache (EModule mn es ds) = do
cash <- gets isCache
-- putStrLnI "*** update tcstate"
let mdl' = addPreludeImport mdl
- ((_, syms, tcstate), ch) <- liftIO $ runStateIO (compileInteractive flgs mdl') cash
+ ((_, syms, tcstate), ch) <- liftIO $ runStateIO (compileInteractive flgs mdl' Nothing) cash
let idmap = translateMap $ concatMap tBindingsOf $ cachedModules ch
-- putStrLnI $ "*** update isFast " ++ show nImps
modify $ \ is -> is{ isCComp = (nImps, tcstate, idmap), isCache = ch, isSymbols = syms }
diff --git a/src/MicroHs/Parse.hs b/src/MicroHs/Parse.hs
index 821718a7..6a68a01a 100644
--- a/src/MicroHs/Parse.hs
+++ b/src/MicroHs/Parse.hs
@@ -791,7 +791,7 @@ pDo = do
case last ss of
SThen e ->
pure $ EDo q [SRec (init ss), SThen e]
- _ -> fail "mdo"
+ _ -> Control.Monad.Fail.fail "mdo"
else
pure (EDo q ss)
diff --git a/src/MicroHs/TCMonad.hs-boot b/src/MicroHs/TCMonad.hs-boot
deleted file mode 100644
index f88ad533..00000000
--- a/src/MicroHs/TCMonad.hs-boot
+++ /dev/null
@@ -1,2 +0,0 @@
-module MicroHs.TCMonad where
-data TCState
diff --git a/src/MicroHs/TypeCheck.hs b/src/MicroHs/TypeCheck.hs
index 47f2b461..db7f3527 100644
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -2,7 +2,7 @@
-- See LICENSE file for full license.
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-unused-imports -Wno-unused-do-bind #-}
module MicroHs.TypeCheck(
- typeCheck,
+ typeCheck, typeCheck', filterImports,
TModule(..), showTModule,
GlobTables, emptyGlobTables, mergeGlobTables,
impossible, impossibleShow,
@@ -102,35 +102,34 @@ type Sigma = EType
type Rho = EType
typeCheck :: Flags -> GlobTables -> ImpType -> [(ImportSpec, TModule a)] -> EModule -> (TModule [EDef], GlobTables, Symbols, TCState)
-typeCheck flags globs impt aimps (EModule mn exps defs) =
+typeCheck flags globs impt aimps mdl@(EModule mn exps defs) =
-- trace (unlines $ map (showTModuleExps . snd) aimps) $
- let
- imps = map filterImports aimps
- tc =
- case defs of
- SetTCState tcs : _ -> tcs -- hack to set the saved TCState
- _ -> mkTCState mn globs imps
- in case tcRun (tcDefs flags impt defs) tc of
- (tds, tcs) ->
- let
- thisMdl = (mn, mkTModule tds tcs)
- impMdls = [(fromMaybe m mm, tm) | (ImportSpec _ _ m mm _, tm) <- imps]
- allMdls = thisMdl : impMdls
- (texps, vexps) =
- unzip $ map (getTVExps impMap (typeTable tcs) (valueTable tcs) (assocTable tcs)) exps
- where impMap = M.fromListWith (++) [(i, [m]) | (i, m) <- allMdls]
- fexps = map (tFixDefs . snd) allMdls
- sexps = synTable tcs
- dexps = dataTable tcs
- iexps = instTable tcs
- ctbl = classTable tcs
- dflts = M.fromList $ filter ((`elem` ds) . fst) $ M.toList $ defaults tcs
- where ds = [ tyQIdent $ expLookup ti (typeTable tcs) | ExpDefault ti <- exps ]
- in ( tModule mn (nubBy ((==) `on` fst) (concat fexps)) (concat texps) (concat vexps) dflts tds
- , GlobTables { gSynTable = sexps, gDataTable = dexps, gClassTable = ctbl, gInstInfo = iexps }
- , (typeTable tcs, valueTable tcs)
- , tcs
- )
+ let imps = map filterImports aimps
+ in typeCheck' flags impt imps mdl $ mkTCState mn globs imps
+
+typeCheck' :: Flags -> ImpType -> [(ImportSpec, TModule a)] -> EModule -> TCState -> (TModule [EDef], GlobTables, Symbols, TCState)
+typeCheck' flags impt imps (EModule mn exps defs) tc =
+ case tcRun (tcDefs flags impt defs) tc of
+ (tds, tcs) ->
+ let
+ thisMdl = (mn, mkTModule tds tcs)
+ impMdls = [(fromMaybe m mm, tm) | (ImportSpec _ _ m mm _, tm) <- imps]
+ allMdls = thisMdl : impMdls
+ (texps, vexps) =
+ unzip $ map (getTVExps impMap (typeTable tcs) (valueTable tcs) (assocTable tcs)) exps
+ where impMap = M.fromListWith (++) [(i, [m]) | (i, m) <- allMdls]
+ fexps = map (tFixDefs . snd) allMdls
+ sexps = synTable tcs
+ dexps = dataTable tcs
+ iexps = instTable tcs
+ ctbl = classTable tcs
+ dflts = M.fromList $ filter ((`elem` ds) . fst) $ M.toList $ defaults tcs
+ where ds = [ tyQIdent $ expLookup ti (typeTable tcs) | ExpDefault ti <- exps ]
+ in ( tModule mn (nubBy ((==) `on` fst) (concat fexps)) (concat texps) (concat vexps) dflts tds
+ , GlobTables { gSynTable = sexps, gDataTable = dexps, gClassTable = ctbl, gInstInfo = iexps }
+ , (typeTable tcs, valueTable tcs)
+ , tcs
+ )
-- A hack to force evaluation of errors.
-- This should be redone to all happen in the T monad.
diff --git a/src/Text/ParserComb.hs b/src/Text/ParserComb.hs
index 5b0e8753..6efd5a3f 100644
--- a/src/Text/ParserComb.hs
+++ b/src/Text/ParserComb.hs
@@ -115,7 +115,7 @@ instance TokenMachine tm t => Alternative (Prsr tm t) where
r -> r
instance TokenMachine tm t => MonadPlus (Prsr tm t) where
- mzero = fail "mzero"
+ mzero = F.fail "mzero"
mplus = (<|>)
satisfy :: forall tm t . TokenMachine tm t => String -> (t -> Bool) -> Prsr tm t t
pkgs/development/compilers/microhs/patches/link-math.patch
+21
View File
@@ -0,0 +1,21 @@
commit beaea6f66e4f53d617418a4c155b9a14e2c9327e
Author: Alex Tunstall <alex@tunstall.xyz>
Date: Fri Mar 20 06:52:08 2026 +0000
Add -lm to default link flags
MicroHs should always link with -lm because its RTS requires it.
diff --git a/src/MicroHs/Flags.hs b/src/MicroHs/Flags.hs
index e20797c6..df89730e 100644
--- a/src/MicroHs/Flags.hs
+++ b/src/MicroHs/Flags.hs
@@ -54,7 +54,7 @@ defaultFlags dir = Flags {
doCPP = False,
cppArgs = [],
cArgs = [],
- lArgs = [],
+ lArgs = ["-lm"],
compress = False,
base64 = False,
buildPkg = Nothing,
pkgs/development/compilers/microhs/patches/simple-unicode.patch
+35
View File
File diff suppressed because one or more lines are too long
pkgs/development/compilers/microhs/stage1.nix
+36
View File
@@ -0,0 +1,36 @@
{
lib,
args,
microhs-boot,
stdenv,
}:
stdenv.mkDerivation (
finalAttrs:
let
args' = args finalAttrs;
in
args'
// {
pname = "microhs-stage1";
patches =
(args'.patches or [ ])
++ lib.optionals microhs-boot.usesHugs [
patches/simple-unicode.patch
];
makeFlags = [ "PREFIX=${placeholder "out"}" ];
installTargets = [
"targets.conf"
"oldinstall"
];
buildPhase = ''
runHook preBuild
mkdir -p bin
printf 'Building bin/mhs using ${microhs-boot}/bin/mhs\n'
${microhs-boot}/bin/mhs -l -imhs -isrc -ipaths MicroHs.Main -o bin/mhs
runHook postBuild
'';
}
)
pkgs/development/compilers/microhs/stage2.nix
+61
View File
@@ -0,0 +1,61 @@
{
args,
cpphs,
microcabal-stage1,
microhs-stage1,
stdenv,
callPackage,
}:
stdenv.mkDerivation (
finalAttrs:
let
args' = args finalAttrs;
haskellCompilerName = "mhs-${args'.version}";
in
args'
// {
pname = "microhs";
nativeBuildInputs = [
microcabal-stage1
microhs-stage1
];
env = {
CABALDIR = "${placeholder "out"}/lib/mcabal";
};
dontBuild = true;
installPhase = ''
runHook preInstall
pushd lib
mcabal -v install
popd
mcabal -v install
mkdir -p $out/bin
ln -s ../lib/mcabal/bin/mhs $out/bin/mhs
runHook postInstall
'';
passthru = {
inherit
haskellCompilerName
cpphs
microcabal-stage1
microhs-stage1
;
targetPrefix = "";
isMhs = true;
usesHugs = false;
tests = {
hello-world = callPackage ./test-hello-world.nix { microhs = finalAttrs.finalPackage; };
};
};
}
)
pkgs/by-name/mi/microhs/test-hello-world.nix → pkgs/development/compilers/microhs/test-hello-world.nix
View File
pkgs/development/compilers/microhs/wrapper.nix
+52
View File
@@ -0,0 +1,52 @@
{
lib,
runCommand,
runtimeShell,
writeShellScript,
}:
{
microhs,
packages,
}:
let
packages' = [ microhs ] ++ lib.filter (p: p != null) packages;
extraFlags = lib.concatMapStringsSep " " (
p: "-a${p}/lib/mcabal/${microhs.haskellCompilerName}"
) packages';
wrapper = writeShellScript "mhs-wrapper" ''
args=("$@")
noExtra=0
for ((i=0; i<"''${#args[@]}"; ++i)); do
case "''${args[i]}" in
--version | --numeric-version)
noExtra=1
;;
*)
;;
esac
done
if test "$noExtra" -eq 0; then
for arg in ${extraFlags}; do
args[i++]="$arg"
done
fi
if (( "''${NIX_DEBUG:-0}" >= 1 )); then
printf 'mhs-wrapper: mhs %s\n' "''${args[*]}" >&2
fi
exec ${microhs}/bin/mhs "''${args[@]}"
'';
in
runCommand "${microhs.name}-wrapped"
{
inherit (microhs) passthru;
}
''
mkdir -p $out/bin
cp -rs ${microhs}/bin/* $out/bin/
rm $out/bin/mhs 2>/dev/null || true
cp ${wrapper} $out/bin/mhs
''
pkgs/development/haskell-modules/configuration-microhs.nix
+78
View File
@@ -0,0 +1,78 @@
{ pkgs, haskellLib }:
with haskellLib;
self: super: {
# Disable MicroHs core libraries
base = null;
bytestring = null;
deepseq = null;
directory = null;
process = null;
text = null;
MicroHs = null;
# External MicroHs core libraries
ghc-compat = doDistribute (markUnbroken super.ghc-compat);
# Bootstrap MicroCabal
MicroCabal = self.mkDerivation {
pname = "MicroCabal";
version = self.ghc.microcabal-stage1.version;
src = self.ghc.microcabal-stage1.src;
isLibrary = false;
isExecutable = true;
executableHaskellDepends = with self; [ base ];
inherit (self.ghc.microcabal-stage1.meta)
description
homepage
license
mainProgram
maintainers
;
};
# hackage-packages does not include GHC core libraries
binary = markBroken self.binary_0_8_9_3;
Cabal = doDistribute self.Cabal_3_16_1_0;
Cabal-syntax = doDistribute self.Cabal-syntax_3_16_1_0;
containers = doDistribute self.containers_0_8;
exceptions = doDistribute self.exceptions_0_10_12;
filepath = doDistribute self.filepath_1_5_5_0;
ghc-bignum = null;
ghc-boot = null;
ghc-boot-th = null;
ghc-compact = null;
ghc-heap = null;
ghc-internal = null;
ghc-platform = null;
ghc-prim = null;
ghci = null;
haskeline = doDistribute self.haskeline_0_8_4_1;
hpc = markBroken self.hpc_0_7_0_2;
integer-gmp = markBroken self.integer-gmp_1_1;
libiserv = null;
mtl = doDistribute self.mtl_2_3_2;
os-string = doDistribute self.os-string_2_0_10;
parsec = doDistribute self.parsec_3_1_18_0;
pretty = markBroken self.pretty_1_1_3_6;
rts = null;
semaphore-compat = null;
stm = null;
system-cxx-std-lib = null;
template-haskell = null;
terminfo = doDistribute self.terminfo_0_4_1_7;
time = doDistribute self.time_1_15;
transformers = doDistribute self.transformers_0_6_3_0;
unix = markBroken self.unix_2_8_8_0;
xhtml = markBroken self.xhtml_3000_4_0_0;
# MicroHs replacements for widely used libraries
array = self.array-mhs;
array-mhs = doDistribute (markUnbroken super.array-mhs);
random = self.random-mhs;
random-mhs = doDistribute (markUnbroken super.random-mhs);
# Depends on time when not using GHC
splitmix = addBuildDepends [ self.time ] super.splitmix;
}
pkgs/development/haskell-modules/make-package-set.nix
+60 -44
View File
@@ -48,50 +48,64 @@ let
inherit (lib) fix' extends makeOverridable;
inherit (haskellLib) overrideCabal;
mkDerivationImpl = pkgs.callPackage ./generic-builder.nix {
inherit stdenv haskellLib;
nodejs = buildPackages.nodejs-slim;
inherit (self)
buildHaskellPackages
ghc
ghcWithHoogle
ghcWithPackages
;
iserv-proxy = {
build = buildHaskellPackages.iserv-proxy;
host = self.iserv-proxy;
};
inherit (self.buildHaskellPackages) jailbreak-cabal;
hscolour = overrideCabal (drv: {
isLibrary = false;
doHaddock = false;
hyperlinkSource = false; # Avoid depending on hscolour for this build.
postFixup = "rm -rf $out/lib $out/share $out/nix-support";
}) self.buildHaskellPackages.hscolour;
cpphs =
overrideCabal
(drv: {
isLibrary = false;
postFixup = "rm -rf $out/lib $out/share $out/nix-support";
})
(
self.cpphs.overrideScope (
self: super: {
mkDerivation =
drv:
super.mkDerivation (
drv
// {
enableSharedExecutables = false;
enableSharedLibraries = false;
doHaddock = false;
useCpphs = false;
}
);
}
)
);
};
builder = if !(ghc.isMhs or false) then ./generic-builder.nix else ./microhs-builder.nix;
mkDerivationImpl = pkgs.callPackage builder (
{
inherit stdenv;
inherit (self)
buildHaskellPackages
ghc
;
inherit (self.buildHaskellPackages) jailbreak-cabal;
}
// lib.optionalAttrs (!(ghc.isMhs or false)) {
inherit haskellLib;
inherit (self)
ghcWithHoogle
ghcWithPackages
;
nodejs = buildPackages.nodejs-slim;
iserv-proxy = {
build = buildHaskellPackages.iserv-proxy;
host = self.iserv-proxy;
};
hscolour = overrideCabal (drv: {
isLibrary = false;
doHaddock = false;
hyperlinkSource = false; # Avoid depending on hscolour for this build.
postFixup = "rm -rf $out/lib $out/share $out/nix-support";
}) self.buildHaskellPackages.hscolour;
cpphs =
overrideCabal
(drv: {
isLibrary = false;
postFixup = "rm -rf $out/lib $out/share $out/nix-support";
})
(
self.cpphs.overrideScope (
self: super: {
mkDerivation =
drv:
super.mkDerivation (
drv
// {
enableSharedExecutables = false;
enableSharedLibraries = false;
doHaddock = false;
useCpphs = false;
}
);
}
)
);
}
// lib.optionalAttrs (ghc.isMhs or false) {
inherit (self) wrapMhs ghc-compat;
MicroCabal = self.ghc.microcabal-stage1;
cpphs = self.ghc.cpphs;
}
);
mkDerivation = makeOverridable mkDerivationImpl;
@@ -663,6 +677,8 @@ package-set { inherit pkgs lib callPackage; } self
withHoogle = self.ghcWithHoogle;
};
wrapMhs = pkgs.callPackage ../compilers/microhs/wrapper.nix { };
/*
Run `cabal sdist` on a source.
pkgs/development/haskell-modules/microhs-builder.nix
+420
View File
@@ -0,0 +1,420 @@
{
buildHaskellPackages,
buildPackages,
fetchurl,
ghc,
jailbreak-cabal,
lib,
MicroCabal,
cpphs,
ghc-compat,
pkg-config,
runCommandCC,
stdenv,
wrapMhs,
}:
let
# make-package-set always names the compiler ghc
compiler = ghc;
isCross = stdenv.buildPlatform != stdenv.hostPlatform;
in
{
pname,
version,
revision ? null,
sha256 ? null,
src ? fetchurl {
url = "mirror://hackage/${pname}-${version}.tar.gz";
inherit sha256;
},
# Extra environment variables to set during the build.
# See: `../../../doc/languages-frameworks/haskell.section.md`
env ? { },
buildDepends ? [ ],
setupHaskellDepends ? [ ],
libraryHaskellDepends ? [ ],
executableHaskellDepends ? [ ],
buildTools ? [ ],
libraryToolDepends ? [ ],
executableToolDepends ? [ ],
testToolDepends ? [ ],
benchmarkToolDepends ? [ ],
configureFlags ? [ ],
description ? null,
doCheck ? !isCross,
doBenchmark ? false,
editedCabalFile ? null,
extraLibraries ? [ ],
librarySystemDepends ? [ ],
executableSystemDepends ? [ ],
# On macOS, statically linking against system frameworks is not supported;
# see https://developer.apple.com/library/content/qa/qa1118/_index.html
# They must be propagated to the environment of any executable linking with the library
libraryFrameworkDepends ? [ ],
executableFrameworkDepends ? [ ],
homepage ? "https://hackage.haskell.org/package/${pname}",
platforms ? with lib.platforms; all, # GHC can cross-compile
badPlatforms ? lib.platforms.none,
hydraPlatforms ? null,
isExecutable ? false,
isLibrary ? !isExecutable,
jailbreak ? false,
license,
maintainers ? null,
teams ? null,
changelog ? null,
mainProgram ? null,
passthru ? { },
pkg-configDepends ? [ ],
libraryPkgconfigDepends ? [ ],
executablePkgconfigDepends ? [ ],
testPkgconfigDepends ? [ ],
benchmarkPkgconfigDepends ? [ ],
testDepends ? [ ],
testHaskellDepends ? [ ],
testSystemDepends ? [ ],
testFrameworkDepends ? [ ],
benchmarkDepends ? [ ],
benchmarkHaskellDepends ? [ ],
benchmarkSystemDepends ? [ ],
benchmarkFrameworkDepends ? [ ],
broken ? false,
preCompileBuildDriver ? null,
postCompileBuildDriver ? null,
preUnpack ? null,
postUnpack ? null,
patches ? null,
patchPhase ? null,
prePatch ? "",
postPatch ? "",
preConfigure ? null,
postConfigure ? null,
preBuild ? null,
postBuild ? null,
preHaddock ? null,
postHaddock ? null,
installPhase ? null,
preInstall ? null,
postInstall ? null,
checkPhase ? null,
preCheck ? null,
postCheck ? null,
preFixup ? null,
postFixup ? null,
shellHook ? "",
...
}@args:
assert editedCabalFile != null -> revision != null;
let
allPkgconfigDepends =
pkg-configDepends
++ libraryPkgconfigDepends
++ executablePkgconfigDepends
++ lib.optionals doCheck testPkgconfigDepends
++ lib.optionals doBenchmark benchmarkPkgconfigDepends;
# MicroCabal adds a dependency on ghc-compat unless the package name is one of the following
isCorePkg = pname == "base" || pname == "ghc-compat" || pname == "MicroHs" || pname == "MicroCabal";
buildDepends' = buildDepends ++ lib.optional (!isCorePkg) ghc-compat;
depsBuildBuild = lib.optionals (!stdenv.hasCC) [ buildPackages.stdenv.cc ];
collectedToolDepends =
buildTools
++ libraryToolDepends
++ executableToolDepends
++ lib.optionals doCheck testToolDepends
++ lib.optionals doBenchmark benchmarkToolDepends;
nativeBuildInputs = [
MicroCabal
cpphs
compilerWithPkgs
buildPackages.removeReferencesTo
];
propagatedBuildInputs =
buildDepends' ++ libraryHaskellDepends ++ executableHaskellDepends ++ libraryFrameworkDepends;
otherBuildInputsHaskell =
lib.optionals doCheck (testDepends ++ testHaskellDepends)
++ lib.optionals doBenchmark (benchmarkDepends ++ benchmarkHaskellDepends);
otherBuildInputsSystem =
extraLibraries
++ librarySystemDepends
++ executableSystemDepends
++ executableFrameworkDepends
++ allPkgconfigDepends
++ lib.optionals doCheck (testSystemDepends ++ testFrameworkDepends)
++ lib.optionals doBenchmark (benchmarkSystemDepends ++ benchmarkFrameworkDepends);
otherBuildInputs = otherBuildInputsHaskell ++ otherBuildInputsSystem;
newCabalFileUrl = "mirror://hackage/${pname}-${version}/revision/${revision}.cabal";
newCabalFile = fetchurl {
url = newCabalFileUrl;
sha256 = editedCabalFile;
name = "${pname}-${version}-r${revision}.cabal";
};
hsLibBuildInputs = lib.filter (p: p ? isHaskellLibrary && p.isHaskellLibrary) propagatedBuildInputs;
compilerWithPkgs = wrapMhs {
microhs = compiler;
packages = hsLibBuildInputs;
};
compilerCommand' = "mhs";
compilerCommand = "${compiler.targetPrefix}${compilerCommand'}";
compilerLibdir = "lib/mcabal/${compiler.haskellCompilerName}";
env' = {
CABALDIR = "${placeholder "out"}/lib/mcabal";
}
// env;
in
stdenv.mkDerivation {
inherit pname version;
pos = builtins.unsafeGetAttrPos "pname" args;
prePhases = [ "setupCompilerEnvironmentPhase" ];
preConfigurePhases = [ "compileBuildDriverPhase" ];
preInstallPhases = [ "haddockPhase" ];
inherit src patches;
inherit depsBuildBuild nativeBuildInputs;
buildInputs = lib.optionals (!isLibrary) propagatedBuildInputs;
propagatedBuildInputs = lib.optionals isLibrary propagatedBuildInputs;
env = env';
prePatch =
lib.optionalString (editedCabalFile != null) ''
echo "Replace Cabal file with edited version from ${newCabalFileUrl}."
cp ${newCabalFile} ${pname}.cabal
''
+ prePatch;
postPatch =
lib.optionalString jailbreak ''
echo "Run jailbreak-cabal to lift version restrictions on build inputs."
${jailbreak-cabal}/bin/jailbreak-cabal ${pname}.cabal
''
+ postPatch;
setupCompilerEnvironmentPhase = ''
runHook preSetupCompilerEnvironment
echo "Building with ${compilerWithPkgs}"
mkdir -p "$CABALDIR/${compiler.haskellCompilerName}/packages"
${lib.concatMapStrings (p: ''
ln -s ${p}/${compilerLibdir}/packages/${p.name}.pkg $CABALDIR/${compiler.haskellCompilerName}/packages/${p.name}.pkg
'') (lib.closePropagation hsLibBuildInputs)}
runHook postSetupCompilerEnvironment
'';
compileBuildDriverPhase = ''
runHook preCompileBuildDriver
runHook postCompileBuildDriver
'';
buildPhase = ''
runHook preBuild
echo "Skipping buildPhase because MicroCabal always builds on install"
runHook postBuild
'';
inherit doCheck;
checkPhase = ''
runHook preCheck
echo "Skipping checkPhase because MicroCabal doesn't support test suites"
runHook postCheck
'';
haddockPhase = ''
runHook preHaddock
echo "Skipping haddockPhase because MicroCabal doesn't support Haddock"
runHook postHaddock
'';
installPhase = ''
runHook preInstall
mcabal -v ${lib.concatStringsSep " " configureFlags} install
mkdir -p $out/bin
find "$CABALDIR/bin" -type f -exec ln -s '{}' "$out/bin/" \; || true
find "$CABALDIR/${compiler.haskellCompilerName}/packages" -type l -delete
runHook postInstall
'';
inherit
preCompileBuildDriver
postCompileBuildDriver
preUnpack
postUnpack
preConfigure
postConfigure
preBuild
postBuild
preHaddock
postHaddock
preInstall
postInstall
preCheck
postCheck
preFixup
postFixup
;
passthru = passthru // rec {
inherit pname version;
compiler = ghc;
# All this information is intended just for `shellFor`. It should be
# considered unstable and indeed we knew how to keep it private we would.
getCabalDeps = {
inherit
buildDepends'
buildTools
executableFrameworkDepends
executableHaskellDepends
executablePkgconfigDepends
executableSystemDepends
executableToolDepends
extraLibraries
libraryFrameworkDepends
libraryHaskellDepends
libraryPkgconfigDepends
librarySystemDepends
libraryToolDepends
pkg-configDepends
setupHaskellDepends
;
}
// lib.optionalAttrs doCheck {
inherit
testDepends
testFrameworkDepends
testHaskellDepends
testPkgconfigDepends
testSystemDepends
testToolDepends
;
}
// lib.optionalAttrs doBenchmark {
inherit
benchmarkDepends
benchmarkFrameworkDepends
benchmarkHaskellDepends
benchmarkPkgconfigDepends
benchmarkSystemDepends
benchmarkToolDepends
;
};
# Attributes for the old definition of `shellFor`. Should be removed but
# this predates the warning at the top of `getCabalDeps`.
getBuildInputs = rec {
inherit propagatedBuildInputs otherBuildInputs allPkgconfigDepends;
haskellBuildInputs = isHaskellPartition.right;
systemBuildInputs = isHaskellPartition.wrong;
isHaskellPartition = lib.partition (x: x ? isHaskellLibrary) (
propagatedBuildInputs ++ otherBuildInputs ++ depsBuildBuild ++ nativeBuildInputs
);
};
isHaskellLibrary = isLibrary;
haddockDir = null;
# Creates a derivation containing all of the necessary dependencies for building the
# parent derivation. The attribute set that it takes as input can be viewed as:
#
# { withHoogle }
#
# The derivation that it builds contains no outpaths because it is meant for use
# as an environment
#
# # Example use
# # Creates a shell with all of the dependencies required to build the "hello" package,
# # and with python:
#
# > nix-shell -E 'with (import <nixpkgs> {}); \
# > haskellPackages.hello.envFunc { buildInputs = [ python ]; }'
envFunc =
{
# Unsupported
withHoogle ? false,
}:
let
name = "microhs-shell-for-${pname}";
compilerCommandCaps = lib.toUpper compilerCommand';
in
runCommandCC name {
inherit shellHook;
nativeBuildInputs = [
compilerWithPkgs
]
++ lib.optional (allPkgconfigDepends != [ ]) pkg-config
++ collectedToolDepends;
buildInputs = otherBuildInputsSystem;
env = {
"NIX_${compilerCommandCaps}" = "${compiler}/bin/${compilerCommand}";
# TODO: is this still valid?
"NIX_${compilerCommandCaps}_LIBDIR" = "${compiler}/${compilerLibdir}";
}
// lib.optionalAttrs (stdenv.buildPlatform.libc == "glibc") {
# TODO: Why is this written in terms of `buildPackages`, unlike
# the outer `env`?
#
# According to @sternenseemann [1]:
#
# > The condition is based on `buildPlatform`, so it needs to
# > match. `LOCALE_ARCHIVE` is set to accompany `LANG` which
# > concerns things we execute on the build platform like
# > `haddock`.
# >
# > Arguably the outer non `buildPackages` one is incorrect and
# > probably works by accident in most cases since the locale
# > archive is not platform specific (the trouble is that it
# > may sometimes be impossible to cross-compile). At least
# > that would be my assumption.
#
# [1]: https://github.com/NixOS/nixpkgs/pull/424368#discussion_r2202683378
LOCALE_ARCHIVE = "${buildPackages.glibcLocales}/lib/locale/locale-archive";
}
// env';
} "echo $nativeBuildInputs $buildInputs > $out";
env = envFunc { };
};
meta = {
inherit homepage license platforms;
}
// lib.optionalAttrs (args ? broken) { inherit broken; }
// lib.optionalAttrs (args ? description) { inherit description; }
// lib.optionalAttrs (args ? maintainers) { inherit maintainers; }
// lib.optionalAttrs (args ? teams) { inherit teams; }
// lib.optionalAttrs (args ? hydraPlatforms) { inherit hydraPlatforms; }
// lib.optionalAttrs (args ? badPlatforms) { inherit badPlatforms; }
// lib.optionalAttrs (args ? changelog) { inherit changelog; }
// lib.optionalAttrs (args ? mainProgram) { inherit mainProgram; };
}
pkgs/development/tools/haskell/microcabal/0.5.3.0-31f1b5dec81561a1b1d36b8e3065ce091dce2ec6.nix
+7
View File
@@ -0,0 +1,7 @@
import ./common.nix rec {
# MicroCabal has important changes to mirror some changes in MicroHs but its
# version releases are not frequent enough, so we need to use newer commits
version = "0.5.3.0-${rev}";
rev = "31f1b5dec81561a1b1d36b8e3065ce091dce2ec6";
hash = "sha256-/oTcWGA43KQwniQKyZEPOlpmoRusDjb+k29GWc8wZzw=";
}
pkgs/development/tools/haskell/microcabal/common.nix
+69
View File
@@ -0,0 +1,69 @@
{
version,
rev,
hash,
}:
{
lib,
microhs,
stdenv,
fetchFromGitHub,
fetchpatch,
}:
stdenv.mkDerivation {
pname = "microcabal-stage1";
inherit version;
src = fetchFromGitHub {
owner = "augustss";
repo = "MicroCabal";
inherit rev hash;
};
patches = [
(fetchpatch {
# https://github.com/augustss/MicroCabal/pull/23
name = "remove-mtl-mhs-override.patch";
url = "https://github.com/AlexandreTunstall/MicroCabal/commit/ad30461aaf3dd295f4f5cf5db12635e42557cbfa.patch";
hash = "sha256-Gmlt76C19ZtCHpKyNim0ggtjXnVuq5F0ywvX8BW15uM=";
})
(fetchpatch {
# https://github.com/augustss/MicroCabal/pull/34
name = "package-install-path.patch";
url = "https://github.com/augustss/MicroCabal/commit/dc358bbab312e1788564fbb36f835347c21792c0.patch";
hash = "sha256-aUQwuyp+ihXZ9PeSCqGUylcvzA6/ktZyeyBXiEoVY54=";
})
(fetchpatch {
# https://github.com/augustss/MicroCabal/pull/34
name = "package-search-path.patch";
url = "https://github.com/augustss/MicroCabal/commit/3898e5f0596a7391818a0a2cfa994317cda62479.patch";
hash = "sha256-76yEUpzH5xZZt3U+BCSqyWsImfpOEowupd5YCaYVTO0=";
})
];
makeFlags = [
"MHS=${microhs}/bin/mhs"
"MHSDIR=${microhs}/lib/mhs"
];
installPhase = ''
runHook preInstall
install -m755 -d $out/bin
install -m755 bin/mcabal $out/bin/mcabal
runHook postInstall
'';
meta = {
description = "A partial Cabal replacement";
longDescription = ''
A portable subset of the Cabal functionality.
'';
homepage = "https://github.com/augustss/MicroCabal";
license = lib.licensesSpdx."Apache-2.0";
mainProgram = "mcabal";
maintainers = with lib.maintainers; [ AlexandreTunstall ];
platforms = lib.platforms.all;
};
}
pkgs/top-level/all-packages.nix
+3
View File
@@ -4265,6 +4265,9 @@ with pkgs;
haskell.compiler.ghc910
);
# TODO(@NixOS/haskell): deprecate this alias?
microhs = targetPackages.haskell.packages.microhs.ghc or haskell.compiler.microhs;
alex = haskell.lib.compose.justStaticExecutables haskellPackages.alex;
happy = haskell.lib.compose.justStaticExecutables haskellPackages.happy;
pkgs/top-level/haskell-packages.nix
+22 -3
View File
@@ -68,6 +68,9 @@ let
ghc910 = sets.ghc9103;
ghc912 = sets.ghc9122;
ghc914 = sets.ghc9141;
microhs_0_15 = sets.microhs_0_15_4_0;
microhs = sets.microhs_0_15;
};
in
{
@@ -220,15 +223,24 @@ in
# with "native" and "gmp" backends.
native-bignum =
let
nativeBignumGhcNames = pkgs.lib.filter (name: !(builtins.elem name nativeBignumExcludes)) (
pkgs.lib.attrNames compiler
);
isNativeBignumGhc =
name:
!(builtins.elem name nativeBignumExcludes) && !(compiler.${name} ? isMhs && compiler.${name}.isMhs);
nativeBignumGhcNames = pkgs.lib.filter isNativeBignumGhc (pkgs.lib.attrNames compiler);
in
pkgs.lib.recurseIntoAttrs (
pkgs.lib.genAttrs nativeBignumGhcNames (
name: compiler.${name}.override { enableNativeBignum = true; }
)
);
microhs-boot = callPackage ../development/compilers/microhs/boot.nix {
microhs-src = bb.compiler.microhs_0_15_4_0;
};
microhs_0_15_4_0 = callPackage ../development/compilers/microhs/0.15.4.0.nix {
inherit (bb.compiler) microhs-boot;
};
}
// chooseDefaultVersions compiler
// pkgs.lib.optionalAttrs config.allowAliases {
@@ -332,6 +344,13 @@ in
buildHaskellPackages = bh.packages.native-bignum.${name};
}
);
microhs_0_15_4_0 = callPackage ../development/haskell-modules {
buildHaskellPackages = bh.packages.microhs_0_15_4_0;
ghc = bh.compiler.microhs_0_15_4_0;
compilerConfig = callPackage ../development/haskell-modules/configuration-microhs.nix { };
packageSetConfig = bootstrapPackageSet;
};
}
// chooseDefaultVersions packages
// pkgs.lib.optionalAttrs config.allowAliases {
pkgs/top-level/release-haskell.nix
+50
View File
@@ -574,6 +574,56 @@ let
compilerNames.ghc9122
compilerNames.ghc9123
] released;
# MicroHs core packages
ghc-compat = [
compilerNames.microhs
];
MicroCabal = [
compilerNames.microhs
];
# MicroHs-specific replacement packages
array = [
compilerNames.microhs
];
# GHC boot packages known to be compatible with MicroHs
containers = [
compilerNames.microhs
];
exceptions = [
compilerNames.microhs
];
filepath = [
compilerNames.microhs
];
mtl = [
compilerNames.microhs
];
os-string = [
compilerNames.microhs
];
parsec = [
compilerNames.microhs
];
terminfo = [
compilerNames.microhs
];
time = [
compilerNames.microhs
];
transformers = [
compilerNames.microhs
];
# MicroHs upstream tested
hscolour = [
compilerNames.microhs
];
random = [
compilerNames.microhs
];
})
{
mergeable = pkgs.releaseTools.aggregate {