diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,46 @@ --- +## [0.17.3] - 2026-08-01 + +Point release on the 0.17.x line, focused on **release-artifact integrity**. The 0.17.2 release shipped +two defects that every existing check missed because they validated only the generated `dist/` tree, never +the packaged artifact: the `hydra-build` sdist shipped 3 of 8 modules, and the published Java `hydra-kernel` +jar was a whole [#417](https://github.com/CategoricalData/hydra/issues/417) rename behind. This release adds +an artifact-level publish-completeness gate that inspects the actual uploaded archive, closing that class of +defect across all five registries. + +### Highlights + +- **Artifact-content completeness gate** ([#621](https://github.com/CategoricalData/hydra/issues/621)): + every publish path (Hackage sdist, Maven-Java jar, Maven-Scala jar, PyPI wheel, npm tarball) now inspects + the *packaged* archive and hard-fails if any module a package's manifest declares is missing. The gate also + asserts the post-#417 class names are present in the Java kernel jar. + +### Bug fixes + +- **PyPI wheels dropped non-`hydra.*` roots** ([#621](https://github.com/CategoricalData/hydra/issues/621)): + the wheel packaging hardcoded `packages = ["src/main/python/hydra"]`, silently omitting `hydra-pg`'s + `com.gdblab.*` and `openGql.*` modules. The generator now ships every emitted top-level root. + +### Improvements + +- **CI guard for dist-tree completeness** ([#524](https://github.com/CategoricalData/hydra/issues/524)): + asserts every manifest `mainModules` namespace is emitted into `dist/haskell`, catching the 0.17.2 + `hydra-build` truncation at the tree level (the artifact gate is the packaged-archive counterpart). +- **Manifest generation extracted** into `Hydra.ManifestGeneration`, and the structurally-unneeded #607 + sed shims dropped ([#622](https://github.com/CategoricalData/hydra/issues/622)). +- **Release-verification signing fix** ([#441](https://github.com/CategoricalData/hydra/issues/441)): + sign the reproducible uncompressed `.tar` and verify the `.asc` against the GitHub Release asset. +- **Java CI signing gate** ([#591](https://github.com/CategoricalData/hydra/issues/591)): `publishToMavenLocal` + skips gpg signing when no key is present. + +### Internal + +- Version bump to 0.17.3; `hostVersion` advanced to 0.17.2 and the temporary #417 Java/Python local-host + shims removed now that 0.17.2 is published on the registries + ([#417](https://github.com/CategoricalData/hydra/issues/417)). + ## [0.17.2] - 2026-07-28 Point release on the 0.17.x line. Themes: promotion of the generator's routing and manifest diff --git a/hydra-lisp.cabal b/hydra-lisp.cabal --- a/hydra-lisp.cabal +++ b/hydra-lisp.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hydra-lisp -version: 0.17.3 +version: 0.17.4 synopsis: Hydra's Lisp coder: emit Clojure/Scheme/Common-Lisp/Emacs-Lisp source description: Hydra is an implementation of the LambdaGraph data model, which takes advantage of an isomorphism between labeled hypergraphs and typed lambda calculus: in Hydra, "graphs are programs, and programs are graphs". Lisp support for Hydra (shared across Clojure, Scheme, Common Lisp, and Emacs Lisp) category: Data @@ -39,6 +39,6 @@ build-depends: base >=4.19.0 && <4.22 , containers >=0.6.7 && <0.8 - , hydra-kernel ==0.17.3 + , hydra-kernel ==0.17.4 , scientific >=0.3.7 && <0.4 default-language: Haskell2010 diff --git a/src/main/haskell/Hydra/Dsl/Lisp/Syntax.hs b/src/main/haskell/Hydra/Dsl/Lisp/Syntax.hs --- a/src/main/haskell/Hydra/Dsl/Lisp/Syntax.hs +++ b/src/main/haskell/Hydra/Dsl/Lisp/Syntax.hs @@ -5,7 +5,6 @@ module Hydra.Dsl.Lisp.Syntax where import qualified Hydra.Core as Core -import qualified Hydra.Dsl.Core as DslCore import qualified Hydra.Lisp.Syntax as Syntax import qualified Hydra.Typed as Typed import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) diff --git a/src/main/haskell/Hydra/Lisp/Coder.hs b/src/main/haskell/Hydra/Lisp/Coder.hs --- a/src/main/haskell/Hydra/Lisp/Coder.hs +++ b/src/main/haskell/Hydra/Lisp/Coder.hs @@ -58,6 +58,7 @@ import qualified Hydra.Variants as Variants import Prelude hiding (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum) import qualified Data.Scientific as Sci +import qualified Data.Set as S -- | Dialect-aware name for "cadr" (second element of a list); Clojure uses "second", other dialects use "cadr" dialectCadr :: Syntax.Dialect -> String @@ -97,14 +98,14 @@ _ -> True -- | Encode a function application, detecting ifElse and other lazy primitives; transforms (((hydra.lib.logic.ifElse C) T) E) into native (if C T E) -encodeApplication :: Syntax.Dialect -> t0 -> Graph.Graph -> Core.Term -> Core.Term -> Either t1 Syntax.Expression -encodeApplication dialect cx g rawFun rawArg = +encodeApplication :: Syntax.Dialect -> S.Set String -> t0 -> Graph.Graph -> Core.Term -> Core.Term -> Either t1 Syntax.Expression +encodeApplication dialect overlaySubs cx g rawFun rawArg = let dFun = Strip.deannotateTerm rawFun normal = - \_ -> Eithers.bind (encodeTerm dialect cx g rawFun) (\fun -> Eithers.bind (encodeTerm dialect cx g rawArg) (\arg -> Right (lispApp fun [ + \_ -> Eithers.bind (encodeTerm dialect overlaySubs cx g rawFun) (\fun -> Eithers.bind (encodeTerm dialect overlaySubs cx g rawArg) (\arg -> Right (lispApp fun [ arg]))) - enc = \t -> encodeTerm dialect cx g t + enc = \t -> encodeTerm dialect overlaySubs cx g t in case dFun of Core.TermApplication v0 -> let midFun = Core.applicationFunction v0 @@ -141,28 +142,28 @@ Syntax.fieldDefinitionDefaultValue = Nothing} -- | Encode a Hydra lambda as a Lisp expression -encodeLambdaTerm :: Syntax.Dialect -> t0 -> Graph.Graph -> Core.Lambda -> Either t1 Syntax.Expression -encodeLambdaTerm dialect cx g lam = +encodeLambdaTerm :: Syntax.Dialect -> S.Set String -> t0 -> Graph.Graph -> Core.Lambda -> Either t1 Syntax.Expression +encodeLambdaTerm dialect overlaySubs cx g lam = let param = Formatting.convertCaseCamelOrUnderscoreToLowerSnake (Formatting.sanitizeWithUnderscores Language.lispReservedWords (Core.unName (Core.lambdaParameter lam))) - in (Eithers.bind (encodeTerm dialect cx g (Core.lambdaBody lam)) (\body -> Right (lispLambdaExpr [ + in (Eithers.bind (encodeTerm dialect overlaySubs cx g (Core.lambdaBody lam)) (\body -> Right (lispLambdaExpr [ param] body))) -- | Encode let bindings as nested ((lambda (x) body) init) applications, for self-referential non-lambda bindings -encodeLetAsLambdaApp :: Syntax.Dialect -> t0 -> Graph.Graph -> [Core.Binding] -> Core.Term -> Either t1 Syntax.Expression -encodeLetAsLambdaApp dialect cx g bindings body = - Eithers.bind (encodeTerm dialect cx g body) (\bodyExpr -> Eithers.foldList (\acc -> \b -> +encodeLetAsLambdaApp :: Syntax.Dialect -> S.Set String -> t0 -> Graph.Graph -> [Core.Binding] -> Core.Term -> Either t1 Syntax.Expression +encodeLetAsLambdaApp dialect overlaySubs cx g bindings body = + Eithers.bind (encodeTerm dialect overlaySubs cx g body) (\bodyExpr -> Eithers.foldList (\acc -> \b -> let bname = Formatting.convertCaseCamelOrUnderscoreToLowerSnake (Formatting.sanitizeWithUnderscores Language.lispReservedWords (Core.unName (Core.bindingName b))) - in (Eithers.bind (encodeTerm dialect cx g (Core.bindingTerm b)) (\bval -> Right (lispApp (lispLambdaExpr [ + in (Eithers.bind (encodeTerm dialect overlaySubs cx g (Core.bindingTerm b)) (\bval -> Right (lispApp (lispLambdaExpr [ bname] acc) [ bval])))) bodyExpr (Lists.reverse bindings)) -- | Encode let bindings as native let, let*, or letrec expressions depending on self-reference and binding count -encodeLetAsNative :: Syntax.Dialect -> t0 -> Graph.Graph -> [Core.Binding] -> Core.Term -> Either t1 Syntax.Expression -encodeLetAsNative dialect cx g bindings body = - Eithers.bind (encodeTerm dialect cx g body) (\bodyExpr -> +encodeLetAsNative :: Syntax.Dialect -> S.Set String -> t0 -> Graph.Graph -> [Core.Binding] -> Core.Term -> Either t1 Syntax.Expression +encodeLetAsNative dialect overlaySubs cx g bindings body = + Eithers.bind (encodeTerm dialect overlaySubs cx g body) (\bodyExpr -> let supportsLetrec = dialectSupportsLetrec dialect allNames = Sets.fromList (Lists.map (\b -> Core.bindingName b) bindings) adjList = @@ -179,7 +180,7 @@ case (Strip.deannotateTerm (Core.bindingTerm b)) of Core.TermLambda _ -> True _ -> False - in (Eithers.bind (encodeTerm dialect cx g (Core.bindingTerm b)) (\bval -> + in (Eithers.bind (encodeTerm dialect overlaySubs cx g (Core.bindingTerm b)) (\bval -> let isClojure = Logic.not supportsLetrec wrappedVal = Logic.ifElse isClojure (Logic.ifElse isSelfRef (Logic.ifElse isLambda (case bval of @@ -261,8 +262,8 @@ Syntax.integerLiteralBigint = False}))) byteValues)})) -- | Encode a Hydra record projection as a Lisp expression, with an optional argument for applied projections -encodeProjectionElim :: Syntax.Dialect -> t0 -> Graph.Graph -> Core.Projection -> Maybe Core.Term -> Either t1 Syntax.Expression -encodeProjectionElim dialect cx g proj marg = +encodeProjectionElim :: Syntax.Dialect -> S.Set String -> t0 -> Graph.Graph -> Core.Projection -> Maybe Core.Term -> Either t1 Syntax.Expression +encodeProjectionElim dialect overlaySubs cx g proj marg = let fname = Formatting.convertCaseCamelToLowerSnake (Core.unName (Core.projectionFieldName proj)) tname = qualifiedSnakeName (Core.projectionTypeName proj) @@ -270,53 +271,53 @@ "__rec"] (Syntax.ExpressionFieldAccess (Syntax.FieldAccess { Syntax.fieldAccessRecordType = (Syntax.Symbol tname), Syntax.fieldAccessField = (Syntax.Symbol fname), - Syntax.fieldAccessTarget = (lispVar "__rec")})))) (\arg -> Eithers.bind (encodeTerm dialect cx g arg) (\sarg -> Right (Syntax.ExpressionFieldAccess (Syntax.FieldAccess { + Syntax.fieldAccessTarget = (lispVar "__rec")})))) (\arg -> Eithers.bind (encodeTerm dialect overlaySubs cx g arg) (\sarg -> Right (Syntax.ExpressionFieldAccess (Syntax.FieldAccess { Syntax.fieldAccessRecordType = (Syntax.Symbol tname), Syntax.fieldAccessField = (Syntax.Symbol fname), Syntax.fieldAccessTarget = sarg}))))) -- | Encode a Hydra term as a Lisp expression -encodeTerm :: Syntax.Dialect -> t0 -> Graph.Graph -> Core.Term -> Either t1 Syntax.Expression -encodeTerm dialect cx g term = +encodeTerm :: Syntax.Dialect -> S.Set String -> t0 -> Graph.Graph -> Core.Term -> Either t1 Syntax.Expression +encodeTerm dialect overlaySubs cx g term = case term of - Core.TermAnnotated v0 -> encodeTerm dialect cx g (Core.annotatedTermBody v0) + Core.TermAnnotated v0 -> encodeTerm dialect overlaySubs cx g (Core.annotatedTermBody v0) Core.TermApplication v0 -> let rawFun = Core.applicationFunction v0 rawArg = Core.applicationArgument v0 - in (encodeApplication dialect cx g rawFun rawArg) - Core.TermEither v0 -> Eithers.either (\l -> Eithers.bind (encodeTerm dialect cx g l) (\sl -> Right (lispApp (lispVar "list") [ + in (encodeApplication dialect overlaySubs cx g rawFun rawArg) + Core.TermEither v0 -> Eithers.either (\l -> Eithers.bind (encodeTerm dialect overlaySubs cx g l) (\sl -> Right (lispApp (lispVar "list") [ lispKeyword "left", - sl]))) (\r -> Eithers.bind (encodeTerm dialect cx g r) (\sr -> Right (lispApp (lispVar "list") [ + sl]))) (\r -> Eithers.bind (encodeTerm dialect overlaySubs cx g r) (\sr -> Right (lispApp (lispVar "list") [ lispKeyword "right", sr]))) v0 - Core.TermLambda v0 -> encodeLambdaTerm dialect cx g v0 - Core.TermProject v0 -> encodeProjectionElim dialect cx g v0 Nothing - Core.TermCases v0 -> encodeUnionElim dialect cx g v0 Nothing - Core.TermUnwrap v0 -> encodeUnwrapElim dialect cx g v0 Nothing + Core.TermLambda v0 -> encodeLambdaTerm dialect overlaySubs cx g v0 + Core.TermProject v0 -> encodeProjectionElim dialect overlaySubs cx g v0 Nothing + Core.TermCases v0 -> encodeUnionElim dialect overlaySubs cx g v0 Nothing + Core.TermUnwrap v0 -> encodeUnwrapElim dialect overlaySubs cx g v0 Nothing Core.TermLet v0 -> let bindings = Core.letBindings v0 body = Core.letBody v0 - in (encodeLetAsNative dialect cx g bindings body) - Core.TermList v0 -> Eithers.bind (Eithers.mapList (encodeTerm dialect cx g) v0) (\sels -> Right (lispListExpr sels)) + in (encodeLetAsNative dialect overlaySubs cx g bindings body) + Core.TermList v0 -> Eithers.bind (Eithers.mapList (encodeTerm dialect overlaySubs cx g) v0) (\sels -> Right (lispListExpr sels)) Core.TermLiteral v0 -> Right (encodeLiteral v0) - Core.TermMap v0 -> Eithers.bind (Eithers.mapList (\entry -> Eithers.bind (encodeTerm dialect cx g (Pairs.first entry)) (\k -> Eithers.bind (encodeTerm dialect cx g (Pairs.second entry)) (\v -> Right (Syntax.MapEntry { + Core.TermMap v0 -> Eithers.bind (Eithers.mapList (\entry -> Eithers.bind (encodeTerm dialect overlaySubs cx g (Pairs.first entry)) (\k -> Eithers.bind (encodeTerm dialect overlaySubs cx g (Pairs.second entry)) (\v -> Right (Syntax.MapEntry { Syntax.mapEntryKey = k, Syntax.mapEntryValue = v})))) (Maps.toList v0)) (\pairs -> Right (Syntax.ExpressionMap (Syntax.MapLiteral { Syntax.mapLiteralEntries = pairs}))) Core.TermOptional v0 -> Optionals.cases v0 (Right (lispApp (lispVar "list") [ - lispKeyword "none"])) (\val -> Eithers.bind (encodeTerm dialect cx g val) (\sval -> Right (lispApp (lispVar "list") [ + lispKeyword "none"])) (\val -> Eithers.bind (encodeTerm dialect overlaySubs cx g val) (\sval -> Right (lispApp (lispVar "list") [ lispKeyword "given", sval]))) - Core.TermPair v0 -> Eithers.bind (encodeTerm dialect cx g (Pairs.first v0)) (\f -> Eithers.bind (encodeTerm dialect cx g (Pairs.second v0)) (\s -> Right (lispListExpr [ + Core.TermPair v0 -> Eithers.bind (encodeTerm dialect overlaySubs cx g (Pairs.first v0)) (\f -> Eithers.bind (encodeTerm dialect overlaySubs cx g (Pairs.second v0)) (\s -> Right (lispListExpr [ f, s]))) Core.TermRecord v0 -> let rname = Core.recordTypeName v0 fields = Core.recordFields v0 - in (Eithers.bind (Eithers.mapList (\f -> encodeTerm dialect cx g (Core.fieldTerm f)) fields) (\sfields -> + in (Eithers.bind (Eithers.mapList (\f -> encodeTerm dialect overlaySubs cx g (Core.fieldTerm f)) fields) (\sfields -> let constructorName = Strings.concat2 (dialectConstructorPrefix dialect) (qualifiedSnakeName rname) in (Right (lispApp (lispVar constructorName) sfields)))) - Core.TermSet v0 -> Eithers.bind (Eithers.mapList (encodeTerm dialect cx g) (Sets.toList v0)) (\sels -> Right (Syntax.ExpressionSet (Syntax.SetLiteral { + Core.TermSet v0 -> Eithers.bind (Eithers.mapList (encodeTerm dialect overlaySubs cx g) (Sets.toList v0)) (\sels -> Right (Syntax.ExpressionSet (Syntax.SetLiteral { Syntax.setLiteralElements = sels}))) Core.TermInject v0 -> let tname = Names.localNameOf (Core.injectionTypeName v0) @@ -331,29 +332,46 @@ _ -> False in (Logic.ifElse isUnit (Right (lispApp (lispVar "list") [ lispKeyword (Formatting.convertCaseCamelToLowerSnake fname), - lispNilExpr])) (Eithers.bind (encodeTerm dialect cx g fterm) (\sval -> Right (lispApp (lispVar "list") [ + lispNilExpr])) (Eithers.bind (encodeTerm dialect overlaySubs cx g fterm) (\sval -> Right (lispApp (lispVar "list") [ lispKeyword (Formatting.convertCaseCamelToLowerSnake fname), sval])))) Core.TermUnit -> Right lispNilExpr - Core.TermVariable v0 -> Right (lispVar (Formatting.convertCaseCamelOrUnderscoreToLowerSnake (Formatting.sanitizeWithUnderscores Language.lispReservedWords (Core.unName v0)))) - Core.TermTypeApplication v0 -> encodeTerm dialect cx g (Core.typeApplicationTermBody v0) - Core.TermTypeLambda v0 -> encodeTerm dialect cx g (Core.typeLambdaBody v0) - Core.TermWrap v0 -> encodeTerm dialect cx g (Core.wrappedTermBody v0) + Core.TermVariable v0 -> + let fullName = Core.unName v0 + parts = Strings.splitOn "." fullName + sub = Optionals.withDefault "" (Lists.at 2 parts) + redirectedName = + Logic.ifElse (Logic.and (Logic.and (Equality.equal (Lists.length parts) 4) (Equality.equal (Lists.take 2 parts) [ + "hydra", + "lib"])) (Sets.member sub overlaySubs)) (Strings.concat [ + "hydra.overlay.", + case dialect of + Syntax.DialectClojure -> "clojure" + Syntax.DialectScheme -> "scheme" + Syntax.DialectCommonLisp -> "common_lisp" + Syntax.DialectEmacsLisp -> "emacs_lisp" + _ -> "lisp", + ".lib.", + (Strings.join "." (Lists.drop 2 parts))]) fullName + in (Right (lispVar (Formatting.convertCaseCamelOrUnderscoreToLowerSnake (Formatting.sanitizeWithUnderscores Language.lispReservedWords redirectedName)))) + Core.TermTypeApplication v0 -> encodeTerm dialect overlaySubs cx g (Core.typeApplicationTermBody v0) + Core.TermTypeLambda v0 -> encodeTerm dialect overlaySubs cx g (Core.typeLambdaBody v0) + Core.TermWrap v0 -> encodeTerm dialect overlaySubs cx g (Core.wrappedTermBody v0) -- | Encode a Hydra term definition as a Lisp top-level form -encodeTermDefinition :: Syntax.Dialect -> t0 -> Graph.Graph -> Packaging.TermDefinition -> Either t1 Syntax.TopLevelFormWithComments -encodeTermDefinition dialect cx g tdef = +encodeTermDefinition :: Syntax.Dialect -> S.Set String -> t0 -> Graph.Graph -> Packaging.TermDefinition -> Either t1 Syntax.TopLevelFormWithComments +encodeTermDefinition dialect overlaySubs cx g tdef = let name = Packaging.termDefinitionName tdef term = Packaging.termDefinitionBody tdef lname = qualifiedSnakeName name dterm = Strip.deannotateTerm term in case dterm of - Core.TermLambda _ -> Eithers.bind (encodeTerm dialect cx g term) (\sterm -> Right (lispTopForm (Syntax.TopLevelFormVariable (Syntax.VariableDefinition { + Core.TermLambda _ -> Eithers.bind (encodeTerm dialect overlaySubs cx g term) (\sterm -> Right (lispTopForm (Syntax.TopLevelFormVariable (Syntax.VariableDefinition { Syntax.variableDefinitionName = (Syntax.Symbol lname), Syntax.variableDefinitionValue = sterm, Syntax.variableDefinitionDoc = Nothing})))) - _ -> Eithers.bind (encodeTerm dialect cx g term) (\sterm -> Right (lispTopForm (Syntax.TopLevelFormVariable (Syntax.VariableDefinition { + _ -> Eithers.bind (encodeTerm dialect overlaySubs cx g term) (\sterm -> Right (lispTopForm (Syntax.TopLevelFormVariable (Syntax.VariableDefinition { Syntax.variableDefinitionName = (Syntax.Symbol lname), Syntax.variableDefinitionValue = sterm, Syntax.variableDefinitionDoc = Nothing})))) @@ -434,8 +452,8 @@ in (encodeTypeBody lname typ dtyp) -- | Encode a Hydra case statement (union elimination) as a Lisp expression, with an optional argument for applied case statements -encodeUnionElim :: Syntax.Dialect -> t0 -> Graph.Graph -> Core.CaseStatement -> Maybe Core.Term -> Either t1 Syntax.Expression -encodeUnionElim dialect cx g cs marg = +encodeUnionElim :: Syntax.Dialect -> S.Set String -> t0 -> Graph.Graph -> Core.CaseStatement -> Maybe Core.Term -> Either t1 Syntax.Expression +encodeUnionElim dialect overlaySubs cx g cs marg = let tname = Names.localNameOf (Core.caseStatementTypeName cs) caseFields = Core.caseStatementCases cs @@ -448,11 +466,11 @@ lispApp (lispVar (dialectCar dialect)) [ lispVar "match_target"], (lispKeyword cfname)] - in (Eithers.bind (encodeTerm dialect cx g (Core.TermApplication (Core.Application { + in (Eithers.bind (encodeTerm dialect overlaySubs cx g (Core.TermApplication (Core.Application { Core.applicationFunction = cfterm, Core.applicationArgument = (Core.TermVariable (Core.Name "match_value"))}))) (\bodyExpr -> Right (Syntax.CondClause { Syntax.condClauseCondition = condExpr, - Syntax.condClauseBody = bodyExpr})))) caseFields) (\clauses -> Eithers.bind (Optionals.cases defCase (Right Nothing) (\dt -> Eithers.bind (encodeTerm dialect cx g dt) (\defBody -> Right (Just defBody)))) (\defExpr -> + Syntax.condClauseBody = bodyExpr})))) caseFields) (\clauses -> Eithers.bind (Optionals.cases defCase (Right Nothing) (\dt -> Eithers.bind (encodeTerm dialect overlaySubs cx g dt) (\defBody -> Right (Just defBody)))) (\defExpr -> let condExpr = Syntax.ExpressionCond (Syntax.CondExpression { Syntax.condExpressionClauses = clauses, @@ -463,15 +481,15 @@ lispApp (lispVar (dialectCadr dialect)) [ lispVar "match_target"]] in (Optionals.cases marg (Right (lispLambdaExpr [ - "match_target"] innerExpr)) (\arg -> Eithers.bind (encodeTerm dialect cx g arg) (\sarg -> Right (lispApp (lispLambdaExpr [ + "match_target"] innerExpr)) (\arg -> Eithers.bind (encodeTerm dialect overlaySubs cx g arg) (\sarg -> Right (lispApp (lispLambdaExpr [ "match_target"] innerExpr) [ sarg]))))))) -- | Encode a Hydra wrap elimination (unwrap) as a Lisp expression, with an optional argument for applied unwraps -encodeUnwrapElim :: Syntax.Dialect -> t0 -> Graph.Graph -> Core.Name -> Maybe Core.Term -> Either t1 Syntax.Expression -encodeUnwrapElim dialect cx g name marg = +encodeUnwrapElim :: Syntax.Dialect -> S.Set String -> t0 -> Graph.Graph -> Core.Name -> Maybe Core.Term -> Either t1 Syntax.Expression +encodeUnwrapElim dialect overlaySubs cx g name marg = Optionals.cases marg (Right (lispLambdaExpr [ - "__rec"] (lispVar "__rec"))) (\arg -> encodeTerm dialect cx g arg) + "__rec"] (lispVar "__rec"))) (\arg -> encodeTerm dialect overlaySubs cx g arg) -- | Check whether a term is a reference to a specific primitive, stripping type applications, type lambdas, and annotations isPrimitiveRef :: String -> Core.Term -> Bool @@ -595,17 +613,36 @@ Syntax.exportDeclarationSymbols = symbols}]) -- | Generate import declarations from the dependency namespaces of a module's definitions -moduleImports :: Packaging.ModuleName -> [Packaging.Definition] -> [Syntax.ImportDeclaration] -moduleImports focusNs defs = +moduleImports :: Syntax.Dialect -> S.Set String -> Packaging.ModuleName -> [Packaging.Definition] -> [Syntax.ImportDeclaration] +moduleImports dialect overlaySubs focusNs defs = - let depNss = Sets.toList (Sets.delete focusNs (Analysis.definitionDependencyModuleNames defs)) + let langSeg = + case dialect of + Syntax.DialectClojure -> "clojure" + Syntax.DialectScheme -> "scheme" + Syntax.DialectCommonLisp -> "common_lisp" + Syntax.DialectEmacsLisp -> "emacs_lisp" + _ -> "lisp" + redirectedNsString = + \ns -> + let raw = Packaging.unModuleName ns + parts = Strings.splitOn "." raw + sub = Strings.join "." (Lists.drop 2 parts) + in (Logic.ifElse (Logic.and (Logic.and (Equality.equal (Lists.length parts) 3) (Equality.equal (Lists.take 2 parts) [ + "hydra", + "lib"])) (Sets.member sub overlaySubs)) (Strings.concat [ + "hydra.overlay.", + langSeg, + ".lib.", + sub]) raw) + depNss = Sets.toList (Sets.delete focusNs (Analysis.definitionDependencyModuleNames defs)) in (Lists.map (\ns -> Syntax.ImportDeclaration { - Syntax.importDeclarationModule = (Syntax.NamespaceName (Packaging.unModuleName ns)), + Syntax.importDeclarationModule = (Syntax.NamespaceName (redirectedNsString ns)), Syntax.importDeclarationSpec = Syntax.ImportSpecAll}) depNss) -- | Convert a Hydra module to a Lisp program -moduleToLisp :: Syntax.Dialect -> Packaging.Module -> [Packaging.Definition] -> t0 -> Graph.Graph -> Either t1 Syntax.Program -moduleToLisp dialect mod defs0 cx g = +moduleToLisp :: Syntax.Dialect -> S.Set String -> Packaging.Module -> [Packaging.Definition] -> t0 -> Graph.Graph -> Either t1 Syntax.Program +moduleToLisp dialect overlaySubs mod defs0 cx g = let defs = Environment.reorderDefs defs0 partitioned = Environment.partitionDefinitions defs @@ -613,11 +650,11 @@ termDefs = Pairs.second partitioned typeDefs = Lists.filter (\td -> Predicates.isNominalType (Core.typeSchemeBody (Packaging.typeDefinitionBody td))) allTypeDefs - in (Eithers.bind (Eithers.mapList (encodeTypeDefinition cx g) typeDefs) (\typeItems -> Eithers.bind (Eithers.mapList (encodeTermDefinition dialect cx g) termDefs) (\termItems -> + in (Eithers.bind (Eithers.mapList (encodeTypeDefinition cx g) typeDefs) (\typeItems -> Eithers.bind (Eithers.mapList (encodeTermDefinition dialect overlaySubs cx g) termDefs) (\termItems -> let allItems = Lists.concat2 typeItems termItems nsName = Packaging.unModuleName (Packaging.moduleName mod) focusNs = Packaging.moduleName mod - imports = moduleImports focusNs defs + imports = moduleImports dialect overlaySubs focusNs defs exports = moduleExports allItems in (Right (Syntax.Program { Syntax.programDialect = dialect,