hydra-lisp 0.17.2 → 0.17.3
raw patch · 3 files changed
+53/−52 lines, 3 filesdep ~hydra-kernelPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hydra-kernel
API changes (from Hackage documentation)
Files
- hydra-lisp.cabal +2/−2
- src/main/haskell/Hydra/Lisp/Coder.hs +14/−13
- src/main/haskell/Hydra/Lisp/Serde.hs +37/−37
hydra-lisp.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hydra-lisp-version: 0.17.2+version: 0.17.3 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.2+ , hydra-kernel ==0.17.3 , scientific >=0.3.7 && <0.4 default-language: Haskell2010
src/main/haskell/Hydra/Lisp/Coder.hs view
@@ -28,6 +28,7 @@ import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps 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.Sets as Sets import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings@@ -151,7 +152,7 @@ -- | 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.foldl (\acc -> \b ->+ Eithers.bind (encodeTerm dialect 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 [@@ -168,8 +169,8 @@ Lists.map (\b -> (Core.bindingName b, (Sets.toList (Sets.intersection allNames (Variables.freeVariablesInTerm (Core.bindingTerm b)))))) bindings sccs = Sorting.topologicalSortComponents adjList nameToBinding = Maps.fromList (Lists.map (\b -> (Core.bindingName b, b)) bindings)- sortedBindings = Optionals.cat (Lists.map (\name -> Maps.lookup name nameToBinding) (Lists.concat sccs))- hasCycle = Lists.foldl (\acc -> \scc -> Logic.or acc (Equality.gt (Lists.length scc) 1)) False sccs+ sortedBindings = Optionals.givens (Lists.map (\name -> Maps.lookup name nameToBinding) (Lists.concat sccs))+ hasCycle = Lists.foldl (\acc -> \scc -> Logic.or acc (Ordering.gt (Lists.length scc) 1)) False sccs in (Eithers.bind (Eithers.mapList (\b -> let bname = Formatting.convertCaseCamelOrUnderscoreToLowerSnake (Formatting.sanitizeWithUnderscores Language.lispReservedWords (Core.unName (Core.bindingName b)))@@ -197,7 +198,7 @@ Lists.foldl (\acc -> \b -> Logic.or acc (Sets.member (Core.bindingName b) (Variables.freeVariablesInTerm (Core.bindingTerm b)))) False bindings isRecursive = Logic.or hasSelfRef hasCycle letKind =- Logic.ifElse isRecursive Syntax.LetKindRecursive (Logic.ifElse (Equality.lte (Lists.length bindings) 1) Syntax.LetKindParallel Syntax.LetKindSequential)+ Logic.ifElse isRecursive Syntax.LetKindRecursive (Logic.ifElse (Ordering.lte (Lists.length bindings) 1) Syntax.LetKindParallel Syntax.LetKindSequential) lispBindings = Lists.map (\eb -> Syntax.LetBindingSimple (Syntax.SimpleBinding { Syntax.simpleBindingName = (Syntax.Symbol (Pairs.first eb)),@@ -313,7 +314,7 @@ let rname = Core.recordTypeName v0 fields = Core.recordFields v0 in (Eithers.bind (Eithers.mapList (\f -> encodeTerm dialect cx g (Core.fieldTerm f)) fields) (\sfields ->- let constructorName = Strings.cat2 (dialectConstructorPrefix dialect) (qualifiedSnakeName rname)+ 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 { Syntax.setLiteralElements = sels})))@@ -405,9 +406,9 @@ Syntax.keywordName = (Formatting.convertCaseCamelToLowerSnake (Core.unName (Core.fieldTypeName f))), Syntax.keywordNamespace = Nothing}))) v0 in (Right (lispTopForm (Syntax.TopLevelFormVariable (Syntax.VariableDefinition {- Syntax.variableDefinitionName = (Syntax.Symbol (Strings.cat2 lname "-variants")),+ Syntax.variableDefinitionName = (Syntax.Symbol (Strings.concat2 lname "-variants")), Syntax.variableDefinitionValue = (lispListExpr variantNames),- Syntax.variableDefinitionDoc = (Just (Syntax.Docstring (Strings.cat2 "Variants of the " lname)))}))))+ Syntax.variableDefinitionDoc = (Just (Syntax.Docstring (Strings.concat2 "Variants of the " lname)))})))) Core.TypeWrap _ -> Right (lispTopForm (Syntax.TopLevelFormRecordType (Syntax.RecordTypeDefinition { Syntax.recordTypeDefinitionName = (Syntax.Symbol lname), Syntax.recordTypeDefinitionFields = [@@ -419,7 +420,7 @@ Syntax.topLevelFormWithCommentsDoc = Nothing, Syntax.topLevelFormWithCommentsComment = (Just (Syntax.Comment { Syntax.commentStyle = Syntax.CommentStyleLine,- Syntax.commentText = (Strings.cat2 (Strings.cat2 lname " = ") (PrintCore.type_ origTyp))})),+ Syntax.commentText = (Strings.concat2 (Strings.concat2 lname " = ") (PrintCore.type_ origTyp))})), Syntax.topLevelFormWithCommentsForm = (Syntax.TopLevelFormExpression (Syntax.ExpressionLiteral Syntax.LiteralNil))}) -- | Encode a Hydra type definition as a Lisp top-level form@@ -579,14 +580,14 @@ fieldSyms = Lists.map (\f -> let fn = Syntax.unSymbol (Syntax.fieldDefinitionName f)- in (Syntax.Symbol (Strings.cat [+ in (Syntax.Symbol (Strings.concat [ rname, "-", fn]))) fields in (Lists.concat [ [- Syntax.Symbol (Strings.cat2 "make-" rname),- (Syntax.Symbol (Strings.cat2 rname "?"))],+ Syntax.Symbol (Strings.concat2 "make-" rname),+ (Syntax.Symbol (Strings.concat2 rname "?"))], fieldSyms]) _ -> []) forms) in (Logic.ifElse (Lists.null symbols) [] [@@ -639,7 +640,7 @@ -- | Whether the primitive referenced by a head term is lazy in the parameter at the given zero-based position primIsLazyAt :: Graph.Graph -> Core.Term -> Int -> Bool-primIsLazyAt g headTerm i = Optionals.fromOptional False (Lists.maybeAt i (lazyFlagsForPrimitiveTerm g headTerm))+primIsLazyAt g headTerm i = Optionals.withDefault False (Lists.at i (lazyFlagsForPrimitiveTerm g headTerm)) -- | Convert a fully-qualified Hydra Name to a snake_case identifier string qualifiedSnakeName :: Core.Name -> String@@ -648,7 +649,7 @@ let raw = Core.unName name parts = Strings.splitOn "." raw snakeParts = Lists.map (\p -> Formatting.convertCaseCamelOrUnderscoreToLowerSnake p) parts- joined = Strings.intercalate "_" snakeParts+ joined = Strings.join "_" snakeParts in (Formatting.sanitizeWithUnderscores Language.lispReservedWords joined) -- | Convert a fully-qualified Hydra Name to a PascalCase type identifier string
src/main/haskell/Hydra/Lisp/Serde.hs view
@@ -104,7 +104,7 @@ commentToExpr c = let text = Syntax.commentText c- in (Serialization.cst (Logic.ifElse (Equality.equal text "") ";" (Strings.cat2 "; " text)))+ in (Serialization.cst (Logic.ifElse (Equality.equal text "") ";" (Strings.concat2 "; " text))) -- | Serialize a cond expression condExpressionToExpr :: Syntax.Dialect -> Syntax.CondExpression -> Ast.Expr@@ -238,7 +238,7 @@ docstringToExpr ds = let text = Syntax.unDocstring ds- in (Serialization.cst (Logic.ifElse (Equality.equal text "") ";;" (Strings.cat [+ in (Serialization.cst (Logic.ifElse (Equality.equal text "") ";;" (Strings.concat [ ";; ", text]))) @@ -457,7 +457,7 @@ (Serialization.cst modName)])]) Syntax.DialectCommonLisp -> Serialization.parens (Serialization.spaceSepAdaptive [ Serialization.cst ":use",- (Serialization.cst (Strings.cat2 ":" modName))])+ (Serialization.cst (Strings.concat2 ":" modName))]) Syntax.DialectScheme -> Serialization.parens (Serialization.spaceSepAdaptive [ Serialization.cst "import", (Serialization.parens (Serialization.cst modName))])@@ -472,7 +472,7 @@ Syntax.DialectScheme -> Serialization.noSep [ Serialization.cst "'", (Serialization.cst name)]- _ -> Serialization.cst (Optionals.cases ns (Strings.cat2 ":" name) (\n -> Strings.cat [+ _ -> Serialization.cst (Optionals.cases ns (Strings.concat2 ":" name) (\n -> Strings.concat [ n, "/:", name]))@@ -657,57 +657,57 @@ Syntax.LiteralInteger v0 -> Serialization.cst (Literals.showBigint (Syntax.integerLiteralValue v0)) Syntax.LiteralFloat v0 -> Serialization.cst (formatLispFloat d (Syntax.floatLiteralValue v0)) Syntax.LiteralString v0 ->- let e1 = Strings.intercalate "\\\\" (Strings.splitOn "\\" v0)+ let e1 = Strings.join "\\\\" (Strings.splitOn "\\" v0) in case d of Syntax.DialectCommonLisp ->- let escaped = Strings.intercalate "\\\"" (Strings.splitOn "\"" e1)- in (Serialization.cst (Strings.cat [+ let escaped = Strings.join "\\\"" (Strings.splitOn "\"" e1)+ in (Serialization.cst (Strings.concat [ "\"", escaped, "\""])) Syntax.DialectClojure ->- let e2 = Strings.intercalate "\\n" (Strings.splitOn (Strings.fromList [+ let e2 = Strings.join "\\n" (Strings.splitOn (Strings.fromList [ 10]) e1)- e3 = Strings.intercalate "\\r" (Strings.splitOn (Strings.fromList [+ e3 = Strings.join "\\r" (Strings.splitOn (Strings.fromList [ 13]) e2)- e4 = Strings.intercalate "\\t" (Strings.splitOn (Strings.fromList [+ e4 = Strings.join "\\t" (Strings.splitOn (Strings.fromList [ 9]) e3)- escaped = Strings.intercalate "\\\"" (Strings.splitOn "\"" e4)- in (Serialization.cst (Strings.cat [+ escaped = Strings.join "\\\"" (Strings.splitOn "\"" e4)+ in (Serialization.cst (Strings.concat [ "\"", escaped, "\""])) Syntax.DialectEmacsLisp ->- let e2 = Strings.intercalate "\\n" (Strings.splitOn (Strings.fromList [+ let e2 = Strings.join "\\n" (Strings.splitOn (Strings.fromList [ 10]) e1)- e3 = Strings.intercalate "\\r" (Strings.splitOn (Strings.fromList [+ e3 = Strings.join "\\r" (Strings.splitOn (Strings.fromList [ 13]) e2)- e4 = Strings.intercalate "\\t" (Strings.splitOn (Strings.fromList [+ e4 = Strings.join "\\t" (Strings.splitOn (Strings.fromList [ 9]) e3)- escaped = Strings.intercalate "\\\"" (Strings.splitOn "\"" e4)- in (Serialization.cst (Strings.cat [+ escaped = Strings.join "\\\"" (Strings.splitOn "\"" e4)+ in (Serialization.cst (Strings.concat [ "\"", escaped, "\""])) Syntax.DialectScheme ->- let e2 = Strings.intercalate "\\n" (Strings.splitOn (Strings.fromList [+ let e2 = Strings.join "\\n" (Strings.splitOn (Strings.fromList [ 10]) e1)- e3 = Strings.intercalate "\\r" (Strings.splitOn (Strings.fromList [+ e3 = Strings.join "\\r" (Strings.splitOn (Strings.fromList [ 13]) e2)- e4 = Strings.intercalate "\\t" (Strings.splitOn (Strings.fromList [+ e4 = Strings.join "\\t" (Strings.splitOn (Strings.fromList [ 9]) e3)- escaped = Strings.intercalate "\\\"" (Strings.splitOn "\"" e4)- in (Serialization.cst (Strings.cat [+ escaped = Strings.join "\\\"" (Strings.splitOn "\"" e4)+ in (Serialization.cst (Strings.concat [ "\"", escaped, "\""])) Syntax.LiteralCharacter v0 -> let ch = Syntax.characterLiteralValue v0 in case d of- Syntax.DialectClojure -> Serialization.cst (Strings.cat2 "\\" ch)- Syntax.DialectEmacsLisp -> Serialization.cst (Strings.cat2 "?" ch)- Syntax.DialectCommonLisp -> Serialization.cst (Strings.cat2 "#\\" ch)- Syntax.DialectScheme -> Serialization.cst (Strings.cat2 "#\\" ch)+ Syntax.DialectClojure -> Serialization.cst (Strings.concat2 "\\" ch)+ Syntax.DialectEmacsLisp -> Serialization.cst (Strings.concat2 "?" ch)+ Syntax.DialectCommonLisp -> Serialization.cst (Strings.concat2 "#\\" ch)+ Syntax.DialectScheme -> Serialization.cst (Strings.concat2 "#\\" ch) Syntax.LiteralBoolean v0 -> Logic.ifElse v0 (trueExpr d) (falseExpr d) Syntax.LiteralNil -> nilExpr d Syntax.LiteralKeyword v0 -> keywordToExpr d v0@@ -800,10 +800,10 @@ Syntax.DialectCommonLisp -> Serialization.newlineSep [ Serialization.parens (Serialization.spaceSepAdaptive [ Serialization.cst "defpackage",- (Serialization.cst (Strings.cat2 ":" name))]),+ (Serialization.cst (Strings.concat2 ":" name))]), (Serialization.parens (Serialization.spaceSepAdaptive [ Serialization.cst "in-package",- (Serialization.cst (Strings.cat2 ":" name))]))]+ (Serialization.cst (Strings.concat2 ":" name))]))] Syntax.DialectScheme -> Serialization.parens (Serialization.spaceSepAdaptive [ Serialization.cst "define-library", (Serialization.parens (Serialization.cst name))])@@ -844,9 +844,9 @@ case d of Syntax.DialectEmacsLisp -> [ Serialization.cst ";; -*- lexical-binding: t -*-",- (Serialization.cst (Strings.cat2 "; " Constants.warningAutoGeneratedFile))]+ (Serialization.cst (Strings.concat2 "; " Constants.warningAutoGeneratedFile))] _ -> [- Serialization.cst (Strings.cat2 "; " Constants.warningAutoGeneratedFile)]+ Serialization.cst (Strings.concat2 "; " Constants.warningAutoGeneratedFile)] importNames = Lists.map (\idecl -> Syntax.unNamespaceName (Syntax.importDeclarationModule idecl)) imports exportSyms = Lists.concat (Lists.map (\edecl -> Lists.map symbolToExpr (Syntax.exportDeclarationSymbols edecl)) exports) in case d of@@ -916,11 +916,11 @@ provideForm]]))) Syntax.DialectCommonLisp -> Optionals.cases modDecl (Serialization.doubleNewlineSep (Lists.concat2 warning formPart)) (\m -> let nameStr = Syntax.unNamespaceName (Syntax.moduleDeclarationName m)- colonName = Strings.cat2 ":" nameStr+ colonName = Strings.concat2 ":" nameStr useClause = Serialization.parens (Serialization.spaceSepAdaptive (Lists.concat2 [ Serialization.cst ":use",- (Serialization.cst ":cl")] (Lists.map (\imp -> Serialization.cst (Strings.cat2 ":" imp)) importNames)))+ (Serialization.cst ":cl")] (Lists.map (\imp -> Serialization.cst (Strings.concat2 ":" imp)) importNames))) exportClause = Logic.ifElse (Lists.null exportSyms) [] [ Serialization.parens (Serialization.spaceSepAdaptive (Lists.concat2 [@@ -1000,12 +1000,12 @@ Serialization.parens (Serialization.spaceSepAdaptive (Lists.concat [ [ Serialization.cst "defn",- (Serialization.cst (Strings.cat2 "make-" nameStr))],+ (Serialization.cst (Strings.concat2 "make-" nameStr))], [ Serialization.brackets Serialization.squareBrackets Serialization.inlineStyle (Serialization.spaceSep fields)], [ Serialization.parens (Serialization.spaceSepAdaptive (Lists.concat2 [- Serialization.cst (Strings.cat2 "->" nameStr)] (Lists.map (\fn -> Serialization.cst fn) fieldNames)))]]))+ Serialization.cst (Strings.concat2 "->" nameStr)] (Lists.map (\fn -> Serialization.cst fn) fieldNames)))]])) in (Serialization.newlineSep [ defrecordForm, makeAlias])@@ -1024,12 +1024,12 @@ fieldNames = Lists.map (\f -> Syntax.unSymbol (Syntax.fieldDefinitionName f)) (Syntax.recordTypeDefinitionFields rdef) constructor = Serialization.parens (Serialization.spaceSepAdaptive (Lists.concat2 [- Serialization.cst (Strings.cat2 "make-" nameStr)] (Lists.map (\fn -> Serialization.cst fn) fieldNames)))- predicate = Serialization.cst (Strings.cat2 nameStr "?")+ Serialization.cst (Strings.concat2 "make-" nameStr)] (Lists.map (\fn -> Serialization.cst fn) fieldNames)))+ predicate = Serialization.cst (Strings.concat2 nameStr "?") accessors = Lists.map (\fn -> Serialization.parens (Serialization.spaceSepAdaptive [ Serialization.cst fn,- (Serialization.cst (Strings.cat [+ (Serialization.cst (Strings.concat [ nameStr, "-", fn]))])) fieldNames