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.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 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 @@ -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 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 @@ -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