diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,88 @@ --- +## [0.17.7] - 2026-09-14 + +Correctness-hardening point release on the 0.17.x line, consolidating the 0.17.6 breaking batch. It +closes a family of silent cross-host correctness bugs in the equality, ordering, integer-narrowing +and string primitives, and adds the systematic test coverage that exposed them. No kernel-surface +breaking changes. + +### Highlights + +- **Silent-wrong primitives corrected across hosts** + ([#745](https://github.com/CategoricalData/hydra/issues/745), + [#742](https://github.com/CategoricalData/hydra/issues/742)): new shared cross-host fixtures + uncovered ~a dozen primitives (`equal`/`compare` on collections, float equality, `bigintToIntN` + narrowing, `parseUint*` bounds, astral-plane string ops) that returned wrong results on one or more + non-Haskell hosts while appearing to pass. All are now correct and verified per-host against the + Haskell reference oracle. +- **Systematic test-coverage hardening** + ([#749](https://github.com/CategoricalData/hydra/issues/749)): new kernel coverage for previously + untested primitive behavior (equality/ordering collection depth, `notEqual`, `functions.const`/`flip`), + which drove wiring those primitives into every host's default-implementation fallback. +- **Scale-preserving decimals across every lossy-double host** + ([#727](https://github.com/CategoricalData/hydra/issues/727), + [#719](https://github.com/CategoricalData/hydra/issues/719)): `Literal.decimal` gains a real + scale-preserving representation (coefficient + scale) in the Scheme, Emacs Lisp, Common Lisp and + TypeScript runtimes and coders, and the generated `Literal.Decimal` `equals`/`compareTo` on Java, + Python and Scala stop ignoring scale. The `scaleDistinctTestNames` skip list — which had been + masking the gap on five hosts — is deleted, so decimal scale is now verified everywhere rather + than excused. + +### Bug fixes + +- **[#745](https://github.com/CategoricalData/hydra/issues/745)** silent-wrong equality/ordering, + `bigintToIntN` narrowing, `parseUint32/64` bounds, and astral-plane `charAt`/`splitOn`/`compare` + across the eight non-Haskell hosts. +- **[#742](https://github.com/CategoricalData/hydra/issues/742)** structural `equal`/`compare` on + maps, sets and nested decimals no longer falls back to scale-blind or print-based comparison + (including a hand-inlined Scala primitive that shadowed the overlay fix). +- **[#743](https://github.com/CategoricalData/hydra/issues/743)** kernel JSON decoder now rejects an + `Either` object carrying both `left` and `right` keys instead of silently resolving one arm. +- **[#740](https://github.com/CategoricalData/hydra/issues/740)** the recursive parametric union decoder + now emits an explicit type application instead of an untyped lambda, so recursive parametric-union + types generate and compile on the Java host; also fixes `update-json-kernel` reconcile to build a + complete inference universe so drifted kernel modules re-infer. +- **[#720](https://github.com/CategoricalData/hydra/issues/720)** Python's + `hydra.lib.equality`/`ordering` did not satisfy IEEE `totalOrder` for floats, mis-ordering `NaN` + and signed zero. +- **[#722](https://github.com/CategoricalData/hydra/issues/722)** two `kernelDefaultCoreProfile` + correctness defects: rule ids that referred to rules no longer present, and a stubbed + `isValidName` that accepted every name. + +### Improvements + +- **[#749](https://github.com/CategoricalData/hydra/issues/749)** `notEqual`/`const`/`flip` wired + into each host's `#609` default-implementation fallback; orphaned Avro coder test suite recovered. +- **[#730](https://github.com/CategoricalData/hydra/issues/730)** a shared `~/.stack` build slot + (`bin/with-stack-slot.sh`) replaces the pgrep slot mechanic, serializing concurrent GHC builds + across the fleet behind a real mutex. The wrapper is now portable to macOS: `flock(1)` is + util-linux and absent there, so it is emulated via Perl's `flock()` where missing, and the + GNU-only `date -Is`/`date -d` calls are replaced with portable equivalents. Its bypass path also + no longer re-execs forever. Without these, every entry point that routes through the slot — + `bin/sync.sh`, `bin/test.sh`, `bin/run-bootstrapping-demo.sh` and `bin/prepare-release.sh` — + failed immediately on macOS. +- **[#600](https://github.com/CategoricalData/hydra/issues/600)** the five published TypeScript + packages are subpath-import-only (uniform export surface). +- **[#716](https://github.com/CategoricalData/hydra/issues/716)** `hydra.paths` reshaped onto the + term-graph model (`TermGraph`/`TypeGraph`), aligning path steps with the term and type grammars + and adding the link view of a graph; `mapKey`/`mapValue` collapse into a single `mapEntry` step. +- **[#701](https://github.com/CategoricalData/hydra/issues/701)** module cache freshness is now a + Merkle hash over each module's dependency closure, so a change deep in the closure correctly + invalidates dependents. +- **[#559](https://github.com/CategoricalData/hydra/issues/559)** host-agnostic build: the + remaining hand-coded host build logic is promoted into `hydra.build.*`, with Java as the + definitive second host. +- **[#721](https://github.com/CategoricalData/hydra/issues/721)** `checkNestedModuleNames` packaging + check enforces the module-namespace no-prefix rule. + +### Documentation + +- **[#508](https://github.com/CategoricalData/hydra/issues/508)** de-Claude-speak documentation pass: + style-guide section added, stale paths and dead links repaired, agent-operations wiki pages moved + into `claude/`, and a `getting-started.md` guardrail against re-adding a TypeScript root export. + ## [0.17.6] - 2026-08-30 Point release on the 0.17.x line, and the last backward-incompatible batch before the 1.0 surface 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.6 +version: 0.17.7 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.6 + , hydra-kernel ==0.17.7 , 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 @@ -893,6 +893,39 @@ Core.projectionFieldName = (Core.Name "arguments")})), Core.applicationArgument = (Typed.unTypedTerm original)}))}]})) +-- | DSL constructor for hydra.lisp.syntax.DecimalLiteral +decimalLiteral :: Typed.TypedTerm String -> Typed.TypedTerm Syntax.DecimalLiteral +decimalLiteral digits = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.lisp.syntax.DecimalLiteral"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "digits"), + Core.fieldTerm = (Typed.unTypedTerm digits)}]})) + +-- | DSL name token for hydra.lisp.syntax.DecimalLiteral +decimalLiteralDecimalLiteral :: Typed.TypedName Syntax.DecimalLiteral +decimalLiteralDecimalLiteral = Typed.TypedName (Core.Name "hydra.lisp.syntax.DecimalLiteral") + +-- | DSL accessor for the digits field of hydra.lisp.syntax.DecimalLiteral +decimalLiteralDigits :: Typed.TypedTerm Syntax.DecimalLiteral -> Typed.TypedTerm String +decimalLiteralDigits x = + Typed.TypedTerm (Core.TermApplication (Core.Application { + Core.applicationFunction = (Core.TermProject (Core.Projection { + Core.projectionTypeName = (Core.Name "hydra.lisp.syntax.DecimalLiteral"), + Core.projectionFieldName = (Core.Name "digits")})), + Core.applicationArgument = (Typed.unTypedTerm x)})) + +-- | DSL updater for the digits field of hydra.lisp.syntax.DecimalLiteral +decimalLiteralWithDigits :: Typed.TypedTerm Syntax.DecimalLiteral -> Typed.TypedTerm String -> Typed.TypedTerm Syntax.DecimalLiteral +decimalLiteralWithDigits original newVal = + Typed.TypedTerm (Core.TermRecord (Core.Record { + Core.recordTypeName = (Core.Name "hydra.lisp.syntax.DecimalLiteral"), + Core.recordFields = [ + Core.Field { + Core.fieldName = (Core.Name "digits"), + Core.fieldTerm = (Typed.unTypedTerm newVal)}]})) + -- | DSL constructor for hydra.lisp.syntax.DestructuringBinding destructuringBinding :: Typed.TypedTerm Syntax.DestructuringPattern -> Typed.TypedTerm Syntax.Expression -> Typed.TypedTerm Syntax.DestructuringBinding destructuringBinding pattern value = @@ -2833,6 +2866,15 @@ Core.injectionTypeName = (Core.Name "hydra.lisp.syntax.Literal"), Core.injectionField = Core.Field { Core.fieldName = (Core.Name "character"), + Core.fieldTerm = (Typed.unTypedTerm x)}})) + +-- | DSL injection for the decimal variant of hydra.lisp.syntax.Literal +literalDecimal :: Typed.TypedTerm Syntax.DecimalLiteral -> Typed.TypedTerm Syntax.Literal +literalDecimal x = + Typed.TypedTerm (Core.TermInject (Core.Injection { + Core.injectionTypeName = (Core.Name "hydra.lisp.syntax.Literal"), + Core.injectionField = Core.Field { + Core.fieldName = (Core.Name "decimal"), Core.fieldTerm = (Typed.unTypedTerm x)}})) -- | DSL injection for the float variant of hydra.lisp.syntax.Literal 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 @@ -216,9 +216,8 @@ encodeLiteral lit = case lit of Core.LiteralBoolean v0 -> Syntax.ExpressionLiteral (Syntax.LiteralBoolean v0) - Core.LiteralDecimal v0 -> Syntax.ExpressionLiteral (Syntax.LiteralFloat (Syntax.FloatLiteral { - Syntax.floatLiteralValue = (Literals.decimalToFloat64 v0), - Syntax.floatLiteralPrecision = Nothing})) + Core.LiteralDecimal v0 -> Syntax.ExpressionLiteral (Syntax.LiteralDecimal (Syntax.DecimalLiteral { + Syntax.decimalLiteralDigits = (Literals.printDecimal v0)})) Core.LiteralString v0 -> Syntax.ExpressionLiteral (Syntax.LiteralString v0) Core.LiteralFloat v0 -> case v0 of Core.FloatValueFloat32 v1 -> Syntax.ExpressionLiteral (Syntax.LiteralFloat (Syntax.FloatLiteral { diff --git a/src/main/haskell/Hydra/Lisp/Language.hs b/src/main/haskell/Hydra/Lisp/Language.hs --- a/src/main/haskell/Hydra/Lisp/Language.hs +++ b/src/main/haskell/Hydra/Lisp/Language.hs @@ -41,6 +41,264 @@ import Data.Void import qualified Data.Set as S +-- | Language constraints for Clojure +clojureLanguage :: Coders.Language +clojureLanguage = + Coders.Language { + Coders.languageName = (Coders.LanguageName "hydra.lisp"), + Coders.languageConstraints = Coders.LanguageConstraints { + Coders.languageConstraintsLiteralVariants = literalVariants, + Coders.languageConstraintsFloatTypes = floatTypes, + Coders.languageConstraintsIntegerTypes = integerTypes, + Coders.languageConstraintsTermVariants = termVariants, + Coders.languageConstraintsTypeVariants = typeVariants, + Coders.languageConstraintsTypes = typePredicate}, + Coders.languageSupportedFeatures = (Sets.fromList [ + Coders.LanguageFeaturePartialApplication, + Coders.LanguageFeatureNestedCaseStatements, + Coders.LanguageFeatureNestedPolymorphicLetBindings]), + Coders.languageCaseConventions = Coders.CaseConventions { + Coders.caseConventionsConstant = Util.CaseConventionUpperSnake, + Coders.caseConventionsDirectory = Util.CaseConventionLowerSnake, + Coders.caseConventionsEnumValue = Util.CaseConventionLowerSnake, + Coders.caseConventionsField = Util.CaseConventionLowerSnake, + Coders.caseConventionsFile = Util.CaseConventionLowerSnake, + Coders.caseConventionsModule = Util.CaseConventionLowerSnake, + Coders.caseConventionsTerm = Util.CaseConventionLowerSnake, + Coders.caseConventionsTermVariable = Util.CaseConventionLowerSnake, + Coders.caseConventionsType = Util.CaseConventionLowerSnake, + Coders.caseConventionsTypeVariable = Util.CaseConventionLowerSnake}, + Coders.languageDefaultFileExtension = (File.FileExtension "clj")} + where + literalVariants = + Sets.fromList [ + Variants.LiteralVariantBinary, + Variants.LiteralVariantBoolean, + Variants.LiteralVariantDecimal, + Variants.LiteralVariantFloat, + Variants.LiteralVariantInteger, + Variants.LiteralVariantString] + floatTypes = Sets.fromList [ + Core.FloatTypeFloat64] + integerTypes = Sets.fromList [ + Core.IntegerTypeBigint] + termVariants = + Sets.fromList [ + Variants.TermVariantAnnotated, + Variants.TermVariantApplication, + Variants.TermVariantEither, + Variants.TermVariantCases, + Variants.TermVariantLambda, + Variants.TermVariantProject, + Variants.TermVariantUnwrap, + Variants.TermVariantTypeApplication, + Variants.TermVariantTypeLambda, + Variants.TermVariantLet, + Variants.TermVariantList, + Variants.TermVariantLiteral, + Variants.TermVariantMap, + Variants.TermVariantOptional, + Variants.TermVariantPair, + Variants.TermVariantRecord, + Variants.TermVariantSet, + Variants.TermVariantInject, + Variants.TermVariantUnit, + Variants.TermVariantVariable, + Variants.TermVariantWrap] + typeVariants = + Sets.fromList [ + Variants.TypeVariantAnnotated, + Variants.TypeVariantApplication, + Variants.TypeVariantEither, + Variants.TypeVariantEffect, + Variants.TypeVariantFunction, + Variants.TypeVariantForall, + Variants.TypeVariantList, + Variants.TypeVariantLiteral, + Variants.TypeVariantMap, + Variants.TypeVariantOptional, + Variants.TypeVariantPair, + Variants.TypeVariantRecord, + Variants.TypeVariantSet, + Variants.TypeVariantUnion, + Variants.TypeVariantUnit, + Variants.TypeVariantVariable, + Variants.TypeVariantVoid, + Variants.TypeVariantWrap] + typePredicate = \_ -> True + +-- | Language constraints for Common Lisp +commonLispLanguage :: Coders.Language +commonLispLanguage = + Coders.Language { + Coders.languageName = (Coders.LanguageName "hydra.lisp"), + Coders.languageConstraints = Coders.LanguageConstraints { + Coders.languageConstraintsLiteralVariants = literalVariants, + Coders.languageConstraintsFloatTypes = floatTypes, + Coders.languageConstraintsIntegerTypes = integerTypes, + Coders.languageConstraintsTermVariants = termVariants, + Coders.languageConstraintsTypeVariants = typeVariants, + Coders.languageConstraintsTypes = typePredicate}, + Coders.languageSupportedFeatures = (Sets.fromList [ + Coders.LanguageFeaturePartialApplication, + Coders.LanguageFeatureNestedCaseStatements, + Coders.LanguageFeatureNestedPolymorphicLetBindings]), + Coders.languageCaseConventions = Coders.CaseConventions { + Coders.caseConventionsConstant = Util.CaseConventionUpperSnake, + Coders.caseConventionsDirectory = Util.CaseConventionLowerSnake, + Coders.caseConventionsEnumValue = Util.CaseConventionLowerSnake, + Coders.caseConventionsField = Util.CaseConventionLowerSnake, + Coders.caseConventionsFile = Util.CaseConventionLowerSnake, + Coders.caseConventionsModule = Util.CaseConventionLowerSnake, + Coders.caseConventionsTerm = Util.CaseConventionLowerSnake, + Coders.caseConventionsTermVariable = Util.CaseConventionLowerSnake, + Coders.caseConventionsType = Util.CaseConventionLowerSnake, + Coders.caseConventionsTypeVariable = Util.CaseConventionLowerSnake}, + Coders.languageDefaultFileExtension = (File.FileExtension "lisp")} + where + literalVariants = + Sets.fromList [ + Variants.LiteralVariantBinary, + Variants.LiteralVariantBoolean, + Variants.LiteralVariantDecimal, + Variants.LiteralVariantFloat, + Variants.LiteralVariantInteger, + Variants.LiteralVariantString] + floatTypes = Sets.fromList [ + Core.FloatTypeFloat64] + integerTypes = Sets.fromList [ + Core.IntegerTypeBigint] + termVariants = + Sets.fromList [ + Variants.TermVariantAnnotated, + Variants.TermVariantApplication, + Variants.TermVariantEither, + Variants.TermVariantCases, + Variants.TermVariantLambda, + Variants.TermVariantProject, + Variants.TermVariantUnwrap, + Variants.TermVariantTypeApplication, + Variants.TermVariantTypeLambda, + Variants.TermVariantLet, + Variants.TermVariantList, + Variants.TermVariantLiteral, + Variants.TermVariantMap, + Variants.TermVariantOptional, + Variants.TermVariantPair, + Variants.TermVariantRecord, + Variants.TermVariantSet, + Variants.TermVariantInject, + Variants.TermVariantUnit, + Variants.TermVariantVariable, + Variants.TermVariantWrap] + typeVariants = + Sets.fromList [ + Variants.TypeVariantAnnotated, + Variants.TypeVariantApplication, + Variants.TypeVariantEither, + Variants.TypeVariantEffect, + Variants.TypeVariantFunction, + Variants.TypeVariantForall, + Variants.TypeVariantList, + Variants.TypeVariantLiteral, + Variants.TypeVariantMap, + Variants.TypeVariantOptional, + Variants.TypeVariantPair, + Variants.TypeVariantRecord, + Variants.TypeVariantSet, + Variants.TypeVariantUnion, + Variants.TypeVariantUnit, + Variants.TypeVariantVariable, + Variants.TypeVariantVoid, + Variants.TypeVariantWrap] + typePredicate = \_ -> True + +-- | Language constraints for Emacs Lisp +emacsLispLanguage :: Coders.Language +emacsLispLanguage = + Coders.Language { + Coders.languageName = (Coders.LanguageName "hydra.lisp"), + Coders.languageConstraints = Coders.LanguageConstraints { + Coders.languageConstraintsLiteralVariants = literalVariants, + Coders.languageConstraintsFloatTypes = floatTypes, + Coders.languageConstraintsIntegerTypes = integerTypes, + Coders.languageConstraintsTermVariants = termVariants, + Coders.languageConstraintsTypeVariants = typeVariants, + Coders.languageConstraintsTypes = typePredicate}, + Coders.languageSupportedFeatures = (Sets.fromList [ + Coders.LanguageFeaturePartialApplication, + Coders.LanguageFeatureNestedCaseStatements, + Coders.LanguageFeatureNestedPolymorphicLetBindings]), + Coders.languageCaseConventions = Coders.CaseConventions { + Coders.caseConventionsConstant = Util.CaseConventionUpperSnake, + Coders.caseConventionsDirectory = Util.CaseConventionLowerSnake, + Coders.caseConventionsEnumValue = Util.CaseConventionLowerSnake, + Coders.caseConventionsField = Util.CaseConventionLowerSnake, + Coders.caseConventionsFile = Util.CaseConventionLowerSnake, + Coders.caseConventionsModule = Util.CaseConventionLowerSnake, + Coders.caseConventionsTerm = Util.CaseConventionLowerSnake, + Coders.caseConventionsTermVariable = Util.CaseConventionLowerSnake, + Coders.caseConventionsType = Util.CaseConventionLowerSnake, + Coders.caseConventionsTypeVariable = Util.CaseConventionLowerSnake}, + Coders.languageDefaultFileExtension = (File.FileExtension "el")} + where + literalVariants = + Sets.fromList [ + Variants.LiteralVariantBinary, + Variants.LiteralVariantBoolean, + Variants.LiteralVariantDecimal, + Variants.LiteralVariantFloat, + Variants.LiteralVariantInteger, + Variants.LiteralVariantString] + floatTypes = Sets.fromList [ + Core.FloatTypeFloat64] + integerTypes = Sets.fromList [ + Core.IntegerTypeBigint] + termVariants = + Sets.fromList [ + Variants.TermVariantAnnotated, + Variants.TermVariantApplication, + Variants.TermVariantEither, + Variants.TermVariantCases, + Variants.TermVariantLambda, + Variants.TermVariantProject, + Variants.TermVariantUnwrap, + Variants.TermVariantTypeApplication, + Variants.TermVariantTypeLambda, + Variants.TermVariantLet, + Variants.TermVariantList, + Variants.TermVariantLiteral, + Variants.TermVariantMap, + Variants.TermVariantOptional, + Variants.TermVariantPair, + Variants.TermVariantRecord, + Variants.TermVariantSet, + Variants.TermVariantInject, + Variants.TermVariantUnit, + Variants.TermVariantVariable, + Variants.TermVariantWrap] + typeVariants = + Sets.fromList [ + Variants.TypeVariantAnnotated, + Variants.TypeVariantApplication, + Variants.TypeVariantEither, + Variants.TypeVariantEffect, + Variants.TypeVariantFunction, + Variants.TypeVariantForall, + Variants.TypeVariantList, + Variants.TypeVariantLiteral, + Variants.TypeVariantMap, + Variants.TypeVariantOptional, + Variants.TypeVariantPair, + Variants.TypeVariantRecord, + Variants.TypeVariantSet, + Variants.TypeVariantUnion, + Variants.TypeVariantUnit, + Variants.TypeVariantVariable, + Variants.TypeVariantVoid, + Variants.TypeVariantWrap] + typePredicate = \_ -> True + -- | Language constraints for Lisp lispLanguage :: Coders.Language lispLanguage = @@ -346,3 +604,89 @@ "else"] hydraLispKeywords = [ "Node"] + +-- | Language constraints for Scheme (R7RS) +schemeLanguage :: Coders.Language +schemeLanguage = + Coders.Language { + Coders.languageName = (Coders.LanguageName "hydra.lisp"), + Coders.languageConstraints = Coders.LanguageConstraints { + Coders.languageConstraintsLiteralVariants = literalVariants, + Coders.languageConstraintsFloatTypes = floatTypes, + Coders.languageConstraintsIntegerTypes = integerTypes, + Coders.languageConstraintsTermVariants = termVariants, + Coders.languageConstraintsTypeVariants = typeVariants, + Coders.languageConstraintsTypes = typePredicate}, + Coders.languageSupportedFeatures = (Sets.fromList [ + Coders.LanguageFeaturePartialApplication, + Coders.LanguageFeatureNestedCaseStatements, + Coders.LanguageFeatureNestedPolymorphicLetBindings]), + Coders.languageCaseConventions = Coders.CaseConventions { + Coders.caseConventionsConstant = Util.CaseConventionUpperSnake, + Coders.caseConventionsDirectory = Util.CaseConventionLowerSnake, + Coders.caseConventionsEnumValue = Util.CaseConventionLowerSnake, + Coders.caseConventionsField = Util.CaseConventionLowerSnake, + Coders.caseConventionsFile = Util.CaseConventionLowerSnake, + Coders.caseConventionsModule = Util.CaseConventionLowerSnake, + Coders.caseConventionsTerm = Util.CaseConventionLowerSnake, + Coders.caseConventionsTermVariable = Util.CaseConventionLowerSnake, + Coders.caseConventionsType = Util.CaseConventionLowerSnake, + Coders.caseConventionsTypeVariable = Util.CaseConventionLowerSnake}, + Coders.languageDefaultFileExtension = (File.FileExtension "scm")} + where + literalVariants = + Sets.fromList [ + Variants.LiteralVariantBinary, + Variants.LiteralVariantBoolean, + Variants.LiteralVariantDecimal, + Variants.LiteralVariantFloat, + Variants.LiteralVariantInteger, + Variants.LiteralVariantString] + floatTypes = Sets.fromList [ + Core.FloatTypeFloat64] + integerTypes = Sets.fromList [ + Core.IntegerTypeBigint] + termVariants = + Sets.fromList [ + Variants.TermVariantAnnotated, + Variants.TermVariantApplication, + Variants.TermVariantEither, + Variants.TermVariantCases, + Variants.TermVariantLambda, + Variants.TermVariantProject, + Variants.TermVariantUnwrap, + Variants.TermVariantTypeApplication, + Variants.TermVariantTypeLambda, + Variants.TermVariantLet, + Variants.TermVariantList, + Variants.TermVariantLiteral, + Variants.TermVariantMap, + Variants.TermVariantOptional, + Variants.TermVariantPair, + Variants.TermVariantRecord, + Variants.TermVariantSet, + Variants.TermVariantInject, + Variants.TermVariantUnit, + Variants.TermVariantVariable, + Variants.TermVariantWrap] + typeVariants = + Sets.fromList [ + Variants.TypeVariantAnnotated, + Variants.TypeVariantApplication, + Variants.TypeVariantEither, + Variants.TypeVariantEffect, + Variants.TypeVariantFunction, + Variants.TypeVariantForall, + Variants.TypeVariantList, + Variants.TypeVariantLiteral, + Variants.TypeVariantMap, + Variants.TypeVariantOptional, + Variants.TypeVariantPair, + Variants.TypeVariantRecord, + Variants.TypeVariantSet, + Variants.TypeVariantUnion, + Variants.TypeVariantUnit, + Variants.TypeVariantVariable, + Variants.TypeVariantVoid, + Variants.TypeVariantWrap] + typePredicate = \_ -> True diff --git a/src/main/haskell/Hydra/Lisp/Serde.hs b/src/main/haskell/Hydra/Lisp/Serde.hs --- a/src/main/haskell/Hydra/Lisp/Serde.hs +++ b/src/main/haskell/Hydra/Lisp/Serde.hs @@ -23,7 +23,9 @@ import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic +import qualified Hydra.Overlay.Haskell.Lib.Math as Math import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals +import qualified Hydra.Overlay.Haskell.Lib.Ordering as Ordering import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings import qualified Hydra.Lisp.Syntax as Syntax @@ -185,6 +187,26 @@ name, value])) +-- | Decode a canonical decimal digit string into a ((sign, digits), scale) nested pair +decimalDigitsAndScale :: String -> ((String, String), Int) +decimalDigitsAndScale s = + + let eParts = Strings.splitOn "e" s + mantissa = Optionals.withDefault "" (Lists.head eParts) + expText = Optionals.withDefault "" (Lists.head (Lists.drop 1 eParts)) + expTextUnplussed = + Logic.ifElse (Equality.equal (Optionals.withDefault 0 (Strings.charAt 0 expText)) 43) (Strings.fromList (Lists.drop 1 (Strings.toList expText))) expText + expPart = Optionals.withDefault 0 (Literals.parseInt32 expTextUnplussed) + isNeg = Equality.equal (Optionals.withDefault 0 (Strings.charAt 0 mantissa)) 45 + unsigned = Logic.ifElse isNeg (Strings.fromList (Lists.drop 1 (Strings.toList mantissa))) mantissa + dotParts = Strings.splitOn "." unsigned + intPart = Optionals.withDefault "" (Lists.head dotParts) + fracPart = Optionals.withDefault "" (Lists.head (Lists.drop 1 dotParts)) + rawDigits = Strings.concat2 intPart fracPart + rawScale = Math.sub (Strings.length fracPart) expPart + sign = Logic.ifElse isNeg "-" "" + in (Logic.ifElse (Ordering.lt rawScale 0) ((sign, (Strings.concat2 rawDigits (Strings.fromList (Lists.replicate (Math.negate rawScale) 48)))), 0) ((sign, rawDigits), rawScale)) + -- | The keyword for variable definitions defKeyword :: Syntax.Dialect -> String defKeyword d = @@ -657,6 +679,44 @@ case lit of Syntax.LiteralInteger v0 -> Serialization.cst (Literals.printBigint (Syntax.integerLiteralValue v0)) Syntax.LiteralFloat v0 -> Serialization.cst (formatLispFloat d (Syntax.floatLiteralValue v0)) + Syntax.LiteralDecimal v0 -> + let digits = Syntax.decimalLiteralDigits v0 + in case d of + Syntax.DialectClojure -> Serialization.cst (Strings.concat2 digits "M") + Syntax.DialectCommonLisp -> + let parts = decimalDigitsAndScale digits + signDigits = Pairs.first parts + scale = Pairs.second parts + coefficientText = Strings.concat2 (Pairs.first signDigits) (Pairs.second signDigits) + in (Serialization.cst (Strings.concat [ + "'(", + coefficientText, + " . ", + (Literals.printInt32 scale), + ")"])) + Syntax.DialectEmacsLisp -> + let parts = decimalDigitsAndScale digits + signDigits = Pairs.first parts + scale = Pairs.second parts + coefficientText = Strings.concat2 (Pairs.first signDigits) (Pairs.second signDigits) + in (Serialization.cst (Strings.concat [ + "'(", + coefficientText, + " . ", + (Literals.printInt32 scale), + ")"])) + Syntax.DialectScheme -> + let parts = decimalDigitsAndScale digits + signDigits = Pairs.first parts + scale = Pairs.second parts + coefficientText = Strings.concat2 (Pairs.first signDigits) (Pairs.second signDigits) + in (Serialization.cst (Strings.concat [ + "'(", + coefficientText, + " . ", + (Literals.printInt32 scale), + ")"])) + _ -> Serialization.cst (Strings.concat2 digits "M") Syntax.LiteralString v0 -> let e1 = Strings.join "\\\\" (Strings.splitOn "\\" v0) in case d of diff --git a/src/main/haskell/Hydra/Lisp/Syntax.hs b/src/main/haskell/Hydra/Lisp/Syntax.hs --- a/src/main/haskell/Hydra/Lisp/Syntax.hs +++ b/src/main/haskell/Hydra/Lisp/Syntax.hs @@ -215,6 +215,17 @@ _ConstructorPattern_arguments = Core.Name "arguments" +-- | An arbitrary-precision, scale-preserving decimal literal, pre-rendered as a plain (non-scientific) decimal digit string with the exact scale to preserve (e.g. "1.10", not "1.1"). Serializes as 1.10M in Clojure. +data DecimalLiteral = + DecimalLiteral { + -- | The decimal value as a plain (non-scientific) digit string, e.g. "1.10" or "-0.5" + decimalLiteralDigits :: String} + deriving (Eq, Ord, Read, Show) + +_DecimalLiteral = Core.Name "hydra.lisp.syntax.DecimalLiteral" + +_DecimalLiteral_digits = Core.Name "digits" + -- | A destructuring binding in a let expression data DestructuringBinding = DestructuringBinding { @@ -679,6 +690,8 @@ LiteralInteger IntegerLiteral | -- | A floating-point literal LiteralFloat FloatLiteral | + -- | An arbitrary-precision, scale-preserving decimal literal (java.math.BigDecimal in Clojure, e.g. 1.10M). Dialects without a native decimal type have no use for this variant. + LiteralDecimal DecimalLiteral | -- | A string literal LiteralString String | -- | A character literal @@ -698,6 +711,8 @@ _Literal_integer = Core.Name "integer" _Literal_float = Core.Name "float" + +_Literal_decimal = Core.Name "decimal" _Literal_string = Core.Name "string"