diff --git a/implement/pine/ElmTime/compile-elm-program/src/ElmCompiler.elm b/implement/pine/ElmTime/compile-elm-program/src/ElmCompiler.elm index f4c53fc4..9ecc71cd 100644 --- a/implement/pine/ElmTime/compile-elm-program/src/ElmCompiler.elm +++ b/implement/pine/ElmTime/compile-elm-program/src/ElmCompiler.elm @@ -69,8 +69,9 @@ type alias CompilationStack = { moduleAliases : Dict.Dict (List String) (List String) , availableModules : Dict.Dict (List String) ElmModuleInCompilation , inlineableDeclarations : List ( String, List Expression -> Expression ) - , elmValuesToExposeToGlobal : Dict.Dict String (List String) , localTypeDeclarations : List ( String, ElmModuleTypeDeclaration ) + , exposedDeclarations : List ( String, List (List String) ) + , localAvailableDeclarations : List String , depth : Int } @@ -101,26 +102,12 @@ type ModuleImportTopLevelExpose Bool -type alias ModuleImports = - { importedModules : Dict.Dict (List String) ElmModuleInCompilation - , importedFunctions : Dict.Dict String Pine.Value - , importedTypes : Dict.Dict String ElmModuleTypeDeclaration - } - - type alias ElmModuleInCompilation = { functionDeclarations : List ( String, Pine.Value ) , typeDeclarations : List ( String, ElmModuleTypeDeclaration ) } -type alias ModuleImportsMerged = - { modulesDeclarationsFlat : Dict.Dict String Pine.Value - , choiceTypeTagConstructorDeclarations : Dict.Dict String Int - , recordConstructorsFieldsNames : Dict.Dict String (List String) - } - - type ElmModuleTypeDeclaration = ElmModuleChoiceTypeDeclaration ElmModuleChoiceType | ElmModuleRecordTypeDeclaration (List String) @@ -172,7 +159,7 @@ autoImportedModulesExposingTagsNames = ] -elmValuesToExposeToGlobalDefault : Dict.Dict String (List String) +elmValuesToExposeToGlobalDefault : List ( String, List String ) elmValuesToExposeToGlobalDefault = [ ( "LT", [ "Basics" ] ) , ( "EQ", [ "Basics" ] ) @@ -214,21 +201,9 @@ elmValuesToExposeToGlobalDefault = , ( "Err", [ "Result" ] ) , ( "Ok", [ "Result" ] ) ] - |> Dict.fromList -elmDeclarationsToExposeToGlobalDefaultQualifiedNames : Set.Set String -elmDeclarationsToExposeToGlobalDefaultQualifiedNames = - elmValuesToExposeToGlobalDefault - |> Dict.toList - |> List.map - (\( name, moduleName ) -> - String.join "." (List.concat [ moduleName, [ name ] ]) - ) - |> Set.fromList - - -elmDeclarationsOverrides : Dict.Dict (List String) (Dict.Dict String Pine.Value) +elmDeclarationsOverrides : List ( List String, List ( String, Pine.Value ) ) elmDeclarationsOverrides = [ ( [ "Basics" ] , [ ( "True" @@ -238,20 +213,16 @@ elmDeclarationsOverrides = , Pine.falseValue ) ] - |> Dict.fromList ) ] - |> Dict.fromList elmDeclarationsOverridesExpressions : List ( String, Expression ) elmDeclarationsOverridesExpressions = elmDeclarationsOverrides - |> Dict.toList |> List.concatMap (\( moduleName, declarations ) -> declarations - |> Dict.toList |> List.concatMap (\( declarationName, declarationValue ) -> [ ( declarationName @@ -412,7 +383,7 @@ expandEnvWithModulesRecursive beforeBatchModules parsedElmModules compiledModule ++ error ) - Ok ( _, moduleValue ) -> + Ok moduleValue -> expandEnvWithModulesRecursive beforeBatchModules followingModules @@ -422,13 +393,14 @@ expandEnvWithModulesRecursive beforeBatchModules parsedElmModules compiledModule compileElmModuleIntoNamedExports : Dict.Dict Elm.Syntax.ModuleName.ModuleName ElmModuleInCompilation -> ProjectParsedElmFile - -> Result String ( Elm.Syntax.ModuleName.ModuleName, ElmModuleInCompilation ) + -> Result String ElmModuleInCompilation compileElmModuleIntoNamedExports availableModules moduleToTranslate = let (Elm.Syntax.Node.Node _ moduleDefSyntax) = moduleToTranslate.parsedModule.moduleDefinition - moduleName = + selfModuleName : Elm.Syntax.ModuleName.ModuleName + selfModuleName = Elm.Syntax.Module.moduleName moduleDefSyntax moduleAliases : Dict.Dict (List String) (List String) @@ -536,15 +508,9 @@ compileElmModuleIntoNamedExports availableModules moduleToTranslate = { moduleAliases = moduleAliases , parsedImports = parsedImports , localTypeDeclarations = localTypeDeclarations + , selfModuleName = selfModuleName } - initialCompilationStack = - { compilationStackForImport - | elmValuesToExposeToGlobal = - Dict.filter (\_ originModule -> not (originModule == moduleName)) - compilationStackForImport.elmValuesToExposeToGlobal - } - moduleExposingList : Elm.Syntax.Exposing.Exposing moduleExposingList = Elm.Syntax.Module.exposingList moduleDefSyntax @@ -579,11 +545,9 @@ compileElmModuleIntoNamedExports availableModules moduleToTranslate = Dict.empty moduleToTranslate.parsedModule.declarations - functionsToExposeForInfix : Set.Set String + functionsToExposeForInfix : List String functionsToExposeForInfix = - Dict.foldl (\_ function aggregate -> Set.insert function aggregate) - Set.empty - redirectsForInfix + Dict.values redirectsForInfix localFunctionDeclarations : Dict.Dict String Elm.Syntax.Expression.Function localFunctionDeclarations = @@ -606,31 +570,39 @@ compileElmModuleIntoNamedExports availableModules moduleToTranslate = Dict.empty moduleToTranslate.parsedModule.declarations - exposedFunctionDecls : Set.Set String + initialCompilationStack : CompilationStack + initialCompilationStack = + { availableModules = availableModules + , moduleAliases = moduleAliases + , inlineableDeclarations = compilationStackForImport.inlineableDeclarations + , exposedDeclarations = compilationStackForImport.exposedDeclarations + , localAvailableDeclarations = Dict.keys localFunctionDeclarations + , localTypeDeclarations = compilationStackForImport.localTypeDeclarations + , depth = 0 + } + + exposedFunctionDecls : List String exposedFunctionDecls = - Set.union - functionsToExposeForInfix - (case moduleExposingList of - Elm.Syntax.Exposing.All _ -> - Dict.foldl - (\name _ aggregate -> - Set.insert name aggregate - ) - Set.empty - localFunctionDeclarations - - Elm.Syntax.Exposing.Explicit explicitList -> - List.foldl - (\(Elm.Syntax.Node.Node _ item) aggregate -> - case item of - Elm.Syntax.Exposing.FunctionExpose name -> - Set.insert name aggregate - - _ -> - aggregate - ) - Set.empty - explicitList + Common.listUnique + (List.concat + [ functionsToExposeForInfix + , case moduleExposingList of + Elm.Syntax.Exposing.All _ -> + Dict.keys localFunctionDeclarations + + Elm.Syntax.Exposing.Explicit explicitList -> + List.foldl + (\(Elm.Syntax.Node.Node _ item) aggregate -> + case item of + Elm.Syntax.Exposing.FunctionExpose name -> + name :: aggregate + + _ -> + aggregate + ) + [] + explicitList + ] ) localFunctionsResult : Result String (List ( String, Pine.Value )) @@ -653,12 +625,8 @@ compileElmModuleIntoNamedExports availableModules moduleToTranslate = Ok localFunctionDeclarationsCompiled -> emitModuleFunctionDeclarations initialEmitStack - { exposedDeclarations = - Dict.filter (\declName _ -> Set.member declName exposedFunctionDecls) - localFunctionDeclarationsCompiled - , supportingDeclarations = - localFunctionDeclarationsCompiled - } + localFunctionDeclarationsCompiled + exposedFunctionDecls in case localFunctionsResult of Err error -> @@ -666,6 +634,7 @@ compileElmModuleIntoNamedExports availableModules moduleToTranslate = Ok functionDeclarations -> let + declarationsValuesForInfix : List ( String, Pine.Value ) declarationsValuesForInfix = Dict.foldl (\name function aggregate -> @@ -683,7 +652,7 @@ compileElmModuleIntoNamedExports availableModules moduleToTranslate = exportedFuncsLessInfix = List.foldl (\( declName, declValue ) aggregate -> - if Set.member declName exposedFunctionDecls then + if List.member declName exposedFunctionDecls then ( declName, declValue ) :: aggregate else @@ -693,11 +662,13 @@ compileElmModuleIntoNamedExports availableModules moduleToTranslate = functionDeclarations in Ok - ( moduleName - , { functionDeclarations = List.concat [ exportedFuncsLessInfix, declarationsValuesForInfix ] - , typeDeclarations = localTypeDeclarations - } - ) + { functionDeclarations = + List.concat + [ exportedFuncsLessInfix + , declarationsValuesForInfix + ] + , typeDeclarations = localTypeDeclarations + } parseElmSyntaxImport : Elm.Syntax.Import.Import -> ModuleImportStatement @@ -765,166 +736,86 @@ compilationAndEmitStackFromModulesInCompilation : { moduleAliases : Dict.Dict (List String) (List String) , parsedImports : List ModuleImportStatement , localTypeDeclarations : List ( String, ElmModuleTypeDeclaration ) + , selfModuleName : List String } -> ( CompilationStack, EmitStack ) -compilationAndEmitStackFromModulesInCompilation availableModules { moduleAliases, parsedImports, localTypeDeclarations } = +compilationAndEmitStackFromModulesInCompilation availableModules { moduleAliases, parsedImports, localTypeDeclarations, selfModuleName } = let - compilationStackForImport = - { moduleAliases = moduleAliases - , availableModules = availableModules - , inlineableDeclarations = [] - , elmValuesToExposeToGlobal = elmValuesToExposeToGlobalDefault - , localTypeDeclarations = localTypeDeclarations - , depth = 0 - } - - moduleImports = - moduleImportsFromCompilationStack + exposedDeclarationsViaImports : Dict.Dict String (List (List String)) + exposedDeclarationsViaImports = + exposedDeclarationsFromImportStatements parsedImports - compilationStackForImport - - mergedImports : ModuleImportsMerged - mergedImports = - Dict.foldl - mergeModuleImports - { modulesDeclarationsFlat = Dict.empty - , choiceTypeTagConstructorDeclarations = Dict.empty - , recordConstructorsFieldsNames = Dict.empty - } - moduleImports.importedModules - - importedChoiceTypeTagConstructorDeclarations : Dict.Dict String Int - importedChoiceTypeTagConstructorDeclarations = - Dict.foldl - (\_ typeDeclaration aggregate -> - case typeDeclaration of - ElmModuleChoiceTypeDeclaration (ElmModuleChoiceType choiceTypeTags) -> - List.foldl - (\( tagName, ElmModuleChoiceTypeTag argumentsCount ) innerAggregate -> - Dict.insert tagName argumentsCount innerAggregate - ) - aggregate - choiceTypeTags - - _ -> - aggregate - ) - mergedImports.choiceTypeTagConstructorDeclarations - moduleImports.importedTypes + availableModules - localTypeDeclarationsSeparate : - { choiceTypeTagDeclarations : List ( String, Int ) - , recordTypeDeclarations : List ( String, List String ) - } - localTypeDeclarationsSeparate = + exposedDeclarationsFromAutoImport : List ( String, List (List String) ) + exposedDeclarationsFromAutoImport = List.foldl - (\( typeName, typeDeclaration ) aggregate -> - case typeDeclaration of - ElmModuleChoiceTypeDeclaration (ElmModuleChoiceType choiceTypeTags) -> - { aggregate - | choiceTypeTagDeclarations = - List.concat - [ List.map - (\( tagName, ElmModuleChoiceTypeTag argumentsCount ) -> - ( tagName, argumentsCount ) - ) - choiceTypeTags - , aggregate.choiceTypeTagDeclarations - ] - } + (\( declName, coreModuleName ) aggregate -> + if coreModuleName == selfModuleName then + aggregate - ElmModuleRecordTypeDeclaration fields -> - { aggregate - | recordTypeDeclarations = - ( typeName, fields ) :: aggregate.recordTypeDeclarations - } + else + ( declName, [ coreModuleName ] ) :: aggregate ) - { recordTypeDeclarations = [] - , choiceTypeTagDeclarations = [] - } - localTypeDeclarations - - declarationsFromTypeAliasesFieldsNames : List ( String, List String ) - declarationsFromTypeAliasesFieldsNames = - List.concat - [ localTypeDeclarationsSeparate.recordTypeDeclarations - , Dict.toList mergedImports.recordConstructorsFieldsNames - ] + [] + elmValuesToExposeToGlobalDefault - choiceTypeTagConstructorDeclarations : List ( String, Int ) - choiceTypeTagConstructorDeclarations = + exposedDeclarations : List ( String, List (List String) ) + exposedDeclarations = List.concat - [ localTypeDeclarationsSeparate.choiceTypeTagDeclarations - , Dict.toList importedChoiceTypeTagConstructorDeclarations + [ Dict.toList exposedDeclarationsViaImports + , exposedDeclarationsFromAutoImport ] - declarationsFromTypeAliases : List ( String, List Expression -> Expression ) - declarationsFromTypeAliases = - List.map - (\( recordName, fieldNames ) -> - ( recordName, compileElmRecordConstructor fieldNames ) - ) - declarationsFromTypeAliasesFieldsNames - - declarationsFromChoiceTypes : List ( String, List Expression -> Expression ) - declarationsFromChoiceTypes = - List.map - (\( tagName, argumentsCount ) -> - ( tagName - , compileElmChoiceTypeTagConstructor - ( case List.reverse (String.split "." tagName) of - [] -> - tagName - - head :: _ -> - head - , argumentsCount - ) - ) - ) - choiceTypeTagConstructorDeclarations - + compilationStack : CompilationStack compilationStack = - { compilationStackForImport - | inlineableDeclarations = - List.concat - [ declarationsFromTypeAliases - , declarationsFromChoiceTypes - ] + { availableModules = availableModules + , moduleAliases = moduleAliases + , inlineableDeclarations = [] + , localTypeDeclarations = localTypeDeclarations + , exposedDeclarations = exposedDeclarations + , localAvailableDeclarations = [] + , depth = 0 } - importedFunctionsBeforeParse : List ( String, Pine.Value ) + importedFunctionsBeforeParse : List ( List String, List ( String, Pine.Value ) ) importedFunctionsBeforeParse = - List.concat - [ Dict.toList mergedImports.modulesDeclarationsFlat - , Dict.toList moduleImports.importedFunctions - ] + List.map + (\( moduleName, availableModule ) -> + ( moduleName, availableModule.functionDeclarations ) + ) + (Dict.toList availableModules) - importedFunctions : List ( String, ( FirCompiler.EnvironmentFunctionEntry, Pine.Value ) ) + importedFunctions : List ( List String, List ( String, ( FirCompiler.EnvironmentFunctionEntry, Pine.Value ) ) ) importedFunctions = List.map - (\( declName, functionValue ) -> - let - ( paramCount, expectedEnv ) = - case FirCompiler.parseFunctionRecordFromValueTagged functionValue of - Err _ -> - ( 0 - , FirCompiler.LocalEnvironment [] - ) + (Tuple.mapSecond + (List.map + (\( declName, functionValue ) -> + let + ( paramCount, expectedEnv ) = + case FirCompiler.parseFunctionRecordFromValueTagged functionValue of + Err _ -> + ( 0 + , FirCompiler.LocalEnvironment [] + ) - Ok (FirCompiler.ParsedFunctionValue _ _ parameterCount _ _) -> - ( parameterCount - , FirCompiler.ImportedEnvironment [] - ) - in - ( declName - , ( FirCompiler.EnvironmentFunctionEntry paramCount expectedEnv - , functionValue - ) + Ok (FirCompiler.ParsedFunctionValue _ _ parameterCount _ _) -> + ( parameterCount + , FirCompiler.ImportedEnvironment [] + ) + in + ( declName + , ( FirCompiler.EnvironmentFunctionEntry paramCount expectedEnv + , functionValue + ) + ) + ) ) ) importedFunctionsBeforeParse + emitStack : FirCompiler.EmitStack emitStack = { importedFunctions = importedFunctions , importedFunctionsToInline = [] @@ -938,233 +829,92 @@ compilationAndEmitStackFromModulesInCompilation availableModules { moduleAliases ) -mergeModuleImports : List String -> ElmModuleInCompilation -> ModuleImportsMerged -> ModuleImportsMerged -mergeModuleImports importedModuleName importedModule aggregateImports = - let - moduleNameFlat = - String.join "." importedModuleName - - modulesDeclarationsFlat : Dict.Dict String Pine.Value - modulesDeclarationsFlat = - List.foldl - (\( declName, declValue ) aggregate -> - Dict.insert (String.join "." [ moduleNameFlat, declName ]) declValue aggregate - ) - aggregateImports.modulesDeclarationsFlat - importedModule.functionDeclarations - - ( typeDeclsChoiceTypeTags, typeDeclsRecordConstructors ) = - List.foldl - (\( typeName, typeDeclaration ) ( choiceTypeTagsBefore, recordConstructorsBefore ) -> - case typeDeclaration of - ElmModuleChoiceTypeDeclaration (ElmModuleChoiceType choiceTypeTags) -> - ( List.foldl - (\( tagName, ElmModuleChoiceTypeTag argumentsCount ) innerAggregate -> - let - qualifiedName = - String.join "." [ moduleNameFlat, tagName ] - - isAutoImported = - Set.member - qualifiedName - elmDeclarationsToExposeToGlobalDefaultQualifiedNames - - withQualifiedName = - Dict.insert - qualifiedName - argumentsCount - innerAggregate - in - if isAutoImported then - Dict.insert - tagName - argumentsCount - withQualifiedName - - else - withQualifiedName - ) - choiceTypeTagsBefore - choiceTypeTags - , recordConstructorsBefore - ) - - ElmModuleRecordTypeDeclaration fields -> - ( choiceTypeTagsBefore - , Dict.insert - (String.join "." [ moduleNameFlat, typeName ]) - fields - recordConstructorsBefore - ) - ) - ( aggregateImports.choiceTypeTagConstructorDeclarations - , aggregateImports.recordConstructorsFieldsNames - ) - importedModule.typeDeclarations - in - { aggregateImports - | modulesDeclarationsFlat = modulesDeclarationsFlat - , choiceTypeTagConstructorDeclarations = typeDeclsChoiceTypeTags - , recordConstructorsFieldsNames = typeDeclsRecordConstructors - } - - -moduleImportsFromCompilationStack : +exposedDeclarationsFromImportStatements : List ModuleImportStatement - -> CompilationStack - -> ModuleImports -moduleImportsFromCompilationStack explicitImports compilation = - let - importedModulesImplicit : Dict.Dict (List String) ElmModuleInCompilation - importedModulesImplicit = - Dict.filter - (\moduleName _ -> List.member moduleName autoImportedModulesNames) - compilation.availableModules - - functionsFromImportStatement : - ModuleImportStatement - -> Maybe ( ElmModuleInCompilation, Dict.Dict String Pine.Value ) - functionsFromImportStatement explicitImport = - case Dict.get explicitImport.canonicalModuleName compilation.availableModules of + -> Dict.Dict (List String) ElmModuleInCompilation + -> Dict.Dict String (List (List String)) +exposedDeclarationsFromImportStatements explicitImports availableModules = + List.foldl + (\explicitImport aggregate -> + case Dict.get explicitImport.canonicalModuleName availableModules of Nothing -> - Nothing + aggregate Just availableModule -> let - exposedDeclarations : Dict.Dict String Pine.Value - exposedDeclarations = + moduleExposedNames : List String + moduleExposedNames = case explicitImport.exposingList of Nothing -> - Dict.empty + [] Just ExposingAll -> - Dict.fromList availableModule.functionDeclarations - - Just (ExposingSelected exposedNames) -> - List.foldl - (\(ModuleImportTopLevelExpose exposedName _) aggregate -> - case Common.assocListGet exposedName availableModule.functionDeclarations of - Nothing -> - aggregate - - Just functionDeclaration -> - Dict.insert exposedName functionDeclaration aggregate - ) - Dict.empty - exposedNames - in - Just - ( availableModule - , exposedDeclarations - ) + List.concat + [ List.map Tuple.first availableModule.functionDeclarations + , List.concatMap + (\( typeName, typeDecl ) -> + let + choiceTypeTagNames = + case typeDecl of + ElmModuleChoiceTypeDeclaration (ElmModuleChoiceType tags) -> + List.map Tuple.first tags - typesFromImportStatement : ModuleImportStatement -> Maybe (Dict.Dict String ElmModuleTypeDeclaration) - typesFromImportStatement explicitImport = - case Dict.get explicitImport.canonicalModuleName compilation.availableModules of - Nothing -> - Nothing + ElmModuleRecordTypeDeclaration _ -> + [] + in + typeName :: choiceTypeTagNames + ) + availableModule.typeDeclarations + ] - Just availableModule -> - let - exposedDeclarations : Dict.Dict String ElmModuleTypeDeclaration - exposedDeclarations = - case explicitImport.exposingList of - Nothing -> - Dict.empty + Just (ExposingSelected topLevels) -> + List.concatMap + (\(ModuleImportTopLevelExpose topLevelName exposeTags) -> + let + choiceTypeTagNames = + if exposeTags then + case Common.assocListGet topLevelName availableModule.typeDeclarations of + Nothing -> + [] - Just ExposingAll -> - Dict.fromList availableModule.typeDeclarations + Just (ElmModuleChoiceTypeDeclaration (ElmModuleChoiceType tags)) -> + List.map Tuple.first tags - Just (ExposingSelected exposedNames) -> - List.foldl - (\(ModuleImportTopLevelExpose topName isOpen) aggregate -> - case Common.assocListGet topName availableModule.typeDeclarations of - Nothing -> - aggregate + Just (ElmModuleRecordTypeDeclaration _) -> + [] - Just typeDeclaration -> - Dict.insert - topName - (mapTypeDeclarationForImport isOpen typeDeclaration) - aggregate + else + [] + in + topLevelName :: choiceTypeTagNames ) - Dict.empty - exposedNames + topLevels in - Just exposedDeclarations - - parsedExplicitImports : List ( List String, ( ElmModuleInCompilation, Dict.Dict String Pine.Value ) ) - parsedExplicitImports = - List.foldl - (\explicitImport aggregate -> - case functionsFromImportStatement explicitImport of - Nothing -> - aggregate - - Just match -> - ( explicitImport.localModuleName - , match - ) - :: aggregate - ) - [] - explicitImports - - importedFunctions : Dict.Dict String Pine.Value - importedFunctions = - Dict.union - (Dict.foldl - (\name moduleName aggregate -> - case Dict.get moduleName compilation.availableModules of - Nothing -> - aggregate - - Just moduleInCompilation -> - case Common.assocListGet name moduleInCompilation.functionDeclarations of - Nothing -> - aggregate - - Just value -> - Dict.insert name value aggregate - ) - Dict.empty - compilation.elmValuesToExposeToGlobal - ) - (List.foldl - (\( _, ( _, functions ) ) aggregate -> - Dict.union functions aggregate - ) - Dict.empty - parsedExplicitImports - ) + List.foldl + (\exposedName dict -> + let + moduleNames = + case Dict.get exposedName dict of + Nothing -> + [ explicitImport.canonicalModuleName ] - importedModules : Dict.Dict (List String) ElmModuleInCompilation - importedModules = - List.foldl - (\( moduleName, ( moduleInCompilation, _ ) ) aggregate -> - Dict.insert moduleName moduleInCompilation aggregate - ) - importedModulesImplicit - parsedExplicitImports + Just moduleNamesBefore -> + if List.member explicitImport.canonicalModuleName moduleNamesBefore then + moduleNamesBefore - importedTypes : Dict.Dict String ElmModuleTypeDeclaration - importedTypes = - List.foldl - (\explicitImport aggregate -> - case typesFromImportStatement explicitImport of - Nothing -> - aggregate - - Just types -> - Dict.union types aggregate - ) - Dict.empty - explicitImports - in - { importedModules = importedModules - , importedFunctions = importedFunctions - , importedTypes = importedTypes - } + else + explicitImport.canonicalModuleName :: moduleNamesBefore + in + Dict.insert + exposedName + moduleNames + dict + ) + aggregate + moduleExposedNames + ) + Dict.empty + explicitImports mapTypeDeclarationForImport : Bool -> ElmModuleTypeDeclaration -> ElmModuleTypeDeclaration @@ -1390,63 +1140,132 @@ compileElmSyntaxApplication stack appliedFunctionElmSyntax argumentsElmSyntax = ) in case appliedFunctionElmSyntax of - Elm.Syntax.Expression.FunctionOrValue functionModuleName functionLocalName -> - let - continueWithDefaultNamedApplication () = + Elm.Syntax.Expression.FunctionOrValue moduleNameBeforeImport declName -> + case sourceModuleNameFromImports ( moduleNameBeforeImport, declName ) stack of + Err err -> + Err err + + Ok moduleName -> let - functionFlatName = - String.join "." (List.concat [ functionModuleName, [ functionLocalName ] ]) - in - case Common.assocListGet functionFlatName elmDeclarationsOverridesExpressions of - Just declarationOverride -> - Ok declarationOverride + continueWithDefaultNamedApplication () = + case tryApplyNamedInlineableOrTypeDecl moduleName declName arguments stack of + Just fromTypeDecl -> + Ok fromTypeDecl - Nothing -> - case Common.assocListGet functionFlatName stack.inlineableDeclarations of - Just applicableDeclaration -> - Ok (applicableDeclaration arguments) + Nothing -> + if stringStartsWithUpper declName then + Err + ("Did not find resolution for type reference: " + ++ String.join "." (List.concat [ moduleName, [ declName ] ]) + ) + + else + continueWithDefaultApplication () + in + case moduleName of + [ "Pine_kernel" ] -> + case arguments of + [ singleArgumentExpression ] -> + Ok + (KernelApplicationExpression + singleArgumentExpression + declName + ) _ -> - continueWithDefaultApplication () - in - case functionModuleName of - [ "Pine_kernel" ] -> - case arguments of - [ singleArgumentExpression ] -> - Ok - (KernelApplicationExpression - singleArgumentExpression - functionLocalName - ) + Err "Invalid argument list for kernel application: Wrap arguments into a single list expression" - _ -> - Err "Invalid argument list for kernel application: Wrap arguments into a single list expression" + [ "Debug" ] -> + case declName of + "log" -> + case arguments of + [ _, contentArg ] -> + let + stringTag = + "Elm application of Debug.log" + in + Ok (StringTagExpression stringTag contentArg) - [ "Debug" ] -> - case functionLocalName of - "log" -> - case arguments of - [ _, contentArg ] -> - let - stringTag = - "Elm application of Debug.log" - in - Ok (StringTagExpression stringTag contentArg) + _ -> + Err "Invalid argument list for Debug.log: Expected two arguments" - _ -> - Err "Invalid argument list for Debug.log: Expected two arguments" + "toString" -> + Err "Unsupported - Debug.toString is not implemented yet" - "toString" -> - Err "Unsupported - Debug.toString is not implemented yet" + _ -> + continueWithDefaultNamedApplication () _ -> continueWithDefaultNamedApplication () + _ -> + continueWithDefaultApplication () + + +tryApplyNamedInlineableOrTypeDecl : + List String + -> String + -> List Expression + -> CompilationStack + -> Maybe Expression +tryApplyNamedInlineableOrTypeDecl moduleName declName arguments stack = + case Common.assocListGet declName elmDeclarationsOverridesExpressions of + Just declarationOverride -> + Just declarationOverride + + Nothing -> + case Dict.get moduleName stack.availableModules of + Nothing -> + case Common.assocListGet declName stack.inlineableDeclarations of + Just applicableDeclaration -> + Just (applicableDeclaration arguments) + _ -> - continueWithDefaultNamedApplication () + if stringStartsWithUpper declName then + tryApplyNamedTypeDeclaration declName arguments stack.localTypeDeclarations + + else + Nothing + + Just moduleInCompilation -> + if stringStartsWithUpper declName then + tryApplyNamedTypeDeclaration declName arguments moduleInCompilation.typeDeclarations + + else + Nothing + + +tryApplyNamedTypeDeclaration : + String + -> List Expression + -> List ( String, ElmModuleTypeDeclaration ) + -> Maybe Expression +tryApplyNamedTypeDeclaration declName arguments typeDeclarations = + case Common.assocListGet declName typeDeclarations of + Just (ElmModuleRecordTypeDeclaration fields) -> + Just (compileElmRecordConstructor fields arguments) + + _ -> + let + allTags : List ( String, ElmModuleChoiceTypeTag ) + allTags = + List.concatMap + (\( _, typeDecl ) -> + case typeDecl of + ElmModuleChoiceTypeDeclaration (ElmModuleChoiceType tags) -> + tags + + _ -> + [] + ) + typeDeclarations + in + case Common.assocListGet declName allTags of + Just (ElmModuleChoiceTypeTag paramCount) -> + Just (compileElmChoiceTypeTagConstructor ( declName, paramCount ) arguments) _ -> - continueWithDefaultApplication () + Nothing compileElmSyntaxLetBlock : @@ -1499,6 +1318,11 @@ compileElmSyntaxLetBlock stackBefore letBlock = stack = { stackBefore | inlineableDeclarations = inlineableDeclarations + , localAvailableDeclarations = + List.concat + [ List.concatMap (List.map Tuple.first) newAvailableDeclarations + , stackBefore.localAvailableDeclarations + ] } in case @@ -1712,7 +1536,7 @@ compileElmSyntaxRecordAccessFunction fieldName = [ [ ( "record-param", [] ) ] ] (compileRecordAccessExpression fieldName - (ReferenceExpression "record-param") + (ReferenceExpression [] "record-param") ) @@ -1742,7 +1566,7 @@ compileElmSyntaxRecordUpdate stack setters recordName = (PineFunctionApplicationExpression pineFunctionForRecordUpdate (ListExpression - [ ReferenceExpression recordName + [ ReferenceExpression [] recordName , ListExpression (List.map (\( fieldName, fieldExpr ) -> @@ -1791,7 +1615,7 @@ compileElmSyntaxCaseBlock stack caseBlock = innerExpr : Expression innerExpr = - FirCompiler.ReferenceExpression pseudoParamName + FirCompiler.ReferenceExpression [] pseudoParamName casesFunctionToWrap : Maybe Expression casesFunctionToWrap = @@ -2127,144 +1951,136 @@ compileElmSyntaxPattern compilation elmPattern = } Elm.Syntax.Pattern.NamedPattern qualifiedName choiceTypeArgumentPatterns -> - case - Common.resultListIndexedMapCombine - (\( argIndex, Elm.Syntax.Node.Node _ argPattern ) -> - case conditionsAndDeclarationsFromItemPattern argIndex argPattern of - Err err -> - Err - ("Failed for named pattern argument " - ++ String.fromInt argIndex - ++ ": " - ++ err - ) - - Ok ok -> - Ok ok - ) - choiceTypeArgumentPatterns - of + case sourceModuleNameFromImports ( qualifiedName.moduleName, qualifiedName.name ) compilation of Err err -> Err err - Ok itemsResults -> - let - conditionExpressions : Expression -> List Expression - conditionExpressions = - \deconstructedExpression -> - let - typeSourceModule = - case qualifiedName.moduleName of - [] -> - Nothing - - _ -> - case Dict.get qualifiedName.moduleName compilation.moduleAliases of - Just fromAlias -> - Just fromAlias - - Nothing -> - Just qualifiedName.moduleName - - typeInfoMaybe : Maybe ( String, ElmModuleChoiceType ) - typeInfoMaybe = - case typeSourceModule of - Nothing -> - {- - TODO: Expand lookup of type to also support cases of import all (exposing (..)) - -} - case Common.assocListGet qualifiedName.name compilation.localTypeDeclarations of - Nothing -> - Nothing + Ok moduleName -> + case + Common.resultListIndexedMapCombine + (\( argIndex, Elm.Syntax.Node.Node _ argPattern ) -> + case conditionsAndDeclarationsFromItemPattern argIndex argPattern of + Err err -> + Err + ("Failed for named pattern argument " + ++ String.fromInt argIndex + ++ ": " + ++ err + ) - Just typeDeclaration -> - case typeDeclaration of - ElmModuleChoiceTypeDeclaration choiceTypeDeclaration -> - Just ( qualifiedName.name, choiceTypeDeclaration ) + Ok ok -> + Ok ok + ) + choiceTypeArgumentPatterns + of + Err err -> + Err err - _ -> + Ok itemsResults -> + let + conditionExpressions : Expression -> List Expression + conditionExpressions = + \deconstructedExpression -> + let + typeInfoMaybe : Maybe ( String, ElmModuleChoiceType ) + typeInfoMaybe = + case moduleName of + [] -> + {- + TODO: Expand lookup of type to also support cases of import all (exposing (..)) + -} + case Common.assocListGet qualifiedName.name compilation.localTypeDeclarations of + Nothing -> Nothing - Just sourceModuleName -> - case Dict.get sourceModuleName compilation.availableModules of - Nothing -> - Nothing - - Just moduleInCompilation -> - Common.listMapFind - (\( typeName, typeDeclaration ) -> + Just typeDeclaration -> case typeDeclaration of - ElmModuleChoiceTypeDeclaration (ElmModuleChoiceType choiceTypeTags) -> - case Common.assocListGet qualifiedName.name choiceTypeTags of - Nothing -> - Nothing - - Just _ -> - Just ( typeName, ElmModuleChoiceType choiceTypeTags ) + ElmModuleChoiceTypeDeclaration choiceTypeDeclaration -> + Just ( qualifiedName.name, choiceTypeDeclaration ) _ -> Nothing - ) - moduleInCompilation.typeDeclarations - tagIsOnlyPossible : Bool - tagIsOnlyPossible = - case typeInfoMaybe of - Nothing -> - False + sourceModuleName -> + case Dict.get sourceModuleName compilation.availableModules of + Nothing -> + Nothing + + Just moduleInCompilation -> + Common.listMapFind + (\( typeName, typeDeclaration ) -> + case typeDeclaration of + ElmModuleChoiceTypeDeclaration (ElmModuleChoiceType choiceTypeTags) -> + case Common.assocListGet qualifiedName.name choiceTypeTags of + Nothing -> + Nothing - Just ( _, ElmModuleChoiceType choiceTypeTags ) -> - case List.length choiceTypeTags of - 1 -> - True + Just _ -> + Just ( typeName, ElmModuleChoiceType choiceTypeTags ) - _ -> + _ -> + Nothing + ) + moduleInCompilation.typeDeclarations + + tagIsOnlyPossible : Bool + tagIsOnlyPossible = + case typeInfoMaybe of + Nothing -> False - matchingTagConditions = - if tagIsOnlyPossible then - [] + Just ( _, ElmModuleChoiceType choiceTypeTags ) -> + case List.length choiceTypeTags of + 1 -> + True - else - [ case Common.assocListGet qualifiedName.name elmDeclarationsOverridesExpressions of - Just tagNameExpressionFromOverrides -> - equalCondition - [ tagNameExpressionFromOverrides - , deconstructedExpression - ] + _ -> + False - Nothing -> - equalCondition - [ LiteralExpression (Pine.valueFromString qualifiedName.name) - , pineKernel_ListHead deconstructedExpression - ] - ] + matchingTagConditions = + if tagIsOnlyPossible then + [] - argumentsConditions = - List.concatMap - (\{ conditions } -> - conditions (listItemFromIndexExpression 1 deconstructedExpression) - ) - itemsResults - in - List.concat [ matchingTagConditions, argumentsConditions ] + else + [ case Common.assocListGet qualifiedName.name elmDeclarationsOverridesExpressions of + Just tagNameExpressionFromOverrides -> + equalCondition + [ tagNameExpressionFromOverrides + , deconstructedExpression + ] + + Nothing -> + equalCondition + [ LiteralExpression (Pine.valueFromString qualifiedName.name) + , pineKernel_ListHead deconstructedExpression + ] + ] - mergedDeclarations : List ( String, List Deconstruction ) - mergedDeclarations = - List.concatMap - (\{ declarations } -> - List.map - (\( declName, deconstruction ) -> - ( declName, ListItemDeconstruction 1 :: deconstruction ) + argumentsConditions = + List.concatMap + (\{ conditions } -> + conditions (listItemFromIndexExpression 1 deconstructedExpression) + ) + itemsResults + in + List.concat [ matchingTagConditions, argumentsConditions ] + + mergedDeclarations : List ( String, List Deconstruction ) + mergedDeclarations = + List.concatMap + (\{ declarations } -> + List.map + (\( declName, deconstruction ) -> + ( declName, ListItemDeconstruction 1 :: deconstruction ) + ) + declarations ) - declarations - ) - itemsResults - in - Ok - { conditionExpressions = conditionExpressions - , declarations = mergedDeclarations - } + itemsResults + in + Ok + { conditionExpressions = conditionExpressions + , declarations = mergedDeclarations + } Elm.Syntax.Pattern.CharPattern char -> continueWithOnlyEqualsCondition (LiteralExpression (Pine.valueFromChar char)) @@ -2802,70 +2618,59 @@ recursiveFunctionToLookupFieldInRecord = compileElmFunctionOrValueLookup : ( List String, String ) -> CompilationStack -> Result String Expression -compileElmFunctionOrValueLookup ( moduleName, localName ) compilation = - if moduleName == [] then - case Common.assocListGet localName compilation.inlineableDeclarations of - Nothing -> - compileElmFunctionOrValueLookupWithoutLocalResolution ( moduleName, localName ) compilation +compileElmFunctionOrValueLookup ( moduleNameBeforeImport, declName ) compilation = + case sourceModuleNameFromImports ( moduleNameBeforeImport, declName ) compilation of + Err err -> + Err err - Just applicableDeclaration -> - Ok (applicableDeclaration []) + Ok moduleName -> + case tryApplyNamedInlineableOrTypeDecl moduleName declName [] compilation of + Just fromTypeDecl -> + Ok fromTypeDecl - else - case getDeclarationValueFromCompilation ( moduleName, localName ) compilation of - Err err -> - Err err + Nothing -> + case moduleName of + [] -> + compileElmFunctionOrValueLookupWithoutLocalResolution ( moduleName, declName ) compilation + + _ -> + case getDeclarationValueFromCompilation ( moduleName, declName ) compilation of + Err err -> + Err err - Ok declarationValue -> - Ok (compileLookupForInlineableDeclaration ( moduleName, localName ) declarationValue) + Ok declarationValue -> + Ok (compileLookupForInlineableDeclaration ( moduleName, declName ) declarationValue) compileElmFunctionOrValueLookupWithoutLocalResolution : ( List String, String ) -> CompilationStack -> Result String Expression -compileElmFunctionOrValueLookupWithoutLocalResolution ( moduleName, name ) compilation = - let - fusedName = - String.join "." (List.concat [ moduleName, [ name ] ]) - in - case Common.assocListGet name elmDeclarationsOverridesExpressions of +compileElmFunctionOrValueLookupWithoutLocalResolution ( moduleName, declName ) compilation = + case Common.assocListGet declName elmDeclarationsOverridesExpressions of Just declarationOverride -> Ok declarationOverride Nothing -> - case Dict.get name compilation.elmValuesToExposeToGlobal of - Nothing -> - Ok (ReferenceExpression fusedName) + case moduleName of + [] -> + if List.member declName compilation.localAvailableDeclarations then + Ok (ReferenceExpression [] declName) - Just sourceModuleName -> - case getDeclarationValueFromCompilation ( sourceModuleName, name ) compilation of - Err err -> - Err err + else + Ok (ReferenceExpression moduleName declName) - Ok declarationValue -> - Ok (compileLookupForInlineableDeclaration ( moduleName, name ) declarationValue) + _ -> + Ok (ReferenceExpression moduleName declName) getDeclarationValueFromCompilation : ( List String, String ) -> CompilationStack -> Result String Expression -getDeclarationValueFromCompilation ( localModuleName, nameInModule ) compilation = - let - canonicalModuleName = - case Dict.get localModuleName compilation.moduleAliases of - Just aliasedModuleName -> - aliasedModuleName - - Nothing -> - localModuleName - - flatName = - String.join "." (List.concat [ canonicalModuleName, [ nameInModule ] ]) - in - case Dict.get canonicalModuleName compilation.availableModules of +getDeclarationValueFromCompilation ( moduleName, nameInModule ) compilation = + case Dict.get moduleName compilation.availableModules of Nothing -> Err ("Did not find module '" - ++ String.join "." canonicalModuleName + ++ String.join "." moduleName ++ "'. There are " ++ String.fromInt (Dict.size compilation.availableModules) ++ " declarations in this scope: " @@ -2874,68 +2679,97 @@ getDeclarationValueFromCompilation ( localModuleName, nameInModule ) compilation Just moduleValue -> case Common.assocListGet nameInModule moduleValue.functionDeclarations of + Just declarationValue -> + Ok (LiteralExpression declarationValue) + Nothing -> - case Common.assocListGet flatName compilation.inlineableDeclarations of - Just applicableDeclaration -> - Ok (applicableDeclaration []) + let + declsReport = + if stringStartsWithUpper nameInModule then + let + allTypesNames = + List.foldl + (\( typeName, value ) aggregate -> + case value of + ElmModuleChoiceTypeDeclaration (ElmModuleChoiceType choiceTypeTags) -> + List.concat + [ [ typeName ] + , List.map Tuple.first choiceTypeTags + , aggregate + ] + + ElmModuleRecordTypeDeclaration _ -> + typeName :: aggregate + ) + [] + moduleValue.typeDeclarations + in + "There are " + ++ String.fromInt (List.length allTypesNames) + ++ " type declarations available in that module: " + ++ String.join ", " allTypesNames - Nothing -> - let - declsReport = - if stringStartsWithUpper nameInModule then - let - allTypesNames = - List.foldl - (\( typeName, value ) aggregate -> - case value of - ElmModuleChoiceTypeDeclaration (ElmModuleChoiceType choiceTypeTags) -> - List.concat - [ [ typeName ] - , List.map Tuple.first choiceTypeTags - , aggregate - ] + else + "There are " + ++ String.fromInt (List.length moduleValue.functionDeclarations) + ++ " function declarations available in that module: " + ++ String.join ", " (List.map Tuple.first moduleValue.functionDeclarations) + in + Err + ("Did not find '" + ++ nameInModule + ++ "' in module '" + ++ String.join "." moduleName + ++ "'. " + ++ declsReport + ) - ElmModuleRecordTypeDeclaration _ -> - typeName :: aggregate - ) - [] - moduleValue.typeDeclarations - in - "There are " - ++ String.fromInt (List.length allTypesNames) - ++ " type declarations available in that module: " - ++ String.join ", " allTypesNames - else - "There are " - ++ String.fromInt (List.length moduleValue.functionDeclarations) - ++ " function declarations available in that module: " - ++ String.join ", " (List.map Tuple.first moduleValue.functionDeclarations) - in - Err - ("Did not find '" - ++ nameInModule - ++ "' in module '" - ++ String.join "." canonicalModuleName - ++ "'. " - ++ declsReport - ) +sourceModuleNameFromImports : ( List String, String ) -> CompilationStack -> Result String (List String) +sourceModuleNameFromImports ( moduleName, declName ) compilation = + case moduleName of + [] -> + if List.member declName compilation.localAvailableDeclarations then + Ok moduleName - Just declarationValue -> - Ok (LiteralExpression declarationValue) + else + case Common.assocListGet declName compilation.exposedDeclarations of + Just moduleNames -> + case moduleNames of + [ singleModuleName ] -> + Ok singleModuleName + + _ -> + Err + (String.join "" + [ "Ambiguous reference to '" + , declName + , "': Found " + , String.fromInt (List.length moduleNames) + , " matching modules: " + , String.join ", " (List.map (String.join ".") moduleNames) + ] + ) + + Nothing -> + Ok moduleName + + _ -> + case Dict.get moduleName compilation.moduleAliases of + Nothing -> + Ok moduleName + + Just aliasedModuleName -> + Ok aliasedModuleName compileLookupForInlineableDeclaration : ( List String, String ) -> Expression -> Expression compileLookupForInlineableDeclaration ( moduleName, name ) expression = - let - fusedName = - String.join "." (List.concat [ moduleName, [ name ] ]) - in if shouldInlineDeclaration name expression then expression else - ReferenceExpression fusedName + ReferenceExpression moduleName name {-| Encodes an Elm module into a transportable form. @@ -3005,29 +2839,11 @@ type alias EmittedRecursionDomain = emitModuleFunctionDeclarations : EmitStack - -> - { exposedDeclarations : Dict.Dict String Expression - , supportingDeclarations : Dict.Dict String Expression - } + -> Dict.Dict String Expression + -> List String -> Result String (List ( String, Pine.Value )) -emitModuleFunctionDeclarations stackBefore declarations = +emitModuleFunctionDeclarations stackBefore allModuleDeclarations exposedDeclarationsNames = let - exposedDeclarationsNames : List String - exposedDeclarationsNames = - Dict.keys declarations.exposedDeclarations - - allModuleDeclarations : Dict.Dict String Expression - allModuleDeclarations = - Dict.union declarations.exposedDeclarations declarations.supportingDeclarations - - importedFunctionsNotShadowed : List ( String, ( FirCompiler.EnvironmentFunctionEntry, Pine.Value ) ) - importedFunctionsNotShadowed = - List.filter - (\( importedFunctionName, _ ) -> - not (Dict.member importedFunctionName allModuleDeclarations) - ) - stackBefore.importedFunctions - declarationsDirectDependencies : Dict.Dict String (Set.Set String) declarationsDirectDependencies = Dict.foldl @@ -3062,7 +2878,18 @@ emitModuleFunctionDeclarations stackBefore declarations = declarationsDirectDependencies ( importedFunctionsToShare, importedFunctionsToInline ) = - splitEmittedFunctionsToInline importedFunctionsNotShadowed + List.foldl + (\( moduleName, moduleDecls ) ( toShareBefore, toInlineBefore ) -> + let + ( moduleDeclsToShare, moduleDeclsToInline ) = + splitEmittedFunctionsToInline moduleDecls + in + ( ( moduleName, moduleDeclsToShare ) :: toShareBefore + , ( moduleName, moduleDeclsToInline ) :: toInlineBefore + ) + ) + ( [], [] ) + stackBefore.importedFunctions recursionDomains : List (Set.Set String) recursionDomains = @@ -3118,8 +2945,8 @@ emitModuleFunctionDeclarations stackBefore declarations = emitRecursionDomain : { exposedDeclarationsNames : List String , allModuleDeclarations : Dict.Dict String Expression - , importedFunctionsToShare : List ( String, ( FirCompiler.EnvironmentFunctionEntry, Pine.Value ) ) - , importedFunctionsToInline : List ( String, Pine.Value ) + , importedFunctionsToShare : List ( List String, List ( String, ( FirCompiler.EnvironmentFunctionEntry, Pine.Value ) ) ) + , importedFunctionsToInline : List ( List String, List ( String, Pine.Value ) ) , declarationsDirectDependencies : Dict.Dict String (Set.Set String) } -> EmitStack @@ -3176,13 +3003,23 @@ emitRecursionDomain { exposedDeclarationsNames, allModuleDeclarations, importedF recursionDomainDeclarationsInBlock : List ( String, Expression ) recursionDomainDeclarationsInBlock = List.filter - (\( declName, _ ) -> Set.member declName recursionDomainDeclarationsToIncludeInBlock) + (\( declName, _ ) -> + Set.member declName recursionDomainDeclarationsToIncludeInBlock + ) recursionDomainDeclarations + + importedFunctions : List ( List String, List ( String, ( FirCompiler.EnvironmentFunctionEntry, Pine.Value ) ) ) + importedFunctions = + List.concat + [ [ ( [], prevEmittedDeclarationsToShare ) ] + , importedFunctionsToShare + ] in case FirCompiler.emitDeclarationBlock - { importedFunctions = List.concat [ importedFunctionsToShare, prevEmittedDeclarationsToShare ] - , importedFunctionsToInline = List.concat [ importedFunctionsToInline, prevEmittedDeclarationsToInline ] + { importedFunctions = importedFunctions + , importedFunctionsToInline = + ( [], prevEmittedDeclarationsToInline ) :: importedFunctionsToInline , declarationsDependencies = emitStack.declarationsDependencies , environmentFunctions = emitStack.environmentFunctions , environmentDeconstructions = emitStack.environmentDeconstructions @@ -3203,7 +3040,7 @@ emitRecursionDomain { exposedDeclarationsNames, allModuleDeclarations, importedF recursionDomainDeclarations |> Common.resultListMapCombine (\( declName, declExpression ) -> - case Common.assocListGetWithIndex declName blockEmitStack.environmentFunctions of + case Common.assocListGetWithIndex ( [], declName ) blockEmitStack.environmentFunctions of Just ( _, FirCompiler.EnvironmentFunctionEntry declParamCount _ ) -> case Common.assocListGet declName newEnvFunctionsValues of Nothing -> @@ -3256,9 +3093,11 @@ emitRecursionDomain { exposedDeclarationsNames, allModuleDeclarations, importedF Ok emittedForExposeOrReuse -> let - expectedEnvironmentFunctions : List String + expectedEnvironmentFunctions : List ( List String, String ) expectedEnvironmentFunctions = - List.map Tuple.first blockEmitStack.environmentFunctions + List.map + Tuple.first + blockEmitStack.environmentFunctions emittedDeclarationsFromBlock : List ( String, ( FirCompiler.EnvironmentFunctionEntry, Pine.Value ) ) emittedDeclarationsFromBlock = @@ -3341,7 +3180,7 @@ emitRecursionDomain { exposedDeclarationsNames, allModuleDeclarations, importedF getFunctionInnerExpression : Pine.Expression getFunctionInnerExpression = - case Common.assocListGetWithIndex declName blockEmitStack.environmentFunctions of + case Common.assocListGetWithIndex ( [], declName ) blockEmitStack.environmentFunctions of Just ( indexInBlock, _ ) -> getFunctionInnerExpressionFromIndex indexInBlock @@ -3522,7 +3361,11 @@ reportEmittedDeclarationsForErrorMsg emittedDeclarations = "local: " ++ String.fromInt (List.length localEnvExpectedDecls) ++ " (" - ++ String.join ", " localEnvExpectedDecls + ++ String.join + ", " + (List.map (\( moduleName, declName ) -> String.join "." (List.concat [ moduleName, [ declName ] ])) + localEnvExpectedDecls + ) ++ ")" FirCompiler.ImportedEnvironment _ -> @@ -3677,8 +3520,8 @@ compileElmRecordConstructor recordFieldNames = else FunctionApplicationExpression (FunctionExpression - (recordFieldNamesStringAndValue - |> List.map (\( fieldName, _ ) -> [ ( fieldName, [] ) ]) + (List.map (\( fieldName, _ ) -> [ ( fieldName, [] ) ]) + recordFieldNamesStringAndValue ) (ListExpression [ LiteralExpression elmRecordTypeTagNameAsValue @@ -3688,7 +3531,7 @@ compileElmRecordConstructor recordFieldNames = (\( fieldName, fieldNameValue ) -> ListExpression [ LiteralExpression fieldNameValue - , ReferenceExpression fieldName + , ReferenceExpression [] fieldName ] ) recordFieldNamesStringAndValue diff --git a/implement/pine/ElmTime/compile-elm-program/src/ElmInteractive.elm b/implement/pine/ElmTime/compile-elm-program/src/ElmInteractive.elm index 9a93f9b5..38974eea 100644 --- a/implement/pine/ElmTime/compile-elm-program/src/ElmInteractive.elm +++ b/implement/pine/ElmTime/compile-elm-program/src/ElmInteractive.elm @@ -508,151 +508,6 @@ parsedElmFileRecordFromSeparatelyParsedSyntax ( fileText, parsedModule ) = } -inlineApplicationsOfEnvironmentDeclarations : EmitStack -> List ( String, Expression ) -> Expression -> Expression -inlineApplicationsOfEnvironmentDeclarations stackBeforeAddingDeps environmentDeclarations = - let - newReferencesDependencies = - environmentDeclarations - |> List.map (Tuple.mapSecond (listTransitiveDependenciesOfExpression stackBeforeAddingDeps)) - |> Dict.fromList - - stackWithEnvironmentDeclDeps = - { stackBeforeAddingDeps - | declarationsDependencies = Dict.union newReferencesDependencies stackBeforeAddingDeps.declarationsDependencies - } - - environmentDeclarationsDict = - Dict.fromList environmentDeclarations - - findReplacement expr = - case expr of - FunctionApplicationExpression (ReferenceExpression functionName) arguments -> - case Dict.get functionName environmentDeclarationsDict of - Nothing -> - Nothing - - Just appliedFunction -> - let - (FirCompiler.DeclBlockFunctionEntry functionParsedParams functionParsedBody) = - parseFunctionParameters appliedFunction - - dependencies = - listTransitiveDependenciesOfExpression stackWithEnvironmentDeclDeps appliedFunction - in - if - (List.length arguments /= List.length functionParsedParams) - || Set.member functionName dependencies - then - Nothing - - else - let - replacementsDict : Dict.Dict String Expression - replacementsDict = - functionParsedParams - |> List.indexedMap - (\paramIndex paramDeconstructions -> - arguments - |> List.drop paramIndex - |> List.head - |> Maybe.map - (\argumentExpr -> - paramDeconstructions - |> List.map - (Tuple.mapSecond - (expressionForDeconstructions - >> (|>) argumentExpr - ) - ) - ) - |> Maybe.withDefault [] - ) - |> List.concat - |> Dict.fromList - - findReplacementForReference innerExpr = - case innerExpr of - ReferenceExpression innerReference -> - Dict.get innerReference replacementsDict - - _ -> - Nothing - in - functionParsedBody - |> transformExpressionWithOptionalReplacement findReplacementForReference - |> inlineApplicationsOfEnvironmentDeclarations stackWithEnvironmentDeclDeps environmentDeclarations - |> Just - - _ -> - Nothing - in - transformExpressionWithOptionalReplacement findReplacement - - -transformExpressionWithOptionalReplacement : (Expression -> Maybe Expression) -> Expression -> Expression -transformExpressionWithOptionalReplacement findReplacement expression = - case findReplacement expression of - Just replacement -> - replacement - - Nothing -> - case expression of - LiteralExpression _ -> - expression - - ListExpression list -> - ListExpression (List.map (transformExpressionWithOptionalReplacement findReplacement) list) - - KernelApplicationExpression argument functionName -> - KernelApplicationExpression - (transformExpressionWithOptionalReplacement findReplacement argument) - functionName - - ConditionalExpression condition falseBranch trueBranch -> - ConditionalExpression - (transformExpressionWithOptionalReplacement findReplacement condition) - (transformExpressionWithOptionalReplacement findReplacement falseBranch) - (transformExpressionWithOptionalReplacement findReplacement trueBranch) - - ReferenceExpression _ -> - expression - - FunctionExpression functionParam functionBody -> - FunctionExpression - functionParam - (transformExpressionWithOptionalReplacement findReplacement functionBody) - - FunctionApplicationExpression functionExpression arguments -> - let - mappedArguments = - List.map (transformExpressionWithOptionalReplacement findReplacement) arguments - - mappedFunctionExpression = - transformExpressionWithOptionalReplacement findReplacement functionExpression - in - FunctionApplicationExpression - mappedFunctionExpression - mappedArguments - - DeclarationBlockExpression declarations innerExpression -> - DeclarationBlockExpression - (List.map - (\( declName, declExpr ) -> - ( declName, transformExpressionWithOptionalReplacement findReplacement declExpr ) - ) - declarations - ) - (transformExpressionWithOptionalReplacement findReplacement innerExpression) - - StringTagExpression tag tagged -> - StringTagExpression tag (transformExpressionWithOptionalReplacement findReplacement tagged) - - PineFunctionApplicationExpression pineFunctionValue argument -> - PineFunctionApplicationExpression - pineFunctionValue - (transformExpressionWithOptionalReplacement findReplacement argument) - - compilationAndEmitStackFromInteractiveEnvironment : { modules : Dict.Dict Elm.Syntax.ModuleName.ModuleName ElmModuleInCompilation , otherDeclarations : List ( String, Pine.Value ) @@ -677,6 +532,7 @@ compilationAndEmitStackFromInteractiveEnvironment environmentDeclarations = { moduleAliases = Dict.empty , parsedImports = interactiveImplicitImportStatements , localTypeDeclarations = [] + , selfModuleName = [] } compilationStack = @@ -1176,9 +1032,10 @@ expressionAsJson expression = ) ] - ReferenceExpression name -> + ReferenceExpression moduleName name -> [ ( "Reference" - , [ ( "name", Json.Encode.string name ) + , [ ( "moduleName", Json.Encode.list Json.Encode.string moduleName ) + , ( "name", Json.Encode.string name ) ] |> Json.Encode.object ) diff --git a/implement/pine/ElmTime/compile-elm-program/src/FirCompiler.elm b/implement/pine/ElmTime/compile-elm-program/src/FirCompiler.elm index 37683340..74a7d97b 100644 --- a/implement/pine/ElmTime/compile-elm-program/src/FirCompiler.elm +++ b/implement/pine/ElmTime/compile-elm-program/src/FirCompiler.elm @@ -62,7 +62,7 @@ type Expression Referencing a declaration from a declaration block enables (mutual) recursion. References, in general, enable modeling closures. -} - | ReferenceExpression String + | ReferenceExpression (List String) String | DeclarationBlockExpression (List ( String, Expression )) Expression | PineFunctionApplicationExpression Pine.Expression Expression -- The tag expression case is only a wrapper to label a node for inspection and does not influence the evaluation result. @@ -80,12 +80,12 @@ type Deconstruction type alias EmitStack = - { importedFunctions : List ( String, ( EnvironmentFunctionEntry, Pine.Value ) ) - , importedFunctionsToInline : List ( String, Pine.Value ) + { importedFunctions : List ( List String, List ( String, ( EnvironmentFunctionEntry, Pine.Value ) ) ) + , importedFunctionsToInline : List ( List String, List ( String, Pine.Value ) ) , declarationsDependencies : Dict.Dict String (Set.Set String) -- The functions in the first item in the environment list - , environmentFunctions : List ( String, EnvironmentFunctionEntry ) + , environmentFunctions : List ( ( List String, String ), EnvironmentFunctionEntry ) -- Deconstructions we can derive from the second item in the environment list , environmentDeconstructions : List ( String, EnvironmentDeconstructionEntry ) @@ -106,7 +106,7 @@ type EnvironmentFunctionEntry type FunctionEnvironment = LocalEnvironment -- List of expected declarations - (List String) + (List ( List String, String )) | ImportedEnvironment -- Path to the tagged function record relative to the entry in the current environment. (List Deconstruction) @@ -201,8 +201,8 @@ emitExpression stack expression = trueBranch ) - ReferenceExpression localReference -> - emitReferenceExpression localReference stack + ReferenceExpression moduleName localReference -> + emitReferenceExpression ( moduleName, localReference ) stack FunctionExpression functionParams functionBody -> emitFunctionExpression stack functionParams functionBody @@ -276,14 +276,6 @@ emitExpressionInDeclarationBlock stackBeforeAddingDeps blockDeclarations mainExp (\( declName, _ ) -> List.member declName mainExpressionOuterDependencies) blockDeclarations - mainDependsOnImport : Bool - mainDependsOnImport = - List.any - (\( importedName, _ ) -> - List.member importedName mainExpressionOuterDependencies - ) - stackBefore.importedFunctions - mainExpressionAsFunction : DeclBlockFunctionEntry mainExpressionAsFunction = parseFunctionParameters mainExpression @@ -298,12 +290,8 @@ emitExpressionInDeclarationBlock stackBeforeAddingDeps blockDeclarations mainExp List.member declName mainExpressionOuterDependencies ) stackBefore.environmentDeconstructions - in - case ( mainExprParams, usedBlockDeclarations, mainDependsOnImport ) of - ( [], [], False ) -> - emitExpression stackBeforeAddingDeps mainExprInnerExpr - _ -> + continueEmitBlock () = case emitDeclarationBlock stackBefore @@ -330,6 +318,36 @@ emitExpressionInDeclarationBlock stackBeforeAddingDeps blockDeclarations mainExp (List.length mainExprParams) mainExpressionEmitted ) + in + case ( mainExprParams, usedBlockDeclarations ) of + ( [], [] ) -> + let + mainExpressionImports : Set.Set ( List String, String ) + mainExpressionImports = + listImportingReferencesInExpression mainExpression + + mainDependsOnImport : Bool + mainDependsOnImport = + List.any + (\importedName -> + case Common.assocListGet importedName stackBefore.environmentFunctions of + Nothing -> + True + + _ -> + False + ) + (Set.toList mainExpressionImports) + in + case mainDependsOnImport of + False -> + emitExpression stackBeforeAddingDeps mainExprInnerExpr + + True -> + continueEmitBlock () + + _ -> + continueEmitBlock () emitDeclarationBlock : @@ -346,28 +364,47 @@ emitDeclarationBlock stackBefore blockDeclarations (DeclBlockClosureCaptures con availableEmittedDependencies : Dict.Dict String (Set.Set String) availableEmittedDependencies = - List.foldl - (\( functionName, ( EnvironmentFunctionEntry _ expectedEnvironment, _ ) ) aggregate -> - case expectedEnvironment of - LocalEnvironment localEnvExpectedDecls -> - case localEnvExpectedDecls of - [] -> - aggregate + case Common.assocListGet [] stackBefore.importedFunctions of + Nothing -> + Dict.empty - _ -> - Dict.insert - functionName - (Set.fromList localEnvExpectedDecls) - aggregate + Just prevCompiledDecls -> + List.foldl + (\( functionName, ( EnvironmentFunctionEntry _ expectedEnvironment, _ ) ) aggregate -> + case expectedEnvironment of + LocalEnvironment localEnvExpectedDecls -> + let + localEnvExpectedDeclsLocal : List String + localEnvExpectedDeclsLocal = + List.concatMap + (\( depModuleName, depDeclName ) -> + case depModuleName of + [] -> + [ depDeclName ] + + _ -> + [] + ) + localEnvExpectedDecls + in + case localEnvExpectedDeclsLocal of + [] -> + aggregate - ImportedEnvironment _ -> - aggregate + _ -> + Dict.insert + functionName + (Set.fromList localEnvExpectedDeclsLocal) + aggregate - IndependentEnvironment -> - aggregate - ) - Dict.empty - stackBefore.importedFunctions + ImportedEnvironment _ -> + aggregate + + IndependentEnvironment -> + aggregate + ) + Dict.empty + prevCompiledDecls blockDeclarationsDirectDependencies : Dict.Dict String (Set.Set String) blockDeclarationsDirectDependencies = @@ -382,39 +419,36 @@ emitDeclarationBlock stackBefore blockDeclarations (DeclBlockClosureCaptures con dependenciesRelations = Dict.union availableEmittedDependencies blockDeclarationsDirectDependencies - usedAvailableEmittedForInternals : List ( String, EnvironmentFunctionEntry, Pine.Expression ) + usedAvailableEmittedForInternals : List ( ( List String, String ), EnvironmentFunctionEntry, Pine.Expression ) usedAvailableEmittedForInternals = - if List.member environmentFunctionPartialApplicationName forwardedDecls then + if List.member ( [], environmentFunctionPartialApplicationName ) forwardedDecls then [] else if not contentsDependOnFunctionApplication then [] else - [ ( environmentFunctionPartialApplicationName + [ ( ( [], environmentFunctionPartialApplicationName ) , EnvironmentFunctionEntry 0 IndependentEnvironment , Pine.LiteralExpression (adaptivePartialApplicationRecursiveValue ()) ) ] - emittedImports : List ( String, EnvironmentFunctionEntry, Pine.Expression ) + emittedImports : List ( ( List String, String ), EnvironmentFunctionEntry, Pine.Expression ) emittedImports = emittedImportsFromRoots rootDependencies stackBefore dependenciesRelations + blockDeclarations - usedAvailableEmitted : List ( String, EnvironmentFunctionEntry, Pine.Expression ) + usedAvailableEmitted : List ( ( List String, String ), EnvironmentFunctionEntry, Pine.Expression ) usedAvailableEmitted = List.concat [ usedAvailableEmittedForInternals , emittedImports ] - usedAvailableEmittedNames : List String - usedAvailableEmittedNames = - List.map (\( name, _, _ ) -> name) usedAvailableEmitted - allBlockDeclarationsAsFunctions : List ( String, DeclBlockFunctionEntry ) allBlockDeclarationsAsFunctions = List.map @@ -436,7 +470,7 @@ emitDeclarationBlock stackBefore blockDeclarations (DeclBlockClosureCaptures con List.concat [ prefix, forwarded, appendedFromDecls, appendedFromClosureCaptures ] - prefixEnvironmentFunctions : List ( String, EnvironmentFunctionEntry ) + prefixEnvironmentFunctions : List ( ( List String, String ), EnvironmentFunctionEntry ) prefixEnvironmentFunctions = List.map (\( functionName, functionEntry, _ ) -> ( functionName, functionEntry )) @@ -448,7 +482,7 @@ emitDeclarationBlock stackBefore blockDeclarations (DeclBlockClosureCaptures con (\( _, _, emittedExpr ) -> emittedExpr) usedAvailableEmitted - forwardedDecls : List String + forwardedDecls : List ( List String, String ) forwardedDecls = List.map Tuple.first stackBefore.environmentFunctions @@ -469,28 +503,24 @@ emitDeclarationBlock stackBefore blockDeclarations (DeclBlockClosureCaptures con (\( declName, DeclBlockFunctionEntry asFunctionParams asFunctionInnerExpr ) aggregate -> case asFunctionParams of [] -> - if List.member declName usedAvailableEmittedNames then - aggregate + case Dict.get declName blockDeclarationsDirectDependencies of + Nothing -> + aggregate - else - case Dict.get declName blockDeclarationsDirectDependencies of - Nothing -> + Just declDirectDeps -> + let + declTransitiveDeps = + getTransitiveDependencies dependenciesRelations declDirectDeps + in + if + List.any + (\depName -> Set.member depName declTransitiveDeps) + blockDeclarationsNames + then aggregate - Just declDirectDeps -> - let - declTransitiveDeps = - getTransitiveDependencies dependenciesRelations declDirectDeps - in - if - List.any - (\depName -> Set.member depName declTransitiveDeps) - blockDeclarationsNames - then - aggregate - - else - ( declName, asFunctionInnerExpr ) :: aggregate + else + ( declName, asFunctionInnerExpr ) :: aggregate _ -> -- Do not include functions into closureCapturesForBlockDecls @@ -521,7 +551,7 @@ emitDeclarationBlock stackBefore blockDeclarations (DeclBlockClosureCaptures con closureCapturesForBlockDecls ] - newEnvironmentFunctionsNames : List String + newEnvironmentFunctionsNames : List ( List String, String ) newEnvironmentFunctionsNames = composeEnvironmentFunctions { prefix = @@ -529,15 +559,21 @@ emitDeclarationBlock stackBefore blockDeclarations (DeclBlockClosureCaptures con (\( functionName, _, _ ) -> functionName) usedAvailableEmitted , forwarded = forwardedDecls - , appendedFromDecls = List.map Tuple.first blockDeclarationsAsFunctionsLessClosure - , appendedFromClosureCaptures = List.map Tuple.first closureCaptures + , appendedFromDecls = + List.map + (\( declName, _ ) -> ( [], declName )) + blockDeclarationsAsFunctionsLessClosure + , appendedFromClosureCaptures = + List.map + (\( declName, _ ) -> ( [], declName )) + closureCaptures } - newEnvironmentFunctionsFromDecls : List ( String, EnvironmentFunctionEntry ) + newEnvironmentFunctionsFromDecls : List ( ( List String, String ), EnvironmentFunctionEntry ) newEnvironmentFunctionsFromDecls = List.map (\( functionName, DeclBlockFunctionEntry functionEntryParams _ ) -> - ( functionName + ( ( [], functionName ) , EnvironmentFunctionEntry (List.length functionEntryParams) (LocalEnvironment newEnvironmentFunctionsNames) @@ -545,17 +581,17 @@ emitDeclarationBlock stackBefore blockDeclarations (DeclBlockClosureCaptures con ) blockDeclarationsAsFunctionsLessClosure - newEnvironmentFunctionsFromClosureCaptures : List ( String, EnvironmentFunctionEntry ) + newEnvironmentFunctionsFromClosureCaptures : List ( ( List String, String ), EnvironmentFunctionEntry ) newEnvironmentFunctionsFromClosureCaptures = List.map (\( captureName, _ ) -> - ( captureName + ( ( [], captureName ) , EnvironmentFunctionEntry 0 IndependentEnvironment ) ) closureCaptures - environmentFunctions : List ( String, EnvironmentFunctionEntry ) + environmentFunctions : List ( ( List String, String ), EnvironmentFunctionEntry ) environmentFunctions = composeEnvironmentFunctions { prefix = prefixEnvironmentFunctions @@ -699,8 +735,9 @@ emittedImportsFromRoots : List Expression -> EmitStack -> Dict.Dict String (Set.Set String) - -> List ( String, EnvironmentFunctionEntry, Pine.Expression ) -emittedImportsFromRoots rootDependencies emitStack dependenciesRelations = + -> List ( String, Expression ) + -> List ( ( List String, String ), EnvironmentFunctionEntry, Pine.Expression ) +emittedImportsFromRoots rootDependencies emitStack dependenciesRelations blockDecls = case emitStack.importedFunctions of [] -> {- @@ -711,6 +748,15 @@ emittedImportsFromRoots rootDependencies emitStack dependenciesRelations = importedFunctions -> let + prevCompiledFunctions : List ( String, ( EnvironmentFunctionEntry, Pine.Value ) ) + prevCompiledFunctions = + case Common.assocListGet [] importedFunctions of + Nothing -> + [] + + Just list -> + list + rootDependenciesNames : Set.Set String rootDependenciesNames = List.foldl @@ -720,23 +766,71 @@ emittedImportsFromRoots rootDependencies emitStack dependenciesRelations = Set.empty rootDependencies - allDependencies : Set.Set String - allDependencies = + allLocalDependencies : Set.Set String + allLocalDependencies = getTransitiveDependencies dependenciesRelations rootDependenciesNames + + rootDependenciesImportedNames : Set.Set ( List String, String ) + rootDependenciesImportedNames = + List.foldl + (\rootDep aggregate -> + Set.union + (listImportingReferencesInExpression rootDep) + aggregate + ) + Set.empty + rootDependencies + + allImportedNames : Set.Set ( List String, String ) + allImportedNames = + Set.foldl + (\depName aggregate -> + let + addedNames = + case Common.assocListGet depName blockDecls of + Nothing -> + case Common.assocListGet depName prevCompiledFunctions of + Nothing -> + Set.singleton ( [], depName ) + + Just ( EnvironmentFunctionEntry _ prevCompiledEnv, _ ) -> + case prevCompiledEnv of + LocalEnvironment localDeps -> + Set.fromList (( [], depName ) :: localDeps) + + _ -> + Set.singleton ( [], depName ) + + Just blockDecl -> + listImportingReferencesInExpression blockDecl + in + Set.union addedNames aggregate + ) + rootDependenciesImportedNames + allLocalDependencies in Set.foldl - (\depName aggregate -> - case Common.assocListGet depName importedFunctions of + (\( moduleName, declName ) aggregate -> + case Common.assocListGet moduleName importedFunctions of Nothing -> aggregate - Just ( availableEmitted, emittedValue ) -> - ( depName, availableEmitted, Pine.LiteralExpression emittedValue ) :: aggregate + Just moduleDecls -> + case Common.assocListGet declName moduleDecls of + Nothing -> + aggregate + + Just ( availableEmitted, emittedValue ) -> + ( ( moduleName, declName ) + , availableEmitted + , Pine.LiteralExpression emittedValue + ) + :: aggregate ) [] - allDependencies + allImportedNames {-| Searches the tree of subexpressions for any that might require adaptive application. @@ -789,7 +883,7 @@ expressionNeedsAdaptiveApplication expression = declarations || expressionNeedsAdaptiveApplication innerExpression - ReferenceExpression _ -> + ReferenceExpression _ _ -> False StringTagExpression _ tagged -> @@ -885,8 +979,8 @@ parseFunctionParameters expression = DeclBlockFunctionEntry [] expression -emitReferenceExpression : String -> EmitStack -> Result String Pine.Expression -emitReferenceExpression name compilation = +emitReferenceExpression : ( List String, String ) -> EmitStack -> Result String Pine.Expression +emitReferenceExpression ( moduleName, declName ) compilation = {- Prioritize environmentDeconstructions before environmentFunctions here to support shadowing for function parameters. @@ -895,41 +989,67 @@ emitReferenceExpression name compilation = which can result in shadowing when nested. An example is the `pseudoParamName` in `compileElmSyntaxCaseBlock` -} - case Common.assocListGet name compilation.environmentDeconstructions of - Just deconstruction -> - Ok - (pineExpressionForDeconstructions deconstruction - (listItemFromIndexExpression_Pine 1 Pine.environmentExpr) - ) + let + continueWithoutImport () = + case + emitApplyFunctionFromCurrentEnvironment compilation ( moduleName, declName ) [] + of + Nothing -> + Err + (String.join "" + [ "Failed referencing '" + , String.join "." (List.concat [ moduleName, [ declName ] ]) + , "'. " + , String.fromInt (List.length compilation.environmentDeconstructions) + , " deconstructions in scope: " + , String.join ", " (List.map Tuple.first compilation.environmentDeconstructions) + , ". " + , String.fromInt (List.length compilation.environmentFunctions) + , " functions in scope: " + , String.join + ", " + (List.map + (\( ( availableModuleName, localName ), _ ) -> + String.join "." (List.concat [ availableModuleName, [ localName ] ]) + ) + compilation.environmentFunctions + ) + ] + ) - Nothing -> - case Common.assocListGet name compilation.importedFunctionsToInline of - Just importedFunction -> - Ok (Pine.LiteralExpression importedFunction) + Just (Err err) -> + Err ("Failed emitting reference as function application: " ++ err) + Just (Ok functionApplicationOk) -> + Ok functionApplicationOk + + continueWithoutDecons () = + case Common.assocListGet moduleName compilation.importedFunctionsToInline of Nothing -> - case emitApplyFunctionFromCurrentEnvironment compilation name [] of + continueWithoutImport () + + Just importedModule -> + case Common.assocListGet declName importedModule of Nothing -> - Err - (String.join "" - [ "Failed referencing '" - , name - , "'. " - , String.fromInt (List.length compilation.environmentDeconstructions) - , " deconstructions in scope: " - , String.join ", " (List.map Tuple.first compilation.environmentDeconstructions) - , ". " - , String.fromInt (List.length compilation.environmentFunctions) - , " functions in scope: " - , String.join ", " (List.map Tuple.first compilation.environmentFunctions) - ] - ) + continueWithoutImport () - Just (Err err) -> - Err ("Failed emitting reference as function application: " ++ err) + Just importedFunction -> + Ok (Pine.LiteralExpression importedFunction) + in + case moduleName of + [] -> + case Common.assocListGet declName compilation.environmentDeconstructions of + Just deconstruction -> + Ok + (pineExpressionForDeconstructions deconstruction + (listItemFromIndexExpression_Pine 1 Pine.environmentExpr) + ) - Just (Ok functionApplicationOk) -> - Ok functionApplicationOk + Nothing -> + continueWithoutDecons () + + _ -> + continueWithoutDecons () listTransitiveDependenciesOfExpression : EmitStack -> Expression -> Set.Set String @@ -961,12 +1081,17 @@ listUnboundReferencesInExpression expression boundNames = (listUnboundReferencesInExpression condition boundNames) ) - ReferenceExpression reference -> - if List.member reference boundNames then - Set.empty + ReferenceExpression moduleName reference -> + case moduleName of + [] -> + if List.member reference boundNames then + Set.empty - else - Set.singleton reference + else + Set.singleton reference + + _ -> + Set.empty FunctionExpression functionParam functionBody -> let @@ -1011,6 +1136,64 @@ listUnboundReferencesInExpression expression boundNames = listUnboundReferencesInExpression argument boundNames +listImportingReferencesInExpression : Expression -> Set.Set ( List String, String ) +listImportingReferencesInExpression expression = + case expression of + LiteralExpression _ -> + Set.empty + + ListExpression list -> + List.foldl + (\item aggregate -> + Set.union (listImportingReferencesInExpression item) aggregate + ) + Set.empty + list + + KernelApplicationExpression argument _ -> + listImportingReferencesInExpression argument + + ConditionalExpression condition falseBranch trueBranch -> + Set.union (listImportingReferencesInExpression falseBranch) + (Set.union (listImportingReferencesInExpression trueBranch) + (listImportingReferencesInExpression condition) + ) + + ReferenceExpression moduleName reference -> + case moduleName of + [] -> + Set.empty + + _ -> + Set.singleton ( moduleName, reference ) + + FunctionExpression _ functionBody -> + listImportingReferencesInExpression + functionBody + + FunctionApplicationExpression functionExpression arguments -> + List.foldl + (\argument aggregate -> + Set.union (listImportingReferencesInExpression argument) aggregate + ) + (listImportingReferencesInExpression functionExpression) + arguments + + DeclarationBlockExpression declarations innerExpression -> + List.foldl + (\( _, decl ) aggregate -> + Set.union (listImportingReferencesInExpression decl) aggregate + ) + (listImportingReferencesInExpression innerExpression) + declarations + + StringTagExpression _ tagged -> + listImportingReferencesInExpression tagged + + PineFunctionApplicationExpression _ argument -> + listImportingReferencesInExpression argument + + getTransitiveDependencies : Dict.Dict String (Set.Set String) -> Set.Set String -> Set.Set String getTransitiveDependencies dependenciesDependencies current = let @@ -1211,8 +1394,13 @@ emitFunctionApplication functionExpression arguments compilation = ) ) - ReferenceExpression functionName -> - case emitApplyFunctionFromCurrentEnvironment compilation functionName argumentsPine of + ReferenceExpression moduleName functionName -> + case + emitApplyFunctionFromCurrentEnvironment + compilation + ( moduleName, functionName ) + argumentsPine + of Nothing -> genericFunctionApplication () @@ -1300,16 +1488,16 @@ emitFunctionApplicationPine emitStack arguments functionExpressionPine = emitApplyFunctionFromCurrentEnvironment : EmitStack - -> String + -> ( List String, String ) -> List Pine.Expression -> Maybe (Result String Pine.Expression) -emitApplyFunctionFromCurrentEnvironment compilation functionName arguments = +emitApplyFunctionFromCurrentEnvironment compilation ( moduleName, functionName ) arguments = let - currentEnvironmentFunctionEntryFromName : String -> Maybe ( Int, EnvironmentFunctionEntry ) + currentEnvironmentFunctionEntryFromName : ( List String, String ) -> Maybe ( Int, EnvironmentFunctionEntry ) currentEnvironmentFunctionEntryFromName name = Common.assocListGetWithIndex name compilation.environmentFunctions in - case currentEnvironmentFunctionEntryFromName functionName of + case currentEnvironmentFunctionEntryFromName ( moduleName, functionName ) of Nothing -> Nothing @@ -1371,7 +1559,7 @@ emitApplyFunctionFromCurrentEnvironment compilation functionName arguments = LocalEnvironment localEnvExpectedDecls -> let - currentEnv : List String + currentEnv : List ( List String, String ) currentEnv = List.map Tuple.first compilation.environmentFunctions @@ -1381,7 +1569,7 @@ emitApplyFunctionFromCurrentEnvironment compilation functionName arguments = buildEnvironmentRecursive : List Pine.Expression - -> List String + -> List ( List String, String ) -> Result String Pine.Expression buildEnvironmentRecursive alreadyMapped remainingToBeMapped = case remainingToBeMapped of @@ -1391,11 +1579,16 @@ emitApplyFunctionFromCurrentEnvironment compilation functionName arguments = nextExpectedFunctionName :: remainingExpectedFunctions -> case currentEnvironmentFunctionEntryFromName nextExpectedFunctionName of Nothing -> + let + ( expectModuleName, expectDeclName ) = + nextExpectedFunctionName + in Err ("Function '" ++ functionName ++ "' expects environment function '" - ++ nextExpectedFunctionName + ++ String.join "." + (List.concat [ expectModuleName, [ expectDeclName ] ]) ++ "' but it is not in the environment" ) @@ -1490,7 +1683,7 @@ partialApplicationExpressionFromListOfArguments arguments emitStack function = { function = function , arguments = arguments , applicationFunctionSource = - case emitReferenceExpression environmentFunctionPartialApplicationName emitStack of + case emitReferenceExpression ( [], environmentFunctionPartialApplicationName ) emitStack of Err _ -> Nothing @@ -2109,7 +2302,7 @@ listFunctionAppExpressions expr = FunctionExpression _ functionBody -> listFunctionAppExpressions functionBody - ReferenceExpression _ -> + ReferenceExpression _ _ -> [] DeclarationBlockExpression declarations innerExpression -> diff --git a/implement/pine/ElmTime/compile-elm-program/tests/ElmCompilerTests.elm b/implement/pine/ElmTime/compile-elm-program/tests/ElmCompilerTests.elm index 177ad5ff..9e00bfb4 100644 --- a/implement/pine/ElmTime/compile-elm-program/tests/ElmCompilerTests.elm +++ b/implement/pine/ElmTime/compile-elm-program/tests/ElmCompilerTests.elm @@ -203,7 +203,7 @@ emitClosureExpressionTests = , ( "Zero parameters - return from function with one param" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "repeat_three_times") + (FirCompiler.ReferenceExpression [] "repeat_three_times") [ FirCompiler.LiteralExpression (Pine.valueFromString "argument_alfa") ] , functionParams = [] , arguments = [] @@ -211,9 +211,9 @@ emitClosureExpressionTests = [ ( "repeat_three_times" , { functionInnerExpr = FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "param_name" - , FirCompiler.ReferenceExpression "param_name" - , FirCompiler.ReferenceExpression "param_name" + [ FirCompiler.ReferenceExpression [] "param_name" + , FirCompiler.ReferenceExpression [] "param_name" + , FirCompiler.ReferenceExpression [] "param_name" ] , functionParams = [ [ ( "param_name", [] ) ] ] @@ -231,7 +231,7 @@ emitClosureExpressionTests = , ( "Zero parameters - return literal from function with zero param - once" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "return_constant_literal") + (FirCompiler.ReferenceExpression [] "return_constant_literal") [] , functionParams = [] , arguments = [] @@ -249,7 +249,7 @@ emitClosureExpressionTests = , ( "Zero parameters - return literal from function with zero param - twice" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "return_constant_literal_first") + (FirCompiler.ReferenceExpression [] "return_constant_literal_first") [] , functionParams = [] , arguments = [] @@ -257,7 +257,7 @@ emitClosureExpressionTests = [ ( "return_constant_literal_first" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "return_constant_literal_second") + (FirCompiler.ReferenceExpression [] "return_constant_literal_second") [] , functionParams = [] } @@ -283,7 +283,7 @@ emitClosureExpressionTests = ) , ( "One parameter - reference" , { functionInnerExpr = - FirCompiler.ReferenceExpression "param-name" + FirCompiler.ReferenceExpression [] "param-name" , functionParams = [ [ ( "param-name", [] ) ] ] , arguments = [ Pine.valueFromString "test-345" ] , environmentFunctions = [] @@ -292,7 +292,7 @@ emitClosureExpressionTests = ) , ( "One parameter - reference decons tuple second" , { functionInnerExpr = - FirCompiler.ReferenceExpression "param-name" + FirCompiler.ReferenceExpression [] "param-name" , functionParams = [ [ ( "param-name" , [ FirCompiler.ListItemDeconstruction 1 ] @@ -312,11 +312,11 @@ emitClosureExpressionTests = , ( "One parameter - repeat" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "repeat_help") + (FirCompiler.ReferenceExpression [] "repeat_help") [ FirCompiler.ListExpression [ FirCompiler.LiteralExpression (Pine.ListValue []) - , FirCompiler.ReferenceExpression "count" - , FirCompiler.ReferenceExpression "value" + , FirCompiler.ReferenceExpression [] "count" + , FirCompiler.ReferenceExpression [] "value" ] ] , functionParams = @@ -340,36 +340,36 @@ emitClosureExpressionTests = FirCompiler.ConditionalExpression (FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "remainingCount" + [ FirCompiler.ReferenceExpression [] "remainingCount" , FirCompiler.LiteralExpression (Pine.valueFromInt 0) ] ) "is_sorted_ascending_int" ) (FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "repeat_help") + (FirCompiler.ReferenceExpression [] "repeat_help") [ FirCompiler.ListExpression [ FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression [ FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "value" + [ FirCompiler.ReferenceExpression [] "value" ] - , FirCompiler.ReferenceExpression "result" + , FirCompiler.ReferenceExpression [] "result" ] ) "concat" , FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "remainingCount" + [ FirCompiler.ReferenceExpression [] "remainingCount" , FirCompiler.LiteralExpression (Pine.valueFromInt -1) ] ) "add_int" - , FirCompiler.ReferenceExpression "value" + , FirCompiler.ReferenceExpression [] "value" ] ] ) - (FirCompiler.ReferenceExpression "result") + (FirCompiler.ReferenceExpression [] "result") , functionParams = [ [ ( "result" , [ FirCompiler.ListItemDeconstruction 0 ] @@ -394,11 +394,11 @@ emitClosureExpressionTests = , ( "One parameter - repeat - separate <= 0" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "repeat_help") + (FirCompiler.ReferenceExpression [] "repeat_help") [ FirCompiler.ListExpression [ FirCompiler.LiteralExpression (Pine.ListValue []) - , FirCompiler.ReferenceExpression "count" - , FirCompiler.ReferenceExpression "value" + , FirCompiler.ReferenceExpression [] "count" + , FirCompiler.ReferenceExpression [] "value" ] ] , functionParams = @@ -421,7 +421,7 @@ emitClosureExpressionTests = , { functionInnerExpr = FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "num" + [ FirCompiler.ReferenceExpression [] "num" , FirCompiler.LiteralExpression (Pine.valueFromInt 0) ] ) @@ -436,34 +436,34 @@ emitClosureExpressionTests = , { functionInnerExpr = FirCompiler.ConditionalExpression (FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "is_less_than_or_equal_to_zero") - [ FirCompiler.ReferenceExpression "remainingCount" + (FirCompiler.ReferenceExpression [] "is_less_than_or_equal_to_zero") + [ FirCompiler.ReferenceExpression [] "remainingCount" ] ) (FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "repeat_help") + (FirCompiler.ReferenceExpression [] "repeat_help") [ FirCompiler.ListExpression [ FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression [ FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "value" + [ FirCompiler.ReferenceExpression [] "value" ] - , FirCompiler.ReferenceExpression "result" + , FirCompiler.ReferenceExpression [] "result" ] ) "concat" , FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "remainingCount" + [ FirCompiler.ReferenceExpression [] "remainingCount" , FirCompiler.LiteralExpression (Pine.valueFromInt -1) ] ) "add_int" - , FirCompiler.ReferenceExpression "value" + , FirCompiler.ReferenceExpression [] "value" ] ] ) - (FirCompiler.ReferenceExpression "result") + (FirCompiler.ReferenceExpression [] "result") , functionParams = [ [ ( "result" , [ FirCompiler.ListItemDeconstruction 0 ] @@ -502,7 +502,7 @@ emitClosureExpressionTests = } ) , ( "Two parameters - return second" - , { functionInnerExpr = FirCompiler.ReferenceExpression "param_beta" + , { functionInnerExpr = FirCompiler.ReferenceExpression [] "param_beta" , functionParams = [ [ ( "param_alfa", [] ) ] @@ -518,7 +518,7 @@ emitClosureExpressionTests = } ) , ( "Two parameters - return first" - , { functionInnerExpr = FirCompiler.ReferenceExpression "param_alfa" + , { functionInnerExpr = FirCompiler.ReferenceExpression [] "param_alfa" , functionParams = [ [ ( "param_alfa", [] ) ] @@ -553,7 +553,7 @@ emitClosureExpressionTests = } ) , ( "Three parameters - return third" - , { functionInnerExpr = FirCompiler.ReferenceExpression "param_gamma" + , { functionInnerExpr = FirCompiler.ReferenceExpression [] "param_gamma" , functionParams = [ [ ( "param_alfa", [] ) ] @@ -572,7 +572,7 @@ emitClosureExpressionTests = } ) , ( "Three parameters - return second" - , { functionInnerExpr = FirCompiler.ReferenceExpression "param_beta" + , { functionInnerExpr = FirCompiler.ReferenceExpression [] "param_beta" , functionParams = [ [ ( "param_alfa", [] ) ] , [ ( "param_beta", [] ) ] @@ -588,7 +588,7 @@ emitClosureExpressionTests = } ) , ( "Three parameters - return first" - , { functionInnerExpr = FirCompiler.ReferenceExpression "param_alfa" + , { functionInnerExpr = FirCompiler.ReferenceExpression [] "param_alfa" , functionParams = [ [ ( "param_alfa", [] ) ] , [ ( "param_beta", [] ) ] @@ -606,8 +606,8 @@ emitClosureExpressionTests = , ( "Three parameters - return from function with one param" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "repeat_three_times") - [ FirCompiler.ReferenceExpression "param_alfa" ] + (FirCompiler.ReferenceExpression [] "repeat_three_times") + [ FirCompiler.ReferenceExpression [] "param_alfa" ] , functionParams = [ [ ( "param_alfa", [] ) ] , [ ( "param_beta", [] ) ] @@ -622,9 +622,9 @@ emitClosureExpressionTests = [ ( "repeat_three_times" , { functionInnerExpr = FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "param_name" - , FirCompiler.ReferenceExpression "param_name" - , FirCompiler.ReferenceExpression "param_name" + [ FirCompiler.ReferenceExpression [] "param_name" + , FirCompiler.ReferenceExpression [] "param_name" + , FirCompiler.ReferenceExpression [] "param_name" ] , functionParams = [ [ ( "param_name", [] ) ] ] @@ -642,9 +642,9 @@ emitClosureExpressionTests = , ( "Three parameters - return from function with two param - first" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "repeat_three_times") - [ FirCompiler.ReferenceExpression "param_alfa" - , FirCompiler.ReferenceExpression "param_beta" + (FirCompiler.ReferenceExpression [] "repeat_three_times") + [ FirCompiler.ReferenceExpression [] "param_alfa" + , FirCompiler.ReferenceExpression [] "param_beta" ] , functionParams = [ [ ( "param_alfa", [] ) @@ -663,9 +663,9 @@ emitClosureExpressionTests = [ ( "repeat_three_times" , { functionInnerExpr = FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "param_name_a" - , FirCompiler.ReferenceExpression "param_name_a" - , FirCompiler.ReferenceExpression "param_name_a" + [ FirCompiler.ReferenceExpression [] "param_name_a" + , FirCompiler.ReferenceExpression [] "param_name_a" + , FirCompiler.ReferenceExpression [] "param_name_a" ] , functionParams = [ [ ( "param_name_a", [] ) @@ -687,11 +687,11 @@ emitClosureExpressionTests = , ( "Two parameters - repeat" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "repeat_help") + (FirCompiler.ReferenceExpression [] "repeat_help") [ FirCompiler.LiteralExpression (Pine.ListValue []) , FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "count" - , FirCompiler.ReferenceExpression "value" + [ FirCompiler.ReferenceExpression [] "count" + , FirCompiler.ReferenceExpression [] "value" ] ] , functionParams = @@ -710,36 +710,36 @@ emitClosureExpressionTests = FirCompiler.ConditionalExpression (FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "remainingCount" + [ FirCompiler.ReferenceExpression [] "remainingCount" , FirCompiler.LiteralExpression (Pine.valueFromInt 0) ] ) "is_sorted_ascending_int" ) (FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "repeat_help") + (FirCompiler.ReferenceExpression [] "repeat_help") [ FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression [ FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "value" + [ FirCompiler.ReferenceExpression [] "value" ] - , FirCompiler.ReferenceExpression "result" + , FirCompiler.ReferenceExpression [] "result" ] ) "concat" , FirCompiler.ListExpression [ FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "remainingCount" + [ FirCompiler.ReferenceExpression [] "remainingCount" , FirCompiler.LiteralExpression (Pine.valueFromInt -1) ] ) "add_int" - , FirCompiler.ReferenceExpression "value" + , FirCompiler.ReferenceExpression [] "value" ] ] ) - (FirCompiler.ReferenceExpression "result") + (FirCompiler.ReferenceExpression [] "result") , functionParams = [ [ ( "result", [] ) ] @@ -763,7 +763,7 @@ emitClosureExpressionTests = , ( "Three parameters - repeat" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "repeat_help") + (FirCompiler.ReferenceExpression [] "repeat_help") (List.map FirCompiler.LiteralExpression [ Pine.ListValue [] , Pine.valueFromInt 3 @@ -778,34 +778,34 @@ emitClosureExpressionTests = FirCompiler.ConditionalExpression (FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "remainingCount" + [ FirCompiler.ReferenceExpression [] "remainingCount" , FirCompiler.LiteralExpression (Pine.valueFromInt 0) ] ) "is_sorted_ascending_int" ) (FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "repeat_help") + (FirCompiler.ReferenceExpression [] "repeat_help") [ FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression [ FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "value" + [ FirCompiler.ReferenceExpression [] "value" ] - , FirCompiler.ReferenceExpression "result" + , FirCompiler.ReferenceExpression [] "result" ] ) "concat" , FirCompiler.KernelApplicationExpression (FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "remainingCount" + [ FirCompiler.ReferenceExpression [] "remainingCount" , FirCompiler.LiteralExpression (Pine.valueFromInt -1) ] ) "add_int" - , FirCompiler.ReferenceExpression "value" + , FirCompiler.ReferenceExpression [] "value" ] ) - (FirCompiler.ReferenceExpression "result") + (FirCompiler.ReferenceExpression [] "result") , functionParams = [ [ ( "result", [] ) ] @@ -830,7 +830,7 @@ emitClosureExpressionTests = , FirCompiler.LiteralExpression (Pine.valueFromString "constant_in_let") ) ] - (FirCompiler.ReferenceExpression "decl_from_let") + (FirCompiler.ReferenceExpression [] "decl_from_let") , functionParams = [] , arguments = [] , environmentFunctions = [] @@ -841,13 +841,13 @@ emitClosureExpressionTests = , { functionInnerExpr = FirCompiler.DeclarationBlockExpression [ ( "decl_from_let" - , FirCompiler.ReferenceExpression "other_decl_from_let" + , FirCompiler.ReferenceExpression [] "other_decl_from_let" ) , ( "other_decl_from_let" , FirCompiler.LiteralExpression (Pine.valueFromString "constant_in_let") ) ] - (FirCompiler.ReferenceExpression "decl_from_let") + (FirCompiler.ReferenceExpression [] "decl_from_let") , functionParams = [] , arguments = [] , environmentFunctions = [] @@ -858,10 +858,10 @@ emitClosureExpressionTests = , { functionInnerExpr = FirCompiler.DeclarationBlockExpression [ ( "decl_from_let" - , FirCompiler.ReferenceExpression "param_0" + , FirCompiler.ReferenceExpression [] "param_0" ) ] - (FirCompiler.ReferenceExpression "decl_from_let") + (FirCompiler.ReferenceExpression [] "decl_from_let") , functionParams = [ [ ( "param_0", [] ) ] ] @@ -874,15 +874,15 @@ emitClosureExpressionTests = , { functionInnerExpr = FirCompiler.DeclarationBlockExpression [ ( "decl_from_let" - , FirCompiler.ReferenceExpression "param_0" + , FirCompiler.ReferenceExpression [] "param_0" ) ] (FirCompiler.DeclarationBlockExpression [ ( "decl_from_let_inner" - , FirCompiler.ReferenceExpression "decl_from_let" + , FirCompiler.ReferenceExpression [] "decl_from_let" ) ] - (FirCompiler.ReferenceExpression "decl_from_let_inner") + (FirCompiler.ReferenceExpression [] "decl_from_let_inner") ) , functionParams = [ [ ( "param_0", [] ) ] @@ -896,10 +896,10 @@ emitClosureExpressionTests = , { functionInnerExpr = FirCompiler.DeclarationBlockExpression [ ( "decl_from_let" - , FirCompiler.ReferenceExpression "param_1" + , FirCompiler.ReferenceExpression [] "param_1" ) ] - (FirCompiler.ReferenceExpression "decl_from_let") + (FirCompiler.ReferenceExpression [] "decl_from_let") , functionParams = [ [ ( "param_0", [] ) ] , [ ( "param_1", [] ) ] @@ -923,7 +923,7 @@ emitClosureExpressionTests = ] ] (FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "final_func_param_0") + (FirCompiler.ReferenceExpression [] "final_func_param_0") [ FirCompiler.LiteralExpression (Pine.valueFromString "literal_0") ] ) @@ -936,15 +936,15 @@ emitClosureExpressionTests = ] ] (FirCompiler.ListExpression - [ FirCompiler.ReferenceExpression "closure_func_param_0" - , FirCompiler.ReferenceExpression "param_0" + [ FirCompiler.ReferenceExpression [] "closure_func_param_0" + , FirCompiler.ReferenceExpression [] "param_0" ] ) ) ] (FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "decl_from_let") - [ FirCompiler.ReferenceExpression "closure_func" + (FirCompiler.ReferenceExpression [] "decl_from_let") + [ FirCompiler.ReferenceExpression [] "closure_func" ] ) , functionParams = @@ -966,10 +966,10 @@ emitClosureExpressionTests = , { functionInnerExpr = FirCompiler.DeclarationBlockExpression [ ( "decl_from_let" - , FirCompiler.ReferenceExpression "env_func" + , FirCompiler.ReferenceExpression [] "env_func" ) ] - (FirCompiler.ReferenceExpression "decl_from_let") + (FirCompiler.ReferenceExpression [] "decl_from_let") , functionParams = [ [ ( "param_0", [] ) ] ] @@ -987,7 +987,7 @@ emitClosureExpressionTests = , ( "Partial application - two - return literal" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "second_function_partially_applied") + (FirCompiler.ReferenceExpression [] "second_function_partially_applied") [ FirCompiler.LiteralExpression (Pine.valueFromString "second_arg") ] , functionParams = [] @@ -1004,7 +1004,7 @@ emitClosureExpressionTests = , ( "second_function_partially_applied" , { functionInnerExpr = FirCompiler.FunctionApplicationExpression - (FirCompiler.ReferenceExpression "second_function") + (FirCompiler.ReferenceExpression [] "second_function") [ FirCompiler.LiteralExpression (Pine.valueFromString "first_arg") ] , functionParams = []