zeolite-lang 0.12.0.0 → 0.13.0.0
raw patch · 66 files changed
+3183/−3634 lines, 66 filesdep +microlensdep +microlens-thPVP ok
version bump matches the API change (PVP)
Dependencies added: microlens, microlens-th
API changes (from Hackage documentation)
- Compilation.CompilerState: instance GHC.Show.Show c => GHC.Show.Show (Types.DefinedCategory.VariableValue c)
- Compilation.ProcedureContext: [pcAllFilters] :: ProcedureContext c -> ParamFilters
- Compilation.ProcedureContext: [pcCategories] :: ProcedureContext c -> CategoryMap c
- Compilation.ProcedureContext: [pcCleanupBlocks] :: ProcedureContext c -> [Maybe (CleanupBlock c [String])]
- Compilation.ProcedureContext: [pcDisallowInit] :: ProcedureContext c -> Bool
- Compilation.ProcedureContext: [pcExprMap] :: ProcedureContext c -> ExprMap c
- Compilation.ProcedureContext: [pcExtFilters] :: ProcedureContext c -> [ParamFilter c]
- Compilation.ProcedureContext: [pcExtParams] :: ProcedureContext c -> Positional (ValueParam c)
- Compilation.ProcedureContext: [pcFunctions] :: ProcedureContext c -> Map FunctionName (ScopedFunction c)
- Compilation.ProcedureContext: [pcInCleanup] :: ProcedureContext c -> Bool
- Compilation.ProcedureContext: [pcIntFilters] :: ProcedureContext c -> [ParamFilter c]
- Compilation.ProcedureContext: [pcIntParams] :: ProcedureContext c -> Positional (ValueParam c)
- Compilation.ProcedureContext: [pcIsNamed] :: ProcedureContext c -> Bool
- Compilation.ProcedureContext: [pcJumpType] :: ProcedureContext c -> JumpType
- Compilation.ProcedureContext: [pcLoopSetup] :: ProcedureContext c -> LoopSetup [String]
- Compilation.ProcedureContext: [pcMembers] :: ProcedureContext c -> [DefinedMember c]
- Compilation.ProcedureContext: [pcNoTrace] :: ProcedureContext c -> Bool
- Compilation.ProcedureContext: [pcOutput] :: ProcedureContext c -> [String]
- Compilation.ProcedureContext: [pcParamScopes] :: ProcedureContext c -> Map ParamName SymbolScope
- Compilation.ProcedureContext: [pcPrimNamed] :: ProcedureContext c -> [ReturnVariable]
- Compilation.ProcedureContext: [pcRequiredTypes] :: ProcedureContext c -> Set CategoryName
- Compilation.ProcedureContext: [pcReservedMacros] :: ProcedureContext c -> [(MacroName, [c])]
- Compilation.ProcedureContext: [pcReturns] :: ProcedureContext c -> ReturnValidation c
- Compilation.ProcedureContext: [pcScope] :: ProcedureContext c -> SymbolScope
- Compilation.ProcedureContext: [pcType] :: ProcedureContext c -> CategoryName
- Compilation.ProcedureContext: [pcUsedVars] :: ProcedureContext c -> [UsedVariable c]
- Compilation.ProcedureContext: [pcVariables] :: ProcedureContext c -> Map VariableName (VariableValue c)
- CompilerCxx.Category: CxxOutput :: Maybe CategoryName -> String -> Namespace -> Set Namespace -> Set CategoryName -> [String] -> CxxOutput
- CompilerCxx.Category: LanguageModule :: Set Namespace -> Set Namespace -> Set Namespace -> [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c] -> [CategoryName] -> [CategoryName] -> ExprMap c -> LanguageModule c
- CompilerCxx.Category: PrivateSource :: Namespace -> Bool -> [AnyCategory c] -> [DefinedCategory c] -> PrivateSource c
- CompilerCxx.Category: [coCategory] :: CxxOutput -> Maybe CategoryName
- CompilerCxx.Category: [coFilename] :: CxxOutput -> String
- CompilerCxx.Category: [coNamespace] :: CxxOutput -> Namespace
- CompilerCxx.Category: [coOutput] :: CxxOutput -> [String]
- CompilerCxx.Category: [coUsesCategory] :: CxxOutput -> Set CategoryName
- CompilerCxx.Category: [coUsesNamespace] :: CxxOutput -> Set Namespace
- CompilerCxx.Category: [lmExprMap] :: LanguageModule c -> ExprMap c
- CompilerCxx.Category: [lmExternal] :: LanguageModule c -> [CategoryName]
- CompilerCxx.Category: [lmLocalNamespaces] :: LanguageModule c -> Set Namespace
- CompilerCxx.Category: [lmPrivateDeps] :: LanguageModule c -> [AnyCategory c]
- CompilerCxx.Category: [lmPrivateLocal] :: LanguageModule c -> [AnyCategory c]
- CompilerCxx.Category: [lmPrivateNamespaces] :: LanguageModule c -> Set Namespace
- CompilerCxx.Category: [lmPublicDeps] :: LanguageModule c -> [AnyCategory c]
- CompilerCxx.Category: [lmPublicLocal] :: LanguageModule c -> [AnyCategory c]
- CompilerCxx.Category: [lmPublicNamespaces] :: LanguageModule c -> Set Namespace
- CompilerCxx.Category: [lmStreamlined] :: LanguageModule c -> [CategoryName]
- CompilerCxx.Category: [lmTestingDeps] :: LanguageModule c -> [AnyCategory c]
- CompilerCxx.Category: [lmTestingLocal] :: LanguageModule c -> [AnyCategory c]
- CompilerCxx.Category: [psCategory] :: PrivateSource c -> [AnyCategory c]
- CompilerCxx.Category: [psDefine] :: PrivateSource c -> [DefinedCategory c]
- CompilerCxx.Category: [psNamespace] :: PrivateSource c -> Namespace
- CompilerCxx.Category: [psTesting] :: PrivateSource c -> Bool
- CompilerCxx.Category: compileCategoryDeclaration :: (Ord c, Show c, CollectErrorsM m) => Bool -> CategoryMap c -> Set Namespace -> AnyCategory c -> m CxxOutput
- CompilerCxx.Category: compileConcreteDefinition :: (Ord c, Show c, CollectErrorsM m) => Bool -> CategoryMap c -> ExprMap c -> Set Namespace -> Maybe [ValueRefine c] -> DefinedCategory c -> m CxxOutput
- CompilerCxx.Category: compileConcreteTemplate :: (Ord c, Show c, CollectErrorsM m) => Bool -> CategoryMap c -> CategoryName -> m CxxOutput
- CompilerCxx.Category: compileInterfaceDefinition :: CollectErrorsM m => Bool -> AnyCategory c -> m CxxOutput
- CompilerCxx.Category: compileLanguageModule :: (Ord c, Show c, CollectErrorsM m) => LanguageModule c -> [PrivateSource c] -> m [CxxOutput]
- CompilerCxx.Category: compileModuleMain :: (Ord c, Show c, CollectErrorsM m) => LanguageModule c -> [PrivateSource c] -> CategoryName -> FunctionName -> m CxxOutput
- CompilerCxx.Category: compileTestsModule :: (Ord c, Show c, CollectErrorsM m) => LanguageModule c -> Namespace -> [String] -> [AnyCategory c] -> [DefinedCategory c] -> [TestProcedure c] -> m ([CxxOutput], CxxOutput, [(FunctionName, [c])])
- CompilerCxx.Category: data CxxOutput
- CompilerCxx.Category: data LanguageModule c
- CompilerCxx.Category: data PrivateSource c
- CompilerCxx.Category: instance GHC.Show.Show CompilerCxx.Category.CxxOutput
- Parser.Pragma: instance Parser.Common.ParseFromSource Types.Pragma.MacroName
- Parser.Pragma: pragmaComment :: TextParser (Pragma SourceContext)
- Parser.Pragma: pragmaExprLookup :: TextParser (Pragma SourceContext)
- Parser.Pragma: pragmaModuleOnly :: TextParser (Pragma SourceContext)
- Parser.Pragma: pragmaNoTrace :: TextParser (Pragma SourceContext)
- Parser.Pragma: pragmaSourceContext :: TextParser (Pragma SourceContext)
- Parser.Pragma: pragmaTestsOnly :: TextParser (Pragma SourceContext)
- Parser.Pragma: pragmaTraceCreation :: TextParser (Pragma SourceContext)
- Types.DefinedCategory: [vvWritable] :: VariableValue c -> Bool
- Types.Pragma: FromDependency :: CodeVisibility
- Types.Pragma: MacroName :: String -> MacroName
- Types.Pragma: ModuleOnly :: CodeVisibility
- Types.Pragma: NoTrace :: TraceType
- Types.Pragma: PragmaComment :: [c] -> String -> Pragma c
- Types.Pragma: PragmaExprLookup :: [c] -> MacroName -> Pragma c
- Types.Pragma: PragmaSourceContext :: c -> Pragma c
- Types.Pragma: PragmaTracing :: [c] -> TraceType -> Pragma c
- Types.Pragma: PragmaVisibility :: [c] -> CodeVisibility -> Pragma c
- Types.Pragma: TestsOnly :: CodeVisibility
- Types.Pragma: TraceCreation :: TraceType
- Types.Pragma: WithVisibility :: Set CodeVisibility -> a -> WithVisibility a
- Types.Pragma: [mnName] :: MacroName -> String
- Types.Pragma: [pcComment] :: Pragma c -> String
- Types.Pragma: [pcContext] :: Pragma c -> [c]
- Types.Pragma: [pelContext] :: Pragma c -> [c]
- Types.Pragma: [pelName] :: Pragma c -> MacroName
- Types.Pragma: [pscContext] :: Pragma c -> c
- Types.Pragma: [ptContext] :: Pragma c -> [c]
- Types.Pragma: [ptType] :: Pragma c -> TraceType
- Types.Pragma: [pvContext] :: Pragma c -> [c]
- Types.Pragma: [pvScopes] :: Pragma c -> CodeVisibility
- Types.Pragma: [wvData] :: WithVisibility a -> a
- Types.Pragma: [wvVisibility] :: WithVisibility a -> Set CodeVisibility
- Types.Pragma: data CodeVisibility
- Types.Pragma: data Pragma c
- Types.Pragma: data TraceType
- Types.Pragma: data WithVisibility a
- Types.Pragma: getPragmaContext :: Pragma c -> [c]
- Types.Pragma: hasCodeVisibility :: CodeVisibility -> WithVisibility a -> Bool
- Types.Pragma: instance GHC.Classes.Eq Types.Pragma.CodeVisibility
- Types.Pragma: instance GHC.Classes.Eq Types.Pragma.MacroName
- Types.Pragma: instance GHC.Classes.Ord Types.Pragma.CodeVisibility
- Types.Pragma: instance GHC.Classes.Ord Types.Pragma.MacroName
- Types.Pragma: instance GHC.Show.Show Types.Pragma.CodeVisibility
- Types.Pragma: instance GHC.Show.Show Types.Pragma.MacroName
- Types.Pragma: instance GHC.Show.Show Types.Pragma.TraceType
- Types.Pragma: instance GHC.Show.Show a => GHC.Show.Show (Types.Pragma.WithVisibility a)
- Types.Pragma: instance GHC.Show.Show c => GHC.Show.Show (Types.Pragma.Pragma c)
- Types.Pragma: isExprLookup :: Pragma c -> Bool
- Types.Pragma: isModuleOnly :: Pragma c -> Bool
- Types.Pragma: isNoTrace :: Pragma c -> Bool
- Types.Pragma: isSourceContext :: Pragma c -> Bool
- Types.Pragma: isTestsOnly :: Pragma c -> Bool
- Types.Pragma: isTraceCreation :: Pragma c -> Bool
- Types.Pragma: mapCodeVisibility :: (a -> b) -> WithVisibility a -> WithVisibility b
- Types.Pragma: newtype MacroName
- Types.Pragma: updateCodeVisibility :: (Set CodeVisibility -> Set CodeVisibility) -> WithVisibility a -> WithVisibility a
+ Compilation.CompilerState: ccSetHidden :: CompilerContext c m s a => a -> UsedVariable c -> m a
+ Compilation.CompilerState: ccSetReadOnly :: CompilerContext c m s a => a -> UsedVariable c -> m a
+ Compilation.CompilerState: csSetHidden :: CompilerContext c m s a => UsedVariable c -> CompilerState a m ()
+ Compilation.CompilerState: csSetReadOnly :: CompilerContext c m s a => UsedVariable c -> CompilerState a m ()
+ Compilation.ProcedureContext: [_pcAllFilters] :: ProcedureContext c -> ParamFilters
+ Compilation.ProcedureContext: [_pcCategories] :: ProcedureContext c -> CategoryMap c
+ Compilation.ProcedureContext: [_pcCleanupBlocks] :: ProcedureContext c -> [Maybe (CleanupBlock c [String])]
+ Compilation.ProcedureContext: [_pcDisallowInit] :: ProcedureContext c -> Bool
+ Compilation.ProcedureContext: [_pcExprMap] :: ProcedureContext c -> ExprMap c
+ Compilation.ProcedureContext: [_pcExtFilters] :: ProcedureContext c -> [ParamFilter c]
+ Compilation.ProcedureContext: [_pcExtParams] :: ProcedureContext c -> Positional (ValueParam c)
+ Compilation.ProcedureContext: [_pcFunctions] :: ProcedureContext c -> Map FunctionName (ScopedFunction c)
+ Compilation.ProcedureContext: [_pcInCleanup] :: ProcedureContext c -> Bool
+ Compilation.ProcedureContext: [_pcIntFilters] :: ProcedureContext c -> [ParamFilter c]
+ Compilation.ProcedureContext: [_pcIntParams] :: ProcedureContext c -> Positional (ValueParam c)
+ Compilation.ProcedureContext: [_pcIsNamed] :: ProcedureContext c -> Bool
+ Compilation.ProcedureContext: [_pcJumpType] :: ProcedureContext c -> JumpType
+ Compilation.ProcedureContext: [_pcLoopSetup] :: ProcedureContext c -> LoopSetup [String]
+ Compilation.ProcedureContext: [_pcMembers] :: ProcedureContext c -> [DefinedMember c]
+ Compilation.ProcedureContext: [_pcNoTrace] :: ProcedureContext c -> Bool
+ Compilation.ProcedureContext: [_pcOutput] :: ProcedureContext c -> [String]
+ Compilation.ProcedureContext: [_pcParamScopes] :: ProcedureContext c -> Map ParamName SymbolScope
+ Compilation.ProcedureContext: [_pcPrimNamed] :: ProcedureContext c -> [ReturnVariable]
+ Compilation.ProcedureContext: [_pcRequiredTypes] :: ProcedureContext c -> Set CategoryName
+ Compilation.ProcedureContext: [_pcReservedMacros] :: ProcedureContext c -> [(MacroName, [c])]
+ Compilation.ProcedureContext: [_pcReturns] :: ProcedureContext c -> ReturnValidation c
+ Compilation.ProcedureContext: [_pcScope] :: ProcedureContext c -> SymbolScope
+ Compilation.ProcedureContext: [_pcType] :: ProcedureContext c -> CategoryName
+ Compilation.ProcedureContext: [_pcUsedVars] :: ProcedureContext c -> [UsedVariable c]
+ Compilation.ProcedureContext: [_pcVariables] :: ProcedureContext c -> Map VariableName (VariableValue c)
+ CompilerCxx.CxxFiles: CxxOutput :: Maybe CategoryName -> String -> Namespace -> Set Namespace -> Set CategoryName -> [String] -> CxxOutput
+ CompilerCxx.CxxFiles: FileContext :: Bool -> CategoryMap c -> Set Namespace -> ExprMap c -> FileContext c
+ CompilerCxx.CxxFiles: [coCategory] :: CxxOutput -> Maybe CategoryName
+ CompilerCxx.CxxFiles: [coFilename] :: CxxOutput -> String
+ CompilerCxx.CxxFiles: [coNamespace] :: CxxOutput -> Namespace
+ CompilerCxx.CxxFiles: [coOutput] :: CxxOutput -> [String]
+ CompilerCxx.CxxFiles: [coUsesCategory] :: CxxOutput -> Set CategoryName
+ CompilerCxx.CxxFiles: [coUsesNamespace] :: CxxOutput -> Set Namespace
+ CompilerCxx.CxxFiles: [fcCategories] :: FileContext c -> CategoryMap c
+ CompilerCxx.CxxFiles: [fcExprMap] :: FileContext c -> ExprMap c
+ CompilerCxx.CxxFiles: [fcNamespaces] :: FileContext c -> Set Namespace
+ CompilerCxx.CxxFiles: [fcTesting] :: FileContext c -> Bool
+ CompilerCxx.CxxFiles: data CxxOutput
+ CompilerCxx.CxxFiles: data FileContext c
+ CompilerCxx.CxxFiles: generateMainFile :: (Ord c, Show c, CollectErrorsM m) => CategoryMap c -> ExprMap c -> CategoryName -> FunctionName -> m (Namespace, [String])
+ CompilerCxx.CxxFiles: generateNativeConcrete :: (Ord c, Show c, CollectErrorsM m) => FileContext c -> (AnyCategory c, DefinedCategory c) -> m [CxxOutput]
+ CompilerCxx.CxxFiles: generateNativeInterface :: (Ord c, Show c, CollectErrorsM m) => Bool -> AnyCategory c -> m [CxxOutput]
+ CompilerCxx.CxxFiles: generateStreamlinedExtension :: (Ord c, Show c, CollectErrorsM m) => Bool -> AnyCategory c -> m [CxxOutput]
+ CompilerCxx.CxxFiles: generateStreamlinedTemplate :: (Ord c, Show c, CollectErrorsM m) => FileContext c -> AnyCategory c -> m [CxxOutput]
+ CompilerCxx.CxxFiles: generateTestFile :: (Ord c, Show c, CollectErrorsM m) => CategoryMap c -> ExprMap c -> [String] -> [TestProcedure c] -> m (CompiledData [String])
+ CompilerCxx.CxxFiles: generateVerboseExtension :: (Ord c, Show c, CollectErrorsM m) => Bool -> AnyCategory c -> m [CxxOutput]
+ CompilerCxx.CxxFiles: instance GHC.Show.Show CompilerCxx.CxxFiles.CxxOutput
+ CompilerCxx.LanguageModule: LanguageModule :: Set Namespace -> Set Namespace -> Set Namespace -> [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c] -> [AnyCategory c] -> [CategoryName] -> [CategoryName] -> ExprMap c -> LanguageModule c
+ CompilerCxx.LanguageModule: PrivateSource :: Namespace -> Bool -> [AnyCategory c] -> [DefinedCategory c] -> PrivateSource c
+ CompilerCxx.LanguageModule: [lmExprMap] :: LanguageModule c -> ExprMap c
+ CompilerCxx.LanguageModule: [lmExternal] :: LanguageModule c -> [CategoryName]
+ CompilerCxx.LanguageModule: [lmLocalNamespaces] :: LanguageModule c -> Set Namespace
+ CompilerCxx.LanguageModule: [lmPrivateDeps] :: LanguageModule c -> [AnyCategory c]
+ CompilerCxx.LanguageModule: [lmPrivateLocal] :: LanguageModule c -> [AnyCategory c]
+ CompilerCxx.LanguageModule: [lmPrivateNamespaces] :: LanguageModule c -> Set Namespace
+ CompilerCxx.LanguageModule: [lmPublicDeps] :: LanguageModule c -> [AnyCategory c]
+ CompilerCxx.LanguageModule: [lmPublicLocal] :: LanguageModule c -> [AnyCategory c]
+ CompilerCxx.LanguageModule: [lmPublicNamespaces] :: LanguageModule c -> Set Namespace
+ CompilerCxx.LanguageModule: [lmStreamlined] :: LanguageModule c -> [CategoryName]
+ CompilerCxx.LanguageModule: [lmTestingDeps] :: LanguageModule c -> [AnyCategory c]
+ CompilerCxx.LanguageModule: [lmTestingLocal] :: LanguageModule c -> [AnyCategory c]
+ CompilerCxx.LanguageModule: [psCategory] :: PrivateSource c -> [AnyCategory c]
+ CompilerCxx.LanguageModule: [psDefine] :: PrivateSource c -> [DefinedCategory c]
+ CompilerCxx.LanguageModule: [psNamespace] :: PrivateSource c -> Namespace
+ CompilerCxx.LanguageModule: [psTesting] :: PrivateSource c -> Bool
+ CompilerCxx.LanguageModule: compileLanguageModule :: (Ord c, Show c, CollectErrorsM m) => LanguageModule c -> [PrivateSource c] -> m [CxxOutput]
+ CompilerCxx.LanguageModule: compileModuleMain :: (Ord c, Show c, CollectErrorsM m) => LanguageModule c -> [PrivateSource c] -> CategoryName -> FunctionName -> m CxxOutput
+ CompilerCxx.LanguageModule: compileTestsModule :: (Ord c, Show c, CollectErrorsM m) => LanguageModule c -> Namespace -> [String] -> [AnyCategory c] -> [DefinedCategory c] -> [TestProcedure c] -> m ([CxxOutput], CxxOutput, [(FunctionName, [c])])
+ CompilerCxx.LanguageModule: data LanguageModule c
+ CompilerCxx.LanguageModule: data PrivateSource c
+ CompilerCxx.Naming: categoryCustom :: CategoryName -> String
+ CompilerCxx.Naming: templateStreamlined :: CategoryName -> String
+ CompilerCxx.Naming: typeCustom :: CategoryName -> String
+ CompilerCxx.Naming: valueCustom :: CategoryName -> String
+ CompilerCxx.Procedure: procedureDeclaration :: Monad m => Bool -> ScopedFunction c -> m (CompiledData [String])
+ Parser.Pragma: autoPragma :: String -> Either (SourceContext -> a) (SourceContext -> TextParser a) -> TextParser a
+ Parser.Pragma: unknownPragma :: TextParser a
+ Parser.Procedure: Hidden :: MarkType
+ Parser.Procedure: PragmaExprLookup :: [c] -> MacroName -> PragmaExpr c
+ Parser.Procedure: PragmaMarkVars :: [c] -> MarkType -> [VariableName] -> PragmaStatement c
+ Parser.Procedure: PragmaSourceContext :: c -> PragmaExpr c
+ Parser.Procedure: ReadOnly :: MarkType
+ Parser.Procedure: [pelContext] :: PragmaExpr c -> [c]
+ Parser.Procedure: [pelName] :: PragmaExpr c -> MacroName
+ Parser.Procedure: [pmvContext] :: PragmaStatement c -> [c]
+ Parser.Procedure: [pmvType] :: PragmaStatement c -> MarkType
+ Parser.Procedure: [pmvVars] :: PragmaStatement c -> [VariableName]
+ Parser.Procedure: [pscContext] :: PragmaExpr c -> c
+ Parser.Procedure: data MarkType
+ Parser.Procedure: data PragmaExpr c
+ Parser.Procedure: data PragmaStatement c
+ Parser.Procedure: instance GHC.Show.Show Parser.Procedure.MarkType
+ Parser.Procedure: instance GHC.Show.Show c => GHC.Show.Show (Parser.Procedure.PragmaExpr c)
+ Parser.Procedure: instance GHC.Show.Show c => GHC.Show.Show (Parser.Procedure.PragmaStatement c)
+ Parser.Procedure: instance Parser.Common.ParseFromSource Types.Procedure.MacroName
+ Parser.Procedure: pragmaExprLookup :: TextParser (PragmaExpr SourceContext)
+ Parser.Procedure: pragmaHidden :: TextParser (PragmaStatement SourceContext)
+ Parser.Procedure: pragmaNoTrace :: TextParser (PragmaProcedure SourceContext)
+ Parser.Procedure: pragmaReadOnly :: TextParser (PragmaStatement SourceContext)
+ Parser.Procedure: pragmaSourceContext :: TextParser (PragmaExpr SourceContext)
+ Parser.Procedure: pragmaTraceCreation :: TextParser (PragmaProcedure SourceContext)
+ Parser.SourceFile: FromDependency :: CodeVisibility
+ Parser.SourceFile: ModuleOnly :: CodeVisibility
+ Parser.SourceFile: PragmaVisibility :: [c] -> CodeVisibility -> PragmaSource c
+ Parser.SourceFile: TestsOnly :: CodeVisibility
+ Parser.SourceFile: WithVisibility :: Set CodeVisibility -> a -> WithVisibility a
+ Parser.SourceFile: [pvContext] :: PragmaSource c -> [c]
+ Parser.SourceFile: [pvScopes] :: PragmaSource c -> CodeVisibility
+ Parser.SourceFile: [wvData] :: WithVisibility a -> a
+ Parser.SourceFile: [wvVisibility] :: WithVisibility a -> Set CodeVisibility
+ Parser.SourceFile: data CodeVisibility
+ Parser.SourceFile: data PragmaSource c
+ Parser.SourceFile: data WithVisibility a
+ Parser.SourceFile: hasCodeVisibility :: CodeVisibility -> WithVisibility a -> Bool
+ Parser.SourceFile: instance GHC.Classes.Eq Parser.SourceFile.CodeVisibility
+ Parser.SourceFile: instance GHC.Classes.Ord Parser.SourceFile.CodeVisibility
+ Parser.SourceFile: instance GHC.Show.Show Parser.SourceFile.CodeVisibility
+ Parser.SourceFile: instance GHC.Show.Show a => GHC.Show.Show (Parser.SourceFile.WithVisibility a)
+ Parser.SourceFile: instance GHC.Show.Show c => GHC.Show.Show (Parser.SourceFile.PragmaSource c)
+ Parser.SourceFile: isModuleOnly :: PragmaSource c -> Bool
+ Parser.SourceFile: isTestsOnly :: PragmaSource c -> Bool
+ Parser.SourceFile: mapCodeVisibility :: (a -> b) -> WithVisibility a -> WithVisibility b
+ Parser.SourceFile: pragmaModuleOnly :: TextParser (PragmaSource SourceContext)
+ Parser.SourceFile: pragmaTestsOnly :: TextParser (PragmaSource SourceContext)
+ Parser.SourceFile: updateCodeVisibility :: (Set CodeVisibility -> Set CodeVisibility) -> WithVisibility a -> WithVisibility a
+ Test.Common: checkParseError :: Show a => String -> String -> TextParser a -> IO (TrackedErrors ())
+ Test.Common: checkParseMatch :: Show a => String -> TextParser a -> (a -> Bool) -> IO (TrackedErrors ())
+ Test.Pragma: instance GHC.Show.Show c => GHC.Show.Show (Test.Pragma.PragmaComment c)
+ Types.Builtin: defaultCategoryDeps :: Set CategoryName
+ Types.DefinedCategory: VariableDefault :: VariableRule c
+ Types.DefinedCategory: VariableHidden :: [c] -> VariableRule c
+ Types.DefinedCategory: VariableReadOnly :: [c] -> VariableRule c
+ Types.DefinedCategory: [vhContext] :: VariableRule c -> [c]
+ Types.DefinedCategory: [vroContext] :: VariableRule c -> [c]
+ Types.DefinedCategory: [vvReadOnlyAt] :: VariableValue c -> VariableRule c
+ Types.DefinedCategory: data VariableRule c
+ Types.DefinedCategory: instance GHC.Show.Show c => GHC.Show.Show (Types.DefinedCategory.VariableValue c)
+ Types.Procedure: MacroName :: String -> MacroName
+ Types.Procedure: MarkHidden :: [c] -> [VariableName] -> Statement c
+ Types.Procedure: MarkReadOnly :: [c] -> [VariableName] -> Statement c
+ Types.Procedure: NoTrace :: TraceType
+ Types.Procedure: PragmaTracing :: [c] -> TraceType -> PragmaProcedure c
+ Types.Procedure: TraceCreation :: TraceType
+ Types.Procedure: [mnName] :: MacroName -> String
+ Types.Procedure: [ptContext] :: PragmaProcedure c -> [c]
+ Types.Procedure: [ptType] :: PragmaProcedure c -> TraceType
+ Types.Procedure: data PragmaProcedure c
+ Types.Procedure: data TraceType
+ Types.Procedure: instance GHC.Classes.Eq Types.Procedure.MacroName
+ Types.Procedure: instance GHC.Classes.Ord Types.Procedure.MacroName
+ Types.Procedure: instance GHC.Show.Show Types.Procedure.MacroName
+ Types.Procedure: instance GHC.Show.Show Types.Procedure.TraceType
+ Types.Procedure: instance GHC.Show.Show c => GHC.Show.Show (Types.Procedure.PragmaProcedure c)
+ Types.Procedure: isNoTrace :: PragmaProcedure c -> Bool
+ Types.Procedure: isTraceCreation :: PragmaProcedure c -> Bool
+ Types.Procedure: newtype MacroName
- Compilation.CompilerState: ccStartCleanup :: CompilerContext c m s a => a -> m a
+ Compilation.CompilerState: ccStartCleanup :: CompilerContext c m s a => a -> [c] -> m a
- Compilation.CompilerState: csStartCleanup :: CompilerContext c m s a => CompilerState a m ()
+ Compilation.CompilerState: csStartCleanup :: CompilerContext c m s a => [c] -> CompilerState a m ()
- CompilerCxx.Procedure: compileExecutableProcedure :: (Ord c, Show c, CollectErrorsM m) => ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> m (CompiledData [String], CompiledData [String])
+ CompilerCxx.Procedure: compileExecutableProcedure :: (Ord c, Show c, CollectErrorsM m) => Maybe String -> ScopeContext c -> ScopedFunction c -> ExecutableProcedure c -> m (CompiledData [String])
- Parser.SourceFile: parseInternalSource :: ErrorContextM m => (FilePath, String) -> m ([Pragma SourceContext], [AnyCategory SourceContext], [DefinedCategory SourceContext])
+ Parser.SourceFile: parseInternalSource :: ErrorContextM m => (FilePath, String) -> m ([PragmaSource SourceContext], [AnyCategory SourceContext], [DefinedCategory SourceContext])
- Parser.SourceFile: parsePublicSource :: ErrorContextM m => (FilePath, String) -> m ([Pragma SourceContext], [AnyCategory SourceContext])
+ Parser.SourceFile: parsePublicSource :: ErrorContextM m => (FilePath, String) -> m ([PragmaSource SourceContext], [AnyCategory SourceContext])
- Parser.SourceFile: parseTestSource :: ErrorContextM m => (FilePath, String) -> m ([Pragma SourceContext], [IntegrationTest SourceContext])
+ Parser.SourceFile: parseTestSource :: ErrorContextM m => (FilePath, String) -> m ([PragmaSource SourceContext], [IntegrationTest SourceContext])
- Types.DefinedCategory: VariableValue :: [c] -> SymbolScope -> ValueType -> Bool -> VariableValue c
+ Types.DefinedCategory: VariableValue :: [c] -> SymbolScope -> ValueType -> VariableRule c -> VariableValue c
- Types.Procedure: ExecutableProcedure :: [c] -> [Pragma c] -> [c] -> FunctionName -> ArgValues c -> ReturnValues c -> Procedure c -> ExecutableProcedure c
+ Types.Procedure: ExecutableProcedure :: [c] -> [PragmaProcedure c] -> [c] -> FunctionName -> ArgValues c -> ReturnValues c -> Procedure c -> ExecutableProcedure c
- Types.Procedure: [epPragmas] :: ExecutableProcedure c -> [Pragma c]
+ Types.Procedure: [epPragmas] :: ExecutableProcedure c -> [PragmaProcedure c]
Files
- ChangeLog.md +31/−0
- base/category-source.cpp +27/−2
- bin/zeolite.hs +1/−1
- example/parser/parse-text.0rx +3/−0
- lib/file/.zeolite-module +2/−2
- lib/file/Category_RawFileReader.cpp +0/−229
- lib/file/Category_RawFileWriter.cpp +0/−210
- lib/file/Extension_RawFileReader.cpp +128/−0
- lib/file/Extension_RawFileWriter.cpp +110/−0
- lib/math/.zeolite-module +1/−6
- lib/math/Category_Math.cpp +0/−225
- lib/math/Extension_Math.cpp +217/−0
- lib/math/Source_Math.cpp +0/−162
- lib/math/Source_Math.hpp +0/−112
- lib/util/.zeolite-module +3/−3
- lib/util/Category_Argv.cpp +0/−163
- lib/util/Category_SimpleInput.cpp +0/−168
- lib/util/Category_SimpleOutput.cpp +0/−220
- lib/util/Extension_Argv.cpp +96/−0
- lib/util/Extension_SimpleInput.cpp +90/−0
- lib/util/Extension_SimpleOutput.cpp +136/−0
- src/Base/MergeTree.hs +3/−5
- src/Cli/Compiler.hs +21/−15
- src/Cli/RunCompiler.hs +12/−3
- src/Cli/TestRunner.hs +2/−1
- src/Compilation/CompilerState.hs +16/−8
- src/Compilation/ProcedureContext.hs +135/−565
- src/Compilation/ScopeContext.hs +2/−2
- src/CompilerCxx/Category.hs +0/−874
- src/CompilerCxx/CategoryContext.hs +78/−78
- src/CompilerCxx/CxxFiles.hs +904/−0
- src/CompilerCxx/LanguageModule.hs +215/−0
- src/CompilerCxx/Naming.hs +16/−0
- src/CompilerCxx/Procedure.hs +55/−33
- src/Module/CompileMetadata.hs +2/−3
- src/Module/ParseMetadata.hs +2/−3
- src/Module/ProcessMetadata.hs +3/−4
- src/Parser/Pragma.hs +4/−51
- src/Parser/Procedure.hs +73/−3
- src/Parser/SourceFile.hs +61/−8
- src/Test/Common.hs +29/−1
- src/Test/ParseMetadata.hs +1/−2
- src/Test/Parser.hs +3/−3
- src/Test/Pragma.hs +17/−89
- src/Test/Procedure.hs +37/−3
- src/Test/SourceFile.hs +37/−1
- src/Types/Builtin.hs +5/−0
- src/Types/DefinedCategory.hs +19/−3
- src/Types/Pragma.hs +0/−124
- src/Types/Procedure.hs +37/−3
- tests/cli-tests.sh +23/−2
- tests/internal-inheritance.0rt +23/−1
- tests/local-rules.0rt +258/−0
- tests/module-only3/README.md +0/−1
- tests/module-only4/common-source.cpp +49/−231
- tests/reduce.0rt +50/−1
- tests/simple.0rt +11/−0
- tests/templates/.zeolite-module +1/−1
- tests/templates/README.md +4/−4
- tests/tests-only4/.zeolite-module +13/−0
- tests/tests-only4/README.md +25/−0
- tests/tests-only4/normal.0rp +19/−0
- tests/tests-only4/source1.cpp +20/−0
- tests/tests-only4/source2.cpp +20/−0
- tests/tests-only4/testing.0rp +23/−0
- zeolite-lang.cabal +10/−5
ChangeLog.md view
@@ -1,5 +1,34 @@ # Revision history for zeolite-lang +## 0.13.0.0 -- 2021-03-17++### Language++* **[breaking]** Streamlines C++ extensions to cut down on boilerplate code.+ This is a massive change that breaks *all* existing C++ extensions; however,+ hand-written procedure definitions can be copied-and-pasted into a new+ extension template. Use `zeolite --templates` to regenerate new templates for+ C++ extensions.++* **[new]** Adds pragmas for local variable rules:++ * **[new]** `$ReadOnly[foo]$` marks `foo` as read-only in the current context+ following the line with the pragma.++ * **[new]** `$Hidden[foo]$` hides `foo` in the current context following the+ line with the pragma.++* **[fix]** Fixes a latent issue with the `reduce` built-in when converting an+ intersection type to a union type, when one or both sides contains another+ nested union or intersection. This was previously fixed for compile-time+ checks, but `reduce` was missed.++### Compiler CLI++* **[breaking]** Adds [`microlens`][microlens] and+ [`microlens-th`][microlens-th] as dependencies, to help clean up the compiler+ code. This should not change the compiler's behavior.+ ## 0.12.0.0 -- 2020-12-11 ### Language@@ -475,4 +504,6 @@ * First version. Released on an unsuspecting world. [megaparsec]: https://hackage.haskell.org/package/megaparsec+[microlens]: https://hackage.haskell.org/package/microlens+[microlens-th]: https://hackage.haskell.org/package/microlens-th [parsec]: https://hackage.haskell.org/package/parsec
base/category-source.cpp view
@@ -1,5 +1,5 @@ /* ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry+Copyright 2019-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -158,9 +158,34 @@ bool TypeInstance::CanConvert(const S<const TypeInstance>& x, const S<const TypeInstance>& y) {- // See checkGeneralType for the ordering here.+ // See pairMergeTree for the ordering here.+ // TODO: Consider using a cache here, since the check could be expensive. if (x.get() == y.get()) { return true;+ } else if (x->InstanceMergeType() == MergeType::INTERSECT &&+ y->InstanceMergeType() == MergeType::UNION) {+ for (const auto& left : x->MergedTypes()) {+ if (left->InstanceMergeType() == MergeType::SINGLE) {+ for (const auto& right : y->MergedTypes()) {+ if (right->InstanceMergeType() == MergeType::SINGLE) {+ if (TypeInstance::CanConvert(left, right)) {+ return true;+ }+ }+ }+ }+ }+ for (const auto& left : x->MergedTypes()) {+ if (TypeInstance::CanConvert(left, y)) {+ return true;+ }+ }+ for (const auto right : y->MergedTypes()) {+ if (TypeInstance::CanConvert(x, right)) {+ return true;+ }+ }+ return false; } else if (y->InstanceMergeType() == MergeType::INTERSECT) { for (const auto& right : y->MergedTypes()) { if (!TypeInstance::CanConvert(x, right)) {
bin/zeolite.hs view
@@ -55,7 +55,7 @@ showHelp :: IO () showHelp = do- hPutStrLn stderr "Zeolite CLI Help:"+ hPutStrLn stderr $ "Zeolite " ++ compilerVersion ++ " Help:" mapM_ (hPutStrLn stderr . (" " ++)) optionHelpText hPutStrLn stderr "Also see https://ta0kira.github.io/zeolite for more documentation."
example/parser/parse-text.0rx view
@@ -12,6 +12,7 @@ scoped { Int index <- 0 } in while (index < match.readSize()) {+ $ReadOnly[context,index]$ if (context.atEof() || context.current() != match.readPosition(index)) { if (index > 0) { // Partial match => set error context.@@ -50,10 +51,12 @@ Builder<String> builder <- String.builder() Int count <- 0 while (!context.atEof() && (max == 0 || count < max)) {+ $ReadOnly[context,count]$ Bool found <- false scoped { Int index <- 0 } in while (index < matches.readSize()) {+ $ReadOnly[index]$ if (context.current() == matches.readPosition(index)) { \ builder.append(matches.readPosition(index).formatted()) found <- true
lib/file/.zeolite-module view
@@ -8,11 +8,11 @@ ] extra_files: [ category_source {- source: "file/Category_RawFileReader.cpp"+ source: "file/Extension_RawFileReader.cpp" categories: [RawFileReader] } category_source {- source: "file/Category_RawFileWriter.cpp"+ source: "file/Extension_RawFileWriter.cpp" categories: [RawFileWriter] } ]
− lib/file/Category_RawFileReader.cpp
@@ -1,229 +0,0 @@-/* ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry-Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at- http://www.apache.org/licenses/LICENSE-2.0-Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.------------------------------------------------------------------------------ */--// Author: Kevin P. Barry [ta0kira@gmail.com]--#include <fstream>--#include "category-source.hpp"-#include "Category_BlockReader.hpp"-#include "Category_Bool.hpp"-#include "Category_Formatted.hpp"-#include "Category_Int.hpp"-#include "Category_PersistentResource.hpp"-#include "Category_RawFileReader.hpp"-#include "Category_String.hpp"-#ifdef ZEOLITE_PUBLIC_NAMESPACE-namespace ZEOLITE_PUBLIC_NAMESPACE {-#endif // ZEOLITE_PUBLIC_NAMESPACE-namespace {-const int collection_RawFileReader = 0;-} // namespace-const void* const Functions_RawFileReader = &collection_RawFileReader;-const TypeFunction& Function_RawFileReader_open = (*new TypeFunction{ 0, 1, 1, "RawFileReader", "open", Functions_RawFileReader, 0 });-const ValueFunction& Function_RawFileReader_getFileError = (*new ValueFunction{ 0, 0, 1, "RawFileReader", "getFileError", Functions_RawFileReader, 0 });-namespace {-class Category_RawFileReader;-class Type_RawFileReader;-S<Type_RawFileReader> CreateType_RawFileReader(Params<0>::Type params);-class Value_RawFileReader;-S<TypeValue> CreateValue_RawFileReader(S<Type_RawFileReader> parent, const ParamTuple& params, const ValueTuple& args);-struct Category_RawFileReader : public TypeCategory {- std::string CategoryName() const final { return "RawFileReader"; }- Category_RawFileReader() {- CycleCheck<Category_RawFileReader>::Check();- CycleCheck<Category_RawFileReader> marker(*this);- TRACE_FUNCTION("RawFileReader (init @category)")- }- ReturnTuple Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Category_RawFileReader::*)(const ParamTuple&, const ValueTuple&);- return TypeCategory::Dispatch(label, params, args);- }-};-Category_RawFileReader& CreateCategory_RawFileReader() {- static auto& category = *new Category_RawFileReader();- return category;-}-struct Type_RawFileReader : public TypeInstance {- std::string CategoryName() const final { return parent.CategoryName(); }- void BuildTypeName(std::ostream& output) const final {- return TypeInstance::TypeNameFrom(output, parent);- }- Category_RawFileReader& parent;- bool CanConvertFrom(const S<const TypeInstance>& from) const final {- std::vector<S<const TypeInstance>> args;- if (!from->TypeArgsForParent(parent, args)) return false;- if(args.size() != 0) {- FAIL() << "Wrong number of args (" << args.size() << ") for " << CategoryName();- }- return true;- }- bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {- if (&category == &GetCategory_RawFileReader()) {- args = std::vector<S<const TypeInstance>>{};- return true;- }- if (&category == &GetCategory_PersistentResource()) {- args = std::vector<S<const TypeInstance>>{};- return true;- }- if (&category == &GetCategory_BlockReader()) {- args = std::vector<S<const TypeInstance>>{GetType_String(T_get())};- return true;- }- return false;- }- Type_RawFileReader(Category_RawFileReader& p, Params<0>::Type params) : parent(p) {- CycleCheck<Type_RawFileReader>::Check();- CycleCheck<Type_RawFileReader> marker(*this);- TRACE_FUNCTION("RawFileReader (init @type)")- }- ReturnTuple Dispatch(const S<TypeInstance>& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Type_RawFileReader::*)(const S<TypeInstance>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_RawFileReader[] = {- &Type_RawFileReader::Call_open,- };- if (label.collection == Functions_RawFileReader) {- if (label.function_num < 0 || label.function_num >= sizeof Table_RawFileReader / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_RawFileReader[label.function_num])(self, params, args);- }- return TypeInstance::Dispatch(self, label, params, args);- }- ReturnTuple Call_open(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args);-};-S<Type_RawFileReader> CreateType_RawFileReader(Params<0>::Type params) {- static const auto cached = S_get(new Type_RawFileReader(CreateCategory_RawFileReader(), Params<0>::Type()));- return cached;-}-struct Value_RawFileReader : public TypeValue {- Value_RawFileReader(S<Type_RawFileReader> p, const ParamTuple& params, const ValueTuple& args)- : parent(p), filename(args.At(0)->AsString()),- file(new std::ifstream(filename, std::ios::in | std::ios::binary)) {}- ReturnTuple Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params,const ValueTuple& args) final {- using CallType = ReturnTuple(Value_RawFileReader::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_BlockReader[] = {- &Value_RawFileReader::Call_pastEnd,- &Value_RawFileReader::Call_readBlock,- };- static const CallType Table_PersistentResource[] = {- &Value_RawFileReader::Call_freeResource,- };- static const CallType Table_RawFileReader[] = {- &Value_RawFileReader::Call_getFileError,- };- if (label.collection == Functions_BlockReader) {- if (label.function_num < 0 || label.function_num >= sizeof Table_BlockReader / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_BlockReader[label.function_num])(self, params, args);- }- if (label.collection == Functions_PersistentResource) {- if (label.function_num < 0 || label.function_num >= sizeof Table_PersistentResource / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_PersistentResource[label.function_num])(self, params, args);- }- if (label.collection == Functions_RawFileReader) {- if (label.function_num < 0 || label.function_num >= sizeof Table_RawFileReader / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_RawFileReader[label.function_num])(self, params, args);- }- return TypeValue::Dispatch(self, label, params, args);- }- std::string CategoryName() const final { return parent->CategoryName(); }- ReturnTuple Call_freeResource(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- ReturnTuple Call_getFileError(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- ReturnTuple Call_pastEnd(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- ReturnTuple Call_readBlock(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- const S<Type_RawFileReader> parent;- std::mutex mutex;- const std::string filename;- R<std::istream> file;- CAPTURE_CREATION-};-S<TypeValue> CreateValue_RawFileReader(S<Type_RawFileReader> parent, const ParamTuple& params, const ValueTuple& args) {- return S_get(new Value_RawFileReader(parent, params, args));-}-ReturnTuple Type_RawFileReader::Call_open(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("RawFileReader.open")- return ReturnTuple(CreateValue_RawFileReader(CreateType_RawFileReader(Params<0>::Type()), ParamTuple(), args));-}-ReturnTuple Value_RawFileReader::Call_freeResource(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("RawFileReader.freeResource")- std::lock_guard<std::mutex> lock(mutex);- if (file) {- file = nullptr;- }- return ReturnTuple();-}-ReturnTuple Value_RawFileReader::Call_getFileError(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("RawFileReader.getFileError")- std::lock_guard<std::mutex> lock(mutex);- if (!file) {- return ReturnTuple(Box_String(PrimString_FromLiteral("file has already been closed")));- }- if (file->rdstate() & std::ios::badbit) {- return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be read or opened")));- }- if (file->rdstate() & std::ios::failbit) {- return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be read or opened")));- }- return ReturnTuple(Var_empty);-}-ReturnTuple Value_RawFileReader::Call_pastEnd(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("RawFileReader.pastEnd")- std::lock_guard<std::mutex> lock(mutex);- return ReturnTuple(Box_Bool(!file || file->fail() || file->eof()));-}-ReturnTuple Value_RawFileReader::Call_readBlock(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("RawFileReader.readBlock")- TRACE_CREATION- std::lock_guard<std::mutex> lock(mutex);- const PrimInt Var_arg1 = (args.At(0))->AsInt();- if (Var_arg1 < 0) {- FAIL() << "Read size " << Var_arg1 << " is invalid";- }- if (!file || file->rdstate() != std::ios::goodbit) {- FAIL() << "Error reading file \"" << filename << "\"";- }- std::string buffer(Var_arg1, '\x00');- int read_size = 0;- if (file) {- const bool eof = file->eof();- if (!eof && !file->fail()) {- file->read(&buffer[0], Var_arg1);- read_size = file->gcount();- if (file->fail()) {- // Clear an EOF-related error, since we can't tell if it's because the- // file ended or because of a real error.- file->clear();- file->setstate(std::ios::eofbit);- }- }- }- return ReturnTuple(Box_String(buffer.substr(0, read_size)));-}-} // namespace-TypeCategory& GetCategory_RawFileReader() {- return CreateCategory_RawFileReader();-}-S<TypeInstance> GetType_RawFileReader(Params<0>::Type params) {- return CreateType_RawFileReader(params);-}-#ifdef ZEOLITE_PUBLIC_NAMESPACE-} // namespace ZEOLITE_PUBLIC_NAMESPACE-using namespace ZEOLITE_PUBLIC_NAMESPACE;-#endif // ZEOLITE_PUBLIC_NAMESPACE
− lib/file/Category_RawFileWriter.cpp
@@ -1,210 +0,0 @@--/* ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry-Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at- http://www.apache.org/licenses/LICENSE-2.0-Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.------------------------------------------------------------------------------ */--// Author: Kevin P. Barry [ta0kira@gmail.com]--#include <fstream>--#include "category-source.hpp"-#include "Category_BlockWriter.hpp"-#include "Category_Formatted.hpp"-#include "Category_Int.hpp"-#include "Category_PersistentResource.hpp"-#include "Category_RawFileWriter.hpp"-#include "Category_String.hpp"-#ifdef ZEOLITE_PUBLIC_NAMESPACE-namespace ZEOLITE_PUBLIC_NAMESPACE {-#endif // ZEOLITE_PUBLIC_NAMESPACE-namespace {-const int collection_RawFileWriter = 0;-} // namespace-const void* const Functions_RawFileWriter = &collection_RawFileWriter;-const TypeFunction& Function_RawFileWriter_open = (*new TypeFunction{ 0, 1, 1, "RawFileWriter", "open", Functions_RawFileWriter, 0 });-const ValueFunction& Function_RawFileWriter_getFileError = (*new ValueFunction{ 0, 0, 1, "RawFileWriter", "getFileError", Functions_RawFileWriter, 0 });-namespace {-class Category_RawFileWriter;-class Type_RawFileWriter;-S<Type_RawFileWriter> CreateType_RawFileWriter(Params<0>::Type params);-class Value_RawFileWriter;-S<TypeValue> CreateValue_RawFileWriter(S<Type_RawFileWriter> parent, const ParamTuple& params, const ValueTuple& args);-struct Category_RawFileWriter : public TypeCategory {- std::string CategoryName() const final { return "RawFileWriter"; }- Category_RawFileWriter() {- CycleCheck<Category_RawFileWriter>::Check();- CycleCheck<Category_RawFileWriter> marker(*this);- TRACE_FUNCTION("RawFileWriter (init @category)")- }- ReturnTuple Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Category_RawFileWriter::*)(const ParamTuple&, const ValueTuple&);- return TypeCategory::Dispatch(label, params, args);- }-};-Category_RawFileWriter& CreateCategory_RawFileWriter() {- static auto& category = *new Category_RawFileWriter();- return category;-}-struct Type_RawFileWriter : public TypeInstance {- std::string CategoryName() const final { return parent.CategoryName(); }- void BuildTypeName(std::ostream& output) const final {- return TypeInstance::TypeNameFrom(output, parent);- }- Category_RawFileWriter& parent;- bool CanConvertFrom(const S<const TypeInstance>& from) const final {- std::vector<S<const TypeInstance>> args;- if (!from->TypeArgsForParent(parent, args)) return false;- if(args.size() != 0) {- FAIL() << "Wrong number of args (" << args.size() << ") for " << CategoryName();- }- return true;- }- bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {- if (&category == &GetCategory_RawFileWriter()) {- args = std::vector<S<const TypeInstance>>{};- return true;- }- if (&category == &GetCategory_PersistentResource()) {- args = std::vector<S<const TypeInstance>>{};- return true;- }- if (&category == &GetCategory_BlockWriter()) {- args = std::vector<S<const TypeInstance>>{GetType_String(T_get())};- return true;- }- return false;- }- Type_RawFileWriter(Category_RawFileWriter& p, Params<0>::Type params) : parent(p) {- CycleCheck<Type_RawFileWriter>::Check();- CycleCheck<Type_RawFileWriter> marker(*this);- TRACE_FUNCTION("RawFileWriter (init @type)")- }- ReturnTuple Dispatch(const S<TypeInstance>& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Type_RawFileWriter::*)(const S<TypeInstance>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_RawFileWriter[] = {- &Type_RawFileWriter::Call_open,- };- if (label.collection == Functions_RawFileWriter) {- if (label.function_num < 0 || label.function_num >= sizeof Table_RawFileWriter / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_RawFileWriter[label.function_num])(self, params, args);- }- return TypeInstance::Dispatch(self, label, params, args);- }- ReturnTuple Call_open(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args);-};-S<Type_RawFileWriter> CreateType_RawFileWriter(Params<0>::Type params) {- static const auto cached = S_get(new Type_RawFileWriter(CreateCategory_RawFileWriter(), Params<0>::Type()));- return cached;-}-struct Value_RawFileWriter : public TypeValue {- Value_RawFileWriter(S<Type_RawFileWriter> p, const ParamTuple& params, const ValueTuple& args)- : parent(p), filename(args.At(0)->AsString()),- file(new std::ofstream(filename, std::ios::out | std::ios::binary | std::ios::trunc | std::ios::ate)) {}- ReturnTuple Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params,const ValueTuple& args) final {- using CallType = ReturnTuple(Value_RawFileWriter::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_BlockWriter[] = {- &Value_RawFileWriter::Call_writeBlock,- };- static const CallType Table_PersistentResource[] = {- &Value_RawFileWriter::Call_freeResource,- };- static const CallType Table_RawFileWriter[] = {- &Value_RawFileWriter::Call_getFileError,- };- if (label.collection == Functions_BlockWriter) {- if (label.function_num < 0 || label.function_num >= sizeof Table_BlockWriter / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_BlockWriter[label.function_num])(self, params, args);- }- if (label.collection == Functions_PersistentResource) {- if (label.function_num < 0 || label.function_num >= sizeof Table_PersistentResource / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_PersistentResource[label.function_num])(self, params, args);- }- if (label.collection == Functions_RawFileWriter) {- if (label.function_num < 0 || label.function_num >= sizeof Table_RawFileWriter / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_RawFileWriter[label.function_num])(self, params, args);- }- return TypeValue::Dispatch(self, label, params, args);- }- std::string CategoryName() const final { return parent->CategoryName(); }- ReturnTuple Call_freeResource(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- ReturnTuple Call_getFileError(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- ReturnTuple Call_writeBlock(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- const S<Type_RawFileWriter> parent;- std::mutex mutex;- const std::string filename;- R<std::ostream> file;- CAPTURE_CREATION-};-S<TypeValue> CreateValue_RawFileWriter(S<Type_RawFileWriter> parent, const ParamTuple& params, const ValueTuple& args) {- return S_get(new Value_RawFileWriter(parent, params, args));-}-ReturnTuple Type_RawFileWriter::Call_open(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("RawFileWriter.open")- return ReturnTuple(CreateValue_RawFileWriter(CreateType_RawFileWriter(Params<0>::Type()), ParamTuple(), args));-}-ReturnTuple Value_RawFileWriter::Call_freeResource(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("RawFileWriter.freeResource")- std::lock_guard<std::mutex> lock(mutex);- if (file) {- file = nullptr;- }- return ReturnTuple();-}-ReturnTuple Value_RawFileWriter::Call_getFileError(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("RawFileWriter.getFileError")- std::lock_guard<std::mutex> lock(mutex);- if (!file) {- return ReturnTuple(Box_String(PrimString_FromLiteral("file has already been closed")));- }- if (file->rdstate() & std::ios::badbit) {- return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be written or opened")));- }- if (file->rdstate() & std::ios::failbit) {- return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be written or opened")));- }- return ReturnTuple(Var_empty);-}-ReturnTuple Value_RawFileWriter::Call_writeBlock(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("RawFileWriter.writeBlock")- TRACE_CREATION- std::lock_guard<std::mutex> lock(mutex);- const PrimString& Var_arg1 = args.At(0)->AsString();- if (!file || file->rdstate() != std::ios::goodbit) {- FAIL() << "Error writing file \"" << filename << "\"";- }- int write_size = 0;- if (file) {- file->write(&Var_arg1[0], Var_arg1.size());- file->flush();- write_size = file->fail()? 0 : Var_arg1.size();- }- return ReturnTuple(Box_Int(write_size));-}-} // namespace-TypeCategory& GetCategory_RawFileWriter() {- return CreateCategory_RawFileWriter();-}-S<TypeInstance> GetType_RawFileWriter(Params<0>::Type params) {- return CreateType_RawFileWriter(params);-}-#ifdef ZEOLITE_PUBLIC_NAMESPACE-} // namespace ZEOLITE_PUBLIC_NAMESPACE-using namespace ZEOLITE_PUBLIC_NAMESPACE;-#endif // ZEOLITE_PUBLIC_NAMESPACE
+ lib/file/Extension_RawFileReader.cpp view
@@ -0,0 +1,128 @@+/* -----------------------------------------------------------------------------+Copyright 2020-2021 Kevin P. Barry+Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at+ http://www.apache.org/licenses/LICENSE-2.0+Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++#include <fstream>+#include <mutex>++#include "category-source.hpp"+#include "Streamlined_RawFileReader.hpp"+#include "Category_Formatted.hpp"+#include "Category_String.hpp"++#ifdef ZEOLITE_PUBLIC_NAMESPACE+namespace ZEOLITE_PUBLIC_NAMESPACE {+#endif // ZEOLITE_PUBLIC_NAMESPACE++S<TypeValue> CreateValue_RawFileReader(S<Type_RawFileReader> parent, const ParamTuple& params, const ValueTuple& args);++struct ExtCategory_RawFileReader : public Category_RawFileReader {+};++struct ExtType_RawFileReader : public Type_RawFileReader {+ inline ExtType_RawFileReader(Category_RawFileReader& p, Params<0>::Type params) : Type_RawFileReader(p, params) {}++ ReturnTuple Call_open(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("RawFileReader.open")+ return ReturnTuple(CreateValue_RawFileReader(CreateType_RawFileReader(Params<0>::Type()), ParamTuple(), args));+ }+};++struct ExtValue_RawFileReader : public Value_RawFileReader {+ inline ExtValue_RawFileReader(S<Type_RawFileReader> p, const ParamTuple& params, const ValueTuple& args)+ : Value_RawFileReader(p, params),+ filename(args.At(0)->AsString()),+ file(new std::ifstream(filename, std::ios::in | std::ios::binary)) {}++ ReturnTuple Call_freeResource(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("RawFileReader.freeResource")+ std::lock_guard<std::mutex> lock(mutex);+ if (file) {+ file = nullptr;+ }+ return ReturnTuple();+ }++ ReturnTuple Call_getFileError(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("RawFileReader.getFileError")+ std::lock_guard<std::mutex> lock(mutex);+ if (!file) {+ return ReturnTuple(Box_String(PrimString_FromLiteral("file has already been closed")));+ }+ if (file->rdstate() & std::ios::badbit) {+ return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be read or opened")));+ }+ if (file->rdstate() & std::ios::failbit) {+ return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be read or opened")));+ }+ return ReturnTuple(Var_empty);+ }++ ReturnTuple Call_pastEnd(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("RawFileReader.pastEnd")+ std::lock_guard<std::mutex> lock(mutex);+ return ReturnTuple(Box_Bool(!file || file->fail() || file->eof()));+ }++ ReturnTuple Call_readBlock(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("RawFileReader.readBlock")+ TRACE_CREATION+ std::lock_guard<std::mutex> lock(mutex);+ const PrimInt Var_arg1 = (args.At(0))->AsInt();+ if (Var_arg1 < 0) {+ FAIL() << "Read size " << Var_arg1 << " is invalid";+ }+ if (!file || file->rdstate() != std::ios::goodbit) {+ FAIL() << "Error reading file \"" << filename << "\"";+ }+ std::string buffer(Var_arg1, '\x00');+ int read_size = 0;+ if (file) {+ const bool eof = file->eof();+ if (!eof && !file->fail()) {+ file->read(&buffer[0], Var_arg1);+ read_size = file->gcount();+ if (file->fail()) {+ // Clear an EOF-related error, since we can't tell if it's because the+ // file ended or because of a real error.+ file->clear();+ file->setstate(std::ios::eofbit);+ }+ }+ }+ return ReturnTuple(Box_String(buffer.substr(0, read_size)));+ }++ std::mutex mutex;+ const std::string filename;+ R<std::istream> file;+ CAPTURE_CREATION+};++Category_RawFileReader& CreateCategory_RawFileReader() {+ static auto& category = *new ExtCategory_RawFileReader();+ return category;+}+S<Type_RawFileReader> CreateType_RawFileReader(Params<0>::Type params) {+ static const auto cached = S_get(new ExtType_RawFileReader(CreateCategory_RawFileReader(), Params<0>::Type()));+ return cached;+}+S<TypeValue> CreateValue_RawFileReader(S<Type_RawFileReader> parent, const ParamTuple& params, const ValueTuple& args) {+ return S_get(new ExtValue_RawFileReader(parent, params, args));+}++#ifdef ZEOLITE_PUBLIC_NAMESPACE+} // namespace ZEOLITE_PUBLIC_NAMESPACE+using namespace ZEOLITE_PUBLIC_NAMESPACE;+#endif // ZEOLITE_PUBLIC_NAMESPACE
+ lib/file/Extension_RawFileWriter.cpp view
@@ -0,0 +1,110 @@+/* -----------------------------------------------------------------------------+Copyright 2020-2021 Kevin P. Barry+Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at+ http://www.apache.org/licenses/LICENSE-2.0+Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++#include <fstream>+#include <mutex>++#include "category-source.hpp"+#include "Streamlined_RawFileWriter.hpp"+#include "Category_Formatted.hpp"+#include "Category_String.hpp"++#ifdef ZEOLITE_PUBLIC_NAMESPACE+namespace ZEOLITE_PUBLIC_NAMESPACE {+#endif // ZEOLITE_PUBLIC_NAMESPACE++S<TypeValue> CreateValue_RawFileWriter(S<Type_RawFileWriter> parent, const ParamTuple& params, const ValueTuple& args);++struct ExtCategory_RawFileWriter : public Category_RawFileWriter {+};++struct ExtType_RawFileWriter : public Type_RawFileWriter {+ inline ExtType_RawFileWriter(Category_RawFileWriter& p, Params<0>::Type params) : Type_RawFileWriter(p, params) {}++ ReturnTuple Call_open(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("RawFileWriter.open")+ return ReturnTuple(CreateValue_RawFileWriter(CreateType_RawFileWriter(Params<0>::Type()), ParamTuple(), args));+ }+};++struct ExtValue_RawFileWriter : public Value_RawFileWriter {+ inline ExtValue_RawFileWriter(S<Type_RawFileWriter> p, const ParamTuple& params, const ValueTuple& args)+ : Value_RawFileWriter(p, params),+ filename(args.At(0)->AsString()),+ file(new std::ofstream(filename, std::ios::out | std::ios::binary | std::ios::trunc | std::ios::ate)) {}++ ReturnTuple Call_freeResource(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("RawFileWriter.freeResource")+ std::lock_guard<std::mutex> lock(mutex);+ if (file) {+ file = nullptr;+ }+ return ReturnTuple();+ }++ ReturnTuple Call_getFileError(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("RawFileWriter.getFileError")+ std::lock_guard<std::mutex> lock(mutex);+ if (!file) {+ return ReturnTuple(Box_String(PrimString_FromLiteral("file has already been closed")));+ }+ if (file->rdstate() & std::ios::badbit) {+ return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be written or opened")));+ }+ if (file->rdstate() & std::ios::failbit) {+ return ReturnTuple(Box_String(PrimString_FromLiteral("file could not be written or opened")));+ }+ return ReturnTuple(Var_empty);+ }++ ReturnTuple Call_writeBlock(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("RawFileWriter.writeBlock")+ TRACE_CREATION+ std::lock_guard<std::mutex> lock(mutex);+ const PrimString& Var_arg1 = args.At(0)->AsString();+ if (!file || file->rdstate() != std::ios::goodbit) {+ FAIL() << "Error writing file \"" << filename << "\"";+ }+ int write_size = 0;+ if (file) {+ file->write(&Var_arg1[0], Var_arg1.size());+ file->flush();+ write_size = file->fail()? 0 : Var_arg1.size();+ }+ return ReturnTuple(Box_Int(write_size));+ }++ std::mutex mutex;+ const std::string filename;+ R<std::ostream> file;+ CAPTURE_CREATION+};++Category_RawFileWriter& CreateCategory_RawFileWriter() {+ static auto& category = *new ExtCategory_RawFileWriter();+ return category;+}+S<Type_RawFileWriter> CreateType_RawFileWriter(Params<0>::Type params) {+ static const auto cached = S_get(new ExtType_RawFileWriter(CreateCategory_RawFileWriter(), Params<0>::Type()));+ return cached;+}+S<TypeValue> CreateValue_RawFileWriter(S<Type_RawFileWriter> parent, const ParamTuple& params, const ValueTuple& args) {+ return S_get(new ExtValue_RawFileWriter(parent, params, args));+}++#ifdef ZEOLITE_PUBLIC_NAMESPACE+} // namespace ZEOLITE_PUBLIC_NAMESPACE+using namespace ZEOLITE_PUBLIC_NAMESPACE;+#endif // ZEOLITE_PUBLIC_NAMESPACE
lib/math/.zeolite-module view
@@ -5,13 +5,8 @@ ] extra_files: [ category_source {- source: "lib/math/Category_Math.cpp"- categories: [Math]- }- category_source {- source: "lib/math/Source_Math.cpp"+ source: "lib/math/Extension_Math.cpp" categories: [Math] }- "lib/math/Source_Math.hpp" ] mode: incremental {}
− lib/math/Category_Math.cpp
@@ -1,225 +0,0 @@-/* ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry--Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at-- http://www.apache.org/licenses/LICENSE-2.0--Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.------------------------------------------------------------------------------ */--// Author: Kevin P. Barry [ta0kira@gmail.com]--#include <cmath>--#include "Source_Math.hpp"-#include "Category_Float.hpp"-#include "Category_String.hpp"---#ifdef ZEOLITE_PUBLIC_NAMESPACE-namespace ZEOLITE_PUBLIC_NAMESPACE {-#endif // ZEOLITE_PUBLIC_NAMESPACE--namespace {--struct Impl_Category_Math : public Category_Math {};--struct Impl_Type_Math : public Type_Math {- Impl_Type_Math(Category_Math& p, Params<0>::Type params) : Type_Math(p, std::move(params)) {}-- ReturnTuple Call_acos(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.acos")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::acos(Var_arg1)));- }-- ReturnTuple Call_acosh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.acosh")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::acosh(Var_arg1)));- }-- ReturnTuple Call_asin(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.asin")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::asin(Var_arg1)));- }-- ReturnTuple Call_asinh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.asinh")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::asinh(Var_arg1)));- }-- ReturnTuple Call_atan(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.atan")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::atan(Var_arg1)));- }-- ReturnTuple Call_atanh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.atanh")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::atanh(Var_arg1)));- }-- ReturnTuple Call_ceil(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.ceil")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::ceil(Var_arg1)));- }-- ReturnTuple Call_cos(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.cos")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::cos(Var_arg1)));- }-- ReturnTuple Call_cosh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.cosh")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::cosh(Var_arg1)));- }-- ReturnTuple Call_exp(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.exp")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::exp(Var_arg1)));- }-- ReturnTuple Call_fabs(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.fabs")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::fabs(Var_arg1)));- }-- ReturnTuple Call_floor(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.floor")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::floor(Var_arg1)));- }-- ReturnTuple Call_fmod(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.fmod")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- const PrimFloat Var_arg2 = (args.At(1))->AsFloat();- return ReturnTuple(Box_Float(std::fmod(Var_arg1,Var_arg2)));- }-- ReturnTuple Call_isinf(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.isinf")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Bool(std::isinf(Var_arg1)));- }-- ReturnTuple Call_isnan(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.isnan")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Bool(std::isnan(Var_arg1)));- }-- ReturnTuple Call_log(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.log")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::log(Var_arg1)));- }-- ReturnTuple Call_log10(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.log10")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::log10(Var_arg1)));- }-- ReturnTuple Call_log2(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.log2")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::log2(Var_arg1)));- }-- ReturnTuple Call_pow(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.pow")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- const PrimFloat Var_arg2 = (args.At(1))->AsFloat();- return ReturnTuple(Box_Float(std::pow(Var_arg1,Var_arg2)));- }-- ReturnTuple Call_round(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.round")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::round(Var_arg1)));- }-- ReturnTuple Call_sin(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.sin")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::sin(Var_arg1)));- }-- ReturnTuple Call_sinh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.sinh")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::sinh(Var_arg1)));- }-- ReturnTuple Call_sqrt(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.sqrt")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::sqrt(Var_arg1)));- }-- ReturnTuple Call_tan(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.tan")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::tan(Var_arg1)));- }-- ReturnTuple Call_tanh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.tanh")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::tanh(Var_arg1)));- }-- ReturnTuple Call_trunc(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.trunc")- const PrimFloat Var_arg1 = (args.At(0))->AsFloat();- return ReturnTuple(Box_Float(std::trunc(Var_arg1)));- }-- ReturnTuple Call_abs(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {- TRACE_FUNCTION("Math.abs")- const PrimInt Var_arg1 = (args.At(0))->AsInt();- return ReturnTuple(Box_Int(std::abs(Var_arg1)));- }-};--struct Impl_Value_Math : public Value_Math {- Impl_Value_Math(S<Type_Math> p, const ParamTuple& params, const ValueTuple& args) : Value_Math(p) {}-};--} // namespace--Category_Math& CreateCategory_Math() {- static auto& category = *new Impl_Category_Math();- return category;-}--S<Type_Math> CreateType_Math(Params<0>::Type params) {- static const auto cached = S_get(new Impl_Type_Math(CreateCategory_Math(), Params<0>::Type()));- return cached;-}--S<TypeValue> CreateValue_Math(S<Type_Math> parent, const ParamTuple& params, const ValueTuple& args) {- return S_get(new Impl_Value_Math(parent, params, args));-}--#ifdef ZEOLITE_PUBLIC_NAMESPACE-} // namespace ZEOLITE_PUBLIC_NAMESPACE-using namespace ZEOLITE_PUBLIC_NAMESPACE;-#endif // ZEOLITE_PUBLIC_NAMESPACE
+ lib/math/Extension_Math.cpp view
@@ -0,0 +1,217 @@+/* -----------------------------------------------------------------------------+Copyright 2020-2021 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++#include <cmath>++#include "category-source.hpp"+#include "Streamlined_Math.hpp"+#include "Category_Formatted.hpp"+#include "Category_String.hpp"++#ifdef ZEOLITE_PUBLIC_NAMESPACE+namespace ZEOLITE_PUBLIC_NAMESPACE {+#endif // ZEOLITE_PUBLIC_NAMESPACE++struct ExtCategory_Math : public Category_Math {+};++struct ExtType_Math : public Type_Math {+ inline ExtType_Math(Category_Math& p, Params<0>::Type params) : Type_Math(p, params) {}++ ReturnTuple Call_acos(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.acos")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::acos(Var_arg1)));+ }++ ReturnTuple Call_acosh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.acosh")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::acosh(Var_arg1)));+ }++ ReturnTuple Call_asin(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.asin")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::asin(Var_arg1)));+ }++ ReturnTuple Call_asinh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.asinh")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::asinh(Var_arg1)));+ }++ ReturnTuple Call_atan(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.atan")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::atan(Var_arg1)));+ }++ ReturnTuple Call_atanh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.atanh")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::atanh(Var_arg1)));+ }++ ReturnTuple Call_ceil(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.ceil")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::ceil(Var_arg1)));+ }++ ReturnTuple Call_cos(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.cos")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::cos(Var_arg1)));+ }++ ReturnTuple Call_cosh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.cosh")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::cosh(Var_arg1)));+ }++ ReturnTuple Call_exp(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.exp")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::exp(Var_arg1)));+ }++ ReturnTuple Call_fabs(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.fabs")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::fabs(Var_arg1)));+ }++ ReturnTuple Call_floor(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.floor")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::floor(Var_arg1)));+ }++ ReturnTuple Call_fmod(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.fmod")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ const PrimFloat Var_arg2 = (args.At(1))->AsFloat();+ return ReturnTuple(Box_Float(std::fmod(Var_arg1,Var_arg2)));+ }++ ReturnTuple Call_isinf(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.isinf")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Bool(std::isinf(Var_arg1)));+ }++ ReturnTuple Call_isnan(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.isnan")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Bool(std::isnan(Var_arg1)));+ }++ ReturnTuple Call_log(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.log")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::log(Var_arg1)));+ }++ ReturnTuple Call_log10(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.log10")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::log10(Var_arg1)));+ }++ ReturnTuple Call_log2(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.log2")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::log2(Var_arg1)));+ }++ ReturnTuple Call_pow(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.pow")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ const PrimFloat Var_arg2 = (args.At(1))->AsFloat();+ return ReturnTuple(Box_Float(std::pow(Var_arg1,Var_arg2)));+ }++ ReturnTuple Call_round(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.round")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::round(Var_arg1)));+ }++ ReturnTuple Call_sin(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.sin")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::sin(Var_arg1)));+ }++ ReturnTuple Call_sinh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.sinh")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::sinh(Var_arg1)));+ }++ ReturnTuple Call_sqrt(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.sqrt")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::sqrt(Var_arg1)));+ }++ ReturnTuple Call_tan(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.tan")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::tan(Var_arg1)));+ }++ ReturnTuple Call_tanh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.tanh")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::tanh(Var_arg1)));+ }++ ReturnTuple Call_trunc(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.trunc")+ const PrimFloat Var_arg1 = (args.At(0))->AsFloat();+ return ReturnTuple(Box_Float(std::trunc(Var_arg1)));+ }++ ReturnTuple Call_abs(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) final {+ TRACE_FUNCTION("Math.abs")+ const PrimInt Var_arg1 = (args.At(0))->AsInt();+ return ReturnTuple(Box_Int(std::abs(Var_arg1)));+ }+};++struct ExtValue_Math : public Value_Math {+ inline ExtValue_Math(S<Type_Math> p, const ParamTuple& params, const ValueTuple& args) : Value_Math(p, params) {}+};++Category_Math& CreateCategory_Math() {+ static auto& category = *new ExtCategory_Math();+ return category;+}+S<Type_Math> CreateType_Math(Params<0>::Type params) {+ static const auto cached = S_get(new ExtType_Math(CreateCategory_Math(), Params<0>::Type()));+ return cached;+}++#ifdef ZEOLITE_PUBLIC_NAMESPACE+} // namespace ZEOLITE_PUBLIC_NAMESPACE+using namespace ZEOLITE_PUBLIC_NAMESPACE;+#endif // ZEOLITE_PUBLIC_NAMESPACE
− lib/math/Source_Math.cpp
@@ -1,162 +0,0 @@-/* ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry--Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at-- http://www.apache.org/licenses/LICENSE-2.0--Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.------------------------------------------------------------------------------ */--// Author: Kevin P. Barry [ta0kira@gmail.com]--#include <cmath>--#include "Source_Math.hpp"---#ifdef ZEOLITE_DYNAMIC_NAMESPACE-namespace ZEOLITE_DYNAMIC_NAMESPACE {-#endif // ZEOLITE_DYNAMIC_NAMESPACE--namespace {-const int collection_Math = 0;-} // namespace-const void* const Functions_Math = &collection_Math;-const TypeFunction& Function_Math_acos = (*new TypeFunction{ 0, 1, 1, "Math", "acos", Functions_Math, 0 });-const TypeFunction& Function_Math_acosh = (*new TypeFunction{ 0, 1, 1, "Math", "acosh", Functions_Math, 1 });-const TypeFunction& Function_Math_asin = (*new TypeFunction{ 0, 1, 1, "Math", "asin", Functions_Math, 2 });-const TypeFunction& Function_Math_asinh = (*new TypeFunction{ 0, 1, 1, "Math", "asinh", Functions_Math, 3 });-const TypeFunction& Function_Math_atan = (*new TypeFunction{ 0, 1, 1, "Math", "atan", Functions_Math, 4 });-const TypeFunction& Function_Math_atanh = (*new TypeFunction{ 0, 1, 1, "Math", "atanh", Functions_Math, 5 });-const TypeFunction& Function_Math_ceil = (*new TypeFunction{ 0, 1, 1, "Math", "ceil", Functions_Math, 6 });-const TypeFunction& Function_Math_cos = (*new TypeFunction{ 0, 1, 1, "Math", "cos", Functions_Math, 7 });-const TypeFunction& Function_Math_cosh = (*new TypeFunction{ 0, 1, 1, "Math", "cosh", Functions_Math, 8 });-const TypeFunction& Function_Math_exp = (*new TypeFunction{ 0, 1, 1, "Math", "exp", Functions_Math, 9 });-const TypeFunction& Function_Math_fabs = (*new TypeFunction{ 0, 1, 1, "Math", "fabs", Functions_Math, 10 });-const TypeFunction& Function_Math_floor = (*new TypeFunction{ 0, 1, 1, "Math", "floor", Functions_Math, 11 });-const TypeFunction& Function_Math_fmod = (*new TypeFunction{ 0, 2, 1, "Math", "fmod", Functions_Math, 12 });-const TypeFunction& Function_Math_isinf = (*new TypeFunction{ 0, 1, 1, "Math", "isinf", Functions_Math, 13 });-const TypeFunction& Function_Math_isnan = (*new TypeFunction{ 0, 1, 1, "Math", "isnan", Functions_Math, 14 });-const TypeFunction& Function_Math_log = (*new TypeFunction{ 0, 1, 1, "Math", "log", Functions_Math, 15 });-const TypeFunction& Function_Math_log10 = (*new TypeFunction{ 0, 1, 1, "Math", "log10", Functions_Math, 16 });-const TypeFunction& Function_Math_log2 = (*new TypeFunction{ 0, 1, 1, "Math", "log2", Functions_Math, 17 });-const TypeFunction& Function_Math_pow = (*new TypeFunction{ 0, 2, 1, "Math", "pow", Functions_Math, 18 });-const TypeFunction& Function_Math_round = (*new TypeFunction{ 0, 1, 1, "Math", "round", Functions_Math, 19 });-const TypeFunction& Function_Math_sin = (*new TypeFunction{ 0, 1, 1, "Math", "sin", Functions_Math, 20 });-const TypeFunction& Function_Math_sinh = (*new TypeFunction{ 0, 1, 1, "Math", "sinh", Functions_Math, 21 });-const TypeFunction& Function_Math_sqrt = (*new TypeFunction{ 0, 1, 1, "Math", "sqrt", Functions_Math, 22 });-const TypeFunction& Function_Math_tan = (*new TypeFunction{ 0, 1, 1, "Math", "tan", Functions_Math, 23 });-const TypeFunction& Function_Math_tanh = (*new TypeFunction{ 0, 1, 1, "Math", "tanh", Functions_Math, 24 });-const TypeFunction& Function_Math_trunc = (*new TypeFunction{ 0, 1, 1, "Math", "trunc", Functions_Math, 25 });-const TypeFunction& Function_Math_abs = (*new TypeFunction{ 0, 1, 1, "Math", "abs", Functions_Math, 26 });--std::string Category_Math::CategoryName() const { return "Math"; }--Category_Math::Category_Math() {- CycleCheck<Category_Math>::Check();- CycleCheck<Category_Math> marker(*this);- TRACE_FUNCTION("Math (init @category)")-}--ReturnTuple Category_Math::Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) {- using CallType = ReturnTuple(Category_Math::*)(const ParamTuple&, const ValueTuple&);- return TypeCategory::Dispatch(label, params, args);-}--Type_Math::Type_Math(Category_Math& p, Params<0>::Type params) : parent(p) {- CycleCheck<Type_Math>::Check();- CycleCheck<Type_Math> marker(*this);- TRACE_FUNCTION("Math (init @type)")-}--std::string Type_Math::CategoryName() const { return parent.CategoryName(); }--void Type_Math::BuildTypeName(std::ostream& output) const {- return TypeInstance::TypeNameFrom(output, parent);-}--bool Type_Math::CanConvertFrom(const S<const TypeInstance>& from) const {- std::vector<S<const TypeInstance>> args;- if (!from->TypeArgsForParent(parent, args)) return false;- if(args.size() != 0) {- FAIL() << "Wrong number of args (" << args.size() << ") for " << CategoryName();- }- return true;-}--bool Type_Math::TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const {- if (&category == &GetCategory_Math()) {- args = std::vector<S<const TypeInstance>>{};- return true;- }- return false;-}--ReturnTuple Type_Math::Dispatch(const S<TypeInstance>& self, const TypeFunction& label,- const ParamTuple& params, const ValueTuple& args) {- using CallType = ReturnTuple(Type_Math::*)(const S<TypeInstance>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_Math[] = {- &Type_Math::Call_acos,- &Type_Math::Call_acosh,- &Type_Math::Call_asin,- &Type_Math::Call_asinh,- &Type_Math::Call_atan,- &Type_Math::Call_atanh,- &Type_Math::Call_ceil,- &Type_Math::Call_cos,- &Type_Math::Call_cosh,- &Type_Math::Call_exp,- &Type_Math::Call_fabs,- &Type_Math::Call_floor,- &Type_Math::Call_fmod,- &Type_Math::Call_isinf,- &Type_Math::Call_isnan,- &Type_Math::Call_log,- &Type_Math::Call_log10,- &Type_Math::Call_log2,- &Type_Math::Call_pow,- &Type_Math::Call_round,- &Type_Math::Call_sin,- &Type_Math::Call_sinh,- &Type_Math::Call_sqrt,- &Type_Math::Call_tan,- &Type_Math::Call_tanh,- &Type_Math::Call_trunc,- &Type_Math::Call_abs,- };- if (label.collection == Functions_Math) {- if (label.function_num < 0 || label.function_num >= sizeof Table_Math / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_Math[label.function_num])(self, params, args);- }- return TypeInstance::Dispatch(self, label, params, args);-}--Value_Math::Value_Math(S<Type_Math> p) : parent(p) {}--ReturnTuple Value_Math::Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params,const ValueTuple& args) {- using CallType = ReturnTuple(Value_Math::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);- return TypeValue::Dispatch(self, label, params, args);-}--std::string Value_Math::CategoryName() const { return parent->CategoryName(); }--TypeCategory& GetCategory_Math() {- return CreateCategory_Math();-}-S<TypeInstance> GetType_Math(Params<0>::Type params) {- return CreateType_Math(params);-}--#ifdef ZEOLITE_DYNAMIC_NAMESPACE-} // namespace ZEOLITE_DYNAMIC_NAMESPACE-using namespace ZEOLITE_DYNAMIC_NAMESPACE;-#endif // ZEOLITE_DYNAMIC_NAMESPACE
− lib/math/Source_Math.hpp
@@ -1,112 +0,0 @@-/* ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry--Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at-- http://www.apache.org/licenses/LICENSE-2.0--Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.------------------------------------------------------------------------------ */--// Author: Kevin P. Barry [ta0kira@gmail.com]--#ifndef HEADER_Source_Math-#define HEADER_Source_Math--#include <cmath>--#include "category-source.hpp"-#include "Category_Math.hpp"---#ifdef ZEOLITE_DYNAMIC_NAMESPACE-namespace ZEOLITE_DYNAMIC_NAMESPACE {-#endif // ZEOLITE_DYNAMIC_NAMESPACE--class Category_Math : public TypeCategory {- public:- std::string CategoryName() const final;-- ReturnTuple Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) final;-- protected:- Category_Math();-};--class Type_Math : public TypeInstance {- public:- std::string CategoryName() const final;-- void BuildTypeName(std::ostream& output) const final;-- bool CanConvertFrom(const S<const TypeInstance>& from) const final;-- bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final;-- ReturnTuple Dispatch(const S<TypeInstance>& self, const TypeFunction& label,- const ParamTuple& params, const ValueTuple& args) final;-- protected:- Type_Math(Category_Math& p, Params<0>::Type params);-- virtual ReturnTuple Call_acos(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_acosh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_asin(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_asinh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_atan(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_atanh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_ceil(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_cos(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_cosh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_exp(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_fabs(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_floor(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_fmod(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_isinf(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_isnan(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_log(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_log10(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_log2(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_pow(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_round(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_sin(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_sinh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_sqrt(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_tan(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_tanh(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_trunc(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;- virtual ReturnTuple Call_abs(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) = 0;-- Category_Math& parent;-};--class Value_Math : public TypeValue {- public:- ReturnTuple Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params,const ValueTuple& args) final;-- std::string CategoryName() const final;-- protected:- Value_Math(S<Type_Math> p);-- S<Type_Math> parent;-};--Category_Math& CreateCategory_Math();--S<Type_Math> CreateType_Math(Params<0>::Type params);--S<TypeValue> CreateValue_Math(Type_Math& parent, const ParamTuple& params, const ValueTuple& args);--#ifdef ZEOLITE_DYNAMIC_NAMESPACE-} // namespace ZEOLITE_DYNAMIC_NAMESPACE-using namespace ZEOLITE_DYNAMIC_NAMESPACE;-#endif // ZEOLITE_DYNAMIC_NAMESPACE--#endif // HEADER_Source_Math
lib/util/.zeolite-module view
@@ -11,15 +11,15 @@ ] extra_files: [ category_source {- source: "util/Category_Argv.cpp"+ source: "util/Extension_Argv.cpp" categories: [Argv] } category_source {- source: "util/Category_SimpleInput.cpp"+ source: "util/Extension_SimpleInput.cpp" categories: [SimpleInput] } category_source {- source: "util/Category_SimpleOutput.cpp"+ source: "util/Extension_SimpleOutput.cpp" categories: [SimpleOutput] } ]
− lib/util/Category_Argv.cpp
@@ -1,163 +0,0 @@-/* ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry-Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at- http://www.apache.org/licenses/LICENSE-2.0-Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.------------------------------------------------------------------------------ */--// Author: Kevin P. Barry [ta0kira@gmail.com]--#include "category-source.hpp"-#include "Category_Argv.hpp"-#include "Category_Formatted.hpp"-#include "Category_Int.hpp"-#include "Category_ReadPosition.hpp"-#include "Category_String.hpp"-#ifdef ZEOLITE_PUBLIC_NAMESPACE-namespace ZEOLITE_PUBLIC_NAMESPACE {-#endif // ZEOLITE_PUBLIC_NAMESPACE-namespace {-extern const S<TypeValue>& Var_global;-const int collection_Argv = 0;-} // namespace-const void* const Functions_Argv = &collection_Argv;-const TypeFunction& Function_Argv_global = (*new TypeFunction{ 0, 0, 1, "Argv", "global", Functions_Argv, 0 });-namespace {-class Category_Argv;-class Type_Argv;-S<Type_Argv> CreateType_Argv(Params<0>::Type params);-class Value_Argv;-S<TypeValue> CreateValue_Argv(S<Type_Argv> parent, const ParamTuple& params, const ValueTuple& args);-struct Category_Argv : public TypeCategory {- std::string CategoryName() const final { return "Argv"; }- Category_Argv() {- CycleCheck<Category_Argv>::Check();- CycleCheck<Category_Argv> marker(*this);- TRACE_FUNCTION("Argv (init @category)")- }- ReturnTuple Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Category_Argv::*)(const ParamTuple&, const ValueTuple&);- return TypeCategory::Dispatch(label, params, args);- }-};-Category_Argv& CreateCategory_Argv() {- static auto& category = *new Category_Argv();- return category;-}-struct Type_Argv : public TypeInstance {- std::string CategoryName() const final { return parent.CategoryName(); }- void BuildTypeName(std::ostream& output) const final {- return TypeInstance::TypeNameFrom(output, parent);- }- Category_Argv& parent;- bool CanConvertFrom(const S<const TypeInstance>& from) const final {- std::vector<S<const TypeInstance>> args;- if (!from->TypeArgsForParent(parent, args)) return false;- if(args.size() != 0) {- FAIL() << "Wrong number of args (" << args.size() << ") for " << CategoryName();- }- return true;- }- bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {- if (&category == &GetCategory_Argv()) {- args = std::vector<S<const TypeInstance>>{};- return true;- }- if (&category == &GetCategory_ReadPosition()) {- args = std::vector<S<const TypeInstance>>{GetType_String(T_get())};- return true;- }- return false;- }- Type_Argv(Category_Argv& p, Params<0>::Type params) : parent(p) {- CycleCheck<Type_Argv>::Check();- CycleCheck<Type_Argv> marker(*this);- TRACE_FUNCTION("Argv (init @type)")- }- ReturnTuple Dispatch(const S<TypeInstance>& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Type_Argv::*)(const S<TypeInstance>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_Argv[] = {- &Type_Argv::Call_global,- };- if (label.collection == Functions_Argv) {- if (label.function_num < 0 || label.function_num >= sizeof Table_Argv / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_Argv[label.function_num])(self, params, args);- }- return TypeInstance::Dispatch(self, label, params, args);- }- ReturnTuple Call_global(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args);-};-S<Type_Argv> CreateType_Argv(Params<0>::Type params) {- static const auto cached = S_get(new Type_Argv(CreateCategory_Argv(), Params<0>::Type()));- return cached;-}-struct Value_Argv : public TypeValue {- Value_Argv(int start, int size) : start_(start), size_(size) {}- ReturnTuple Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params,const ValueTuple& args) final {- using CallType = ReturnTuple(Value_Argv::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_ReadPosition[] = {- &Value_Argv::Call_readPosition,- &Value_Argv::Call_readSize,- &Value_Argv::Call_subSequence,- };- if (label.collection == Functions_ReadPosition) {- if (label.function_num < 0 || label.function_num >= sizeof Table_ReadPosition / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_ReadPosition[label.function_num])(self, params, args);- }- return TypeValue::Dispatch(self, label, params, args);- }- std::string CategoryName() const final { return "Argv"; }- inline int GetSize() const { return size_ < 0 ? Argv::ArgCount() : size_; }- ReturnTuple Call_readPosition(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- ReturnTuple Call_readSize(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- ReturnTuple Call_subSequence(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- const int start_;- const int size_;-};-ReturnTuple Type_Argv::Call_global(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("Argv.global")- return ReturnTuple(Var_global);-}-ReturnTuple Value_Argv::Call_readPosition(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("Argv.readPosition")- const PrimInt Var_arg1 = (args.At(0))->AsInt();- return ReturnTuple(Box_String(Argv::GetArgAt(start_ + Var_arg1)));-}-ReturnTuple Value_Argv::Call_readSize(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("Argv.readSize")- return ReturnTuple(Box_Int(GetSize()));-}-ReturnTuple Value_Argv::Call_subSequence(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("Argv.subSequence")- const PrimInt Var_arg1 = (args.At(0))->AsInt();- const PrimInt Var_arg2 = (args.At(1))->AsInt();- if (Var_arg1 < 0 || (Var_arg1 > 0 && Var_arg1 >= GetSize())) {- FAIL() << "Subsequence index " << Var_arg1 << " is out of bounds";- }- if (Var_arg2 < 0 || Var_arg1 + Var_arg2 > GetSize()) {- FAIL() << "Subsequence size " << Var_arg2 << " is invalid";- }- return ReturnTuple(S<TypeValue>(new Value_Argv(start_ + Var_arg1, Var_arg2)));-}-const S<TypeValue>& Var_global = *new S<TypeValue>(new Value_Argv(0, -1));-} // namespace-TypeCategory& GetCategory_Argv() {- return CreateCategory_Argv();-}-S<TypeInstance> GetType_Argv(Params<0>::Type params) {- return CreateType_Argv(params);-}-#ifdef ZEOLITE_PUBLIC_NAMESPACE-} // namespace ZEOLITE_PUBLIC_NAMESPACE-using namespace ZEOLITE_PUBLIC_NAMESPACE;-#endif // ZEOLITE_PUBLIC_NAMESPACE
− lib/util/Category_SimpleInput.cpp
@@ -1,168 +0,0 @@-/* ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry-Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at- http://www.apache.org/licenses/LICENSE-2.0-Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.------------------------------------------------------------------------------ */--// Author: Kevin P. Barry [ta0kira@gmail.com]--// TODO: Maybe use C++ instead.-#include <unistd.h>--#include "category-source.hpp"-#include "Category_BlockReader.hpp"-#include "Category_Bool.hpp"-#include "Category_Formatted.hpp"-#include "Category_Int.hpp"-#include "Category_SimpleInput.hpp"-#include "Category_String.hpp"-#ifdef ZEOLITE_PUBLIC_NAMESPACE-namespace ZEOLITE_PUBLIC_NAMESPACE {-#endif // ZEOLITE_PUBLIC_NAMESPACE-namespace {-extern const S<TypeValue>& Var_stdin;-const int collection_SimpleInput = 0;-} // namespace-const void* const Functions_SimpleInput = &collection_SimpleInput;-const TypeFunction& Function_SimpleInput_stdin = (*new TypeFunction{ 0, 0, 1, "SimpleInput", "stdin", Functions_SimpleInput, 0 });-namespace {-class Category_SimpleInput;-class Type_SimpleInput;-S<Type_SimpleInput> CreateType_SimpleInput(Params<0>::Type params);-class Value_SimpleInput;-S<TypeValue> CreateValue_SimpleInput(S<Type_SimpleInput> parent, const ParamTuple& params, const ValueTuple& args);-struct Category_SimpleInput : public TypeCategory {- std::string CategoryName() const final { return "SimpleInput"; }- Category_SimpleInput() {- CycleCheck<Category_SimpleInput>::Check();- CycleCheck<Category_SimpleInput> marker(*this);- TRACE_FUNCTION("SimpleInput (init @category)")- }- ReturnTuple Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Category_SimpleInput::*)(const ParamTuple&, const ValueTuple&);- return TypeCategory::Dispatch(label, params, args);- }-};-Category_SimpleInput& CreateCategory_SimpleInput() {- static auto& category = *new Category_SimpleInput();- return category;-}-struct Type_SimpleInput : public TypeInstance {- std::string CategoryName() const final { return parent.CategoryName(); }- void BuildTypeName(std::ostream& output) const final {- return TypeInstance::TypeNameFrom(output, parent);- }- Category_SimpleInput& parent;- bool CanConvertFrom(const S<const TypeInstance>& from) const final {- std::vector<S<const TypeInstance>> args;- if (!from->TypeArgsForParent(parent, args)) return false;- if(args.size() != 0) {- FAIL() << "Wrong number of args (" << args.size() << ") for " << CategoryName();- }- return true;- }- bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {- if (&category == &GetCategory_SimpleInput()) {- args = std::vector<S<const TypeInstance>>{};- return true;- }- if (&category == &GetCategory_BlockReader()) {- args = std::vector<S<const TypeInstance>>{GetType_String(T_get())};- return true;- }- return false;- }- Type_SimpleInput(Category_SimpleInput& p, Params<0>::Type params) : parent(p) {- CycleCheck<Type_SimpleInput>::Check();- CycleCheck<Type_SimpleInput> marker(*this);- TRACE_FUNCTION("SimpleInput (init @type)")- }- ReturnTuple Dispatch(const S<TypeInstance>& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Type_SimpleInput::*)(const S<TypeInstance>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_SimpleInput[] = {- &Type_SimpleInput::Call_stdin,- };- if (label.collection == Functions_SimpleInput) {- if (label.function_num < 0 || label.function_num >= sizeof Table_SimpleInput / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_SimpleInput[label.function_num])(self, params, args);- }- return TypeInstance::Dispatch(self, label, params, args);- }- ReturnTuple Call_stdin(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args);-};-S<Type_SimpleInput> CreateType_SimpleInput(Params<0>::Type params) {- static const auto cached = S_get(new Type_SimpleInput(CreateCategory_SimpleInput(), Params<0>::Type()));- return cached;-}-struct Value_SimpleInput : public TypeValue {- Value_SimpleInput(S<Type_SimpleInput> p, const ParamTuple& params, const ValueTuple& args) : parent(p) {}- ReturnTuple Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params,const ValueTuple& args) final {- using CallType = ReturnTuple(Value_SimpleInput::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_BlockReader[] = {- &Value_SimpleInput::Call_pastEnd,- &Value_SimpleInput::Call_readBlock,- };- if (label.collection == Functions_BlockReader) {- if (label.function_num < 0 || label.function_num >= sizeof Table_BlockReader / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_BlockReader[label.function_num])(self, params, args);- }- return TypeValue::Dispatch(self, label, params, args);- }- std::string CategoryName() const final { return parent->CategoryName(); }- ReturnTuple Call_pastEnd(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- ReturnTuple Call_readBlock(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- bool zero_read = false;- std::mutex mutex;- const S<Type_SimpleInput> parent;-};-S<TypeValue> CreateValue_SimpleInput(S<Type_SimpleInput> parent, const ParamTuple& params, const ValueTuple& args) {- return S_get(new Value_SimpleInput(parent, params, args));-}-ReturnTuple Type_SimpleInput::Call_stdin(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("SimpleInput.stdin")- return ReturnTuple(Var_stdin);-}-ReturnTuple Value_SimpleInput::Call_pastEnd(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("SimpleInput.pastEnd")- std::lock_guard<std::mutex> lock(mutex);- return ReturnTuple(Box_Bool(zero_read));-}-ReturnTuple Value_SimpleInput::Call_readBlock(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("SimpleInput.readBlock")- std::lock_guard<std::mutex> lock(mutex);- const int size = args.At(0)->AsInt();- if (size < 0) {- FAIL() << "Read size " << size << " is invalid";- }- std::string buffer(size, '\x00');- const int read_size = read(STDIN_FILENO, &buffer[0], size);- if (read_size < 0) {- return ReturnTuple(Box_String(""));- } else {- zero_read = read_size == 0;- return ReturnTuple(Box_String(buffer.substr(0, read_size)));- }-}-const S<TypeValue>& Var_stdin = *new S<TypeValue>(CreateValue_SimpleInput(CreateType_SimpleInput(Params<0>::Type()), ParamTuple(), ArgTuple()));-} // namespace-TypeCategory& GetCategory_SimpleInput() {- return CreateCategory_SimpleInput();-}-S<TypeInstance> GetType_SimpleInput(Params<0>::Type params) {- return CreateType_SimpleInput(params);-}-#ifdef ZEOLITE_PUBLIC_NAMESPACE-} // namespace ZEOLITE_PUBLIC_NAMESPACE-using namespace ZEOLITE_PUBLIC_NAMESPACE;-#endif // ZEOLITE_PUBLIC_NAMESPACE
− lib/util/Category_SimpleOutput.cpp
@@ -1,220 +0,0 @@-/* ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry-Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at- http://www.apache.org/licenses/LICENSE-2.0-Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.------------------------------------------------------------------------------ */--// Author: Kevin P. Barry [ta0kira@gmail.com]--#include <iostream>-#include <sstream>--#include "category-source.hpp"-#include "Category_BufferedWriter.hpp"-#include "Category_Formatted.hpp"-#include "Category_SimpleOutput.hpp"-#include "Category_String.hpp"-#include "Category_Writer.hpp"-#ifdef ZEOLITE_PUBLIC_NAMESPACE-namespace ZEOLITE_PUBLIC_NAMESPACE {-#endif // ZEOLITE_PUBLIC_NAMESPACE-namespace {-extern const S<TypeValue>& Var_stdout;-extern const S<TypeValue>& Var_stderr;-extern const S<TypeValue>& Var_error;-const int collection_SimpleOutput = 0;-} // namespace-const void* const Functions_SimpleOutput = &collection_SimpleOutput;-const TypeFunction& Function_SimpleOutput_error = (*new TypeFunction{ 0, 0, 1, "SimpleOutput", "error", Functions_SimpleOutput, 0 });-const TypeFunction& Function_SimpleOutput_stderr = (*new TypeFunction{ 0, 0, 1, "SimpleOutput", "stderr", Functions_SimpleOutput, 1 });-const TypeFunction& Function_SimpleOutput_stdout = (*new TypeFunction{ 0, 0, 1, "SimpleOutput", "stdout", Functions_SimpleOutput, 2 });-namespace {-class Category_SimpleOutput;-class Type_SimpleOutput;-S<Type_SimpleOutput> CreateType_SimpleOutput(Params<0>::Type params);-class Value_SimpleOutput;-class Writer;-S<TypeValue> CreateValue_SimpleOutput(S<Writer> writer);-struct Category_SimpleOutput : public TypeCategory {- std::string CategoryName() const final { return "SimpleOutput"; }- Category_SimpleOutput() {- CycleCheck<Category_SimpleOutput>::Check();- CycleCheck<Category_SimpleOutput> marker(*this);- TRACE_FUNCTION("SimpleOutput (init @category)")- }- ReturnTuple Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Category_SimpleOutput::*)(const ParamTuple&, const ValueTuple&);- return TypeCategory::Dispatch(label, params, args);- }-};-Category_SimpleOutput& CreateCategory_SimpleOutput() {- static auto& category = *new Category_SimpleOutput();- return category;-}-struct Type_SimpleOutput : public TypeInstance {- std::string CategoryName() const final { return parent.CategoryName(); }- void BuildTypeName(std::ostream& output) const final {- return TypeInstance::TypeNameFrom(output, parent);- }- Category_SimpleOutput& parent;- bool CanConvertFrom(const S<const TypeInstance>& from) const final {- std::vector<S<const TypeInstance>> args;- if (!from->TypeArgsForParent(parent, args)) return false;- if(args.size() != 0) {- FAIL() << "Wrong number of args (" << args.size() << ") for " << CategoryName();- }- return true;- }- bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {- if (&category == &GetCategory_SimpleOutput()) {- args = std::vector<S<const TypeInstance>>{};- return true;- }- if (&category == &GetCategory_BufferedWriter()) {- args = std::vector<S<const TypeInstance>>{GetType_Formatted(T_get())};- return true;- }- if (&category == &GetCategory_Writer()) {- args = std::vector<S<const TypeInstance>>{GetType_Formatted(T_get())};- return true;- }- return false;- }- Type_SimpleOutput(Category_SimpleOutput& p, Params<0>::Type params) : parent(p) {- CycleCheck<Type_SimpleOutput>::Check();- CycleCheck<Type_SimpleOutput> marker(*this);- TRACE_FUNCTION("SimpleOutput (init @type)")- }- ReturnTuple Dispatch(const S<TypeInstance>& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Type_SimpleOutput::*)(const S<TypeInstance>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_SimpleOutput[] = {- &Type_SimpleOutput::Call_error,- &Type_SimpleOutput::Call_stderr,- &Type_SimpleOutput::Call_stdout,- };- if (label.collection == Functions_SimpleOutput) {- if (label.function_num < 0 || label.function_num >= sizeof Table_SimpleOutput / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_SimpleOutput[label.function_num])(self, params, args);- }- return TypeInstance::Dispatch(self, label, params, args);- }- ReturnTuple Call_error(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args);- ReturnTuple Call_stderr(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args);- ReturnTuple Call_stdout(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args);-};-S<Type_SimpleOutput> CreateType_SimpleOutput(Params<0>::Type params) {- static const auto cached = S_get(new Type_SimpleOutput(CreateCategory_SimpleOutput(), Params<0>::Type()));- return cached;-}-struct Writer {- virtual void Write(const PrimString& message) = 0;- virtual void Flush() = 0;- virtual ~Writer() {}-};-struct Value_SimpleOutput : public TypeValue {- Value_SimpleOutput(S<Writer> w) : writer_(w) {}- ReturnTuple Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params,const ValueTuple& args) final {- using CallType = ReturnTuple(Value_SimpleOutput::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_BufferedWriter[] = {- &Value_SimpleOutput::Call_flush,- };- static const CallType Table_Writer[] = {- &Value_SimpleOutput::Call_write,- };- if (label.collection == Functions_BufferedWriter) {- if (label.function_num < 0 || label.function_num >= sizeof Table_BufferedWriter / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_BufferedWriter[label.function_num])(self, params, args);- }- if (label.collection == Functions_Writer) {- if (label.function_num < 0 || label.function_num >= sizeof Table_Writer / sizeof(CallType)) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_Writer[label.function_num])(self, params, args);- }- return TypeValue::Dispatch(self, label, params, args);- }- std::string CategoryName() const final { return "SimpleOutput"; }- ReturnTuple Call_flush(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- ReturnTuple Call_write(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- std::mutex mutex_;- const S<Writer> writer_;-};-S<TypeValue> CreateValue_SimpleOutput(S<Writer> writer) {- return S_get(new Value_SimpleOutput(writer));-}-ReturnTuple Type_SimpleOutput::Call_error(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("SimpleOutput.error")- return ReturnTuple(Var_error);-}-ReturnTuple Type_SimpleOutput::Call_stderr(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("SimpleOutput.stderr")- return ReturnTuple(Var_stderr);-}-ReturnTuple Type_SimpleOutput::Call_stdout(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("SimpleOutput.stdout")- return ReturnTuple(Var_stdout);-}-ReturnTuple Value_SimpleOutput::Call_flush(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("SimpleOutput.flush");- std::lock_guard<std::mutex> lock(mutex_);- writer_->Flush();- return ReturnTuple();-}-ReturnTuple Value_SimpleOutput::Call_write(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("SimpleOutput.write")- const S<TypeValue>& Var_arg1 = (args.At(0));- std::lock_guard<std::mutex> lock(mutex_);- writer_->Write(TypeValue::Call(args.At(0), Function_Formatted_formatted,- ParamTuple(), ArgTuple()).Only()->AsString());- return ReturnTuple();-}-class StreamWriter : public Writer {- public:- StreamWriter(std::ostream& output) : output_(output) {}-- void Write(const PrimString& message) final {- output_ << message;- }-- void Flush() final {}-- private:- std::ostream& output_;-};-class ErrorWriter : public Writer {- public:- void Write(const PrimString& message) final {- output_ << message;- }-- void Flush() final {- FAIL() << output_.str();- }-- std::ostringstream output_;-};-const S<TypeValue>& Var_stdout = CreateValue_SimpleOutput(S_get(new StreamWriter(std::cout)));-const S<TypeValue>& Var_stderr = CreateValue_SimpleOutput(S_get(new StreamWriter(std::cerr)));-const S<TypeValue>& Var_error = CreateValue_SimpleOutput(S_get(new ErrorWriter()));-} // namespace-TypeCategory& GetCategory_SimpleOutput() {- return CreateCategory_SimpleOutput();-}-S<TypeInstance> GetType_SimpleOutput(Params<0>::Type params) {- return CreateType_SimpleOutput(params);-}-#ifdef ZEOLITE_PUBLIC_NAMESPACE-} // namespace ZEOLITE_PUBLIC_NAMESPACE-using namespace ZEOLITE_PUBLIC_NAMESPACE;-#endif // ZEOLITE_PUBLIC_NAMESPACE
+ lib/util/Extension_Argv.cpp view
@@ -0,0 +1,96 @@+/* -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry+Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at+ http://www.apache.org/licenses/LICENSE-2.0+Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++#include "category-source.hpp"+#include "Streamlined_Argv.hpp"+#include "Category_Formatted.hpp"+#include "Category_String.hpp"++#ifdef ZEOLITE_PUBLIC_NAMESPACE+namespace ZEOLITE_PUBLIC_NAMESPACE {+#endif // ZEOLITE_PUBLIC_NAMESPACE++S<TypeValue> CreateValue_Argv(S<Type_Argv> parent, const ParamTuple& params, int st, int sz);++namespace {+extern const S<TypeValue>& Var_global;+} // namespace++struct ExtCategory_Argv : public Category_Argv {+};++struct ExtType_Argv : public Type_Argv {+ inline ExtType_Argv(Category_Argv& p, Params<0>::Type params) : Type_Argv(p, params) {}++ ReturnTuple Call_global(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("Argv.global")+ return ReturnTuple(Var_global);+ }+};++struct ExtValue_Argv : public Value_Argv {+ inline ExtValue_Argv(S<Type_Argv> p, const ParamTuple& params, int st, int sz)+ : Value_Argv(p, params), start(st), size(sz) {}++ ReturnTuple Call_readPosition(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("Argv.readPosition")+ const PrimInt Var_arg1 = (args.At(0))->AsInt();+ return ReturnTuple(Box_String(Argv::GetArgAt(start + Var_arg1)));+ }++ ReturnTuple Call_readSize(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("Argv.readSize")+ return ReturnTuple(Box_Int(GetSize()));+ }++ ReturnTuple Call_subSequence(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("Argv.subSequence")+ const PrimInt Var_arg1 = (args.At(0))->AsInt();+ const PrimInt Var_arg2 = (args.At(1))->AsInt();+ if (Var_arg1 < 0 || (Var_arg1 > 0 && Var_arg1 >= GetSize())) {+ FAIL() << "Subsequence index " << Var_arg1 << " is out of bounds";+ }+ if (Var_arg2 < 0 || Var_arg1 + Var_arg2 > GetSize()) {+ FAIL() << "Subsequence size " << Var_arg2 << " is invalid";+ }+ return ReturnTuple(S<TypeValue>(new ExtValue_Argv(parent, ParamTuple(), start + Var_arg1, Var_arg2)));+ }++ inline int GetSize() const { return size < 0 ? Argv::ArgCount() : size; }++ const int start;+ const int size;+};++namespace {+const S<TypeValue>& Var_global = *new S<TypeValue>(new ExtValue_Argv(CreateType_Argv(Params<0>::Type()), ParamTuple(), 0, -1));+} // namespace++Category_Argv& CreateCategory_Argv() {+ static auto& category = *new ExtCategory_Argv();+ return category;+}+S<Type_Argv> CreateType_Argv(Params<0>::Type params) {+ static const auto cached = S_get(new ExtType_Argv(CreateCategory_Argv(), Params<0>::Type()));+ return cached;+}+S<TypeValue> CreateValue_Argv(S<Type_Argv> parent, const ParamTuple& params, int st, int sz) {+ return S_get(new ExtValue_Argv(parent, params, st, sz));+}++#ifdef ZEOLITE_PUBLIC_NAMESPACE+} // namespace ZEOLITE_PUBLIC_NAMESPACE+using namespace ZEOLITE_PUBLIC_NAMESPACE;+#endif // ZEOLITE_PUBLIC_NAMESPACE
+ lib/util/Extension_SimpleInput.cpp view
@@ -0,0 +1,90 @@+/* -----------------------------------------------------------------------------+Copyright 2019-2021 Kevin P. Barry+Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at+ http://www.apache.org/licenses/LICENSE-2.0+Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++// TODO: Maybe use C++ instead.+#include <unistd.h>++#include "category-source.hpp"+#include "Streamlined_SimpleInput.hpp"+#include "Category_Formatted.hpp"+#include "Category_String.hpp"++#ifdef ZEOLITE_PUBLIC_NAMESPACE+namespace ZEOLITE_PUBLIC_NAMESPACE {+#endif // ZEOLITE_PUBLIC_NAMESPACE++namespace {+extern const S<TypeValue>& Var_stdin;+} // namespace++struct ExtCategory_SimpleInput : public Category_SimpleInput {+};++struct ExtType_SimpleInput : public Type_SimpleInput {+ inline ExtType_SimpleInput(Category_SimpleInput& p, Params<0>::Type params) : Type_SimpleInput(p, params) {}++ ReturnTuple Call_stdin(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("SimpleInput.stdin")+ return ReturnTuple(Var_stdin);+ }+};++struct ExtValue_SimpleInput : public Value_SimpleInput {+ inline ExtValue_SimpleInput(S<Type_SimpleInput> p, const ParamTuple& params, const ValueTuple& args) : Value_SimpleInput(p, params) {}++ ReturnTuple Call_pastEnd(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("SimpleInput.pastEnd")+ std::lock_guard<std::mutex> lock(mutex);+ return ReturnTuple(Box_Bool(zero_read));+ }++ ReturnTuple Call_readBlock(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("SimpleInput.readBlock")+ std::lock_guard<std::mutex> lock(mutex);+ const int size = args.At(0)->AsInt();+ if (size < 0) {+ FAIL() << "Read size " << size << " is invalid";+ }+ std::string buffer(size, '\x00');+ const int read_size = read(STDIN_FILENO, &buffer[0], size);+ if (read_size < 0) {+ return ReturnTuple(Box_String(""));+ } else {+ zero_read = read_size == 0;+ return ReturnTuple(Box_String(buffer.substr(0, read_size)));+ }+ }++ bool zero_read = false;+ std::mutex mutex;+};++namespace {+const S<TypeValue>& Var_stdin = *new S<TypeValue>(new ExtValue_SimpleInput(CreateType_SimpleInput(Params<0>::Type()), ParamTuple(), ArgTuple()));+} // namespace++Category_SimpleInput& CreateCategory_SimpleInput() {+ static auto& category = *new ExtCategory_SimpleInput();+ return category;+}+S<Type_SimpleInput> CreateType_SimpleInput(Params<0>::Type params) {+ static const auto cached = S_get(new ExtType_SimpleInput(CreateCategory_SimpleInput(), Params<0>::Type()));+ return cached;+}++#ifdef ZEOLITE_PUBLIC_NAMESPACE+} // namespace ZEOLITE_PUBLIC_NAMESPACE+using namespace ZEOLITE_PUBLIC_NAMESPACE;+#endif // ZEOLITE_PUBLIC_NAMESPACE
+ lib/util/Extension_SimpleOutput.cpp view
@@ -0,0 +1,136 @@+/* -----------------------------------------------------------------------------+Copyright 2019-2021 Kevin P. Barry+Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at+ http://www.apache.org/licenses/LICENSE-2.0+Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++#include <iostream>+#include <mutex>+#include <sstream>++#include "category-source.hpp"+#include "Streamlined_SimpleOutput.hpp"+#include "Category_Formatted.hpp"+#include "Category_String.hpp"++#ifdef ZEOLITE_PUBLIC_NAMESPACE+namespace ZEOLITE_PUBLIC_NAMESPACE {+#endif // ZEOLITE_PUBLIC_NAMESPACE++namespace {+extern const S<TypeValue>& Var_stdout;+extern const S<TypeValue>& Var_stderr;+extern const S<TypeValue>& Var_error;+} // namespace++struct ExtCategory_SimpleOutput : public Category_SimpleOutput {+};++struct ExtType_SimpleOutput : public Type_SimpleOutput {+ inline ExtType_SimpleOutput(Category_SimpleOutput& p, Params<0>::Type params) : Type_SimpleOutput(p, params) {}++ ReturnTuple Call_error(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("SimpleOutput.error")+ return ReturnTuple(Var_error);+ }++ ReturnTuple Call_stderr(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("SimpleOutput.stderr")+ return ReturnTuple(Var_stderr);+ }++ ReturnTuple Call_stdout(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("SimpleOutput.stdout")+ return ReturnTuple(Var_stdout);+ }+};++namespace {+struct Writer {+ virtual void Write(const PrimString& message) = 0;+ virtual void Flush() = 0;+ virtual ~Writer() {}+};+} // namespace++struct ExtValue_SimpleOutput : public Value_SimpleOutput {+ inline ExtValue_SimpleOutput(S<Type_SimpleOutput> p, const ParamTuple& params, S<Writer> w)+ : Value_SimpleOutput(p, params), writer(w) {}++ ReturnTuple Call_flush(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("SimpleOutput.flush")+ std::lock_guard<std::mutex> lock(mutex);+ writer->Flush();+ return ReturnTuple();+ }++ ReturnTuple Call_write(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("SimpleOutput.write")+ const S<TypeValue>& Var_arg1 = (args.At(0));+ std::lock_guard<std::mutex> lock(mutex);+ writer->Write(TypeValue::Call(args.At(0), Function_Formatted_formatted,+ ParamTuple(), ArgTuple()).Only()->AsString());+ return ReturnTuple();+ }++ std::mutex mutex;+ const S<Writer> writer;+};++namespace {++class StreamWriter : public Writer {+ public:+ StreamWriter(std::ostream& o) : output(o) {}++ void Write(const PrimString& message) final {+ output << message;+ }++ void Flush() final {}++ private:+ std::ostream& output;+};++class ErrorWriter : public Writer {+ public:+ void Write(const PrimString& message) final {+ output << message;+ }++ void Flush() final {+ FAIL() << output.str();+ }++ std::ostringstream output;+};++const S<TypeValue>& Var_stdout = *new S<TypeValue>(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new StreamWriter(std::cout))));+const S<TypeValue>& Var_stderr = *new S<TypeValue>(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new StreamWriter(std::cerr))));+const S<TypeValue>& Var_error = *new S<TypeValue>(new ExtValue_SimpleOutput(CreateType_SimpleOutput(Params<0>::Type()), ParamTuple(), S_get(new ErrorWriter())));++} // namespace++Category_SimpleOutput& CreateCategory_SimpleOutput() {+ static auto& category = *new ExtCategory_SimpleOutput();+ return category;+}+S<Type_SimpleOutput> CreateType_SimpleOutput(Params<0>::Type params) {+ static const auto cached = S_get(new ExtType_SimpleOutput(CreateCategory_SimpleOutput(), Params<0>::Type()));+ return cached;+}++#ifdef ZEOLITE_PUBLIC_NAMESPACE+} // namespace ZEOLITE_PUBLIC_NAMESPACE+using namespace ZEOLITE_PUBLIC_NAMESPACE;+#endif // ZEOLITE_PUBLIC_NAMESPACE
src/Base/MergeTree.hs view
@@ -89,11 +89,9 @@ pair x2 (MergeAll ys) = allOp $ map (x2 `pair`) ys pair (MergeAll xs) y2 = anyOp $ map (`pair` y2) xs pair x2 (MergeAny ys) = anyOp $ map (x2 `pair`) ys--separateLeaves :: [MergeTree a] -> ([MergeTree a],[a])-separateLeaves = foldr split ([],[]) where- split (MergeLeaf x) (ms,ls) = (ms,x:ls)- split x (ms,ls) = (x:ms,ls)+ separateLeaves = foldr split ([],[]) where+ split (MergeLeaf x2) (ms,ls) = (ms,x2:ls)+ split x2 (ms,ls) = (x2:ms,ls) instance Functor MergeTree where fmap f = reduceMergeCommon mergeAny mergeAll (mergeLeaf . f)
src/Cli/Compiler.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -41,7 +41,8 @@ import Cli.Programs import Cli.TestRunner import Compilation.ProcedureContext (ExprMap)-import CompilerCxx.Category+import CompilerCxx.CxxFiles+import CompilerCxx.LanguageModule import CompilerCxx.Naming import Module.CompileMetadata import Module.Paths@@ -50,7 +51,6 @@ import Parser.TextParser (SourceContext) import Types.Builtin import Types.DefinedCategory-import Types.Pragma import Types.Procedure (isLiteralCategory) import Types.TypeCategory import Types.TypeInstance@@ -108,8 +108,9 @@ -- skip checking all inputs/outputs for each dependency. let ns0 = StaticNamespace $ publicNamespace $ show compilerHash ++ path let ns1 = StaticNamespace . privateNamespace $ show time ++ show compilerHash ++ path- let ex = concat $ map getSourceCategories es- let ss = filter (not . isLiteralCategory) ex+ let extensions = concat $ map getSourceCategories es+ let ss = filter (not . isLiteralCategory) extensions+ let ex = filter isLiteralCategory extensions cs <- loadModuleGlobals resolver p (ns0,ns1) ps Nothing deps1' deps2 let cm = createLanguageModule ex ss em cs let cs2 = filter (not . hasCodeVisibility FromDependency) cs@@ -204,6 +205,7 @@ Nothing -> return [] Just o -> return $ map (\c -> Left $ ([o],fakeCxx c)) cs where+ allDeps = Set.fromList (cs ++ ds2) fakeCxx c = CxxOutput { coCategory = Just c, coFilename = "",@@ -211,7 +213,7 @@ Just ns2 -> ns2 Nothing -> NoNamespace, coUsesNamespace = Set.fromList [ns0,ns1],- coUsesCategory = Set.fromList ds2,+ coUsesCategory = c `Set.delete` allDeps, coOutput = [] } compileExtraSource _ _ paths (OtherSource f2) = do@@ -275,16 +277,20 @@ let ca = Set.fromList $ map getCategoryName $ filter isValueConcrete cs let ca' = foldr Set.delete ca $ map dcName ds2 let testingCats = Set.fromList $ map getCategoryName ts1- ts <- mapErrorsM (\n -> compileConcreteTemplate (n `Set.member` testingCats) tm n) $ Set.toList ca'+ ts <- fmap concat $ mapErrorsM (\n -> generate (n `Set.member` testingCats) tm n) $ Set.toList ca' mapErrorsM_ writeTemplate ts where- writeTemplate (CxxOutput _ n _ _ _ content) = do- let n' = p </> d </> n- exists <- errorFromIO $ doesFileExist n'- if exists- then compilerWarningM $ "Skipping existing file " ++ n- else do- errorFromIO $ hPutStrLn stderr $ "Writing file " ++ n- errorFromIO $ writeFile n' $ concat $ map (++ "\n") content+ generate testing tm n = do+ (_,t) <- getConcreteCategory tm ([],n)+ let ctx = FileContext testing tm Set.empty Map.empty+ generateStreamlinedTemplate ctx t+ writeTemplate (CxxOutput _ n _ _ _ content) = do+ let n' = p </> d </> n+ exists <- errorFromIO $ doesFileExist n'+ if exists+ then compilerWarningM $ "Skipping existing file " ++ n+ else do+ errorFromIO $ hPutStrLn stderr $ "Writing file " ++ n+ errorFromIO $ writeFile n' $ concat $ map (++ "\n") content runModuleTests :: (PathIOHandler r, CompilerBackend b) => r -> b -> FilePath -> [FilePath] -> LoadedTests -> TrackedErrorsIO [((Int,Int),TrackedErrors ())]
src/Cli/RunCompiler.hs view
@@ -21,7 +21,7 @@ ) where import Control.Monad (foldM,when)-import Data.List (intercalate)+import Data.List (intercalate,nub) import System.Directory import System.FilePath import System.IO@@ -161,13 +161,22 @@ compilerHash = getCompilerHash backend compileSingle d = do d' <- errorFromIO $ canonicalizePath (p </> d)+ (is',is2') <- maybeUseConfig d' base <- resolveBaseModule resolver- as <- fmap fixPaths $ mapErrorsM (resolveModule resolver d') is- as2 <- fmap fixPaths $ mapErrorsM (resolveModule resolver d') is2+ as <- fmap fixPaths $ mapErrorsM (resolveModule resolver d') is'+ as2 <- fmap fixPaths $ mapErrorsM (resolveModule resolver d') is2' deps1 <- loadPublicDeps compilerHash f Map.empty (base:as) deps2 <- loadPublicDeps compilerHash f (mapMetadata deps1) as2 path <- errorFromIO $ canonicalizePath p createModuleTemplates resolver path d deps1 deps2 <?? "In module \"" ++ d' ++ "\""+ maybeUseConfig d2 = do+ let rm = loadRecompile d2+ isError <- isCompilerErrorM rm+ if isError+ then return (is,is2)+ else do+ (ModuleConfig _ _ _ is3 is4 _ _ _) <- rm+ return (nub $ is ++ is3,nub $ is2 ++ is4) runCompiler resolver backend (CompileOptions h is is2 ds es ep p m f) = mapM_ compileSingle ds where compileSingle d = do
src/Cli/TestRunner.hs view
@@ -34,7 +34,8 @@ import Base.CompilerError import Base.TrackedErrors import Cli.Programs-import CompilerCxx.Category+import CompilerCxx.CxxFiles+import CompilerCxx.LanguageModule import CompilerCxx.Naming import Module.CompileMetadata import Module.Paths
src/Compilation/CompilerState.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry+Copyright 2019-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -62,8 +62,10 @@ csReserveExprMacro, csResolver, csSameType,+ csSetHidden, csSetJumpType, csSetNoTrace,+ csSetReadOnly, csStartCleanup, csStartLoop, csUpdateAssigned,@@ -87,7 +89,6 @@ import Base.CompilerError import Base.Positional import Types.DefinedCategory-import Types.Pragma (MacroName) import Types.Procedure import Types.TypeCategory import Types.TypeInstance@@ -108,6 +109,8 @@ ccCheckValueInit :: a -> [c] -> TypeInstance -> ExpressionType -> Positional GeneralInstance -> m () ccGetVariable :: a -> UsedVariable c -> m (VariableValue c) ccAddVariable :: a -> UsedVariable c -> VariableValue c -> m a+ ccSetReadOnly :: a -> UsedVariable c -> m a+ ccSetHidden :: a -> UsedVariable c -> m a ccCheckVariableInit :: a -> [UsedVariable c] -> m () ccWrite :: a -> s -> m a ccGetOutput :: a -> m s@@ -123,7 +126,7 @@ ccSetJumpType :: a -> [c] -> JumpType -> m a ccStartLoop :: a -> LoopSetup s -> m a ccGetLoop :: a -> m (LoopSetup s)- ccStartCleanup :: a -> m a+ ccStartCleanup :: a -> [c] -> m a ccPushCleanup :: a -> a -> m a ccGetCleanup :: a -> JumpType -> m (CleanupBlock c s) ccExprLookup :: a -> [c] -> MacroName -> m (Expression c)@@ -184,9 +187,6 @@ JumpMax -- Max value for use as initial state in folds. deriving (Eq,Ord,Show) -instance Show c => Show (VariableValue c) where- show (VariableValue c _ t _) = show t ++ formatFullContextBrace c- csCurrentScope :: CompilerContext c m s a => CompilerState a m SymbolScope csCurrentScope = fmap ccCurrentScope get >>= lift @@ -228,6 +228,14 @@ UsedVariable c -> VariableValue c -> CompilerState a m () csAddVariable v t = fmap (\x -> ccAddVariable x v t) get >>= lift >>= put +csSetReadOnly :: CompilerContext c m s a =>+ UsedVariable c -> CompilerState a m ()+csSetReadOnly v = fmap (\x -> ccSetReadOnly x v) get >>= lift >>= put++csSetHidden :: CompilerContext c m s a =>+ UsedVariable c -> CompilerState a m ()+csSetHidden v = fmap (\x -> ccSetHidden x v) get >>= lift >>= put+ csCheckVariableInit :: CompilerContext c m s a => [UsedVariable c] -> CompilerState a m () csCheckVariableInit vs = fmap (\x -> ccCheckVariableInit x vs) get >>= lift@@ -272,8 +280,8 @@ csStartLoop :: CompilerContext c m s a => LoopSetup s -> CompilerState a m () csStartLoop l = fmap (\x -> ccStartLoop x l) get >>= lift >>= put -csStartCleanup :: CompilerContext c m s a => CompilerState a m ()-csStartCleanup = fmap (\x -> ccStartCleanup x) get >>= lift >>= put+csStartCleanup :: CompilerContext c m s a => [c] -> CompilerState a m ()+csStartCleanup c = fmap (\x -> ccStartCleanup x c) get >>= lift >>= put csGetLoop :: CompilerContext c m s a => CompilerState a m (LoopSetup s) csGetLoop = fmap ccGetLoop get >>= lift
src/Compilation/ProcedureContext.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry+Copyright 2019-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -18,7 +18,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE Safe #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE Trustworthy #-} module Compilation.ProcedureContext ( ExprMap,@@ -29,6 +30,8 @@ ) where import Control.Monad (when)+import Lens.Micro hiding (mapped)+import Lens.Micro.TH import Data.Maybe (fromJust,isJust) import qualified Data.Map as Map import qualified Data.Set as Set@@ -39,42 +42,11 @@ import Base.Positional import Compilation.CompilerState import Types.DefinedCategory-import Types.Pragma (MacroName) import Types.Procedure import Types.TypeCategory import Types.TypeInstance -data ProcedureContext c =- ProcedureContext {- pcScope :: SymbolScope,- pcType :: CategoryName,- pcExtParams :: Positional (ValueParam c),- pcIntParams :: Positional (ValueParam c),- pcMembers :: [DefinedMember c],- pcCategories :: CategoryMap c,- pcAllFilters :: ParamFilters,- pcExtFilters :: [ParamFilter c],- pcIntFilters :: [ParamFilter c],- pcParamScopes :: Map.Map ParamName SymbolScope,- pcFunctions :: Map.Map FunctionName (ScopedFunction c),- pcVariables :: Map.Map VariableName (VariableValue c),- pcReturns :: ReturnValidation c,- pcJumpType :: JumpType,- pcIsNamed :: Bool,- pcPrimNamed :: [ReturnVariable],- pcRequiredTypes :: Set.Set CategoryName,- pcOutput :: [String],- pcDisallowInit :: Bool,- pcLoopSetup :: LoopSetup [String],- pcCleanupBlocks :: [Maybe (CleanupBlock c [String])],- pcInCleanup :: Bool,- pcUsedVars :: [UsedVariable c],- pcExprMap :: ExprMap c,- pcReservedMacros :: [(MacroName,[c])],- pcNoTrace :: Bool- }- type ExprMap c = Map.Map MacroName (Expression c) data ReturnValidation c =@@ -88,59 +60,63 @@ } deriving (Show) +data ProcedureContext c =+ ProcedureContext {+ _pcScope :: SymbolScope,+ _pcType :: CategoryName,+ _pcExtParams :: Positional (ValueParam c),+ _pcIntParams :: Positional (ValueParam c),+ _pcMembers :: [DefinedMember c],+ _pcCategories :: CategoryMap c,+ _pcAllFilters :: ParamFilters,+ _pcExtFilters :: [ParamFilter c],+ _pcIntFilters :: [ParamFilter c],+ _pcParamScopes :: Map.Map ParamName SymbolScope,+ _pcFunctions :: Map.Map FunctionName (ScopedFunction c),+ _pcVariables :: Map.Map VariableName (VariableValue c),+ _pcReturns :: ReturnValidation c,+ _pcJumpType :: JumpType,+ _pcIsNamed :: Bool,+ _pcPrimNamed :: [ReturnVariable],+ _pcRequiredTypes :: Set.Set CategoryName,+ _pcOutput :: [String],+ _pcDisallowInit :: Bool,+ _pcLoopSetup :: LoopSetup [String],+ _pcCleanupBlocks :: [Maybe (CleanupBlock c [String])],+ _pcInCleanup :: Bool,+ _pcUsedVars :: [UsedVariable c],+ _pcExprMap :: ExprMap c,+ _pcReservedMacros :: [(MacroName,[c])],+ _pcNoTrace :: Bool+ }++$(makeLenses ''ProcedureContext)+ instance (Show c, CollectErrorsM m) => CompilerContext c m [String] (ProcedureContext c) where- ccCurrentScope = return . pcScope- ccResolver = return . AnyTypeResolver . CategoryResolver . pcCategories+ ccCurrentScope = return . (^. pcScope)+ ccResolver = return . AnyTypeResolver . CategoryResolver . (^. pcCategories) ccSameType ctx = return . (== same) where- same = TypeInstance (pcType ctx) (fmap (singleType . JustParamName False . vpParam) $ pcExtParams ctx)- ccAllFilters = return . pcAllFilters+ same = TypeInstance (ctx ^. pcType) (fmap (singleType . JustParamName False . vpParam) $ ctx ^. pcExtParams)+ ccAllFilters = return . (^. pcAllFilters) ccGetParamScope ctx p = do- case p `Map.lookup` pcParamScopes ctx of+ case p `Map.lookup` (ctx ^. pcParamScopes) of (Just s) -> return s _ -> compilerErrorM $ "Param " ++ show p ++ " does not exist"- ccAddRequired ctx ts = return $- ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = Set.union (pcRequiredTypes ctx) ts,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }- ccGetRequired = return . pcRequiredTypes- ccGetCategoryFunction ctx c Nothing n = ccGetCategoryFunction ctx c (Just $ pcType ctx) n+ ccAddRequired ctx ts = return $ ctx & pcRequiredTypes <>~ ts+ ccGetRequired = return . (^. pcRequiredTypes)+ ccGetCategoryFunction ctx c Nothing n = ccGetCategoryFunction ctx c (Just $ ctx ^. pcType) n ccGetCategoryFunction ctx c (Just t) n = getFunction where getFunction -- Same category as the procedure itself.- | t == pcType ctx = checkFunction $ n `Map.lookup` pcFunctions ctx+ | t == ctx ^. pcType = checkFunction $ n `Map.lookup` (ctx ^. pcFunctions) -- A different category than the procedure. | otherwise = do- (_,ca) <- getCategory (pcCategories ctx) (c,t)+ (_,ca) <- getCategory (ctx ^. pcCategories) (c,t) let fa = Map.fromList $ map (\f -> (sfName f,f)) $ getCategoryFunctions ca checkFunction $ n `Map.lookup` fa checkFunction (Just f) = do- when (pcDisallowInit ctx && t == pcType ctx && pcScope ctx == CategoryScope) $+ when (ctx ^. pcDisallowInit && t == ctx ^. pcType && ctx ^. pcScope == CategoryScope) $ compilerErrorM $ "Function " ++ show n ++ " disallowed during initialization" ++ formatFullContextBrace c when (sfScope f /= CategoryScope) $@@ -153,8 +129,8 @@ ccGetTypeFunction ctx c t n = getFunction t where getFunction (Just t2) = reduceMergeTree getFromAny getFromAll getFromSingle t2 getFunction Nothing = do- let ps = fmap (singleType . JustParamName False . vpParam) $ pcExtParams ctx- getFunction (Just $ singleType $ JustTypeInstance $ TypeInstance (pcType ctx) ps)+ let ps = fmap (singleType . JustParamName False . vpParam) $ ctx ^. pcExtParams+ getFunction (Just $ singleType $ JustTypeInstance $ TypeInstance (ctx ^. pcType) ps) getFromAny _ = compilerErrorM $ "Use explicit type conversion to call " ++ show n ++ " from " ++ show t getFromAll ts = do@@ -171,22 +147,22 @@ "Function " ++ show n ++ " not available for param " ++ show p ++ formatFullContextBrace c getFromSingle (JustTypeInstance t2) -- Same category as the procedure itself.- | tiName t2 == pcType ctx =- subAndCheckFunction (tiName t2) (fmap vpParam $ pcExtParams ctx) (tiParams t2) $ n `Map.lookup` pcFunctions ctx+ | tiName t2 == ctx ^. pcType =+ subAndCheckFunction (tiName t2) (fmap vpParam $ ctx ^. pcExtParams) (tiParams t2) $ n `Map.lookup` (ctx ^. pcFunctions) -- A different category than the procedure. | otherwise = do- (_,ca) <- getCategory (pcCategories ctx) (c,tiName t2)+ (_,ca) <- getCategory (ctx ^. pcCategories) (c,tiName t2) let params = Positional $ map vpParam $ getCategoryParams ca let fa = Map.fromList $ map (\f -> (sfName f,f)) $ getCategoryFunctions ca subAndCheckFunction (tiName t2) params (tiParams t2) $ n `Map.lookup` fa getFromSingle _ = compilerErrorM $ "Type " ++ show t ++ " contains unresolved types" checkDefine t2 = do- (_,ca) <- getCategory (pcCategories ctx) (c,diName t2)+ (_,ca) <- getCategory (ctx ^. pcCategories) (c,diName t2) let params = Positional $ map vpParam $ getCategoryParams ca let fa = Map.fromList $ map (\f -> (sfName f,f)) $ getCategoryFunctions ca subAndCheckFunction (diName t2) params (diParams t2) $ n `Map.lookup` fa subAndCheckFunction t2 ps1 ps2 (Just f) = do- when (pcDisallowInit ctx && t2 == pcType ctx) $+ when (ctx ^. pcDisallowInit && t2 == ctx ^. pcType) $ compilerErrorM $ "Function " ++ show n ++ " disallowed during initialization" ++ formatFullContextBrace c when (sfScope f == CategoryScope) $@@ -201,25 +177,25 @@ " does not have a type or value function named " ++ show n ++ formatFullContextBrace c ccCheckValueInit ctx c (TypeInstance t as) ts ps- | t /= pcType ctx =- compilerErrorM $ "Category " ++ show (pcType ctx) ++ " cannot initialize values from " +++ | t /= ctx ^. pcType =+ compilerErrorM $ "Category " ++ show (ctx ^. pcType) ++ " cannot initialize values from " ++ show t ++ formatFullContextBrace c | otherwise = "In initialization at " ++ formatFullContext c ??> do- let t' = TypeInstance (pcType ctx) as+ let t' = TypeInstance (ctx ^. pcType) as r <- ccResolver ctx allFilters <- ccAllFilters ctx- pa <- fmap Map.fromList $ processPairs alwaysPair (fmap vpParam $ pcExtParams ctx) as- pa2 <- fmap Map.fromList $ processPairs alwaysPair (fmap vpParam $ pcIntParams ctx) ps+ pa <- fmap Map.fromList $ processPairs alwaysPair (fmap vpParam $ ctx ^. pcExtParams) as+ pa2 <- fmap Map.fromList $ processPairs alwaysPair (fmap vpParam $ ctx ^. pcIntParams) ps let pa' = Map.union pa pa2 validateTypeInstance r allFilters t' -- Check internal param substitution.- let mapped = Map.fromListWith (++) $ map (\f -> (pfParam f,[pfFilter f])) (pcIntFilters ctx)- let positional = map (getFilters mapped) (map vpParam $ pValues $ pcIntParams ctx)- assigned <- fmap Map.fromList $ processPairs alwaysPair (fmap vpParam $ pcIntParams ctx) ps+ let mapped = Map.fromListWith (++) $ map (\f -> (pfParam f,[pfFilter f])) (ctx ^. pcIntFilters)+ let positional = map (getFilters mapped) (map vpParam $ pValues $ ctx ^. pcIntParams)+ assigned <- fmap Map.fromList $ processPairs alwaysPair (fmap vpParam $ ctx ^. pcIntParams) ps subbed <- fmap Positional $ mapErrorsM (assignFilters assigned) positional processPairs_ (validateAssignment r allFilters) ps subbed -- Check initializer types.- ms <- fmap Positional $ mapErrorsM (subSingle pa') (pcMembers ctx)+ ms <- fmap Positional $ mapErrorsM (subSingle pa') (ctx ^. pcMembers) processPairs_ (checkInit r allFilters) ms (Positional $ zip ([1..] :: [Int]) $ pValues ts) return () where@@ -236,49 +212,30 @@ t2' <- uncheckedSubValueType (getValueForParam pa) t2 return $ MemberValue c2 n t2' ccGetVariable ctx (UsedVariable c n) =- case n `Map.lookup` pcVariables ctx of- (Just v) -> return v- _ -> compilerErrorM $ "Variable " ++ show n ++ " is not defined" ++- formatFullContextBrace c+ case n `Map.lookup` (ctx ^. pcVariables) of+ (Just (VariableValue _ _ _ (VariableHidden c2))) ->+ compilerErrorM $ "Variable " ++ show n ++ formatFullContextBrace c +++ " was explicitly hidden at " ++ formatFullContext c2+ (Just v) -> return v+ _ -> compilerErrorM $ "Variable " ++ show n ++ formatFullContextBrace c ++ " is not defined" ccAddVariable ctx (UsedVariable c n) t = do- case n `Map.lookup` pcVariables ctx of+ case n `Map.lookup` (ctx ^. pcVariables) of Nothing -> return () (Just v) -> compilerErrorM $ "Variable " ++ show n ++ formatFullContextBrace c ++ " is already defined: " ++ show v- return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = Map.insert n t (pcVariables ctx),- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }+ return $ ctx & pcVariables <>~ Map.fromList [(n,t)]+ ccSetReadOnly ctx v@(UsedVariable c n) = do+ (VariableValue c2 s t _) <- ccGetVariable ctx v+ return $ ctx & pcVariables %~ Map.insert n (VariableValue c2 s t (VariableReadOnly c))+ ccSetHidden ctx v@(UsedVariable c n) = do+ (VariableValue c2 s t _) <- ccGetVariable ctx v+ return $ ctx & pcVariables %~ Map.insert n (VariableValue c2 s t (VariableHidden c)) ccCheckVariableInit ctx vs -- Returns are checked during cleanup inlining.- | pcInCleanup ctx = return ()+ | ctx ^. pcInCleanup = return () | otherwise =- case pcReturns ctx of+ case ctx ^. pcReturns of ValidateNames _ _ na -> mapErrorsM_ (checkSingle na) vs _ -> return () where@@ -286,222 +243,31 @@ when (n `Map.member` na) $ compilerErrorM $ "Named return " ++ show n ++ " might not be initialized" ++ formatFullContextBrace c- ccWrite ctx ss = return $- ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx ++ ss,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }- ccGetOutput = return . pcOutput- ccClearOutput ctx = return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = [],- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }- ccUpdateAssigned ctx n = update (pcReturns ctx) where- update (ValidateNames ns ts ra) = return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = ValidateNames ns ts $ Map.delete n ra,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }- update _ = return ctx+ ccWrite ctx ss = return $ ctx & pcOutput <>~ ss+ ccGetOutput = return . (^. pcOutput)+ ccClearOutput ctx = return $ ctx & pcOutput .~ mempty+ ccUpdateAssigned ctx n = return $ ctx & pcReturns %~ update where+ update (ValidateNames ns ts ra) = ValidateNames ns ts $ Map.delete n ra+ update rs = rs ccAddUsed ctx v- | pcInCleanup ctx = return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx ++ [v],- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }- | otherwise = return ctx- ccInheritReturns ctx cs = return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = returns,- pcJumpType = jump,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = used,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }- where- used = pcUsedVars ctx ++ (concat $ map pcUsedVars cs)- (returns,jump) = combineSeries (pcReturns ctx,pcJumpType ctx) inherited- combineSeries (r@(ValidatePositions _),j1) (_,j2) = (r,max j1 j2)- combineSeries (_,j1) (r@(ValidatePositions _),j2) = (r,max j1 j2)- combineSeries (ValidateNames ns ts ra1,j1) (ValidateNames _ _ ra2,j2) = (ValidateNames ns ts $ Map.intersection ra1 ra2,max j1 j2)- inherited = foldr combineParallel (ValidateNames (Positional []) (Positional []) Map.empty,JumpMax) $ zip (map pcReturns cs) (map pcJumpType cs)- -- Ignore a branch if it jumps to a higher scope.- combineParallel (_,j1) (r,j2) | j1 > NextStatement = (r,min j1 j2)- combineParallel (ValidateNames ns ts ra1,j1) (ValidateNames _ _ ra2,j2) = (ValidateNames ns ts $ Map.union ra1 ra2,min j1 j2)- combineParallel (r@(ValidatePositions _),j1) (_,j2) = (r,min j1 j2)- combineParallel (_,j1) (r@(ValidatePositions _),j2) = (r,min j1 j2)- ccInheritUsed ctx ctx2 = return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx ++ pcUsedVars ctx2,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }+ | ctx ^. pcInCleanup = return $ ctx & pcUsedVars <>~ [v]+ | otherwise = return ctx+ ccInheritReturns ctx cs = return $ ctx & pcReturns .~ returns & pcJumpType .~ jump & pcUsedVars .~ used where+ used = ctx ^. pcUsedVars ++ (concat $ map (^. pcUsedVars) cs)+ (returns,jump) = combineSeries (ctx ^. pcReturns,ctx ^. pcJumpType) inherited+ combineSeries (r@(ValidatePositions _),j1) (_,j2) = (r,max j1 j2)+ combineSeries (_,j1) (r@(ValidatePositions _),j2) = (r,max j1 j2)+ combineSeries (ValidateNames ns ts ra1,j1) (ValidateNames _ _ ra2,j2) = (ValidateNames ns ts $ Map.intersection ra1 ra2,max j1 j2)+ inherited = foldr combineParallel (ValidateNames (Positional []) (Positional []) Map.empty,JumpMax) $ zip (map (^. pcReturns) cs) (map (^. pcJumpType) cs)+ -- Ignore a branch if it jumps to a higher scope.+ combineParallel (_,j1) (r,j2) | j1 > NextStatement = (r,min j1 j2)+ combineParallel (ValidateNames ns ts ra1,j1) (ValidateNames _ _ ra2,j2) = (ValidateNames ns ts $ Map.union ra1 ra2,min j1 j2)+ combineParallel (r@(ValidatePositions _),j1) (_,j2) = (r,min j1 j2)+ combineParallel (_,j1) (r@(ValidatePositions _),j2) = (r,min j1 j2)+ ccInheritUsed ctx ctx2 = return $ ctx & pcUsedVars <>~ (ctx2 ^. pcUsedVars) ccRegisterReturn ctx c vs = do- returns <- check (pcReturns ctx)- return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = returns,- pcJumpType = JumpReturn,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }+ returns <- check (ctx ^. pcReturns)+ return $ ctx & pcReturns .~ returns & pcJumpType .~ JumpReturn where check (ValidatePositions rs) = do let vs' = case vs of@@ -528,162 +294,50 @@ alwaysError (n,_) = compilerErrorM $ "Named return " ++ show n ++ " might not be initialized" ++ formatFullContextBrace c- ccPrimNamedReturns = return . pcPrimNamed+ ccPrimNamedReturns = return . (^. pcPrimNamed) ccIsUnreachable ctx- | pcInCleanup ctx = return $ pcJumpType ctx > JumpReturn- | otherwise = return $ pcJumpType ctx > NextStatement- ccIsNamedReturns = return . pcIsNamed+ | ctx ^. pcInCleanup = return $ ctx ^. pcJumpType > JumpReturn+ | otherwise = return $ ctx ^. pcJumpType > NextStatement+ ccIsNamedReturns = return . (^. pcIsNamed) ccSetJumpType ctx c j- | pcInCleanup ctx && j == JumpBreak =+ | ctx ^. pcInCleanup && j == JumpBreak = compilerErrorM $ "Explicit break at " ++ formatFullContext c ++ " not allowed in cleanup"- | pcInCleanup ctx && j == JumpContinue =+ | ctx ^. pcInCleanup && j == JumpContinue = compilerErrorM $ "Explicit continue at " ++ formatFullContext c ++ " not allowed in cleanup"- | pcInCleanup ctx && j == JumpReturn =+ | ctx ^. pcInCleanup && j == JumpReturn = compilerErrorM $ "Explicit return at " ++ formatFullContext c ++ " not allowed in cleanup"- | otherwise =- return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = pcReturns ctx,- pcJumpType = max j (pcJumpType ctx),- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }- ccStartLoop ctx l =- return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = l,- pcCleanupBlocks = Nothing:(pcCleanupBlocks ctx),- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }- ccGetLoop = return . pcLoopSetup- ccStartCleanup ctx = do- let vars = protectReturns (pcReturns ctx) (pcVariables ctx)- return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = vars,- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = True,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }- where- protectReturns (ValidateNames ns _ _) vs = foldr protect vs (pValues ns)- protectReturns _ vs = vs- protect n vs =- case n `Map.lookup` vs of- Just (VariableValue c s@LocalScope t _) -> Map.insert n (VariableValue c s t False) vs- _ -> vs- ccPushCleanup ctx ctx2 =- return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = (Just cleanup):(pcCleanupBlocks ctx),- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- } where- cleanup = CleanupBlock (pcOutput ctx2) (pcUsedVars ctx2) (pcJumpType ctx2) (pcRequiredTypes ctx2)+ | otherwise = return $ ctx & pcJumpType %~ max j+ ccStartLoop ctx l = return $ ctx & pcLoopSetup .~ l & pcCleanupBlocks %~ (Nothing:)+ ccGetLoop = return . (^. pcLoopSetup)+ ccStartCleanup ctx c = do+ let vars = protectReturns (ctx ^. pcReturns) (ctx ^. pcVariables)+ return $ ctx & pcVariables .~ vars & pcInCleanup .~ True where+ protectReturns (ValidateNames ns _ _) vs = foldr protect vs (pValues ns)+ protectReturns _ vs = vs+ protect n vs =+ case n `Map.lookup` vs of+ Just (VariableValue c2 s@LocalScope t _) -> Map.insert n (VariableValue c2 s t (VariableReadOnly c)) vs+ _ -> vs+ ccPushCleanup ctx ctx2 = return $ ctx & pcCleanupBlocks %~ (Just cleanup:) where+ cleanup = CleanupBlock (ctx2 ^. pcOutput) (ctx2 ^. pcUsedVars) (ctx2 ^. pcJumpType) (ctx2 ^. pcRequiredTypes) ccGetCleanup ctx j = return combined where combined | j == NextStatement =- case pcCleanupBlocks ctx of+ case ctx ^. pcCleanupBlocks of ((Just b):_) -> b _ -> emptyCleanupBlock- | j == JumpReturn = combine $ map fromJust $ filter isJust $ pcCleanupBlocks ctx- | j == JumpBreak || j == JumpContinue = combine $ map fromJust $ takeWhile isJust $ pcCleanupBlocks ctx+ | j == JumpReturn = combine $ map fromJust $ filter isJust $ ctx ^. pcCleanupBlocks+ | j == JumpBreak || j == JumpContinue = combine $ map fromJust $ takeWhile isJust $ ctx ^. pcCleanupBlocks | otherwise = emptyCleanupBlock combine cs = CleanupBlock (concat $ map csCleanup cs) (concat $ map csUsesVars cs) (foldr max NextStatement (map csJumpType cs)) (Set.unions $ map csRequires cs) ccExprLookup ctx c n =- case n `Map.lookup` pcExprMap ctx of+ case n `Map.lookup` (ctx ^. pcExprMap) of Nothing -> compilerErrorM $ "Env expression " ++ show n ++ " is not defined" ++ formatFullContextBrace c Just e -> do- checkReserved (pcReservedMacros ctx) [(n,c)]+ checkReserved (ctx ^. pcReservedMacros) [(n,c)] return e where checkReserved [] _ = return ()@@ -692,94 +346,10 @@ | otherwise = (mapErrorsM_ singleError (m:rs)) <!! "Expression macro " ++ show n ++ " references itself" singleError (n2,c2) = compilerErrorM $ show n2 ++ " expanded at " ++ formatFullContext c2- ccReserveExprMacro ctx c n =- return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = ((n,c):pcReservedMacros ctx),- pcNoTrace = pcNoTrace ctx- }- ccReleaseExprMacro ctx _ n =- return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = filter ((/= n) . fst) $ pcReservedMacros ctx,- pcNoTrace = pcNoTrace ctx- }- ccSetNoTrace ctx t =- return $ ProcedureContext {- pcScope = pcScope ctx,- pcType = pcType ctx,- pcExtParams = pcExtParams ctx,- pcIntParams = pcIntParams ctx,- pcMembers = pcMembers ctx,- pcCategories = pcCategories ctx,- pcAllFilters = pcAllFilters ctx,- pcExtFilters = pcExtFilters ctx,- pcIntFilters = pcIntFilters ctx,- pcParamScopes = pcParamScopes ctx,- pcFunctions = pcFunctions ctx,- pcVariables = pcVariables ctx,- pcReturns = pcReturns ctx,- pcJumpType = pcJumpType ctx,- pcIsNamed = pcIsNamed ctx,- pcPrimNamed = pcPrimNamed ctx,- pcRequiredTypes = pcRequiredTypes ctx,- pcOutput = pcOutput ctx,- pcDisallowInit = pcDisallowInit ctx,- pcLoopSetup = pcLoopSetup ctx,- pcCleanupBlocks = pcCleanupBlocks ctx,- pcInCleanup = pcInCleanup ctx,- pcUsedVars = pcUsedVars ctx,- pcExprMap = pcExprMap ctx,- pcReservedMacros = pcReservedMacros ctx,- pcNoTrace = t- }- ccGetNoTrace = return . pcNoTrace+ ccReserveExprMacro ctx c n = return $ ctx & pcReservedMacros %~ ((n,c):)+ ccReleaseExprMacro ctx _ n = return $ ctx & pcReservedMacros %~ (filter ((/= n) . fst))+ ccSetNoTrace ctx t = return $ ctx & pcNoTrace .~ t+ ccGetNoTrace = return . (^. pcNoTrace) updateReturnVariables :: (Show c, CollectErrorsM m) => (Map.Map VariableName (VariableValue c)) ->@@ -794,7 +364,7 @@ update (PassedValue c t,r) va = do va' <- va case ovName r `Map.lookup` va' of- Nothing -> return $ Map.insert (ovName r) (VariableValue c LocalScope t True) va'+ Nothing -> return $ Map.insert (ovName r) (VariableValue c LocalScope t VariableDefault) va' (Just v) -> compilerErrorM $ "Variable " ++ show (ovName r) ++ formatFullContextBrace (ovContext r) ++ " is already defined" ++@@ -811,7 +381,7 @@ update (PassedValue c t,a) va = do va' <- va case ivName a `Map.lookup` va' of- Nothing -> return $ Map.insert (ivName a) (VariableValue c LocalScope t False) va'+ Nothing -> return $ Map.insert (ivName a) (VariableValue c LocalScope t (VariableReadOnly c)) va' (Just v) -> compilerErrorM $ "Variable " ++ show (ivName a) ++ formatFullContextBrace (ivContext a) ++ " is already defined" ++
src/Compilation/ScopeContext.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -117,5 +117,5 @@ -- TODO: This is probably in the wrong module. builtinVariables :: TypeInstance -> Map.Map VariableName (VariableValue c) builtinVariables t = Map.fromList [- (VariableName "self",VariableValue [] ValueScope (ValueType RequiredValue $ singleType $ JustTypeInstance t) False)+ (VariableName "self",VariableValue [] ValueScope (ValueType RequiredValue $ singleType $ JustTypeInstance t) (VariableReadOnly [])) ]
− src/CompilerCxx/Category.hs
@@ -1,874 +0,0 @@-{- ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry--Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at-- http://www.apache.org/licenses/LICENSE-2.0--Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.------------------------------------------------------------------------------ -}---- Author: Kevin P. Barry [ta0kira@gmail.com]--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE Safe #-}--module CompilerCxx.Category (- CxxOutput(..),- LanguageModule(..),- PrivateSource(..),- compileCategoryDeclaration,- compileLanguageModule,- compileConcreteDefinition,- compileConcreteTemplate,- compileInterfaceDefinition,- compileModuleMain,- compileTestsModule,-) where--import Control.Monad (foldM,when)-import Data.List (intercalate,sortBy)-import Prelude hiding (pi)-import qualified Data.Map as Map-import qualified Data.Set as Set--#if MIN_VERSION_base(4,11,0)-#else-import Data.Semigroup-#endif--import Base.CompilerError-import Base.GeneralType-import Base.MergeTree-import Base.Positional-import Compilation.CompilerState-import Compilation.ProcedureContext (ExprMap)-import Compilation.ScopeContext-import CompilerCxx.CategoryContext-import CompilerCxx.Code-import CompilerCxx.Naming-import CompilerCxx.Procedure-import Types.Builtin-import Types.DefinedCategory-import Types.Pragma-import Types.Procedure-import Types.TypeCategory-import Types.TypeInstance-import Types.Variance---data CxxOutput =- CxxOutput {- coCategory :: Maybe CategoryName,- coFilename :: String,- coNamespace :: Namespace,- coUsesNamespace :: Set.Set Namespace,- coUsesCategory :: Set.Set CategoryName,- coOutput :: [String]- }- deriving (Show)--data LanguageModule c =- LanguageModule {- lmPublicNamespaces :: Set.Set Namespace,- lmPrivateNamespaces :: Set.Set Namespace,- lmLocalNamespaces :: Set.Set Namespace,- lmPublicDeps :: [AnyCategory c],- lmPrivateDeps :: [AnyCategory c],- lmTestingDeps :: [AnyCategory c],- lmPublicLocal :: [AnyCategory c],- lmPrivateLocal :: [AnyCategory c],- lmTestingLocal :: [AnyCategory c],- lmExternal :: [CategoryName],- lmStreamlined :: [CategoryName],- lmExprMap :: ExprMap c- }--data PrivateSource c =- PrivateSource {- psNamespace :: Namespace,- psTesting :: Bool,- psCategory :: [AnyCategory c],- psDefine :: [DefinedCategory c]- }--compileLanguageModule :: (Ord c, Show c, CollectErrorsM m) =>- LanguageModule c -> [PrivateSource c] -> m [CxxOutput]-compileLanguageModule (LanguageModule ns0 ns1 ns2 cs0 ps0 ts0 cs1 ps1 ts1 ex ss em) xa = do- checkSupefluous $ Set.toList $ (Set.fromList ex) `Set.difference` ca- -- Check public sources up front so that error messages aren't duplicated for- -- every source file.- ta <- tmTesting- xx1 <- fmap concat $ mapErrorsM (compileSourceP False tmPublic nsPublic) cs1- xx2 <- fmap concat $ mapErrorsM (compileSourceP False tmPrivate nsPrivate) ps1- xx3 <- fmap concat $ mapErrorsM (compileSourceP True tmTesting nsTesting) ts1- (ds,xx4) <- fmap mergeGeneratedX $ mapErrorsM compileSourceX xa- xx5 <- fmap concat $ mapErrorsM (\s -> compileConcreteStreamlined (s `Set.member` testingCats) ta s) ss- -- TODO: This should account for a name clash between a category declared in a- -- TestsOnly .0rp and one declared in a non-TestOnly .0rx.- let dm = mapByName ds- checkDefined dm ex $ filter isValueConcrete (cs1 ++ ps1 ++ ts1)- checkStreamlined- return $ xx1 ++ xx2 ++ xx3 ++ xx4 ++ xx5 where- testingCats = Set.fromList $ map getCategoryName ts1- tmPublic = foldM includeNewTypes defaultCategories [cs0,cs1]- tmPrivate = tmPublic >>= \tm -> foldM includeNewTypes tm [ps0,ps1]- tmTesting = tmPrivate >>= \tm -> foldM includeNewTypes tm [ts0,ts1]- nsPublic = ns0 `Set.union` ns2- nsPrivate = ns1 `Set.union` nsPublic- nsTesting = nsPrivate- compileSourceP testing tm ns c = do- tm' <- tm- hxx <- compileCategoryDeclaration testing tm' ns c- cxx <- if isValueConcrete c- then return []- else compileInterfaceDefinition testing c >>= return . (:[])- return (hxx:cxx)- compileSourceX (PrivateSource ns testing cs2 ds) = do- tm <- if testing- then tmTesting- else tmPrivate- let ns4 = if testing- then nsTesting- else nsPrivate- let cs = if testing- then cs1 ++ ps1 ++ ts1- else cs1 ++ ps1- checkLocals ds (ex ++ map getCategoryName (cs2 ++ cs))- when testing $ checkTests ds (cs1 ++ ps1)- let dm = mapByName ds- checkDefined dm [] $ filter isValueConcrete cs2- tm' <- includeNewTypes tm cs2- -- Ensures that there isn't an inavertent collision when resolving- -- dependencies for the module later on.- tmTesting' <- tmTesting- _ <- (includeNewTypes tmTesting' cs2)- hxx <- mapErrorsM (compileCategoryDeclaration testing tm' ns4) cs2- let interfaces = filter (not . isValueConcrete) cs2- cxx1 <- mapErrorsM (compileInterfaceDefinition testing) interfaces- cxx2 <- mapErrorsM (compileDefinition testing tm' (ns `Set.insert` ns4)) ds- return (ds,hxx ++ cxx1 ++ cxx2)- mergeGeneratedX ((ds,xx):xs2) = let (ds2,xx2) = mergeGeneratedX xs2 in (ds++ds2,xx++xx2)- mergeGeneratedX _ = ([],[])- compileDefinition testing tm ns4 d = do- tm' <- mergeInternalInheritance tm d- let refines = dcName d `Map.lookup` tm >>= return . getCategoryRefines- compileConcreteDefinition testing tm' em ns4 refines d- mapByName = Map.fromListWith (++) . map (\d -> (dcName d,[d]))- ca = Set.fromList $ map getCategoryName $ filter isValueConcrete (cs1 ++ ps1 ++ ts1)- checkLocals ds cs2 = mapErrorsM_ (checkLocal $ Set.fromList cs2) ds- checkLocal cs2 d =- when (not $ dcName d `Set.member` cs2) $- compilerErrorM ("Definition for " ++ show (dcName d) ++- formatFullContextBrace (dcContext d) ++- " does not correspond to a visible category in this module")- checkTests ds ps = do- let pa = Map.fromList $ map (\c -> (getCategoryName c,getCategoryContext c)) $ filter isValueConcrete ps- mapErrorsM_ (checkTest pa) ds- checkTest pa d =- case dcName d `Map.lookup` pa of- Nothing -> return ()- Just c ->- compilerErrorM ("Category " ++ show (dcName d) ++- formatFullContextBrace (dcContext d) ++- " was not declared as $TestsOnly$" ++ formatFullContextBrace c)- checkDefined dm ex2 = mapErrorsM_ (checkSingle dm (Set.fromList ex2))- checkSingle dm es t =- case (getCategoryName t `Set.member` es, getCategoryName t `Map.lookup` dm) of- (False,Just [_]) -> return ()- (True,Nothing) -> return ()- (True,Just [d]) ->- compilerErrorM ("Category " ++ show (getCategoryName t) ++- formatFullContextBrace (getCategoryContext t) ++- " was declared external but is also defined at " ++ formatFullContext (dcContext d))- (False,Nothing) ->- compilerErrorM ("Category " ++ show (getCategoryName t) ++- formatFullContextBrace (getCategoryContext t) ++- " has not been defined or declared external")- (_,Just ds) ->- ("Category " ++ show (getCategoryName t) ++- formatFullContextBrace (getCategoryContext t) ++- " is defined " ++ show (length ds) ++ " times") !!>- mapErrorsM_ (\d -> compilerErrorM $ "Defined at " ++ formatFullContext (dcContext d)) ds- checkSupefluous es2- | null es2 = return ()- | otherwise = compilerErrorM $ "External categories either not concrete or not present: " ++- intercalate ", " (map show es2)- checkStreamlined = mapErrorsM_ streamlinedError $ Set.toList $ Set.difference (Set.fromList ss) (Set.fromList ex)- streamlinedError n =- compilerErrorM $ "Category " ++ show n ++ " cannot be streamlined because it was not declared external"--compileTestsModule :: (Ord c, Show c, CollectErrorsM m) =>- LanguageModule c -> Namespace -> [String] -> [AnyCategory c] -> [DefinedCategory c] ->- [TestProcedure c] -> m ([CxxOutput],CxxOutput,[(FunctionName,[c])])-compileTestsModule cm ns args cs ds ts = do- let xs = PrivateSource {- psNamespace = ns,- psTesting = True,- psCategory = cs,- psDefine = ds- }- xx <- compileLanguageModule cm [xs]- (main,fs) <- compileTestMain cm args xs ts- return (xx,main,fs)--compileTestMain :: (Ord c, Show c, CollectErrorsM m) =>- LanguageModule c -> [String] -> PrivateSource c -> [TestProcedure c] ->- m (CxxOutput,[(FunctionName,[c])])-compileTestMain (LanguageModule ns0 ns1 ns2 cs0 ps0 ts0 cs1 ps1 ts1 _ _ em) args ts2 tests = do- tm' <- tm- (CompiledData req main) <- createTestFile tm' em args tests- let output = CxxOutput Nothing testFilename NoNamespace (psNamespace ts2 `Set.insert` Set.unions [ns0,ns1,ns2]) req main- let tests' = map (\t -> (tpName t,tpContext t)) tests- return (output,tests') where- tm = foldM includeNewTypes defaultCategories [cs0,cs1,ps0,ps1,ts0,ts1,psCategory ts2]--compileModuleMain :: (Ord c, Show c, CollectErrorsM m) =>- LanguageModule c -> [PrivateSource c] -> CategoryName -> FunctionName -> m CxxOutput-compileModuleMain (LanguageModule ns0 ns1 ns2 cs0 ps0 _ cs1 ps1 _ _ _ em) xa n f = do- let resolved = filter (\d -> dcName d == n) $ concat $ map psDefine $ filter (not . psTesting) xa- reconcile resolved- tm' <- tm- let cs = filter (\c -> getCategoryName c == n) $ concat $ map psCategory xa- tm'' <- includeNewTypes tm' cs- (ns,main) <- createMainFile tm'' em n f- return $ CxxOutput Nothing mainFilename NoNamespace (ns `Set.insert` Set.unions [ns0,ns1,ns2]) (Set.fromList [n]) main where- tm = foldM includeNewTypes defaultCategories [cs0,cs1,ps0,ps1]- reconcile [_] = return ()- reconcile [] = compilerErrorM $ "No matches for main category " ++ show n ++ " ($TestsOnly$ sources excluded)"- reconcile ds =- "Multiple matches for main category " ++ show n !!>- mapErrorsM_ (\d -> compilerErrorM $ "Defined at " ++ formatFullContext (dcContext d)) ds--compileCategoryDeclaration :: (Ord c, Show c, CollectErrorsM m) =>- Bool -> CategoryMap c -> Set.Set Namespace -> AnyCategory c -> m CxxOutput-compileCategoryDeclaration testing _ ns t =- return $ CxxOutput (Just $ getCategoryName t)- (headerFilename name)- (getCategoryNamespace t)- (getCategoryNamespace t `Set.insert` ns)- (cdRequired file)- (cdOutput file) where- file = mconcat $ [- CompiledData depends [],- onlyCodes guardTop,- onlyCodes $ (if testing then testsOnlyCategoryGuard (getCategoryName t) else []),- onlyCodes baseHeaderIncludes,- addNamespace t content,- onlyCodes guardBottom- ]- depends = getCategoryDeps t- content = onlyCodes $ collection ++ labels ++ getCategory2 ++ getType- name = getCategoryName t- guardTop = ["#ifndef " ++ guardName,"#define " ++ guardName]- guardBottom = ["#endif // " ++ guardName]- guardName = "HEADER_" ++ guardNamespace ++ show name- guardNamespace- | isStaticNamespace $ getCategoryNamespace t = show (getCategoryNamespace t) ++ "_"- | otherwise = ""- labels = map label $ filter ((== name) . sfType) $ getCategoryFunctions t- label f = "extern " ++ functionLabelType f ++ " " ++ functionName f ++ ";"- collection- | isValueConcrete t = []- | otherwise = ["extern const void* const " ++ collectionName name ++ ";"]- getCategory2- | isInstanceInterface t = []- | otherwise = declareGetCategory t- getType- | isInstanceInterface t = []- | otherwise = declareGetType t--compileInterfaceDefinition :: CollectErrorsM m => Bool -> AnyCategory c -> m CxxOutput-compileInterfaceDefinition testing t = do- te <- typeConstructor- commonDefineAll testing t Set.empty Nothing emptyCode emptyCode emptyCode te []- where- typeConstructor = do- let ps = map vpParam $ getCategoryParams t- let argParent = categoryName (getCategoryName t) ++ "& p"- let argsPassed = "Params<" ++ show (length ps) ++ ">::Type params"- let allArgs = intercalate ", " [argParent,argsPassed]- let initParent = "parent(p)"- let initPassed = map (\(i,p) -> paramName p ++ "(std::get<" ++ show i ++ ">(params))") $ zip ([0..] :: [Int]) ps- let allInit = intercalate ", " $ initParent:initPassed- return $ onlyCode $ typeName (getCategoryName t) ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {}"--compileConcreteTemplate :: (Ord c, Show c, CollectErrorsM m) =>- Bool -> CategoryMap c -> CategoryName -> m CxxOutput-compileConcreteTemplate testing ta n = do- (_,t) <- getConcreteCategory ta ([],n)- compileConcreteDefinition testing ta Map.empty Set.empty Nothing (defined t) <?? "In generated template for " ++ show n where- defined t = DefinedCategory {- dcContext = [],- dcName = getCategoryName t,- dcParams = [],- dcRefines = [],- dcDefines = [],- dcParamFilter = [],- dcMembers = [],- dcProcedures = map defaultFail (getCategoryFunctions t),- dcFunctions = []- }- defaultFail f = ExecutableProcedure {- epContext = [],- epPragmas = [],- epEnd = [],- epName = sfName f,- epArgs = ArgValues [] $ Positional $ map createArg [1..(length $ pValues $ sfArgs f)],- epReturns = UnnamedReturns [],- epProcedure = failProcedure f- }- createArg = InputValue [] . VariableName . ("arg" ++) . show- failProcedure f = Procedure [] [- NoValueExpression [] $ LineComment $ "TODO: Implement " ++ funcName f ++ ".",- FailCall [] (Literal (StringLiteral [] $ funcName f ++ " is not implemented"))- ]- funcName f = show (sfType f) ++ "." ++ show (sfName f)--compileConcreteStreamlined :: (Ord c, Show c, CollectErrorsM m) =>- Bool -> CategoryMap c -> CategoryName -> m [CxxOutput]-compileConcreteStreamlined testing ta n = "In streamlined compilation of " ++ show n ??> do- (_,t) <- getConcreteCategory ta ([],n)- let guard = if testing- then testsOnlySourceGuard- else noTestsOnlySourceGuard- -- TODO: Implement this.- let hxx = CxxOutput (Just $ getCategoryName t)- (headerStreamlined $ getCategoryName t)- (getCategoryNamespace t)- (Set.fromList [getCategoryNamespace t])- (Set.fromList $ getCategoryMentions t)- guard- let cxx = CxxOutput (Just $ getCategoryName t)- (sourceStreamlined $ getCategoryName t)- (getCategoryNamespace t)- (Set.fromList [getCategoryNamespace t])- (Set.fromList $ getCategoryMentions t)- []- return [hxx,cxx]--compileConcreteDefinition :: (Ord c, Show c, CollectErrorsM m) =>- Bool -> CategoryMap c -> ExprMap c -> Set.Set Namespace -> Maybe [ValueRefine c] ->- DefinedCategory c -> m CxxOutput-compileConcreteDefinition testing ta em ns rs dd@(DefinedCategory c n pi _ _ fi ms _ fs) = do- (_,t) <- getConcreteCategory ta (c,n)- let r = CategoryResolver ta- [cp,tp,vp] <- getProcedureScopes ta em dd- let (cm,tm,vm) = partitionByScope dmScope ms- let filters = getCategoryFilters t- let filters2 = fi- allFilters <- getFilterMap (getCategoryParams t ++ pi) $ filters ++ filters2- -- Functions explicitly declared externally.- let externalFuncs = Set.fromList $ map sfName $ filter ((== n) . sfType) $ getCategoryFunctions t- -- Functions explicitly declared internally.- let overrideFuncs = Map.fromList $ map (\f -> (sfName f,f)) fs- -- Functions only declared internally.- let internalFuncs = Map.filter (not . (`Set.member` externalFuncs) . sfName) overrideFuncs- let fe = Map.elems internalFuncs- let allFuncs = getCategoryFunctions t ++ fe- cf <- collectAllM $ applyProcedureScope compileExecutableProcedure cp- ce <- concatM [- categoryConstructor t cm,- categoryDispatch allFuncs,- return $ mconcat $ map fst cf,- concatM $ map (createMemberLazy r allFilters) cm- ]- tf <- collectAllM $ applyProcedureScope compileExecutableProcedure tp- disallowTypeMembers tm- te <- concatM [- typeConstructor t tm,- typeDispatch allFuncs,- return $ mconcat $ map fst tf,- concatM $ map (createMember r allFilters) tm- ]- vf <- collectAllM $ applyProcedureScope compileExecutableProcedure vp- let internalCount = length pi- let memberCount = length vm- top <- concatM [- return $ onlyCode $ "class " ++ valueName n ++ ";",- declareInternalValue n internalCount memberCount- ]- defineValue <- concatM [- return $ onlyCode $ "struct " ++ valueName n ++ " : public " ++ valueBase ++ " {",- fmap indentCompiled $ valueConstructor vm,- fmap indentCompiled $ valueDispatch allFuncs,- return $ indentCompiled $ defineCategoryName ValueScope n,- return $ indentCompiled $ mconcat $ map fst vf,- fmap indentCompiled $ concatM $ map (createMember r allFilters) vm,- fmap indentCompiled $ createParams,- return $ indentCompiled $ onlyCode $ "const S<" ++ typeName n ++ "> parent;",- return $ indentCompiled $ onlyCodes $ traceCreation (psProcedures vp),- return $ onlyCode "};"- ]- bottom <- concatM $ [- return $ defineValue,- defineInternalValue n internalCount memberCount- ] ++ map (return . snd) (cf ++ tf ++ vf)- commonDefineAll testing t ns rs top bottom ce te fe- where- disallowTypeMembers :: (Ord c, Show c, CollectErrorsM m) =>- [DefinedMember c] -> m ()- disallowTypeMembers tm =- collectAllM_ $ flip map tm- (\m -> compilerErrorM $ "Member " ++ show (dmName m) ++- " is not allowed to be @type-scoped" ++- formatFullContextBrace (dmContext m))- createParams = concatM $ map createParam pi- createParam p = return $ onlyCode $ paramType ++ " " ++ paramName (vpParam p) ++ ";"- -- TODO: Can probably remove this if @type members are disallowed. Or, just- -- skip it if there are no @type members.- getCycleCheck n2 = [- "CycleCheck<" ++ n2 ++ ">::Check();",- "CycleCheck<" ++ n2 ++ "> marker(*this);"- ]- categoryConstructor t ms2 = do- ctx <- getContextForInit ta em t dd CategoryScope- initMembers <- runDataCompiler (sequence $ map compileLazyInit ms2) ctx- let initMembersStr = intercalate ", " $ cdOutput initMembers- let initColon = if null initMembersStr then "" else " : "- concatM [- return $ onlyCode $ categoryName n ++ "()" ++ initColon ++ initMembersStr ++ " {",- return $ indentCompiled $ onlyCodes $ getCycleCheck (categoryName n),- return $ indentCompiled $ onlyCode $ startInitTracing n CategoryScope,- return $ onlyCode "}",- return $ clearCompiled initMembers -- Inherit required types.- ]- typeConstructor t ms2 = do- let ps2 = map vpParam $ getCategoryParams t- let argParent = categoryName n ++ "& p"- let paramsPassed = "Params<" ++ show (length ps2) ++ ">::Type params"- let allArgs = intercalate ", " [argParent,paramsPassed]- let initParent = "parent(p)"- let initPassed = map (\(i,p) -> paramName p ++ "(std::get<" ++ show i ++ ">(params))") $ zip ([0..] :: [Int]) ps2- let allInit = intercalate ", " $ initParent:initPassed- ctx <- getContextForInit ta em t dd TypeScope- initMembers <- runDataCompiler (sequence $ map compileRegularInit ms2) ctx- concatM [- return $ onlyCode $ typeName n ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {",- return $ indentCompiled $ onlyCodes $ getCycleCheck (typeName n),- return $ indentCompiled $ onlyCode $ startInitTracing n TypeScope,- return $ indentCompiled $ initMembers,- return $ onlyCode "}"- ]- valueConstructor ms2 = do- let argParent = "S<" ++ typeName n ++ "> p"- let paramsPassed = "const ParamTuple& params"- let argsPassed = "const ValueTuple& args"- let allArgs = intercalate ", " [argParent,paramsPassed,argsPassed]- let initParent = "parent(p)"- let initParams = map (\(i,p) -> paramName (vpParam p) ++ "(params.At(" ++ show i ++ "))") $ zip ([0..] :: [Int]) pi- let initArgs = map (\(i,m) -> variableName (dmName m) ++ "(" ++ unwrappedArg i m ++ ")") $ zip ([0..] :: [Int]) ms2- let allInit = intercalate ", " $ initParent:(initParams ++ initArgs)- return $ onlyCode $ valueName n ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {}"- unwrappedArg i m = writeStoredVariable (dmType m) (UnwrappedSingle $ "args.At(" ++ show i ++ ")")- createMember r filters m = do- validateGeneralInstance r filters (vtType $ dmType m) <??- "In creation of " ++ show (dmName m) ++ " at " ++ formatFullContext (dmContext m)- return $ onlyCode $ variableStoredType (dmType m) ++ " " ++ variableName (dmName m) ++ ";"- createMemberLazy r filters m = do- validateGeneralInstance r filters (vtType $ dmType m) <??- "In creation of " ++ show (dmName m) ++ " at " ++ formatFullContext (dmContext m)- return $ onlyCode $ variableLazyType (dmType m) ++ " " ++ variableName (dmName m) ++ ";"- categoryDispatch fs2 =- return $ onlyCodes $ [- "ReturnTuple Dispatch(" ++- "const CategoryFunction& label, " ++- "const ParamTuple& params, " ++- "const ValueTuple& args) final {"- ] ++ createFunctionDispatch n CategoryScope fs2 ++ ["}"]- typeDispatch fs2 =- return $ onlyCodes $ [- "ReturnTuple Dispatch(" ++- "const S<TypeInstance>& self, " ++- "const TypeFunction& label, " ++- "const ParamTuple& params, " ++- "const ValueTuple& args) final {"- ] ++ createFunctionDispatch n TypeScope fs2 ++ ["}"]- valueDispatch fs2 =- return $ onlyCodes $ [- "ReturnTuple Dispatch(" ++- "const S<TypeValue>& self, " ++- "const ValueFunction& label, " ++- "const ParamTuple& params," ++- "const ValueTuple& args) final {"- ] ++ createFunctionDispatch n ValueScope fs2 ++ ["}"]- traceCreation vp- | any isTraceCreation $ concat $ map (epPragmas . snd) vp = [captureCreationTrace]- | otherwise = []--commonDefineAll :: CollectErrorsM m =>- Bool -> AnyCategory c -> Set.Set Namespace -> Maybe [ValueRefine c] ->- CompiledData [String] -> CompiledData [String] -> CompiledData [String] ->- CompiledData [String] -> [ScopedFunction c] -> m CxxOutput-commonDefineAll testing t ns rs top bottom ce te fe = do- let filename = sourceFilename name- (CompiledData req out) <- fmap (addNamespace t) $ concatM $ [- return $ CompiledData (Set.fromList (name:getCategoryMentions t)) [],- return $ mconcat [createCollection,createAllLabels]- ] ++ conditionalContent- let rs' = case rs of- Nothing -> []- Just rs2 -> rs2- let guard = if testing- then testsOnlySourceGuard- else noTestsOnlySourceGuard- let inherited = Set.unions $ (map (categoriesFromRefine . vrType) (getCategoryRefines t ++ rs')) ++- (map (categoriesFromDefine . vdType) $ getCategoryDefines t)- let includes = map (\i -> "#include \"" ++ headerFilename i ++ "\"") $- Set.toList $ Set.union req inherited- return $ CxxOutput (Just $ getCategoryName t)- filename- (getCategoryNamespace t)- (getCategoryNamespace t `Set.insert` ns)- req- (guard ++ baseSourceIncludes ++ includes ++ out)- where- conditionalContent- | isInstanceInterface t = []- | otherwise = [- return $ onlyCode $ "namespace {",- declareTypes,- declareInternalType name paramCount,- return top,- commonDefineCategory t ce,- return $ onlyCodes getInternal,- commonDefineType t rs te,- defineInternalType name paramCount,- return bottom,- return $ onlyCode $ "} // namespace",- return $ onlyCodes $ getCategory2 ++ getType- ]- declareTypes =- return $ onlyCodes $ map (\f -> "class " ++ f name ++ ";") [categoryName,typeName]- paramCount = length $ getCategoryParams t- name = getCategoryName t- createCollection = onlyCodes [- "namespace {",- "const int " ++ collectionValName ++ " = 0;",- "} // namespace",- "const void* const " ++ collectionName name ++ " = &" ++ collectionValName ++ ";"- ]- collectionValName = "collection_" ++ show name- (fc,ft,fv) = partitionByScope sfScope $ getCategoryFunctions t ++ fe- createAllLabels = onlyCodes $ concat $ map createLabels [fc,ft,fv]- createLabels = map (uncurry createLabelForFunction) . zip [0..] . sortBy compareName . filter ((== name) . sfType)- getInternal = defineInternalCategory t- getCategory2 = defineGetCatetory t- getType = defineGetType t- compareName x y = sfName x `compare` sfName y--addNamespace :: AnyCategory c -> CompiledData [String] -> CompiledData [String]-addNamespace t cs- | isStaticNamespace $ getCategoryNamespace t = mconcat [- onlyCode $ "namespace " ++ show (getCategoryNamespace t) ++ " {",- cs,- onlyCode $ "} // namespace " ++ show (getCategoryNamespace t),- onlyCode $ "using namespace " ++ show (getCategoryNamespace t) ++ ";"- ]- | isPublicNamespace $ getCategoryNamespace t = mconcat [- onlyCode $ "#ifdef " ++ publicNamespaceMacro,- onlyCode $ "namespace " ++ publicNamespaceMacro ++ " {",- onlyCode $ "#endif // " ++ publicNamespaceMacro,- cs,- onlyCode $ "#ifdef " ++ publicNamespaceMacro,- onlyCode $ "} // namespace " ++ publicNamespaceMacro,- onlyCode $ "using namespace " ++ publicNamespaceMacro ++ ";",- onlyCode $ "#endif // " ++ publicNamespaceMacro- ]- | isPrivateNamespace $ getCategoryNamespace t = mconcat [- onlyCode $ "#ifdef " ++ privateNamespaceMacro,- onlyCode $ "namespace " ++ privateNamespaceMacro ++ " {",- onlyCode $ "#endif // " ++ privateNamespaceMacro,- cs,- onlyCode $ "#ifdef " ++ privateNamespaceMacro,- onlyCode $ "} // namespace " ++ privateNamespaceMacro,- onlyCode $ "using namespace " ++ privateNamespaceMacro ++ ";",- onlyCode $ "#endif // " ++ privateNamespaceMacro- ]- | otherwise = cs--createLabelForFunction :: Int -> ScopedFunction c -> String-createLabelForFunction i f = functionLabelType f ++ " " ++ functionName f ++- " = " ++ newFunctionLabel i f ++ ";"--createFunctionDispatch :: CategoryName -> SymbolScope -> [ScopedFunction c] -> [String]-createFunctionDispatch n s fs = [typedef] ++ concat (map table $ byCategory) ++- concat (map dispatch $ byCategory) ++ [fallback] where- filtered = filter ((== s) . sfScope) fs- flatten f = f:(concat $ map flatten $ sfMerges f)- flattened = concat $ map flatten filtered- byCategory = Map.toList $ Map.fromListWith (++) $ map (\f -> (sfType f,[f])) flattened- typedef- | s == CategoryScope = " using CallType = ReturnTuple(" ++ categoryName n ++- "::*)(const ParamTuple&, const ValueTuple&);"- | s == TypeScope = " using CallType = ReturnTuple(" ++ typeName n ++- "::*)(const S<TypeInstance>&, const ParamTuple&, const ValueTuple&);"- | s == ValueScope = " using CallType = ReturnTuple(" ++ valueName n ++- "::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);"- | otherwise = undefined- name f- | s == CategoryScope = categoryName n ++ "::" ++ callName f- | s == TypeScope = typeName n ++ "::" ++ callName f- | s == ValueScope = valueName n ++ "::" ++ callName f- | otherwise = undefined- table (n2,fs2) =- [" static const CallType " ++ tableName n2 ++ "[] = {"] ++- map (\f -> " &" ++ name f ++ ",") (Set.toList $ Set.fromList $ map sfName fs2) ++- [" };"]- dispatch (n2,_) = [- " if (label.collection == " ++ collectionName n2 ++ ") {",- " if (label.function_num < 0 || label.function_num >= sizeof " ++ tableName n2 ++ " / sizeof(CallType)) {",- " FAIL() << \"Bad function call \" << label;",- " }",- " return (this->*" ++ tableName n2 ++ "[label.function_num])(" ++ args ++ ");",- " }"- ]- args- | s == CategoryScope = "params, args"- | s == TypeScope = "self, params, args"- | s == ValueScope = "self, params, args"- | otherwise = undefined- fallback- | s == CategoryScope = " return TypeCategory::Dispatch(label, params, args);"- | s == TypeScope = " return TypeInstance::Dispatch(self, label, params, args);"- | s == ValueScope = " return TypeValue::Dispatch(self, label, params, args);"- | otherwise = undefined--commonDefineCategory :: CollectErrorsM m =>- AnyCategory c -> CompiledData [String] -> m (CompiledData [String])-commonDefineCategory t extra = do- concatM $ [- return $ onlyCode $ "struct " ++ categoryName name ++ " : public " ++ categoryBase ++ " {",- return $ indentCompiled $ defineCategoryName CategoryScope name,- return $ indentCompiled extra,- return $ onlyCode "};"- ]- where- name = getCategoryName t--commonDefineType :: CollectErrorsM m =>- AnyCategory c -> Maybe [ValueRefine c] -> CompiledData [String] -> m (CompiledData [String])-commonDefineType t rs extra = do- let rs' = case rs of- Nothing -> getCategoryRefines t- Just rs2 -> rs2- concatM [- return $ CompiledData depends [],- return $ onlyCode $ "struct " ++ typeName (getCategoryName t) ++ " : public " ++ typeBase ++ " {",- return $ indentCompiled $ defineCategoryName TypeScope name,- return $ indentCompiled $ defineTypeName name (map vpParam $ getCategoryParams t),- return $ indentCompiled $ onlyCode $ categoryName (getCategoryName t) ++ "& parent;",- return $ indentCompiled createParams,- return $ indentCompiled canConvertFrom,- return $ indentCompiled $ typeArgsForParent rs',- return $ indentCompiled extra,- return $ onlyCode "};"- ]- where- name = getCategoryName t- depends = getCategoryDeps t- createParams = mconcat $ map createParam $ getCategoryParams t- createParam p = onlyCode $ paramType ++ " " ++ paramName (vpParam p) ++ ";"- canConvertFrom- | isInstanceInterface t = emptyCode- | otherwise = onlyCodes $ [- "bool CanConvertFrom(const S<const TypeInstance>& from) const final {",- -- TODO: This should be a typedef.- " std::vector<S<const TypeInstance>> args;",- " if (!from->TypeArgsForParent(parent, args)) return false;",- -- TODO: Create a helper function for this error.- " if(args.size() != " ++ show (length params) ++ ") {",- " FAIL() << \"Wrong number of args (\" << args.size() << \") for \" << CategoryName();",- " }"- ] ++ checks ++ [" return true;","}"]- params = map (\p -> (vpParam p,vpVariance p)) $ getCategoryParams t- checks = concat $ map singleCheck $ zip ([0..] :: [Int]) params- singleCheck (i,(p,Covariant)) = [checkCov i p]- singleCheck (i,(p,Contravariant)) = [checkCon i p]- singleCheck (i,(p,Invariant)) = [checkCov i p,checkCon i p]- checkCov i p = " if (!TypeInstance::CanConvert(args[" ++ show i ++ "], " ++ paramName p ++ ")) return false;"- checkCon i p = " if (!TypeInstance::CanConvert(" ++ paramName p ++ ", args[" ++ show i ++ "])) return false;"- typeArgsForParent rs2- | isInstanceInterface t = emptyCode- | otherwise = onlyCodes $ [- "bool TypeArgsForParent(" ++- "const TypeCategory& category, " ++- "std::vector<S<const TypeInstance>>& args) const final {"- ] ++ allCats rs2 ++ [" return false;","}"]- myType = (getCategoryName t,map (singleType . JustParamName False . fst) params)- refines rs2 = map (\r -> (tiName r,pValues $ tiParams r)) $ map vrType rs2- allCats rs2 = concat $ map singleCat (myType:refines rs2)- singleCat (t2,ps) = [- " if (&category == &" ++ categoryGetter t2 ++ "()) {",- " args = std::vector<S<const TypeInstance>>{" ++ expanded ++ "};",- " return true;",- " }"- ]- where- expanded = intercalate ", " $ map expandLocalType ps---- Similar to Procedure.expandGeneralInstance but doesn't account for scope.-expandLocalType :: GeneralInstance -> String-expandLocalType t- | t == minBound = allGetter ++ "()"- | t == maxBound = anyGetter ++ "()"-expandLocalType t = reduceMergeTree getAny getAll getSingle t where- getAny ts = unionGetter ++ combine ts- getAll ts = intersectGetter ++ combine ts- getSingle (JustTypeInstance (TypeInstance t2 ps)) =- typeGetter t2 ++ "(T_get(" ++ intercalate ", " (map expandLocalType $ pValues ps) ++ "))"- getSingle (JustParamName _ p) = paramName p- getSingle (JustInferredType p) = paramName p- combine ps = "(L_get<" ++ typeBase ++ "*>(" ++ intercalate "," (map ("&" ++) ps) ++ "))"--defineCategoryName :: SymbolScope -> CategoryName -> CompiledData [String]-defineCategoryName TypeScope _ = onlyCode $ "std::string CategoryName() const final { return parent.CategoryName(); }"-defineCategoryName ValueScope _ = onlyCode $ "std::string CategoryName() const final { return parent->CategoryName(); }"-defineCategoryName _ t = onlyCode $ "std::string CategoryName() const final { return \"" ++ show t ++ "\"; }"--defineTypeName :: CategoryName -> [ParamName] -> CompiledData [String]-defineTypeName _ ps =- onlyCodes [- "void BuildTypeName(std::ostream& output) const final {",- " return TypeInstance::TypeNameFrom(output, parent" ++ concat (map ((", " ++) . paramName) ps) ++ ");",- "}"- ]--declareGetCategory :: AnyCategory c -> [String]-declareGetCategory t = [categoryBase ++ "& " ++ categoryGetter (getCategoryName t) ++ "();"]--defineGetCatetory :: AnyCategory c -> [String]-defineGetCatetory t = [- categoryBase ++ "& " ++ categoryGetter (getCategoryName t) ++ "() {",- " return " ++ categoryCreator (getCategoryName t) ++ "();",- "}"- ]--declareGetType :: AnyCategory c -> [String]-declareGetType t = ["S<" ++ typeBase ++ "> " ++ typeGetter (getCategoryName t) ++ "(Params<" ++- show (length $getCategoryParams t) ++ ">::Type params);"]--defineGetType :: AnyCategory c -> [String]-defineGetType t = [- "S<" ++ typeBase ++ "> " ++ typeGetter (getCategoryName t) ++ "(Params<" ++- show (length $ getCategoryParams t) ++ ">::Type params) {",- " return " ++ typeCreator (getCategoryName t) ++ "(params);",- "}"- ]--defineInternalCategory :: AnyCategory c -> [String]-defineInternalCategory t = [- internal ++ "& " ++ categoryCreator (getCategoryName t) ++ "() {",- " static auto& category = *new " ++ internal ++ "();",- " return category;",- "}"- ]- where- internal = categoryName (getCategoryName t)--declareInternalType :: Monad m =>- CategoryName -> Int -> m (CompiledData [String])-declareInternalType t n =- return $ onlyCode $ "S<" ++ typeName t ++ "> " ++ typeCreator t ++- "(Params<" ++ show n ++ ">::Type params);"--defineInternalType :: Monad m =>- CategoryName -> Int -> m (CompiledData [String])-defineInternalType t n- | n < 1 =- return $ onlyCodes [- "S<" ++ typeName t ++ "> " ++ typeCreator t ++ "(Params<" ++ show n ++ ">::Type params) {",- " static const auto cached = S_get(new " ++ typeName t ++ "(" ++ categoryCreator t ++ "(), Params<" ++ show n ++ ">::Type()));",- " return cached;",- "}"- ]- | otherwise =- return $ onlyCodes [- "S<" ++ typeName t ++ "> " ++ typeCreator t ++ "(Params<" ++ show n ++ ">::Type params) {",- " static auto& cache = *new WeakInstanceMap<" ++ show n ++ ", " ++ typeName t ++ ">();",- " static auto& cache_mutex = *new std::mutex;",- " std::lock_guard<std::mutex> lock(cache_mutex);",- " auto& cached = cache[GetKeyFromParams<" ++ show n ++ ">(params)];",- " S<" ++ typeName t ++ "> type = cached;",- " if (!type) { cached = type = S_get(new " ++ typeName t ++ "(" ++ categoryCreator t ++ "(), params)); }",- " return type;",- "}"- ]--declareInternalValue :: Monad m =>- CategoryName -> Int -> Int -> m (CompiledData [String])-declareInternalValue t _ _ =- return $ onlyCodes [- "S<TypeValue> " ++ valueCreator t ++- "(S<" ++ typeName t ++ "> parent, " ++- "const ParamTuple& params, const ValueTuple& args);"- ]--defineInternalValue :: Monad m =>- CategoryName -> Int -> Int -> m (CompiledData [String])-defineInternalValue t _ _ =- return $ onlyCodes [- "S<TypeValue> " ++ valueCreator t ++ "(S<" ++ typeName t ++ "> parent, " ++- "const ParamTuple& params, const ValueTuple& args) {",- " return S_get(new " ++ valueName t ++ "(parent, params, args));",- "}"- ]--createMainCommon :: String -> CompiledData [String] -> CompiledData [String] -> [String]-createMainCommon n (CompiledData req0 out0) (CompiledData req1 out1) =- baseSourceIncludes ++ mainSourceIncludes ++ depIncludes (req0 `Set.union` req1) ++ out0 ++ [- "int main(int argc, const char** argv) {",- " SetSignalHandler();",- " " ++ startFunctionTracing CategoryNone (FunctionName n)- ] ++ map (" " ++) out1 ++ ["}"] where- depIncludes req2 = map (\i -> "#include \"" ++ headerFilename i ++ "\"") $- Set.toList req2--createMainFile :: (Ord c, Show c, CollectErrorsM m) =>- CategoryMap c -> ExprMap c -> CategoryName -> FunctionName -> m (Namespace,[String])-createMainFile tm em n f = "In the creation of the main binary procedure" ??> do- ca <- compileMainProcedure tm em expr- let file = noTestsOnlySourceGuard ++ createMainCommon "main" emptyCode (argv <> ca)- (_,t) <- getConcreteCategory tm ([],n)- return (getCategoryNamespace t,file) where- funcCall = FunctionCall [] f (Positional []) (Positional [])- mainType = JustTypeInstance $ TypeInstance n (Positional [])- expr = Expression [] (TypeCall [] mainType funcCall) []- argv = onlyCode "ProgramArgv program_argv(argc, argv);"--createTestFile :: (Ord c, Show c, CollectErrorsM m) =>- CategoryMap c -> ExprMap c -> [String] -> [TestProcedure c] -> m (CompiledData [String])-createTestFile tm em args ts = "In the creation of the test binary procedure" ??> do- ts' <- fmap mconcat $ mapErrorsM (compileTestProcedure tm em) ts- (include,sel) <- selectTestFromArgv1 $ map tpName ts- let (CompiledData req _) = ts' <> sel- let file = testsOnlySourceGuard ++ createMainCommon "testcase" (onlyCodes include <> ts') (argv <> sel)- return $ CompiledData req file where- args' = map escapeChars args- argv = onlyCodes [- "const char* argv2[] = { \"testcase\" " ++ concat (map (", " ++) args') ++ " };",- "ProgramArgv program_argv(sizeof argv2 / sizeof(char*), argv2);"- ]--getCategoryMentions :: AnyCategory c -> [CategoryName]-getCategoryMentions t = fromRefines (getCategoryRefines t) ++- fromDefines (getCategoryDefines t) ++- fromFunctions (getCategoryFunctions t) ++- fromFilters (getCategoryFilters t) where- fromRefines rs = Set.toList $ Set.unions $ map (categoriesFromRefine . vrType) rs- fromDefines ds = Set.toList $ Set.unions $ map (categoriesFromDefine . vdType) ds- fromDefine (DefinesInstance d ps) = d:(fromGenerals $ pValues ps)- fromFunctions fs = concat $ map fromFunction fs- fromFunction (ScopedFunction _ _ t2 _ as rs _ fs _) =- [t2] ++ (fromGenerals $ map (vtType . pvType) (pValues as ++ pValues rs)) ++ fromFilters fs- fromFilters fs = concat $ map (fromFilter . pfFilter) fs- fromFilter (TypeFilter _ t2) = Set.toList $ categoriesFromTypes t2- fromFilter (DefinesFilter t2) = fromDefine t2- fromGenerals = Set.toList . Set.unions . map categoriesFromTypes
src/CompilerCxx/CategoryContext.hs view
@@ -59,32 +59,32 @@ let builtin = Map.filter ((== LocalScope) . vvScope) $ builtinVariables typeInstance members <- mapMembers $ filter ((<= s) . dmScope) (dcMembers d) return $ ProcedureContext {- pcScope = s,- pcType = getCategoryName t,- pcExtParams = ps,- pcIntParams = Positional [],- pcMembers = ms,- pcCategories = tm,- pcAllFilters = fm,- pcExtFilters = pa,- pcIntFilters = [],- pcParamScopes = sa,- pcFunctions = fa,- pcVariables = Map.union builtin members,- pcReturns = ValidatePositions (Positional []),- pcJumpType = NextStatement,- pcIsNamed = False,- pcPrimNamed = [],- pcRequiredTypes = Set.empty,- pcOutput = [],- pcDisallowInit = True,- pcLoopSetup = NotInLoop,- pcCleanupBlocks = [],- pcInCleanup = False,- pcUsedVars = [],- pcExprMap = em,- pcReservedMacros = [],- pcNoTrace = False+ _pcScope = s,+ _pcType = getCategoryName t,+ _pcExtParams = ps,+ _pcIntParams = Positional [],+ _pcMembers = ms,+ _pcCategories = tm,+ _pcAllFilters = fm,+ _pcExtFilters = pa,+ _pcIntFilters = [],+ _pcParamScopes = sa,+ _pcFunctions = fa,+ _pcVariables = Map.union builtin members,+ _pcReturns = ValidatePositions (Positional []),+ _pcJumpType = NextStatement,+ _pcIsNamed = False,+ _pcPrimNamed = [],+ _pcRequiredTypes = Set.empty,+ _pcOutput = [],+ _pcDisallowInit = True,+ _pcLoopSetup = NotInLoop,+ _pcCleanupBlocks = [],+ _pcInCleanup = False,+ _pcUsedVars = [],+ _pcExprMap = em,+ _pcReservedMacros = [],+ _pcNoTrace = False } getProcedureContext :: (Show c, CollectErrorsM m) =>@@ -121,63 +121,63 @@ else zipWith3 ReturnVariable [0..] (map ovName $ pValues $ nrNames rs2) (map pvType $ pValues rs1) let ns = filter (isPrimType . rvType) ns0 return $ ProcedureContext {- pcScope = s,- pcType = t,- pcExtParams = ps,- pcIntParams = pi,- pcMembers = ms,- pcCategories = tm,- pcAllFilters = allFilters,- pcExtFilters = pa',+ _pcScope = s,+ _pcType = t,+ _pcExtParams = ps,+ _pcIntParams = pi,+ _pcMembers = ms,+ _pcCategories = tm,+ _pcAllFilters = allFilters,+ _pcExtFilters = pa', -- fs is duplicated so value initialization checks work properly.- pcIntFilters = fi ++ fs,- pcParamScopes = sa,- pcFunctions = fa,- pcVariables = va'',- pcReturns = rs',- pcJumpType = NextStatement,- pcIsNamed = not (isUnnamedReturns rs2),- pcPrimNamed = ns,- pcRequiredTypes = Set.empty,- pcOutput = [],- pcDisallowInit = False,- pcLoopSetup = NotInLoop,- pcCleanupBlocks = [],- pcInCleanup = False,- pcUsedVars = [],- pcExprMap = em,- pcReservedMacros = [],- pcNoTrace = False+ _pcIntFilters = fi ++ fs,+ _pcParamScopes = sa,+ _pcFunctions = fa,+ _pcVariables = va'',+ _pcReturns = rs',+ _pcJumpType = NextStatement,+ _pcIsNamed = not (isUnnamedReturns rs2),+ _pcPrimNamed = ns,+ _pcRequiredTypes = Set.empty,+ _pcOutput = [],+ _pcDisallowInit = False,+ _pcLoopSetup = NotInLoop,+ _pcCleanupBlocks = [],+ _pcInCleanup = False,+ _pcUsedVars = [],+ _pcExprMap = em,+ _pcReservedMacros = [],+ _pcNoTrace = False } where pairOutput (PassedValue c1 t2) (OutputValue c2 n2) = return $ (n2,PassedValue (c2++c1) t2) getMainContext :: CollectErrorsM m => CategoryMap c -> ExprMap c -> m (ProcedureContext c) getMainContext tm em = return $ ProcedureContext {- pcScope = LocalScope,- pcType = CategoryNone,- pcExtParams = Positional [],- pcIntParams = Positional [],- pcMembers = [],- pcCategories = tm,- pcAllFilters = Map.empty,- pcExtFilters = [],- pcIntFilters = [],- pcParamScopes = Map.empty,- pcFunctions = Map.empty,- pcVariables = Map.empty,- pcReturns = ValidatePositions (Positional []),- pcJumpType = NextStatement,- pcIsNamed = False,- pcPrimNamed = [],- pcRequiredTypes = Set.empty,- pcOutput = [],- pcDisallowInit = False,- pcLoopSetup = NotInLoop,- pcCleanupBlocks = [],- pcInCleanup = False,- pcUsedVars = [],- pcExprMap = em,- pcReservedMacros = [],- pcNoTrace = False+ _pcScope = LocalScope,+ _pcType = CategoryNone,+ _pcExtParams = Positional [],+ _pcIntParams = Positional [],+ _pcMembers = [],+ _pcCategories = tm,+ _pcAllFilters = Map.empty,+ _pcExtFilters = [],+ _pcIntFilters = [],+ _pcParamScopes = Map.empty,+ _pcFunctions = Map.empty,+ _pcVariables = Map.empty,+ _pcReturns = ValidatePositions (Positional []),+ _pcJumpType = NextStatement,+ _pcIsNamed = False,+ _pcPrimNamed = [],+ _pcRequiredTypes = Set.empty,+ _pcOutput = [],+ _pcDisallowInit = False,+ _pcLoopSetup = NotInLoop,+ _pcCleanupBlocks = [],+ _pcInCleanup = False,+ _pcUsedVars = [],+ _pcExprMap = em,+ _pcReservedMacros = [],+ _pcNoTrace = False }
+ src/CompilerCxx/CxxFiles.hs view
@@ -0,0 +1,904 @@+{- -----------------------------------------------------------------------------+Copyright 2019-2021 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++{-# LANGUAGE CPP #-}+{-# LANGUAGE Safe #-}++module CompilerCxx.CxxFiles (+ CxxOutput(..),+ FileContext(..),+ generateMainFile,+ generateNativeConcrete,+ generateNativeInterface,+ generateStreamlinedExtension,+ generateStreamlinedTemplate,+ generateTestFile,+ generateVerboseExtension,+) where++import Data.List (intercalate,sortBy)+import Prelude hiding (pi)+import qualified Data.Map as Map+import qualified Data.Set as Set++#if MIN_VERSION_base(4,11,0)+#else+import Data.Semigroup+#endif++import Base.CompilerError+import Base.GeneralType+import Base.MergeTree+import Base.Positional+import Compilation.CompilerState+import Compilation.ProcedureContext (ExprMap)+import Compilation.ScopeContext+import CompilerCxx.CategoryContext+import CompilerCxx.Code+import CompilerCxx.Naming+import CompilerCxx.Procedure+import Types.Builtin+import Types.DefinedCategory+import Types.Procedure+import Types.TypeCategory+import Types.TypeInstance+import Types.Variance+++data CxxOutput =+ CxxOutput {+ coCategory :: Maybe CategoryName,+ coFilename :: String,+ coNamespace :: Namespace,+ coUsesNamespace :: Set.Set Namespace,+ coUsesCategory :: Set.Set CategoryName,+ coOutput :: [String]+ }+ deriving (Show)++data FileContext c =+ FileContext {+ fcTesting :: Bool,+ fcCategories :: CategoryMap c,+ fcNamespaces :: Set.Set Namespace,+ fcExprMap :: ExprMap c+ }++generateNativeConcrete :: (Ord c, Show c, CollectErrorsM m) =>+ FileContext c -> (AnyCategory c,DefinedCategory c) -> m [CxxOutput]+generateNativeConcrete (FileContext testing tm ns em) (t,d) = do+ dec <- compileCategoryDeclaration testing ns t+ def <- generateCategoryDefinition testing (NativeConcrete t d tm ns em)+ return (dec:def)++generateNativeInterface :: (Ord c, Show c, CollectErrorsM m) =>+ Bool -> AnyCategory c -> m [CxxOutput]+generateNativeInterface testing t = do+ dec <- compileCategoryDeclaration testing Set.empty t+ def <- generateCategoryDefinition testing (NativeInterface t)+ return (dec:def)++generateStreamlinedExtension :: (Ord c, Show c, CollectErrorsM m) =>+ Bool -> AnyCategory c -> m [CxxOutput]+generateStreamlinedExtension testing t = do+ dec <- compileCategoryDeclaration testing Set.empty t+ def <- generateCategoryDefinition testing (StreamlinedExtension t)+ return (dec:def)++generateVerboseExtension :: (Ord c, Show c, CollectErrorsM m) =>+ Bool -> AnyCategory c -> m [CxxOutput]+generateVerboseExtension testing t =+ fmap (:[]) $ compileCategoryDeclaration testing Set.empty t++generateStreamlinedTemplate :: (Ord c, Show c, CollectErrorsM m) =>+ FileContext c -> AnyCategory c -> m [CxxOutput]+generateStreamlinedTemplate (FileContext testing tm _ _) t =+ generateCategoryDefinition testing (StreamlinedTemplate t tm)++compileCategoryDeclaration :: (Ord c, Show c, CollectErrorsM m) =>+ Bool -> Set.Set Namespace -> AnyCategory c -> m CxxOutput+compileCategoryDeclaration testing ns t =+ return $ CxxOutput (Just $ getCategoryName t)+ (headerFilename name)+ (getCategoryNamespace t)+ (getCategoryNamespace t `Set.insert` ns)+ (cdRequired file)+ (cdOutput file) where+ file = mconcat $ [+ CompiledData depends [],+ onlyCodes guardTop,+ onlyCodes $ (if testing then testsOnlyCategoryGuard (getCategoryName t) else []),+ onlyCodes baseHeaderIncludes,+ addNamespace t content,+ onlyCodes guardBottom+ ]+ depends = getCategoryDeps t+ content = mconcat [collection,labels,getCategory2,getType]+ name = getCategoryName t+ guardTop = ["#ifndef " ++ guardName,"#define " ++ guardName]+ guardBottom = ["#endif // " ++ guardName]+ guardName = "HEADER_" ++ guardNamespace ++ show name+ guardNamespace+ | isStaticNamespace $ getCategoryNamespace t = show (getCategoryNamespace t) ++ "_"+ | otherwise = ""+ labels = onlyCodes $ map label $ filter ((== name) . sfType) $ getCategoryFunctions t+ label f = "extern " ++ functionLabelType f ++ " " ++ functionName f ++ ";"+ collection+ | isValueConcrete t = emptyCode+ | otherwise = onlyCodes ["extern const void* const " ++ collectionName name ++ ";"]+ getCategory2+ | isInstanceInterface t = emptyCode+ | otherwise = declareGetCategory t+ getType+ | isInstanceInterface t = emptyCode+ | otherwise = declareGetType t++data CategoryDefinition c =+ NativeInterface {+ niCategory :: AnyCategory c+ } |+ NativeConcrete {+ ncCategory :: AnyCategory c,+ ncDefined :: DefinedCategory c,+ ncCategories :: CategoryMap c,+ ncNamespaces :: Set.Set Namespace,+ ncExprMap :: ExprMap c+ } |+ StreamlinedExtension {+ seCategory :: AnyCategory c+ } |+ StreamlinedTemplate {+ stCategory :: AnyCategory c,+ stCategories :: CategoryMap c+ }++generateCategoryDefinition :: (Ord c, Show c, CollectErrorsM m) =>+ Bool -> CategoryDefinition c -> m [CxxOutput]+generateCategoryDefinition testing = common where+ common :: (Ord c, Show c, CollectErrorsM m) => CategoryDefinition c -> m [CxxOutput]+ common (NativeInterface t) = fmap (:[]) singleSource where+ singleSource = do+ let filename = sourceFilename (getCategoryName t)+ let (cf,tf,vf) = partitionByScope sfScope $ getCategoryFunctions t+ (CompiledData req out) <- fmap (addNamespace t) $ concatM [+ defineFunctions t cf tf vf,+ declareInternalGetters t,+ defineInterfaceCategory t,+ defineInterfaceType t,+ defineCategoryOverrides t [],+ defineTypeOverrides t [],+ defineInternalGetters t,+ defineExternalGetters t+ ]+ let req' = req `Set.union` getCategoryMentions t+ return $ CxxOutput (Just $ getCategoryName t)+ filename+ (getCategoryNamespace t)+ (Set.fromList [getCategoryNamespace t])+ req'+ (allowTestsOnly $ addSourceIncludes $ addCategoryHeader t $ addIncludes req' out)+ common (StreamlinedExtension t) = sequence [streamlinedHeader,streamlinedSource] where+ streamlinedHeader = do+ let filename = headerStreamlined (getCategoryName t)+ (CompiledData req out) <- fmap (addNamespace t) $ concatM [+ defineAbstractCategory t,+ defineAbstractType t,+ defineAbstractValue t defined,+ declareAbstractGetters t+ ]+ return $ CxxOutput (Just $ getCategoryName t)+ filename+ (getCategoryNamespace t)+ (Set.fromList [getCategoryNamespace t])+ req+ (headerGuard (getCategoryName t) $ allowTestsOnly $ addSourceIncludes $ addCategoryHeader t $ addIncludes req out)+ defined = DefinedCategory {+ dcContext = [],+ dcName = getCategoryName t,+ dcParams = [],+ dcRefines = [],+ dcDefines = [],+ dcParamFilter = [],+ dcMembers = [],+ dcProcedures = [],+ dcFunctions = []+ }+ streamlinedSource = do+ let filename = sourceStreamlined (getCategoryName t)+ let (cf,tf,vf) = partitionByScope sfScope $ getCategoryFunctions t+ (CompiledData req out) <- fmap (addNamespace t) $ concatM [+ defineFunctions t cf tf vf,+ defineCategoryOverrides t (getCategoryFunctions t),+ defineTypeOverrides t (getCategoryFunctions t),+ defineValueOverrides t (getCategoryFunctions t),+ defineExternalGetters t+ ]+ let req' = Set.unions [req,getCategoryMentions t,defaultCategoryDeps]+ return $ CxxOutput (Just $ getCategoryName t)+ filename+ (getCategoryNamespace t)+ (Set.fromList [getCategoryNamespace t])+ req'+ (addSourceIncludes $ addStreamlinedHeader t $ addIncludes req' out)+ common (StreamlinedTemplate t tm) = fmap (:[]) streamlinedTemplate where+ streamlinedTemplate = do+ let filename = templateStreamlined (getCategoryName t)+ [cp,tp,vp] <- getProcedureScopes tm Map.empty defined+ (CompiledData req out) <- fmap (addNamespace t) $ concatM [+ declareCustomValueGetter t,+ defineCustomCategory t cp,+ defineCustomType t tp,+ defineCustomValue t vp,+ defineCustomGetters t,+ defineCustomValueGetter t+ ]+ return $ CxxOutput (Just $ getCategoryName t)+ filename+ (getCategoryNamespace t)+ (Set.fromList [getCategoryNamespace t])+ req+ (addSourceIncludes $ addStreamlinedHeader t $ addIncludes req out)+ defined = DefinedCategory {+ dcContext = [],+ dcName = getCategoryName t,+ dcParams = [],+ dcRefines = [],+ dcDefines = [],+ dcParamFilter = [],+ dcMembers = [],+ dcProcedures = map defaultFail (getCategoryFunctions t),+ dcFunctions = []+ }+ defaultFail f = ExecutableProcedure {+ epContext = [],+ epPragmas = [],+ epEnd = [],+ epName = sfName f,+ epArgs = ArgValues [] $ Positional $ map createArg [1..(length $ pValues $ sfArgs f)],+ epReturns = UnnamedReturns [],+ epProcedure = failProcedure f+ }+ createArg = InputValue [] . VariableName . ("arg" ++) . show+ failProcedure f = Procedure [] [+ NoValueExpression [] $ LineComment $ "TODO: Implement " ++ funcName f ++ ".",+ FailCall [] (Literal (StringLiteral [] $ funcName f ++ " is not implemented"))+ ]+ funcName f = show (sfType f) ++ "." ++ show (sfName f)+ common (NativeConcrete t d@(DefinedCategory _ _ pi _ _ fi ms _ _) ta ns em) = fmap (:[]) singleSource where+ singleSource = do+ let filename = sourceFilename (getCategoryName t)+ ta' <- mergeInternalInheritance ta d+ let r = CategoryResolver ta'+ [cp,tp,vp] <- getProcedureScopes ta' em d+ let (_,tm,_) = partitionByScope dmScope ms+ disallowTypeMembers tm+ let filters = getCategoryFilters t+ let filters2 = fi+ allFilters <- getFilterMap (getCategoryParams t ++ pi) $ filters ++ filters2+ let cf = map fst $ psProcedures cp+ let tf = map fst $ psProcedures tp+ let vf = map fst $ psProcedures vp+ (CompiledData req out) <- fmap (addNamespace t) $ concatM [+ defineFunctions t cf tf vf,+ declareInternalGetters t,+ defineConcreteCategory r allFilters cf ta' em t d,+ defineConcreteType tf t,+ defineConcreteValue r allFilters vf t d,+ defineCategoryOverrides t cf,+ defineTypeOverrides t tf,+ defineValueOverrides t vf,+ defineCategoryFunctions t cp,+ defineTypeFunctions t tp,+ defineValueFunctions t vp,+ defineInternalGetters t,+ defineExternalGetters t+ ]+ let req' = req `Set.union` getCategoryMentions t+ return $ CxxOutput (Just $ getCategoryName t)+ filename+ (getCategoryNamespace t)+ (getCategoryNamespace t `Set.insert` ns)+ req'+ (allowTestsOnly $ addSourceIncludes $ addCategoryHeader t $ addIncludes req' out)++ defineFunctions t cf tf vf = concatM [createCollection,createAllLabels] where+ name = getCategoryName t+ createCollection = return $ onlyCodes [+ "namespace {",+ "const int " ++ collectionValName ++ " = 0;",+ "} // namespace",+ "const void* const " ++ collectionName name ++ " = &" ++ collectionValName ++ ";"+ ]+ createAllLabels = return $ onlyCodes $ concat $ map createLabels [cf,tf,vf]+ collectionValName = "collection_" ++ show name+ createLabels = map (uncurry createLabelForFunction) . zip [0..] . sortBy compareName . filter ((== name) . sfType)+ compareName x y = sfName x `compare` sfName y++ declareInternalGetters t = concatM [+ return $ onlyCode $ "struct " ++ categoryName (getCategoryName t) ++ ";",+ return $ declareInternalCategory t,+ return $ onlyCode $ "struct " ++ typeName (getCategoryName t) ++ ";",+ return $ declareInternalType t (length $ getCategoryParams t),+ return $ valueGetter+ ] where+ valueGetter+ | isValueConcrete t = mconcat [+ onlyCode $ "struct " ++ valueName (getCategoryName t) ++ ";",+ declareInternalValue t+ ]+ | otherwise = emptyCode+ defineInternalGetters t = concatM [+ return $ defineInternalCategory t,+ return $ defineInternalType t (length $ getCategoryParams t),+ return $ valueGetter+ ] where+ valueGetter+ | isValueConcrete t = defineInternalValue t+ | otherwise = emptyCode++ declareCustomValueGetter t = concatM [+ return $ declareInternalValue t+ ]+ defineCustomValueGetter t = concatM [+ return $ defineInternalValue2 (valueCustom $ getCategoryName t) t+ ]++ declareAbstractGetters t = concatM [+ return $ onlyCode $ "struct " ++ categoryName (getCategoryName t) ++ ";",+ return $ declareInternalCategory t,+ return $ onlyCode $ "struct " ++ typeName (getCategoryName t) ++ ";",+ return $ declareInternalType t (length $ getCategoryParams t)+ ]++ defineExternalGetters t = concatM [+ return $ defineGetCatetory t,+ return $ defineGetType t+ ]+ defineCustomGetters t = concatM [+ return $ defineInternalCategory2 (categoryCustom (getCategoryName t)) t,+ return $ defineInternalType2 (typeCustom (getCategoryName t)) t (length $ getCategoryParams t)+ ]++ defineInterfaceCategory t = concatM [+ return $ onlyCode $ "struct " ++ categoryName (getCategoryName t) ++ " : public " ++ categoryBase ++ " {",+ return declareCategoryOverrides,+ return $ onlyCode "};"+ ]+ defineInterfaceType t = concatM [+ return $ onlyCode $ "struct " ++ typeName (getCategoryName t) ++ " : public " ++ typeBase ++ " {",+ fmap indentCompiled $ inlineTypeConstructor t,+ return declareTypeOverrides,+ return $ indentCompiled $ createParams $ getCategoryParams t,+ return $ onlyCode $ " " ++ categoryName (getCategoryName t) ++ "& parent;",+ return $ onlyCode "};"+ ]++ defineConcreteCategory r allFilters fs tm em t d = concatM [+ return $ onlyCode $ "struct " ++ categoryName (getCategoryName t) ++ " : public " ++ categoryBase ++ " {",+ fmap indentCompiled $ inlineCategoryConstructor t d tm em,+ return declareCategoryOverrides,+ fmap indentCompiled $ concatM $ map (procedureDeclaration False) fs,+ fmap indentCompiled $ concatM $ map (createMemberLazy r allFilters) members,+ return $ onlyCode "};"+ ] where+ members = filter ((== CategoryScope). dmScope) $ dcMembers d+ defineConcreteType fs t = concatM [+ return $ onlyCode $ "struct " ++ typeName (getCategoryName t) ++ " : public " ++ typeBase ++ " {",+ fmap indentCompiled $ inlineTypeConstructor t,+ return declareTypeOverrides,+ fmap indentCompiled $ concatM $ map (procedureDeclaration False) fs,+ return $ indentCompiled $ createParams $ getCategoryParams t,+ return $ onlyCode $ " " ++ categoryName (getCategoryName t) ++ "& parent;",+ return $ onlyCode "};"+ ]+ defineConcreteValue r allFilters fs t d = concatM [+ return $ onlyCode $ "struct " ++ valueName (getCategoryName t) ++ " : public " ++ valueBase ++ " {",+ fmap indentCompiled $ inlineValueConstructor t d,+ return declareValueOverrides,+ fmap indentCompiled $ concatM $ map (procedureDeclaration False) fs,+ fmap indentCompiled $ concatM $ map (createMember r allFilters) members,+ return $ indentCompiled $ createParams $ dcParams d,+ return $ onlyCode $ " const S<" ++ typeName (getCategoryName t) ++ "> parent;",+ return $ onlyCodes traceCreation,+ return $ onlyCode "};"+ ] where+ members = filter ((== ValueScope). dmScope) $ dcMembers d+ procedures = dcProcedures d+ traceCreation+ | any isTraceCreation $ concat $ map epPragmas procedures = [captureCreationTrace]+ | otherwise = []++ defineAbstractCategory t = concatM [+ return $ onlyCode $ "struct " ++ categoryName (getCategoryName t) ++ " : public " ++ categoryBase ++ " {",+ return declareCategoryOverrides,+ fmap indentCompiled $ concatM $ map (procedureDeclaration True) $ filter ((== CategoryScope). sfScope) $ getCategoryFunctions t,+ return $ onlyCode $ " virtual inline ~" ++ categoryName (getCategoryName t) ++ "() {}",+ return $ onlyCode "};"+ ]+ defineAbstractType t = concatM [+ return $ onlyCode $ "struct " ++ typeName (getCategoryName t) ++ " : public " ++ typeBase ++ " {",+ fmap indentCompiled $ inlineTypeConstructor t,+ return declareTypeOverrides,+ fmap indentCompiled $ concatM $ map (procedureDeclaration True) $ filter ((== TypeScope). sfScope) $ getCategoryFunctions t,+ return $ onlyCode $ " virtual inline ~" ++ typeName (getCategoryName t) ++ "() {}",+ return $ indentCompiled $ createParams $ getCategoryParams t,+ return $ onlyCode $ " " ++ categoryName (getCategoryName t) ++ "& parent;",+ return $ onlyCode "};"+ ]+ defineAbstractValue t d = concatM [+ return $ onlyCode $ "struct " ++ valueName (getCategoryName t) ++ " : public " ++ valueBase ++ " {",+ fmap indentCompiled $ abstractValueConstructor t d,+ return declareValueOverrides,+ fmap indentCompiled $ concatM $ map (procedureDeclaration True) $ filter ((== ValueScope). sfScope) $ getCategoryFunctions t,+ return $ onlyCode $ " virtual inline ~" ++ valueName (getCategoryName t) ++ "() {}",+ return $ onlyCode $ " const S<" ++ typeName (getCategoryName t) ++ "> parent;",+ return $ onlyCode "};"+ ]++ defineCustomCategory :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])+ defineCustomCategory t ps = concatM [+ return $ onlyCode $ "struct " ++ categoryCustom (getCategoryName t) ++ " : public " ++ categoryName (getCategoryName t) ++ " {",+ fmap indentCompiled $ concatM $ applyProcedureScope (compileExecutableProcedure Nothing) ps,+ return $ onlyCode "};"+ ]+ defineCustomType :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])+ defineCustomType t ps = concatM [+ return $ onlyCode $ "struct " ++ typeCustom (getCategoryName t) ++ " : public " ++ typeName (getCategoryName t) ++ " {",+ fmap indentCompiled $ customTypeConstructor t,+ fmap indentCompiled $ concatM $ applyProcedureScope (compileExecutableProcedure Nothing) ps,+ return $ onlyCode "};"+ ]+ defineCustomValue :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])+ defineCustomValue t ps = concatM [+ return $ onlyCode $ "struct " ++ valueCustom (getCategoryName t) ++ " : public " ++ valueName (getCategoryName t) ++ " {",+ fmap indentCompiled $ customValueConstructor t,+ fmap indentCompiled $ concatM $ applyProcedureScope (compileExecutableProcedure Nothing) ps,+ return $ onlyCode "};"+ ]++ defineCategoryFunctions :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])+ defineCategoryFunctions t = concatM . applyProcedureScope (compileExecutableProcedure $ Just $ categoryName $ getCategoryName t)+ defineTypeFunctions :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])+ defineTypeFunctions t = concatM . applyProcedureScope (compileExecutableProcedure $ Just $ typeName $ getCategoryName t)+ defineValueFunctions :: (Ord c, Show c, CollectErrorsM m) => AnyCategory c -> ProcedureScope c -> m (CompiledData [String])+ defineValueFunctions t = concatM . applyProcedureScope (compileExecutableProcedure $ Just $ valueName $ getCategoryName t)++ declareCategoryOverrides = onlyCodes [+ " std::string CategoryName() const final;",+ " ReturnTuple Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) final;"+ ]+ declareTypeOverrides = onlyCodes [+ " std::string CategoryName() const final;",+ " void BuildTypeName(std::ostream& output) const final;",+ " bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final;",+ " ReturnTuple Dispatch(const S<TypeInstance>& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) final;",+ " bool CanConvertFrom(const S<const TypeInstance>& from) const final;"+ ]+ declareValueOverrides = onlyCodes [+ " std::string CategoryName() const final;",+ " ReturnTuple Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) final;"+ ]++ defineCategoryOverrides t fs = return $ mconcat [+ onlyCode $ "std::string " ++ className ++ "::CategoryName() const { return \"" ++ show (getCategoryName t) ++ "\"; }",+ onlyCode $ "ReturnTuple " ++ className ++ "::Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) {",+ createFunctionDispatch (getCategoryName t) CategoryScope fs,+ onlyCode "}"+ ] where+ className = categoryName (getCategoryName t)+ defineTypeOverrides t fs = return $ mconcat [+ onlyCode $ "std::string " ++ className ++ "::CategoryName() const { return parent.CategoryName(); }",+ onlyCode $ "void " ++ className ++ "::BuildTypeName(std::ostream& output) const {",+ defineTypeName params,+ onlyCode "}",+ onlyCode $ "bool " ++ className ++ "::TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const {",+ createTypeArgsForParent t,+ onlyCode $ "}",+ onlyCode $ "ReturnTuple " ++ className ++ "::Dispatch(const S<TypeInstance>& self, const TypeFunction& label, const ParamTuple& params, const ValueTuple& args) {",+ createFunctionDispatch (getCategoryName t) TypeScope fs,+ onlyCode $ "}",+ onlyCode $ "bool " ++ className ++ "::CanConvertFrom(const S<const TypeInstance>& from) const {",+ createCanConvertFrom t,+ onlyCode "}"+ ] where+ className = typeName (getCategoryName t)+ params = map vpParam $ getCategoryParams t+ defineValueOverrides t fs = return $ mconcat [+ onlyCode $ "std::string " ++ className ++ "::CategoryName() const { return parent->CategoryName(); }",+ onlyCode $ "ReturnTuple " ++ className ++ "::Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params, const ValueTuple& args) {",+ createFunctionDispatch (getCategoryName t) ValueScope fs,+ onlyCode $ "}"+ ] where+ className = valueName (getCategoryName t)++ createMember r filters m = do+ validateGeneralInstance r filters (vtType $ dmType m) <??+ "In creation of " ++ show (dmName m) ++ " at " ++ formatFullContext (dmContext m)+ return $ onlyCode $ variableStoredType (dmType m) ++ " " ++ variableName (dmName m) ++ ";"+ createMemberLazy r filters m = do+ validateGeneralInstance r filters (vtType $ dmType m) <??+ "In creation of " ++ show (dmName m) ++ " at " ++ formatFullContext (dmContext m)+ return $ onlyCode $ variableLazyType (dmType m) ++ " " ++ variableName (dmName m) ++ ";"++ createParams = mconcat . map createParam where+ createParam p = onlyCode $ paramType ++ " " ++ paramName (vpParam p) ++ ";"++ inlineCategoryConstructor t d tm em = do+ ctx <- getContextForInit tm em t d CategoryScope+ initMembers <- runDataCompiler (sequence $ map compileLazyInit members) ctx+ let initMembersStr = intercalate ", " $ cdOutput initMembers+ let initColon = if null initMembersStr then "" else " : "+ return $ mconcat [+ onlyCode $ "inline " ++ categoryName (getCategoryName t) ++ "()" ++ initColon ++ initMembersStr ++ " {",+ indentCompiled $ onlyCodes $ getCycleCheck (categoryName (getCategoryName t)),+ indentCompiled $ onlyCode $ startInitTracing (getCategoryName t) CategoryScope,+ onlyCode "}",+ clearCompiled initMembers -- Inherit required types.+ ] where+ members = filter ((== CategoryScope). dmScope) $ dcMembers d+ inlineTypeConstructor t = do+ let ps2 = map vpParam $ getCategoryParams t+ let argParent = categoryName (getCategoryName t) ++ "& p"+ let paramsPassed = "Params<" ++ show (length ps2) ++ ">::Type params"+ let allArgs = intercalate ", " [argParent,paramsPassed]+ let initParent = "parent(p)"+ let initPassed = map (\(i,p) -> paramName p ++ "(std::get<" ++ show i ++ ">(params))") $ zip ([0..] :: [Int]) ps2+ let allInit = intercalate ", " $ initParent:initPassed+ return $ mconcat [+ onlyCode $ "inline " ++ typeName (getCategoryName t) ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {",+ indentCompiled $ onlyCodes $ getCycleCheck (typeName (getCategoryName t)),+ indentCompiled $ onlyCode $ startInitTracing (getCategoryName t) TypeScope,+ onlyCode "}"+ ]+ inlineValueConstructor t d = do+ let argParent = "S<" ++ typeName (getCategoryName t) ++ "> p"+ let paramsPassed = "const ParamTuple& params"+ let argsPassed = "const ValueTuple& args"+ let allArgs = intercalate ", " [argParent,paramsPassed,argsPassed]+ let initParent = "parent(p)"+ let initParams = map (\(i,p) -> paramName (vpParam p) ++ "(params.At(" ++ show i ++ "))") $ zip ([0..] :: [Int]) $ dcParams d+ let initArgs = map (\(i,m) -> variableName (dmName m) ++ "(" ++ unwrappedArg i m ++ ")") $ zip ([0..] :: [Int]) members+ let allInit = intercalate ", " $ initParent:(initParams ++ initArgs)+ return $ onlyCode $ "inline " ++ valueName (getCategoryName t) ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {}" where+ unwrappedArg i m = writeStoredVariable (dmType m) (UnwrappedSingle $ "args.At(" ++ show i ++ ")")+ members = filter ((== ValueScope). dmScope) $ dcMembers d++ abstractValueConstructor t d = do+ let argParent = "S<" ++ typeName (getCategoryName t) ++ "> p"+ let paramsPassed = "const ParamTuple& params"+ let allArgs = intercalate ", " [argParent,paramsPassed]+ let initParent = "parent(p)"+ let initParams = map (\(i,p) -> paramName (vpParam p) ++ "(params.At(" ++ show i ++ "))") $ zip ([0..] :: [Int]) $ dcParams d+ let allInit = intercalate ", " $ initParent:initParams+ return $ onlyCode $ "inline " ++ valueName (getCategoryName t) ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {}"++ customTypeConstructor t = do+ let ps2 = map vpParam $ getCategoryParams t+ let argParent = categoryName (getCategoryName t) ++ "& p"+ let paramsPassed = "Params<" ++ show (length ps2) ++ ">::Type params"+ let allArgs = intercalate ", " [argParent,paramsPassed]+ let allInit = typeName (getCategoryName t) ++ "(p, params)"+ return $ onlyCode $ "inline " ++ typeCustom (getCategoryName t) ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {}"+ customValueConstructor t = do+ let argParent = "S<" ++ typeName (getCategoryName t) ++ "> p"+ let paramsPassed = "const ParamTuple& params"+ let argsPassed = "const ValueTuple& args"+ let allArgs = intercalate ", " [argParent,paramsPassed,argsPassed]+ let allInit = valueName (getCategoryName t) ++ "(p, params)"+ return $ onlyCode $ "inline " ++ valueCustom (getCategoryName t) ++ "(" ++ allArgs ++ ") : " ++ allInit ++ " {}"++ allowTestsOnly+ | testing = (testsOnlySourceGuard ++)+ | otherwise = (noTestsOnlySourceGuard ++)+ addSourceIncludes = (baseSourceIncludes ++)+ addCategoryHeader t = (["#include \"" ++ headerFilename (getCategoryName t) ++ "\""] ++)+ addStreamlinedHeader t = (["#include \"" ++ headerStreamlined (getCategoryName t) ++ "\""] ++)+ addIncludes req = (map (\i -> "#include \"" ++ headerFilename i ++ "\"") (Set.toList req) ++)+ headerGuard t out = guardTop ++ out ++ guardBottom where+ guardTop = ["#ifndef " ++ guardName,"#define " ++ guardName]+ guardBottom = ["#endif // " ++ guardName]+ guardName = "STREAMLINED_" ++ show t+ disallowTypeMembers :: (Ord c, Show c, CollectErrorsM m) => [DefinedMember c] -> m ()+ disallowTypeMembers tm =+ collectAllM_ $ flip map tm+ (\m -> compilerErrorM $ "Member " ++ show (dmName m) +++ " is not allowed to be @type-scoped" +++ formatFullContextBrace (dmContext m))+ getCycleCheck n2 = [+ "CycleCheck<" ++ n2 ++ ">::Check();",+ "CycleCheck<" ++ n2 ++ "> marker(*this);"+ ]++createMainCommon :: String -> CompiledData [String] -> CompiledData [String] -> [String]+createMainCommon n (CompiledData req0 out0) (CompiledData req1 out1) =+ baseSourceIncludes ++ mainSourceIncludes ++ depIncludes (req0 `Set.union` req1) ++ out0 ++ [+ "int main(int argc, const char** argv) {",+ " SetSignalHandler();",+ " " ++ startFunctionTracing CategoryNone (FunctionName n)+ ] ++ map (" " ++) out1 ++ ["}"] where+ depIncludes req2 = map (\i -> "#include \"" ++ headerFilename i ++ "\"") $+ Set.toList req2++generateMainFile :: (Ord c, Show c, CollectErrorsM m) =>+ CategoryMap c -> ExprMap c -> CategoryName -> FunctionName -> m (Namespace,[String])+generateMainFile tm em n f = "In the creation of the main binary procedure" ??> do+ ca <- compileMainProcedure tm em expr+ let file = noTestsOnlySourceGuard ++ createMainCommon "main" emptyCode (argv <> ca)+ (_,t) <- getConcreteCategory tm ([],n)+ return (getCategoryNamespace t,file) where+ funcCall = FunctionCall [] f (Positional []) (Positional [])+ mainType = JustTypeInstance $ TypeInstance n (Positional [])+ expr = Expression [] (TypeCall [] mainType funcCall) []+ argv = onlyCode "ProgramArgv program_argv(argc, argv);"++generateTestFile :: (Ord c, Show c, CollectErrorsM m) =>+ CategoryMap c -> ExprMap c -> [String] -> [TestProcedure c] -> m (CompiledData [String])+generateTestFile tm em args ts = "In the creation of the test binary procedure" ??> do+ ts' <- fmap mconcat $ mapErrorsM (compileTestProcedure tm em) ts+ (include,sel) <- selectTestFromArgv1 $ map tpName ts+ let (CompiledData req _) = ts' <> sel+ let file = testsOnlySourceGuard ++ createMainCommon "testcase" (onlyCodes include <> ts') (argv <> sel)+ return $ CompiledData req file where+ args' = map escapeChars args+ argv = onlyCodes [+ "const char* argv2[] = { \"testcase\" " ++ concat (map (", " ++) args') ++ " };",+ "ProgramArgv program_argv(sizeof argv2 / sizeof(char*), argv2);"+ ]++addNamespace :: AnyCategory c -> CompiledData [String] -> CompiledData [String]+addNamespace t cs+ | isStaticNamespace $ getCategoryNamespace t = mconcat [+ onlyCode $ "namespace " ++ show (getCategoryNamespace t) ++ " {",+ cs,+ onlyCode $ "} // namespace " ++ show (getCategoryNamespace t),+ onlyCode $ "using namespace " ++ show (getCategoryNamespace t) ++ ";"+ ]+ | isPublicNamespace $ getCategoryNamespace t = mconcat [+ onlyCode $ "#ifdef " ++ publicNamespaceMacro,+ onlyCode $ "namespace " ++ publicNamespaceMacro ++ " {",+ onlyCode $ "#endif // " ++ publicNamespaceMacro,+ cs,+ onlyCode $ "#ifdef " ++ publicNamespaceMacro,+ onlyCode $ "} // namespace " ++ publicNamespaceMacro,+ onlyCode $ "using namespace " ++ publicNamespaceMacro ++ ";",+ onlyCode $ "#endif // " ++ publicNamespaceMacro+ ]+ | isPrivateNamespace $ getCategoryNamespace t = mconcat [+ onlyCode $ "#ifdef " ++ privateNamespaceMacro,+ onlyCode $ "namespace " ++ privateNamespaceMacro ++ " {",+ onlyCode $ "#endif // " ++ privateNamespaceMacro,+ cs,+ onlyCode $ "#ifdef " ++ privateNamespaceMacro,+ onlyCode $ "} // namespace " ++ privateNamespaceMacro,+ onlyCode $ "using namespace " ++ privateNamespaceMacro ++ ";",+ onlyCode $ "#endif // " ++ privateNamespaceMacro+ ]+ | otherwise = cs++createLabelForFunction :: Int -> ScopedFunction c -> String+createLabelForFunction i f = functionLabelType f ++ " " ++ functionName f +++ " = " ++ newFunctionLabel i f ++ ";"++createFunctionDispatch :: CategoryName -> SymbolScope -> [ScopedFunction c] -> CompiledData [String]+createFunctionDispatch n s fs = onlyCodes $ [typedef] +++ concat (map table $ byCategory) +++ concat (map dispatch $ byCategory) +++ [fallback] where+ filtered = filter ((== s) . sfScope) fs+ flatten f = f:(concat $ map flatten $ sfMerges f)+ flattened = concat $ map flatten filtered+ byCategory = Map.toList $ Map.fromListWith (++) $ map (\f -> (sfType f,[f])) flattened+ typedef+ | s == CategoryScope = " using CallType = ReturnTuple(" ++ categoryName n +++ "::*)(const ParamTuple&, const ValueTuple&);"+ | s == TypeScope = " using CallType = ReturnTuple(" ++ typeName n +++ "::*)(const S<TypeInstance>&, const ParamTuple&, const ValueTuple&);"+ | s == ValueScope = " using CallType = ReturnTuple(" ++ valueName n +++ "::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);"+ | otherwise = undefined+ name f+ | s == CategoryScope = categoryName n ++ "::" ++ callName f+ | s == TypeScope = typeName n ++ "::" ++ callName f+ | s == ValueScope = valueName n ++ "::" ++ callName f+ | otherwise = undefined+ table (n2,fs2) =+ [" static const CallType " ++ tableName n2 ++ "[] = {"] +++ map (\f -> " &" ++ name f ++ ",") (Set.toList $ Set.fromList $ map sfName fs2) +++ [" };"]+ dispatch (n2,_) = [+ " if (label.collection == " ++ collectionName n2 ++ ") {",+ " if (label.function_num < 0 || label.function_num >= sizeof " ++ tableName n2 ++ " / sizeof(CallType)) {",+ " FAIL() << \"Bad function call \" << label;",+ " }",+ " return (this->*" ++ tableName n2 ++ "[label.function_num])(" ++ args ++ ");",+ " }"+ ]+ args+ | s == CategoryScope = "params, args"+ | s == TypeScope = "self, params, args"+ | s == ValueScope = "self, params, args"+ | otherwise = undefined+ fallback+ | s == CategoryScope = " return TypeCategory::Dispatch(label, params, args);"+ | s == TypeScope = " return TypeInstance::Dispatch(self, label, params, args);"+ | s == ValueScope = " return TypeValue::Dispatch(self, label, params, args);"+ | otherwise = undefined++createCanConvertFrom :: AnyCategory c -> CompiledData [String]+createCanConvertFrom t+ | isInstanceInterface t = onlyCode $ " return " ++ typeBase ++ "::CanConvertFrom(from);"+ | otherwise = onlyCodes $ [+ " std::vector<S<const TypeInstance>> args;",+ " if (!from->TypeArgsForParent(parent, args)) return false;",+ " if(args.size() != " ++ show (length params) ++ ") {",+ " FAIL() << \"Wrong number of args (\" << args.size() << \") for \" << CategoryName();",+ " }"+ ] ++ checks ++ [" return true;"] where+ params = map (\p -> (vpParam p,vpVariance p)) $ getCategoryParams t+ checks = concat $ map singleCheck $ zip ([0..] :: [Int]) params+ singleCheck (i,(p,Covariant)) = [checkCov i p]+ singleCheck (i,(p,Contravariant)) = [checkCon i p]+ singleCheck (i,(p,Invariant)) = [checkCov i p,checkCon i p]+ checkCov i p = " if (!TypeInstance::CanConvert(args[" ++ show i ++ "], " ++ paramName p ++ ")) return false;"+ checkCon i p = " if (!TypeInstance::CanConvert(" ++ paramName p ++ ", args[" ++ show i ++ "])) return false;"++createTypeArgsForParent :: AnyCategory c -> CompiledData [String]+createTypeArgsForParent t+ | isInstanceInterface t = onlyCode $ " return " ++ typeBase ++ "::TypeArgsForParent(category, args);"+ | otherwise = onlyCodes $ allCats ++ [" return false;"] where+ params = map (\p -> (vpParam p,vpVariance p)) $ getCategoryParams t+ myType = (getCategoryName t,map (singleType . JustParamName False . fst) params)+ refines = map (\r -> (tiName r,pValues $ tiParams r)) $ map vrType $ getCategoryRefines t+ allCats = concat $ map singleCat (myType:refines)+ singleCat (t2,ps) = [+ " if (&category == &" ++ categoryGetter t2 ++ "()) {",+ " args = std::vector<S<const TypeInstance>>{" ++ expanded ++ "};",+ " return true;",+ " }"+ ]+ where+ expanded = intercalate ", " $ map expandLocalType ps++-- Similar to Procedure.expandGeneralInstance but doesn't account for scope.+expandLocalType :: GeneralInstance -> String+expandLocalType t+ | t == minBound = allGetter ++ "()"+ | t == maxBound = anyGetter ++ "()"+expandLocalType t = reduceMergeTree getAny getAll getSingle t where+ getAny ts = unionGetter ++ combine ts+ getAll ts = intersectGetter ++ combine ts+ getSingle (JustTypeInstance (TypeInstance t2 ps)) =+ typeGetter t2 ++ "(T_get(" ++ intercalate ", " (map expandLocalType $ pValues ps) ++ "))"+ getSingle (JustParamName _ p) = paramName p+ getSingle (JustInferredType p) = paramName p+ combine ps = "(L_get<" ++ typeBase ++ "*>(" ++ intercalate "," (map ("&" ++) ps) ++ "))"++defineCategoryName :: SymbolScope -> CategoryName -> CompiledData [String]+defineCategoryName TypeScope _ = onlyCode $ "std::string CategoryName() const final { return parent.CategoryName(); }"+defineCategoryName ValueScope _ = onlyCode $ "std::string CategoryName() const final { return parent->CategoryName(); }"+defineCategoryName _ t = onlyCode $ "std::string CategoryName() const final { return \"" ++ show t ++ "\"; }"++defineTypeName :: [ParamName] -> CompiledData [String]+defineTypeName ps = onlyCode $ " return TypeInstance::TypeNameFrom(output, parent" ++ concat (map ((", " ++) . paramName) ps) ++ ");"++declareGetCategory :: AnyCategory c -> CompiledData [String]+declareGetCategory t = onlyCodes [categoryBase ++ "& " ++ categoryGetter (getCategoryName t) ++ "();"]++defineGetCatetory :: AnyCategory c -> CompiledData [String]+defineGetCatetory t = onlyCodes [+ categoryBase ++ "& " ++ categoryGetter (getCategoryName t) ++ "() {",+ " return " ++ categoryCreator (getCategoryName t) ++ "();",+ "}"+ ]++declareGetType :: AnyCategory c -> CompiledData [String]+declareGetType t = onlyCodes [+ "S<" ++ typeBase ++ "> " ++ typeGetter (getCategoryName t) ++ "(Params<" +++ show (length $getCategoryParams t) ++ ">::Type params);"+ ]++defineGetType :: AnyCategory c -> CompiledData [String]+defineGetType t = onlyCodes [+ "S<" ++ typeBase ++ "> " ++ typeGetter (getCategoryName t) ++ "(Params<" +++ show (length $ getCategoryParams t) ++ ">::Type params) {",+ " return " ++ typeCreator (getCategoryName t) ++ "(params);",+ "}"+ ]++declareInternalCategory :: AnyCategory c -> CompiledData [String]+declareInternalCategory t = onlyCodes [+ categoryName (getCategoryName t) ++ "& " ++ categoryCreator (getCategoryName t) ++ "();"+ ]++defineInternalCategory :: AnyCategory c -> CompiledData [String]+defineInternalCategory t = defineInternalCategory2 (categoryName (getCategoryName t)) t++defineInternalCategory2 :: String -> AnyCategory c -> CompiledData [String]+defineInternalCategory2 className t = onlyCodes [+ categoryName (getCategoryName t) ++ "& " ++ categoryCreator (getCategoryName t) ++ "() {",+ " static auto& category = *new " ++ className ++ "();",+ " return category;",+ "}"+ ]++declareInternalType :: AnyCategory c -> Int -> CompiledData [String]+declareInternalType t n = onlyCodes [+ "S<" ++ typeName (getCategoryName t) ++ "> " ++ typeCreator (getCategoryName t) +++ "(Params<" ++ show n ++ ">::Type params);"+ ]++defineInternalType :: AnyCategory c -> Int -> CompiledData [String]+defineInternalType t = defineInternalType2 (typeName (getCategoryName t)) t++defineInternalType2 :: String -> AnyCategory c -> Int -> CompiledData [String]+defineInternalType2 className t n+ | n < 1 =+ onlyCodes [+ "S<" ++ typeName (getCategoryName t) ++ "> " ++ typeCreator (getCategoryName t) ++ "(Params<" ++ show n ++ ">::Type params) {",+ " static const auto cached = S_get(new " ++ className ++ "(" ++ categoryCreator (getCategoryName t) ++ "(), Params<" ++ show n ++ ">::Type()));",+ " return cached;",+ "}"+ ]+ | otherwise =+ onlyCodes [+ "S<" ++ typeName (getCategoryName t) ++ "> " ++ typeCreator (getCategoryName t) ++ "(Params<" ++ show n ++ ">::Type params) {",+ " static auto& cache = *new WeakInstanceMap<" ++ show n ++ ", " ++ typeName (getCategoryName t) ++ ">();",+ " static auto& cache_mutex = *new std::mutex;",+ " std::lock_guard<std::mutex> lock(cache_mutex);",+ " auto& cached = cache[GetKeyFromParams<" ++ show n ++ ">(params)];",+ " S<" ++ typeName (getCategoryName t) ++ "> type = cached;",+ " if (!type) { cached = type = S_get(new " ++ className ++ "(" ++ categoryCreator (getCategoryName t) ++ "(), params)); }",+ " return type;",+ "}"+ ]++declareInternalValue :: AnyCategory c -> CompiledData [String]+declareInternalValue t =+ onlyCodes [+ "S<TypeValue> " ++ valueCreator (getCategoryName t) +++ "(S<" ++ typeName (getCategoryName t) ++ "> parent, " +++ "const ParamTuple& params, const ValueTuple& args);"+ ]++defineInternalValue :: AnyCategory c -> CompiledData [String]+defineInternalValue t = defineInternalValue2 (valueName (getCategoryName t)) t++defineInternalValue2 :: String -> AnyCategory c -> CompiledData [String]+defineInternalValue2 className t =+ onlyCodes [+ "S<TypeValue> " ++ valueCreator (getCategoryName t) ++ "(S<" ++ typeName (getCategoryName t) ++ "> parent, " +++ "const ParamTuple& params, const ValueTuple& args) {",+ " return S_get(new " ++ className ++ "(parent, params, args));",+ "}"+ ]++getCategoryMentions :: AnyCategory c -> Set.Set CategoryName+getCategoryMentions t = Set.fromList $ fromRefines (getCategoryRefines t) +++ fromDefines (getCategoryDefines t) +++ fromFunctions (getCategoryFunctions t) +++ fromFilters (getCategoryFilters t) where+ fromRefines rs = Set.toList $ Set.unions $ map (categoriesFromRefine . vrType) rs+ fromDefines ds = Set.toList $ Set.unions $ map (categoriesFromDefine . vdType) ds+ fromDefine (DefinesInstance d ps) = d:(fromGenerals $ pValues ps)+ fromFunctions fs = concat $ map fromFunction fs+ fromFunction (ScopedFunction _ _ t2 _ as rs _ fs _) =+ [t2] ++ (fromGenerals $ map (vtType . pvType) (pValues as ++ pValues rs)) ++ fromFilters fs+ fromFilters fs = concat $ map (fromFilter . pfFilter) fs+ fromFilter (TypeFilter _ t2) = Set.toList $ categoriesFromTypes t2+ fromFilter (DefinesFilter t2) = fromDefine t2+ fromGenerals = Set.toList . Set.unions . map categoriesFromTypes
+ src/CompilerCxx/LanguageModule.hs view
@@ -0,0 +1,215 @@+{- -----------------------------------------------------------------------------+Copyright 2019-2021 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++{-# LANGUAGE Safe #-}++module CompilerCxx.LanguageModule (+ LanguageModule(..),+ PrivateSource(..),+ compileLanguageModule,+ compileModuleMain,+ compileTestsModule,+) where++import Control.Monad (foldM,foldM_,when)+import Data.List (intercalate,nub)+import qualified Data.Map as Map+import qualified Data.Set as Set++import Base.CompilerError+import Compilation.CompilerState+import Compilation.ProcedureContext (ExprMap)+import CompilerCxx.CxxFiles+import CompilerCxx.Naming+import Types.Builtin+import Types.DefinedCategory+import Types.Procedure+import Types.TypeCategory+import Types.TypeInstance+++data LanguageModule c =+ LanguageModule {+ lmPublicNamespaces :: Set.Set Namespace,+ lmPrivateNamespaces :: Set.Set Namespace,+ lmLocalNamespaces :: Set.Set Namespace,+ lmPublicDeps :: [AnyCategory c],+ lmPrivateDeps :: [AnyCategory c],+ lmTestingDeps :: [AnyCategory c],+ lmPublicLocal :: [AnyCategory c],+ lmPrivateLocal :: [AnyCategory c],+ lmTestingLocal :: [AnyCategory c],+ lmExternal :: [CategoryName],+ lmStreamlined :: [CategoryName],+ lmExprMap :: ExprMap c+ }++data PrivateSource c =+ PrivateSource {+ psNamespace :: Namespace,+ psTesting :: Bool,+ psCategory :: [AnyCategory c],+ psDefine :: [DefinedCategory c]+ }++compileLanguageModule :: (Ord c, Show c, CollectErrorsM m) =>+ LanguageModule c -> [PrivateSource c] -> m [CxxOutput]+compileLanguageModule (LanguageModule ns0 ns1 ns2 cs0 ps0 ts0 cs1 ps1 ts1 ex ss em) xa = do+ let dm = mapDefByName $ concat $ map psDefine xa+ checkDefined dm extensions $ filter isValueConcrete (cs1 ++ ps1 ++ ts1)+ checkSupefluous $ Set.toList $ extensions `Set.difference` ca+ tmPublic <- foldM includeNewTypes defaultCategories [cs0,cs1]+ tmPrivate <- foldM includeNewTypes tmPublic [ps0,ps1]+ tmTesting <- foldM includeNewTypes tmPrivate [ts0,ts1]+ let nsPublic = ns0 `Set.union` ns2+ let nsPrivate = ns1 `Set.union` nsPublic+ let nsTesting = nsPrivate+ xxInterfaces <- fmap concat $ collectAllM $+ map (generateNativeInterface False) (onlyNativeInterfaces cs1) +++ map (generateNativeInterface False) (onlyNativeInterfaces ps1) +++ map (generateNativeInterface True) (onlyNativeInterfaces ts1)+ xxPrivate <- fmap concat $ mapErrorsM (compilePrivate (tmPrivate,nsPrivate) (tmTesting,nsTesting)) xa+ xxStreamlined <- fmap concat $ mapErrorsM (streamlined tmTesting) $ nub ss+ xxVerbose <- fmap concat $ mapErrorsM (verbose tmTesting) $ nub ex+ let allFiles = xxInterfaces ++ xxPrivate ++ xxStreamlined ++ xxVerbose+ noDuplicateFiles $ map (\f -> (coFilename f,coNamespace f)) allFiles+ return allFiles where+ extensions = Set.fromList $ ex ++ ss+ testingCats = Set.fromList $ map getCategoryName ts1+ onlyNativeInterfaces = filter (not . (`Set.member` extensions) . getCategoryName) . filter (not . isValueConcrete)+ localCats = Set.fromList $ map getCategoryName $ cs1 ++ ps1 ++ ts1+ streamlined tm n = do+ checkLocal localCats ([] :: [String]) n+ (_,t) <- getConcreteCategory tm ([],n)+ generateStreamlinedExtension (n `Set.member` testingCats) t+ verbose tm n = do+ checkLocal localCats ([] :: [String]) n+ (_,t) <- getConcreteCategory tm ([],n)+ generateVerboseExtension (n `Set.member` testingCats) t+ compilePrivate (tmPrivate,nsPrivate) (tmTesting,nsTesting) (PrivateSource ns3 testing cs2 ds) = do+ let (tm,ns) = if testing+ then (tmTesting,nsTesting)+ else (tmPrivate,nsPrivate)+ let cs = Set.fromList $ map getCategoryName $ if testing+ then cs2 ++ cs1 ++ ps1 ++ ts1+ else cs2 ++ cs1 ++ ps1+ tm' <- includeNewTypes tm cs2+ let ctx = FileContext testing tm' (ns3 `Set.insert` ns) em+ checkLocals ds $ Map.keysSet tm'+ when testing $ checkTests ds (cs1 ++ ps1)+ let dm = mapDefByName ds+ checkDefined dm Set.empty $ filter isValueConcrete cs2+ xxInterfaces <- fmap concat $ mapErrorsM (generateNativeInterface testing) (filter (not . isValueConcrete) cs2)+ xxConcrete <- fmap concat $ mapErrorsM (generateConcrete cs ctx) ds+ return $ xxInterfaces ++ xxConcrete+ generateConcrete cs (FileContext testing tm ns em2) d = do+ tm' <- mergeInternalInheritance tm d+ t <- getCategoryDecl cs tm d+ let ctx = FileContext testing tm' ns em2+ generateNativeConcrete ctx (t,d)+ getCategoryDecl cs tm d = do+ checkLocal cs (dcContext d) (dcName d)+ fmap snd $ getConcreteCategory tm (dcContext d,dcName d)+ mapDefByName = Map.fromListWith (++) . map (\d -> (dcName d,[d]))+ ca = Set.fromList $ map getCategoryName $ filter isValueConcrete (cs1 ++ ps1 ++ ts1)+ checkLocals ds tm = mapErrorsM_ (\d -> checkLocal tm (dcContext d) (dcName d)) ds+ checkLocal cs2 c n =+ when (not $ n `Set.member` cs2) $+ compilerErrorM ("Category " ++ show n +++ formatFullContextBrace c +++ " does not correspond to a visible category in this module")+ checkTests ds ps = do+ let pa = Map.fromList $ map (\c -> (getCategoryName c,getCategoryContext c)) $ filter isValueConcrete ps+ mapErrorsM_ (checkTest pa) ds+ checkTest pa d =+ case dcName d `Map.lookup` pa of+ Nothing -> return ()+ Just c ->+ compilerErrorM ("Category " ++ show (dcName d) +++ formatFullContextBrace (dcContext d) +++ " was not declared as $TestsOnly$" ++ formatFullContextBrace c)+ checkDefined dm ext = mapErrorsM_ (checkSingle dm ext)+ checkSingle dm ext t =+ case (getCategoryName t `Set.member` ext,getCategoryName t `Map.lookup` dm) of+ (False,Just [_]) -> return ()+ (True,Nothing) -> return ()+ (True,Just [d]) ->+ compilerErrorM ("Category " ++ show (getCategoryName t) +++ formatFullContextBrace (getCategoryContext t) +++ " was declared external but is also defined at " ++ formatFullContext (dcContext d))+ (False,Nothing) ->+ compilerErrorM ("Category " ++ show (getCategoryName t) +++ formatFullContextBrace (getCategoryContext t) +++ " has not been defined or declared external")+ (_,Just ds) ->+ ("Category " ++ show (getCategoryName t) +++ formatFullContextBrace (getCategoryContext t) +++ " is defined " ++ show (length ds) ++ " times") !!>+ mapErrorsM_ (\d -> compilerErrorM $ "Defined at " ++ formatFullContext (dcContext d)) ds+ checkSupefluous es2+ | null es2 = return ()+ | otherwise = compilerErrorM $ "External categories either not concrete or not present: " +++ intercalate ", " (map show es2)+ noDuplicateFiles = foldM_ checkFileUsed Set.empty+ checkFileUsed used (f,ns3) = do+ when ((f,ns3) `Set.member` used) $+ compilerErrorM $ "Filename " ++ f ++ " in namespace " ++ show ns3 +++ " was already generated (internal compiler error)"+ return $ (f,ns3) `Set.insert` used++compileTestsModule :: (Ord c, Show c, CollectErrorsM m) =>+ LanguageModule c -> Namespace -> [String] -> [AnyCategory c] -> [DefinedCategory c] ->+ [TestProcedure c] -> m ([CxxOutput],CxxOutput,[(FunctionName,[c])])+compileTestsModule cm ns args cs ds ts = do+ let xs = PrivateSource {+ psNamespace = ns,+ psTesting = True,+ psCategory = cs,+ psDefine = ds+ }+ xx <- compileLanguageModule cm [xs]+ (main,fs) <- compileTestMain cm args xs ts+ return (xx,main,fs)++compileTestMain :: (Ord c, Show c, CollectErrorsM m) =>+ LanguageModule c -> [String] -> PrivateSource c -> [TestProcedure c] ->+ m (CxxOutput,[(FunctionName,[c])])+compileTestMain (LanguageModule ns0 ns1 ns2 cs0 ps0 ts0 cs1 ps1 ts1 _ _ em) args ts2 tests = do+ tm' <- tm+ (CompiledData req main) <- generateTestFile tm' em args tests+ let output = CxxOutput Nothing testFilename NoNamespace (psNamespace ts2 `Set.insert` Set.unions [ns0,ns1,ns2]) req main+ let tests' = map (\t -> (tpName t,tpContext t)) tests+ return (output,tests') where+ tm = foldM includeNewTypes defaultCategories [cs0,cs1,ps0,ps1,ts0,ts1,psCategory ts2]++compileModuleMain :: (Ord c, Show c, CollectErrorsM m) =>+ LanguageModule c -> [PrivateSource c] -> CategoryName -> FunctionName -> m CxxOutput+compileModuleMain (LanguageModule ns0 ns1 ns2 cs0 ps0 _ cs1 ps1 _ _ _ em) xa n f = do+ let resolved = filter (\d -> dcName d == n) $ concat $ map psDefine $ filter (not . psTesting) xa+ reconcile resolved+ tm' <- tm+ let cs = filter (\c -> getCategoryName c == n) $ concat $ map psCategory xa+ tm'' <- includeNewTypes tm' cs+ (ns,main) <- generateMainFile tm'' em n f+ return $ CxxOutput Nothing mainFilename NoNamespace (ns `Set.insert` Set.unions [ns0,ns1,ns2]) (Set.fromList [n]) main where+ tm = foldM includeNewTypes defaultCategories [cs0,cs1,ps0,ps1]+ reconcile [_] = return ()+ reconcile [] = compilerErrorM $ "No matches for main category " ++ show n ++ " ($TestsOnly$ sources excluded)"+ reconcile ds =+ "Multiple matches for main category " ++ show n !!>+ mapErrorsM_ (\d -> compilerErrorM $ "Defined at " ++ formatFullContext (dcContext d)) ds
src/CompilerCxx/Naming.hs view
@@ -25,6 +25,7 @@ baseSourceIncludes, callName, categoryCreator,+ categoryCustom, categoryGetter, categoryName, collectionName,@@ -44,13 +45,16 @@ sourceFilename, sourceStreamlined, tableName,+ templateStreamlined, testFilename, testFunctionName, typeCreator,+ typeCustom, typeGetter, typeName, unionGetter, valueCreator,+ valueCustom, valueName, variableName, ) where@@ -75,6 +79,9 @@ sourceStreamlined :: CategoryName -> String sourceStreamlined n = "Streamlined_" ++ show n ++ ".cpp" +templateStreamlined :: CategoryName -> String+templateStreamlined n = "Extension_" ++ show n ++ ".cpp"+ mainFilename :: String mainFilename = "main.cpp" @@ -125,6 +132,15 @@ valueName :: CategoryName -> String valueName n = "Value_" ++ show n++categoryCustom :: CategoryName -> String+categoryCustom n = "ExtCategory_" ++ show n++typeCustom :: CategoryName -> String+typeCustom n = "ExtType_" ++ show n++valueCustom :: CategoryName -> String+valueCustom n = "ExtValue_" ++ show n callName :: FunctionName -> String callName f = "Call_" ++ show f
src/CompilerCxx/Procedure.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry+Copyright 2019-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -30,6 +30,7 @@ compileLazyInit, compileRegularInit, compileTestProcedure,+ procedureDeclaration, selectTestFromArgv1, ) where @@ -54,23 +55,41 @@ import Types.Builtin import Types.DefinedCategory import Types.Function-import Types.Pragma import Types.Procedure import Types.TypeCategory import Types.TypeInstance import Types.Variance +procedureDeclaration :: Monad m => Bool -> ScopedFunction c -> m (CompiledData [String])+procedureDeclaration abstract f = return $ onlyCode func where+ func+ | abstract = "virtual " ++ proto ++ " = 0;"+ | otherwise = proto ++ ";"+ name = callName (sfName f)+ proto+ | sfScope f == CategoryScope =+ "ReturnTuple " ++ name ++ "(const ParamTuple& params, const ValueTuple& args)"+ | sfScope f == TypeScope =+ "ReturnTuple " ++ name +++ -- NOTE: Don't use Var_self, since self isn't accessible to @type functions.+ "(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args)"+ | sfScope f == ValueScope =+ "ReturnTuple " ++ name +++ "(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args)"+ | otherwise = undefined+ compileExecutableProcedure :: (Ord c, Show c, CollectErrorsM m) =>- ScopeContext c -> ScopedFunction c -> ExecutableProcedure c ->- m (CompiledData [String],CompiledData [String])-compileExecutableProcedure ctx ff@(ScopedFunction _ _ _ s as1 rs1 ps1 _ _)- pp@(ExecutableProcedure c pragmas c2 n as2 rs2 p) = do+ Maybe String -> ScopeContext c -> ScopedFunction c ->+ ExecutableProcedure c -> m (CompiledData [String])+compileExecutableProcedure className ctx+ ff@(ScopedFunction _ _ _ s as1 rs1 ps1 _ _)+ pp@(ExecutableProcedure c pragmas c2 n as2 rs2 p) = do ctx' <- getProcedureContext ctx ff pp output <- runDataCompiler compileWithReturn ctx' procedureTrace <- setProcedureTrace creationTrace <- setCreationTrace- return (onlyCode header,wrapProcedure output procedureTrace creationTrace)+ return $ wrapProcedure output procedureTrace creationTrace where t = scName ctx compileWithReturn = do@@ -80,9 +99,11 @@ when (not unreachable) $ doImplicitReturn c2 <?? "In implicit return from " ++ show n ++ formatFullContextBrace c+ funcMergeDeps f = mconcat $ (CompiledData (Set.fromList [sfType f]) []):(map funcMergeDeps $ sfMerges f) wrapProcedure output pt ct = mconcat [- onlyCode header2,+ funcMergeDeps ff,+ onlyCode proto, indentCompiled $ onlyCodes pt, indentCompiled $ onlyCodes ct, indentCompiled $ onlyCodes defineReturns,@@ -94,26 +115,18 @@ ] close = "}" name = callName n- header- | s == CategoryScope =- returnType ++ " " ++ name ++ "(const ParamTuple& params, const ValueTuple& args);"- | s == TypeScope =- returnType ++ " " ++ name ++- -- NOTE: Don't use Var_self, since self isn't accessible to @type functions.- "(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args);"- | s == ValueScope =- returnType ++ " " ++ name ++- "(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);"- | otherwise = undefined- header2+ prefix = case className of+ Nothing -> ""+ Just cn -> cn ++ "::"+ proto | s == CategoryScope =- returnType ++ " " ++ categoryName t ++ "::" ++ name ++ "(const ParamTuple& params, const ValueTuple& args) {"+ returnType ++ " " ++ prefix ++ name ++ "(const ParamTuple& params, const ValueTuple& args) {" | s == TypeScope =- returnType ++ " " ++ typeName t ++ "::" ++ name +++ returnType ++ " " ++ prefix ++ name ++ -- NOTE: Don't use Var_self, since self isn't accessible to @type functions. "(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {" | s == ValueScope =- returnType ++ " " ++ valueName t ++ "::" ++ name +++ returnType ++ " " ++ prefix ++ name ++ "(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {" | otherwise = undefined returnType = "ReturnTuple"@@ -275,13 +288,11 @@ -- TODO: Call csAddRequired for t1. (Maybe needs a helper function.) lift $ collectAllM_ [validateGeneralInstance r fa (vtType t1), checkValueAssignment r fa t2 t1]- csAddVariable (UsedVariable c2 n) (VariableValue c2 LocalScope t1 True)+ csAddVariable (UsedVariable c2 n) (VariableValue c2 LocalScope t1 VariableDefault) csWrite [variableStoredType t1 ++ " " ++ variableName n ++ ";"] createVariable r fa (ExistingVariable (InputValue c2 n)) t2 = "In assignment to " ++ show n ++ " at " ++ formatFullContext c2 ??> do- (VariableValue _ _ t1 w) <- csGetVariable (UsedVariable c2 n)- when (not w) $ compilerErrorM $ "Cannot assign to read-only variable " ++- show n ++ formatFullContextBrace c2+ (VariableValue _ _ t1 _) <- getWritableVariable c2 n -- TODO: Also show original context. lift $ (checkValueAssignment r fa t2 t1) csUpdateAssigned n@@ -303,6 +314,8 @@ writeStoredVariable t (UnwrappedSingle $ "r.At(" ++ show i ++ ")") ++ ";"] assignMulti _ = return () compileStatement (NoValueExpression _ v) = compileVoidExpression v+compileStatement (MarkReadOnly c vs) = mapM_ (\v -> csSetReadOnly (UsedVariable c v)) vs+compileStatement (MarkHidden c vs) = mapM_ (\v -> csSetHidden (UsedVariable c v)) vs compileStatement (RawCodeLine s) = csWrite [s] compileRegularInit :: (Ord c, Show c, CollectErrorsM m,@@ -310,10 +323,21 @@ DefinedMember c -> CompilerState a m () compileRegularInit (DefinedMember _ _ _ _ Nothing) = return () compileRegularInit (DefinedMember c2 s t n2 (Just e)) = resetBackgroundM $ do- csAddVariable (UsedVariable c2 n2) (VariableValue c2 s t True)+ csAddVariable (UsedVariable c2 n2) (VariableValue c2 s t VariableDefault) let assign = Assignment c2 (Positional [ExistingVariable (InputValue c2 n2)]) e compileStatement assign +getWritableVariable :: (Show c, CollectErrorsM m, CompilerContext c m [String] a) =>+ [c] -> VariableName -> CompilerState a m (VariableValue c)+getWritableVariable c n = do+ v@(VariableValue _ _ _ ro) <- csGetVariable (UsedVariable c n)+ case ro of+ VariableReadOnly [] -> compilerErrorM $ "Variable " ++ show n +++ formatFullContextBrace c ++ " is read-only"+ VariableReadOnly c2 -> compilerErrorM $ "Variable " ++ show n +++ formatFullContextBrace c ++ " is marked read-only at " ++ formatFullContext c2+ _ -> return v+ compileLazyInit :: (Ord c, Show c, CollectErrorsM m, CompilerContext c m [String] a) => DefinedMember c -> CompilerState a m ()@@ -408,7 +432,7 @@ -- Make variables to be created visible *after* p has been compiled so that p -- can't refer to them. ctxP <- lift $ execStateT (sequence $ map showVariable vs) ctxP0- ctxCl0 <- lift $ ccClearOutput ctxP >>= ccStartCleanup+ ctxCl0 <- lift $ ccClearOutput ctxP >>= flip ccStartCleanup c2 ctxP' <- case cl of -- Insert cleanup into the context for the in block.@@ -437,7 +461,7 @@ csWrite [variableStoredType t ++ " " ++ variableName n ++ ";"] showVariable (c,t,n) = do -- TODO: Call csAddRequired for t. (Maybe needs a helper function.)- csAddVariable (UsedVariable c n) (VariableValue c LocalScope t True)+ csAddVariable (UsedVariable c n) (VariableValue c LocalScope t VariableDefault) -- Don't merge if the second scope has cleanup, so that the latter can't -- refer to variables defined in the first scope. rewriteScoped (ScopedBlock _ p cl@(Just _) _@@ -793,9 +817,7 @@ compileExpressionStart (BuiltinCall _ _) = undefined compileExpressionStart (ParensExpression _ e) = compileExpression e compileExpressionStart (InlineAssignment c n e) = do- (VariableValue _ s t0 w) <- csGetVariable (UsedVariable c n)- when (not w) $ compilerErrorM $ "Cannot assign to read-only variable " ++- show n ++ formatFullContextBrace c+ (VariableValue _ s t0 _) <- getWritableVariable c n (Positional [t],e') <- compileExpression e -- TODO: Get rid of the Positional matching here. r <- csResolver fa <- csAllFilters
src/Module/CompileMetadata.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -30,8 +30,7 @@ import Cli.CompileOptions import Cli.Programs (VersionHash) import Parser.TextParser (SourceContext)-import Types.Pragma (MacroName)-import Types.Procedure (Expression)+import Types.Procedure (Expression,MacroName) import Types.TypeCategory (Namespace) import Types.TypeInstance (CategoryName)
src/Module/ParseMetadata.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -35,8 +35,7 @@ import Parser.TypeCategory () import Parser.TypeInstance () import Text.Regex.TDFA-import Types.Pragma (MacroName)-import Types.Procedure (Expression)+import Types.Procedure (Expression,MacroName) import Types.TypeCategory (FunctionName(..),Namespace(..)) import Types.TypeInstance (CategoryName(..))
src/Module/ProcessMetadata.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -63,14 +63,13 @@ import Cli.CompileOptions import Cli.Programs (VersionHash(..)) import Compilation.ProcedureContext (ExprMap)-import CompilerCxx.Category (CxxOutput(..))+import CompilerCxx.CxxFiles (CxxOutput(..)) import Module.CompileMetadata import Module.ParseMetadata import Module.Paths import Parser.SourceFile import Parser.TextParser (SourceContext)-import Types.Pragma-import Types.Procedure (Expression(Literal),ValueLiteral(..))+import Types.Procedure import Types.TypeCategory import Types.TypeInstance
src/Parser/Pragma.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -17,14 +17,9 @@ -- Author: Kevin P. Barry [ta0kira@gmail.com] module Parser.Pragma (+ autoPragma, parsePragmas,- pragmaComment,- pragmaExprLookup,- pragmaNoTrace,- pragmaModuleOnly,- pragmaSourceContext,- pragmaTestsOnly,- pragmaTraceCreation,+ unknownPragma, ) where import Control.Monad (when)@@ -32,52 +27,10 @@ import Base.CompilerError import Parser.Common import Parser.TextParser-import Types.Pragma parsePragmas :: [TextParser a] -> TextParser [a]-parsePragmas = many . foldr ((<|>)) unknownPragma--pragmaModuleOnly :: TextParser (Pragma SourceContext)-pragmaModuleOnly = autoPragma "ModuleOnly" $ Left parseAt where- parseAt c = PragmaVisibility [c] ModuleOnly--instance ParseFromSource MacroName where- sourceParser = labeled "macro name" $ do- h <- upperChar <|> char '_'- t <- many (upperChar <|> digitChar <|> char '_')- optionalSpace- return $ MacroName (h:t)--pragmaExprLookup :: TextParser (Pragma SourceContext)-pragmaExprLookup = autoPragma "ExprLookup" $ Right parseAt where- parseAt c = do- name <- sourceParser- return $ PragmaExprLookup [c] name--pragmaSourceContext :: TextParser (Pragma SourceContext)-pragmaSourceContext = autoPragma "SourceContext" $ Left parseAt where- parseAt c = PragmaSourceContext c--pragmaNoTrace :: TextParser (Pragma SourceContext)-pragmaNoTrace = autoPragma "NoTrace" $ Left parseAt where- parseAt c = PragmaTracing [c] NoTrace--pragmaTraceCreation :: TextParser (Pragma SourceContext)-pragmaTraceCreation = autoPragma "TraceCreation" $ Left parseAt where- parseAt c = PragmaTracing [c] TraceCreation--pragmaTestsOnly :: TextParser (Pragma SourceContext)-pragmaTestsOnly = autoPragma "TestsOnly" $ Left parseAt where- parseAt c = PragmaVisibility [c] TestsOnly--pragmaComment :: TextParser (Pragma SourceContext)-pragmaComment = autoPragma "Comment" $ Right parseAt where- parseAt c = do- string_ "\""- ss <- manyTill stringChar (string_ "\"")- optionalSpace- return $ PragmaComment [c] ss+parsePragmas = many . foldr ((<|>)) (try unknownPragma) unknownPragma :: TextParser a unknownPragma = do
src/Parser/Procedure.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry+Copyright 2019-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -20,6 +20,15 @@ {-# LANGUAGE FlexibleInstances #-} module Parser.Procedure (+ MarkType(..),+ PragmaExpr(..),+ PragmaStatement(..),+ pragmaExprLookup,+ pragmaHidden,+ pragmaNoTrace,+ pragmaReadOnly,+ pragmaSourceContext,+ pragmaTraceCreation, ) where import Control.Monad (when)@@ -32,7 +41,6 @@ import Parser.TextParser import Parser.TypeCategory () import Parser.TypeInstance ()-import Types.Pragma import Types.Procedure import Types.TypeCategory @@ -118,6 +126,7 @@ parseFailCall <|> parseVoid <|> parseAssign <|>+ parsePragma <|> parseIgnore where parseAssign = labeled "statement" $ do c <- getSourceContext@@ -163,6 +172,11 @@ c <- getSourceContext e <- sourceParser return $ NoValueExpression [c] e+ parsePragma = do+ p <- pragmaReadOnly <|> pragmaHidden <|> unknownPragma+ case p of+ PragmaMarkVars c ReadOnly vs -> return $ MarkReadOnly c vs+ PragmaMarkVars c Hidden vs -> return $ MarkHidden c vs instance ParseFromSource (Assignable SourceContext) where sourceParser = existing <|> create where@@ -345,7 +359,6 @@ else if bothInOperatorSet o1 o2 rightAssocInfix then return False -- Logical operators are right-associative. else return True -- Default is left-associative.- where checkAmbiguous :: (Show c, ErrorContextM m) => Operator c -> Operator c -> m () checkAmbiguous o1 o2 = checked where@@ -639,3 +652,60 @@ n <- sourceParser f <- parseFunctionCall c n return $ ConvertedCall [c] t f++instance ParseFromSource MacroName where+ sourceParser = labeled "macro name" $ do+ h <- upperChar <|> char '_'+ t <- many (upperChar <|> digitChar <|> char '_')+ optionalSpace+ return $ MacroName (h:t)++pragmaNoTrace :: TextParser (PragmaProcedure SourceContext)+pragmaNoTrace = autoPragma "NoTrace" $ Left parseAt where+ parseAt c = PragmaTracing [c] NoTrace++pragmaTraceCreation :: TextParser (PragmaProcedure SourceContext)+pragmaTraceCreation = autoPragma "TraceCreation" $ Left parseAt where+ parseAt c = PragmaTracing [c] TraceCreation++data PragmaExpr c =+ PragmaExprLookup {+ pelContext :: [c],+ pelName :: MacroName+ } |+ PragmaSourceContext {+ pscContext :: c+ }+ deriving (Show)++pragmaExprLookup :: TextParser (PragmaExpr SourceContext)+pragmaExprLookup = autoPragma "ExprLookup" $ Right parseAt where+ parseAt c = do+ name <- sourceParser+ return $ PragmaExprLookup [c] name++pragmaSourceContext :: TextParser (PragmaExpr SourceContext)+pragmaSourceContext = autoPragma "SourceContext" $ Left parseAt where+ parseAt c = PragmaSourceContext c++data MarkType = ReadOnly | Hidden deriving (Show)++data PragmaStatement c =+ PragmaMarkVars {+ pmvContext :: [c],+ pmvType :: MarkType,+ pmvVars :: [VariableName]+ }+ deriving (Show)++pragmaReadOnly :: TextParser (PragmaStatement SourceContext)+pragmaReadOnly = autoPragma "ReadOnly" $ Right parseAt where+ parseAt c = do+ vs <- labeled "variable names" $ sepBy sourceParser (sepAfter $ string ",")+ return $ PragmaMarkVars [c] ReadOnly vs++pragmaHidden :: TextParser (PragmaStatement SourceContext)+pragmaHidden = autoPragma "Hidden" $ Right parseAt where+ parseAt c = do+ vs <- labeled "variable names" $ sepBy sourceParser (sepAfter $ string ",")+ return $ PragmaMarkVars [c] Hidden vs
src/Parser/SourceFile.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -17,11 +17,23 @@ -- Author: Kevin P. Barry [ta0kira@gmail.com] module Parser.SourceFile (+ CodeVisibility(..),+ PragmaSource(..),+ WithVisibility(..),+ hasCodeVisibility,+ isModuleOnly,+ isTestsOnly,+ mapCodeVisibility, parseInternalSource, parsePublicSource, parseTestSource,+ pragmaModuleOnly,+ pragmaTestsOnly,+ updateCodeVisibility, ) where +import qualified Data.Set as Set+ import Base.CompilerError import Parser.Common import Parser.DefinedCategory ()@@ -31,12 +43,11 @@ import Parser.TypeCategory () import Types.DefinedCategory import Types.IntegrationTest-import Types.Pragma import Types.TypeCategory parseInternalSource :: ErrorContextM m =>- (FilePath,String) -> m ([Pragma SourceContext],[AnyCategory SourceContext],[DefinedCategory SourceContext])+ (FilePath,String) -> m ([PragmaSource SourceContext],[AnyCategory SourceContext],[DefinedCategory SourceContext]) parseInternalSource (f,s) = runTextParser (between optionalSpace endOfDoc withPragmas) f s where withPragmas = do pragmas <- parsePragmas internalSourcePragmas@@ -44,7 +55,7 @@ (cs,ds) <- parseAny2 sourceParser sourceParser return (pragmas,cs,ds) -parsePublicSource :: ErrorContextM m => (FilePath,String) -> m ([Pragma SourceContext],[AnyCategory SourceContext])+parsePublicSource :: ErrorContextM m => (FilePath,String) -> m ([PragmaSource SourceContext],[AnyCategory SourceContext]) parsePublicSource (f,s) = runTextParser (between optionalSpace endOfDoc withPragmas) f s where withPragmas = do pragmas <- parsePragmas publicSourcePragmas@@ -52,7 +63,7 @@ cs <- sepBy sourceParser optionalSpace return (pragmas,cs) -parseTestSource :: ErrorContextM m => (FilePath,String) -> m ([Pragma SourceContext],[IntegrationTest SourceContext])+parseTestSource :: ErrorContextM m => (FilePath,String) -> m ([PragmaSource SourceContext],[IntegrationTest SourceContext]) parseTestSource (f,s) = runTextParser (between optionalSpace endOfDoc withPragmas) f s where withPragmas = do pragmas <- parsePragmas testSourcePragmas@@ -60,11 +71,53 @@ ts <- sepBy sourceParser optionalSpace return (pragmas,ts) -publicSourcePragmas :: [TextParser (Pragma SourceContext)]+publicSourcePragmas :: [TextParser (PragmaSource SourceContext)] publicSourcePragmas = [pragmaModuleOnly,pragmaTestsOnly] -internalSourcePragmas :: [TextParser (Pragma SourceContext)]+internalSourcePragmas :: [TextParser (PragmaSource SourceContext)] internalSourcePragmas = [pragmaTestsOnly] -testSourcePragmas :: [TextParser (Pragma SourceContext)]+testSourcePragmas :: [TextParser (PragmaSource SourceContext)] testSourcePragmas = []++pragmaModuleOnly :: TextParser (PragmaSource SourceContext)+pragmaModuleOnly = autoPragma "ModuleOnly" $ Left parseAt where+ parseAt c = PragmaVisibility [c] ModuleOnly++pragmaTestsOnly :: TextParser (PragmaSource SourceContext)+pragmaTestsOnly = autoPragma "TestsOnly" $ Left parseAt where+ parseAt c = PragmaVisibility [c] TestsOnly++data CodeVisibility = ModuleOnly | TestsOnly | FromDependency deriving (Eq,Ord,Show)++data WithVisibility a =+ WithVisibility {+ wvVisibility :: Set.Set CodeVisibility,+ wvData :: a+ }+ deriving (Show)++hasCodeVisibility :: CodeVisibility -> WithVisibility a -> Bool+hasCodeVisibility v = Set.member v . wvVisibility++mapCodeVisibility :: (a -> b) -> WithVisibility a -> WithVisibility b+mapCodeVisibility f (WithVisibility v x) = WithVisibility v (f x)++updateCodeVisibility :: (Set.Set CodeVisibility -> Set.Set CodeVisibility) ->+ WithVisibility a -> WithVisibility a+updateCodeVisibility f (WithVisibility v x) = WithVisibility (f v) x++data PragmaSource c =+ PragmaVisibility {+ pvContext :: [c],+ pvScopes :: CodeVisibility+ }+ deriving (Show)++isModuleOnly :: PragmaSource c -> Bool+isModuleOnly (PragmaVisibility _ ModuleOnly) = True+isModuleOnly _ = False++isTestsOnly :: PragmaSource c -> Bool+isTestsOnly (PragmaVisibility _ TestsOnly) = True+isTestsOnly _ = False
src/Test/Common.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry+Copyright 2019-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -20,6 +20,8 @@ checkDefinesFail, checkDefinesSuccess, checkEquals,+ checkParseError,+ checkParseMatch, checkTypeFail, checkTypeSuccess, containsAtLeast,@@ -43,6 +45,7 @@ import System.Exit import System.FilePath import System.IO+import Text.Regex.TDFA import qualified Data.Map as Map import qualified Data.Set as Set @@ -179,3 +182,28 @@ loadFile :: String -> IO String loadFile f = readFile ("src" </> "Test" </> f)++checkParseMatch :: Show a => String -> TextParser a -> (a -> Bool) -> IO (TrackedErrors ())+checkParseMatch s p m = return $ do+ let parsed = readSingleWith p "(string)" s+ check parsed+ e <- parsed+ when (not $ m e) $+ compilerErrorM $ "No match in '" ++ s ++ "':\n" ++ show e+ where+ check c+ | isCompilerError c = compilerErrorM $ "Parse '" ++ s ++ "':\n" ++ show (getCompilerError c)+ | otherwise = return ()++checkParseError :: Show a => String -> String -> TextParser a -> IO (TrackedErrors ())+checkParseError s m p = return $ do+ let parsed = readSingleWith p "(string)" s+ check parsed+ where+ check c+ | isCompilerError c = do+ let text = show (getCompilerError c)+ when (not $ text =~ m) $+ compilerErrorM $ "Expected pattern " ++ show m ++ " in error output but got\n" ++ text+ | otherwise =+ compilerErrorM $ "Expected write failure but got\n" ++ show (getCompilerSuccess c)
src/Test/ParseMetadata.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -30,7 +30,6 @@ import Module.ParseMetadata import System.FilePath import Test.Common-import Types.Pragma import Types.Procedure import Types.TypeCategory (FunctionName(..),Namespace(..)) import Types.TypeInstance (CategoryName(..))
src/Test/Parser.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -66,7 +66,7 @@ checkParseFail (operator ">>??!" >> many asciiChar) ">>??!!!" ] -checkParsesAs :: (Eq a, Show a) => TextParser a -> [Char] -> a -> IO (TrackedErrors ())+checkParsesAs :: (Eq a, Show a) => TextParser a -> String -> a -> IO (TrackedErrors ()) checkParsesAs p s m = return $ do let parsed = readSingleWith p "(string)" s check parsed@@ -78,7 +78,7 @@ | isCompilerError c = compilerErrorM $ "Parse '" ++ s ++ "':\n" ++ show (getCompilerError c) | otherwise = return () -checkParseFail :: Show a => TextParser a -> [Char] -> IO (TrackedErrors ())+checkParseFail :: Show a => TextParser a -> String -> IO (TrackedErrors ()) checkParseFail p s = do let parsed = readSingleWith p "(string)" s return $ check parsed
src/Test/Pragma.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -18,106 +18,34 @@ module Test.Pragma (tests) where -import Control.Monad (when)-import Text.Regex.TDFA--import Base.CompilerError import Base.TrackedErrors+import Parser.Common import Parser.Pragma import Parser.TextParser import Test.Common-import Types.Pragma tests :: [IO (TrackedErrors ())] tests = [- checkParsesAs "$ModuleOnly$" (fmap (:[]) pragmaModuleOnly)- (\e -> case e of- [PragmaVisibility _ ModuleOnly] -> True- _ -> False),-- checkParsesAs "$TestsOnly$" (fmap (:[]) pragmaTestsOnly)- (\e -> case e of- [PragmaVisibility _ TestsOnly] -> True- _ -> False),-- checkParsesAs "$SourceContext$" (fmap (:[]) pragmaSourceContext)- (\e -> case e of- [PragmaSourceContext _] -> True- _ -> False),-- checkParsesAs "$NoTrace$" (fmap (:[]) pragmaNoTrace)- (\e -> case e of- [PragmaTracing _ NoTrace] -> True- _ -> False),-- checkParsesAs "$TraceCreation$" (fmap (:[]) pragmaTraceCreation)- (\e -> case e of- [PragmaTracing _ TraceCreation] -> True- _ -> False),-- checkParsesAs "$Comment[ \"this is a pragma with args\" ]$" (fmap (:[]) pragmaComment)+ checkParseMatch "$Comment[ \"this is a pragma with args\" ]$" (fmap (:[]) pragmaComment) (\e -> case e of [PragmaComment _ "this is a pragma with args"] -> True _ -> False), - checkParsesAs "$ExprLookup[ \nMODULE_PATH /*comment*/\n ]$" (fmap (:[]) pragmaExprLookup)- (\e -> case e of- [PragmaExprLookup _ (MacroName "MODULE_PATH")] -> True- _ -> False),-- checkParsesAs "/*only comments*/" (parsePragmas [pragmaModuleOnly,pragmaTestsOnly])- (\e -> case e of- [] -> True- _ -> False),-- checkParsesAs "$ModuleOnly$ // comment" (parsePragmas [pragmaTestsOnly,pragmaModuleOnly])- (\e -> case e of- [PragmaVisibility _ ModuleOnly] -> True- _ -> False),-- checkParsesAs "$TestsOnly$ /*comment*/" (parsePragmas [pragmaModuleOnly,pragmaTestsOnly])- (\e -> case e of- [PragmaVisibility _ TestsOnly] -> True- _ -> False),-- checkParsesAs "$TestsOnly$\n$TestsOnly$\n$ModuleOnly$" (parsePragmas [pragmaModuleOnly,pragmaTestsOnly])- (\e -> case e of- [PragmaVisibility _ TestsOnly,- PragmaVisibility _ TestsOnly,- PragmaVisibility _ ModuleOnly] -> True- _ -> False),-- checkParseError "$ModuleOnly[ extra ]$" "does not allow arguments" pragmaModuleOnly,-- checkParseError "$TestsOnly[ extra ]$" "does not allow arguments" pragmaTestsOnly,-- checkParseError "$Comment$" "requires arguments" pragmaComment,-- checkParseError "$ExprLookup[ \"bad stuff\" ]$" "macro name" pragmaExprLookup+ checkParseError "$Comment$" "requires arguments" pragmaComment ] -checkParsesAs :: String -> TextParser [Pragma SourceContext] -> ([Pragma SourceContext] -> Bool) -> IO (TrackedErrors ())-checkParsesAs s p m = return $ do- let parsed = readSingleWith p "(string)" s- check parsed- e <- parsed- when (not $ m e) $- compilerErrorM $ "No match in '" ++ s ++ "':\n" ++ show e- where- check c- | isCompilerError c = compilerErrorM $ "Parse '" ++ s ++ "':\n" ++ show (getCompilerError c)- | otherwise = return ()+data PragmaComment c =+ PragmaComment {+ pcContext :: [c],+ pcComment :: String+ }+ deriving (Show) -checkParseError :: String -> String -> TextParser (Pragma SourceContext) -> IO (TrackedErrors ())-checkParseError s m p = return $ do- let parsed = readSingleWith p "(string)" s- check parsed- where- check c- | isCompilerError c = do- let text = show (getCompilerError c)- when (not $ text =~ m) $- compilerErrorM $ "Expected pattern " ++ show m ++ " in error output but got\n" ++ text- | otherwise =- compilerErrorM $ "Expected write failure but got\n" ++ show (getCompilerSuccess c)+pragmaComment :: TextParser (PragmaComment SourceContext)+pragmaComment = autoPragma "Comment" $ Right parseAt where+ parseAt c = do+ string_ "\""+ ss <- manyTill stringChar (string_ "\"")+ optionalSpace+ return $ PragmaComment [c] ss
src/Test/Procedure.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry+Copyright 2019-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -24,7 +24,7 @@ import Base.CompilerError import Base.Positional import Base.TrackedErrors-import Parser.Procedure ()+import Parser.Procedure import Parser.TextParser (SourceContext) import Test.Common import Types.Procedure@@ -406,7 +406,41 @@ checkParsesAs "1.2345E-4" (\e -> case e of (Literal (DecimalLiteral _ 12345 (-8))) -> True- _ -> False)+ _ -> False),++ checkParseMatch "$NoTrace$" pragmaNoTrace+ (\e -> case e of+ PragmaTracing _ NoTrace -> True+ _ -> False),++ checkParseMatch "$TraceCreation$" pragmaTraceCreation+ (\e -> case e of+ PragmaTracing _ TraceCreation -> True+ _ -> False),++ checkParseMatch "$ReadOnly[foo,bar]$" pragmaReadOnly+ (\e -> case e of+ PragmaMarkVars _ ReadOnly [VariableName "foo", VariableName "bar"] -> True+ _ -> False),++ checkParseMatch "$Hidden[foo,bar]$" pragmaHidden+ (\e -> case e of+ PragmaMarkVars _ Hidden [VariableName "foo", VariableName "bar"] -> True+ _ -> False),++ checkParseMatch "$SourceContext$" pragmaSourceContext+ (\e -> case e of+ PragmaSourceContext _ -> True+ _ -> False),++ checkParseMatch "$ExprLookup[ \nMODULE_PATH /*comment*/\n ]$" pragmaExprLookup+ (\e -> case e of+ PragmaExprLookup _ (MacroName "MODULE_PATH") -> True+ _ -> False),++ checkParseError "$ExprLookup[ \"bad stuff\" ]$" "macro name" pragmaExprLookup,+ checkParseError "$ReadOnly$" "requires arguments" pragmaReadOnly,+ checkParseError "$Hidden$" "requires arguments" pragmaHidden ] checkParseSuccess :: String -> IO (TrackedErrors ())
src/Test/SourceFile.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -22,12 +22,48 @@ import Base.CompilerError import Base.TrackedErrors+import Parser.Pragma (parsePragmas) import Parser.SourceFile import Test.Common tests :: [IO (TrackedErrors ())] tests = [+ checkParseMatch "$ModuleOnly$" (fmap (:[]) pragmaModuleOnly)+ (\e -> case e of+ [PragmaVisibility _ ModuleOnly] -> True+ _ -> False),++ checkParseMatch "$TestsOnly$" (fmap (:[]) pragmaTestsOnly)+ (\e -> case e of+ [PragmaVisibility _ TestsOnly] -> True+ _ -> False),++ checkParseMatch "/*only comments*/" (parsePragmas [pragmaModuleOnly,pragmaTestsOnly])+ (\e -> case e of+ [] -> True+ _ -> False),++ checkParseMatch "$ModuleOnly$ // comment" (parsePragmas [pragmaTestsOnly,pragmaModuleOnly])+ (\e -> case e of+ [PragmaVisibility _ ModuleOnly] -> True+ _ -> False),++ checkParseMatch "$TestsOnly$ /*comment*/" (parsePragmas [pragmaModuleOnly,pragmaTestsOnly])+ (\e -> case e of+ [PragmaVisibility _ TestsOnly] -> True+ _ -> False),++ checkParseMatch "$TestsOnly$\n$TestsOnly$\n$ModuleOnly$" (parsePragmas [pragmaModuleOnly,pragmaTestsOnly])+ (\e -> case e of+ [PragmaVisibility _ TestsOnly,+ PragmaVisibility _ TestsOnly,+ PragmaVisibility _ ModuleOnly] -> True+ _ -> False),++ checkParseError "$ModuleOnly[ extra ]$" "does not allow arguments" pragmaModuleOnly,+ checkParseError "$TestsOnly[ extra ]$" "does not allow arguments" pragmaTestsOnly,+ checkParseSuccess ("testfiles" </> "public.0rp") parsePublicSource, checkParseSuccess ("testfiles" </> "internal.0rx") parseInternalSource, checkParseSuccess ("testfiles" </> "test.0rt") parseTestSource
src/Types/Builtin.hs view
@@ -22,6 +22,7 @@ boolRequiredValue, charRequiredValue, defaultCategories,+ defaultCategoryDeps, emptyValue, floatRequiredValue, formattedRequiredValue,@@ -30,6 +31,7 @@ ) where import qualified Data.Map as Map+import qualified Data.Set as Set import Types.TypeCategory import Types.TypeInstance@@ -37,6 +39,9 @@ defaultCategories :: CategoryMap c defaultCategories = Map.empty++defaultCategoryDeps :: Set.Set CategoryName+defaultCategoryDeps = Set.fromList [BuiltinBool,BuiltinString,BuiltinChar,BuiltinInt,BuiltinFloat,BuiltinFormatted] boolRequiredValue :: ValueType boolRequiredValue = requiredSingleton BuiltinBool
src/Types/DefinedCategory.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2019 Kevin P. Barry+Copyright 2019-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -21,6 +21,7 @@ module Types.DefinedCategory ( DefinedCategory(..), DefinedMember(..),+ VariableRule(..), VariableValue(..), isInitialized, mapMembers,@@ -69,14 +70,29 @@ check Nothing = False check _ = True +data VariableRule c =+ VariableDefault |+ VariableReadOnly {+ vroContext :: [c]+ } |+ VariableHidden {+ vhContext :: [c]+ }+ data VariableValue c = VariableValue { vvContext :: [c], vvScope :: SymbolScope, vvType :: ValueType,- vvWritable :: Bool+ vvReadOnlyAt :: VariableRule c } +instance Show c => Show (VariableValue c) where+ show (VariableValue c _ t ro) = show t ++ formatFullContextBrace c ++ format ro where+ format (VariableReadOnly c2) = " (read-only at " ++ formatFullContext c2 ++ ")"+ format (VariableHidden c2) = " (hidden at " ++ formatFullContext c2 ++ ")"+ format _ = ""+ setInternalFunctions :: (Show c, CollectErrorsM m, TypeResolver r) => r -> AnyCategory c -> [ScopedFunction c] -> m (Map.Map FunctionName (ScopedFunction c))@@ -158,7 +174,7 @@ formatFullContextBrace (dmContext m) ++ " is already defined" ++ formatFullContextBrace (vvContext m0)- return $ Map.insert (dmName m) (VariableValue (dmContext m) (dmScope m) (dmType m) True) ma'+ return $ Map.insert (dmName m) (VariableValue (dmContext m) (dmScope m) (dmType m) VariableDefault) ma' -- TODO: Most of this duplicates parts of flattenAllConnections. mergeInternalInheritance :: (Show c, CollectErrorsM m) =>
− src/Types/Pragma.hs
@@ -1,124 +0,0 @@-{- ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry--Licensed under the Apache License, Version 2.0 (the "License");-you may not use this file except in compliance with the License.-You may obtain a copy of the License at-- http://www.apache.org/licenses/LICENSE-2.0--Unless required by applicable law or agreed to in writing, software-distributed under the License is distributed on an "AS IS" BASIS,-WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-See the License for the specific language governing permissions and-limitations under the License.------------------------------------------------------------------------------ -}---- Author: Kevin P. Barry [ta0kira@gmail.com]--{-# LANGUAGE Safe #-}--module Types.Pragma (- CodeVisibility(..),- MacroName(..),- Pragma(..),- TraceType(..),- WithVisibility(..),- getPragmaContext,- hasCodeVisibility,- isExprLookup,- isModuleOnly,- isNoTrace,- isSourceContext,- isTestsOnly,- isTraceCreation,- mapCodeVisibility,- updateCodeVisibility,-) where--import qualified Data.Set as Set---data CodeVisibility = ModuleOnly | TestsOnly | FromDependency deriving (Eq,Ord,Show)--data WithVisibility a =- WithVisibility {- wvVisibility :: Set.Set CodeVisibility,- wvData :: a- }- deriving (Show)--hasCodeVisibility :: CodeVisibility -> WithVisibility a -> Bool-hasCodeVisibility v = Set.member v . wvVisibility--mapCodeVisibility :: (a -> b) -> WithVisibility a -> WithVisibility b-mapCodeVisibility f (WithVisibility v x) = WithVisibility v (f x)--updateCodeVisibility :: (Set.Set CodeVisibility -> Set.Set CodeVisibility) ->- WithVisibility a -> WithVisibility a-updateCodeVisibility f (WithVisibility v x) = WithVisibility (f v) x--data TraceType = NoTrace | TraceCreation deriving (Show)--newtype MacroName =- MacroName {- mnName :: String- }- deriving (Eq,Ord)--instance Show MacroName where- show = mnName--data Pragma c =- PragmaVisibility {- pvContext :: [c],- pvScopes :: CodeVisibility- } |- PragmaExprLookup {- pelContext :: [c],- pelName :: MacroName- } |- PragmaSourceContext {- pscContext :: c- } |- PragmaTracing {- ptContext :: [c],- ptType :: TraceType- } |- -- This is mostly for testing purposes.- PragmaComment {- pcContext :: [c],- pcComment :: String- }- deriving (Show)--getPragmaContext :: Pragma c -> [c]-getPragmaContext (PragmaVisibility c _) = c-getPragmaContext (PragmaExprLookup c _) = c-getPragmaContext (PragmaSourceContext c) = [c]-getPragmaContext (PragmaTracing c _) = c-getPragmaContext (PragmaComment c _) = c--isModuleOnly :: Pragma c -> Bool-isModuleOnly (PragmaVisibility _ ModuleOnly) = True-isModuleOnly _ = False--isExprLookup :: Pragma c -> Bool-isExprLookup (PragmaExprLookup _ _) = True-isExprLookup _ = False--isSourceContext :: Pragma c -> Bool-isSourceContext (PragmaSourceContext _) = True-isSourceContext _ = False--isNoTrace :: Pragma c -> Bool-isNoTrace (PragmaTracing _ NoTrace) = True-isNoTrace _ = False--isTraceCreation :: Pragma c -> Bool-isTraceCreation (PragmaTracing _ TraceCreation) = True-isTraceCreation _ = False--isTestsOnly :: Pragma c -> Bool-isTestsOnly (PragmaVisibility _ TestsOnly) = True-isTestsOnly _ = False
src/Types/Procedure.hs view
@@ -1,5 +1,5 @@ {- ------------------------------------------------------------------------------Copyright 2019-2020 Kevin P. Barry+Copyright 2019-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -30,13 +30,16 @@ IfElifElse(..), InputValue(..), InstanceOrInferred(..),+ MacroName(..), Operator(..), OutputValue(..),+ PragmaProcedure(..), Procedure(..), ReturnValues(..), ScopedBlock(..), Statement(..), TestProcedure(..),+ TraceType(..), ValueLiteral(..), ValueOperation(..), VariableName(..),@@ -50,6 +53,8 @@ isDiscardedInput, isFunctionOperator, isLiteralCategory,+ isNoTrace,+ isTraceCreation, isRawCodeLine, isUnnamedReturns, ) where@@ -57,7 +62,6 @@ import Data.List (intercalate) import Base.Positional-import Types.Pragma import Types.TypeCategory import Types.TypeInstance @@ -67,7 +71,7 @@ data ExecutableProcedure c = ExecutableProcedure { epContext :: [c],- epPragmas :: [Pragma c],+ epPragmas :: [PragmaProcedure c], epEnd :: [c], epName :: FunctionName, epArgs :: ArgValues c,@@ -165,6 +169,8 @@ IgnoreValues [c] (Expression c) | Assignment [c] (Positional (Assignable c)) (Expression c) | NoValueExpression [c] (VoidExpression c) |+ MarkReadOnly [c] [VariableName] |+ MarkHidden [c] [VariableName] | RawCodeLine String deriving (Show) @@ -181,6 +187,8 @@ getStatementContext (IgnoreValues c _) = c getStatementContext (Assignment c _ _) = c getStatementContext (NoValueExpression c _) = c+getStatementContext (MarkReadOnly c _) = c+getStatementContext (MarkHidden c _) = c getStatementContext (RawCodeLine _) = [] data Assignable c =@@ -308,3 +316,29 @@ ConvertedCall [c] TypeInstance (FunctionCall c) | ValueCall [c] (FunctionCall c) deriving (Show)++newtype MacroName =+ MacroName {+ mnName :: String+ }+ deriving (Eq,Ord)++instance Show MacroName where+ show = mnName++data TraceType = NoTrace | TraceCreation deriving (Show)++data PragmaProcedure c =+ PragmaTracing {+ ptContext :: [c],+ ptType :: TraceType+ }+ deriving (Show)++isNoTrace :: PragmaProcedure c -> Bool+isNoTrace (PragmaTracing _ NoTrace) = True+isNoTrace _ = False++isTraceCreation :: PragmaProcedure c -> Bool+isTraceCreation (PragmaTracing _ TraceCreation) = True+isTraceCreation _ = False
tests/cli-tests.sh view
@@ -75,7 +75,7 @@ test_tests_only() { local output=$(do_zeolite -p "$ZEOLITE_PATH" -r tests/tests-only -f || true)- if ! echo "$output" | egrep -q 'Definition for Type1 .+ visible category'; then+ if ! echo "$output" | egrep -q 'Type1 .+ visible category'; then show_message 'Expected Type1 definition error from tests/tests-only:' echo "$output" 1>&2 return 1@@ -108,6 +108,26 @@ } +test_tests_only4() {+ local output=$(do_zeolite -p "$ZEOLITE_PATH" -r tests/tests-only4 -f || true)+ if ! echo "$output" | egrep -q 'Type2 .+ \$TestsOnly\$'; then+ show_message 'Expected Type2 import error from tests/tests-only4:'+ echo "$output" 1>&2+ return 1+ fi+ if ! echo "$output" | egrep -q 'In compilation of .+/source2\.cpp'; then+ show_message 'Expected source2.cpp import error from tests/tests-only4:'+ echo "$output" 1>&2+ return 1+ fi+ if echo "$output" | egrep -q 'In compilation of .+/source1\.cpp'; then+ show_message 'Unexpected source1.cpp import error from tests/tests-only4:'+ echo "$output" 1>&2+ return 1+ fi+}++ test_module_only() { local output=$(do_zeolite -p "$ZEOLITE_PATH" -R tests/module-only -f || true) if ! echo "$output" | egrep -q 'Type1 not found'; then@@ -185,7 +205,7 @@ test_templates() {- execute rm -f $ZEOLITE_PATH/tests/templates/Category_Templated.cpp+ execute rm -f $ZEOLITE_PATH/tests/templates/Extension_Templated.cpp do_zeolite -p "$ZEOLITE_PATH" --templates tests/templates do_zeolite -p "$ZEOLITE_PATH" -r tests/templates do_zeolite -p "$ZEOLITE_PATH" -t tests/templates@@ -342,6 +362,7 @@ test_tests_only test_tests_only2 test_tests_only3+ test_tests_only4 test_module_only test_module_only2 test_module_only3
tests/internal-inheritance.0rt view
@@ -92,7 +92,29 @@ } -testcase "internal define is private" {+testcase "internal define links properly for dispatching" {+ success+}++unittest test {}++concrete Value {}++define Value {+ refines Formatted+ defines Equals<Value>++ formatted () {+ return "Value"+ }++ equals (_,_) {+ return true+ }+}+++testcase "internal define is visible privately" { success }
+ tests/local-rules.0rt view
@@ -0,0 +1,258 @@+/* -----------------------------------------------------------------------------+Copyright 2021 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++testcase "ReadOnly causes error" {+ error+ require "foo.+read-only"+}++unittest test {+ Int foo <- 1+ scoped {+ } in {+ $ReadOnly[foo]$+ foo <- 2+ }+}+++testcase "ReadOnly with bad variable name" {+ error+ require "foo.+not defined"+}++unittest test {+ $ReadOnly[foo]$+}+++testcase "ReadOnly is scoped" {+ success+}++unittest test {+ Int foo <- 1+ scoped {+ } in {+ $ReadOnly[foo]$+ }+ foo <- 2+ \ Testing.checkEquals<?>(foo,2)+}+++testcase "ReadOnly is passed to nested scope" {+ error+ require "foo.+read-only"+}++unittest test {+ Int foo <- 1+ $ReadOnly[foo]$+ if (true) {+ foo <- 2+ }+}+++testcase "ReadOnly is idempotent" {+ success+}++unittest test {+ Int foo <- 1+ scoped {+ } in {+ $ReadOnly[foo]$+ $ReadOnly[foo]$+ }+ foo <- 2+ \ Testing.checkEquals<?>(foo,2)+}+++testcase "ReadOnly respects order" {+ success+}++unittest test {+ Int foo <- 1+ scoped {+ } in {+ foo <- 2+ $ReadOnly[foo]$+ }+ \ Testing.checkEquals<?>(foo,2)+ foo <- 3+ \ Testing.checkEquals<?>(foo,3)+}+++testcase "ReadOnly with member" {+ error+ require "foo.+read-only"+}++unittest test {+ \ Value.test()+}++concrete Value {+ @type test () -> ()+}++define Value {+ @category Int foo <- 1++ test () {+ $ReadOnly[foo]$+ foo <- 2+ }+}+++testcase "ReadOnly in while does not affect update" {+ success+}++unittest test {+ scoped {+ Int foo <- 0+ } in while (foo < 10) {+ $ReadOnly[foo]$+ continue+ } update {+ foo <- foo+1+ }+}+++testcase "ReadOnly in scoped does not affect cleanup" {+ success+}++unittest test {+ Int foo <- 1+ cleanup {+ foo <- 2+ } in $ReadOnly[foo]$+ \ Testing.checkEquals<?>(foo,2)+}+++testcase "Hidden causes error" {+ error+ require "foo.+hidden"+}++unittest test {+ Int foo <- 1+ scoped {+ } in {+ $Hidden[foo]$+ \ foo+ }+}+++testcase "Hidden is scoped" {+ success+}++unittest test {+ Int foo <- 1+ scoped {+ } in {+ $Hidden[foo]$+ }+ foo <- 2+ \ Testing.checkEquals<?>(foo,2)+}+++testcase "Hidden is passed to nested scope" {+ error+ require "foo.+hidden"+}++unittest test {+ Int foo <- 1+ $Hidden[foo]$+ if (true) {+ foo <- 2+ }+}+++testcase "Hidden is not idempotent" {+ error+ require "foo.+hidden"+}++unittest test {+ Int foo <- 1+ scoped {+ } in {+ $Hidden[foo]$+ $Hidden[foo]$+ }+}+++testcase "ReadOnly cannot be applied to Hidden" {+ error+ require "foo.+hidden"+}++unittest test {+ Int foo <- 1+ scoped {+ } in {+ $Hidden[foo]$+ $ReadOnly[foo]$+ }+}+++testcase "Hidden respects order" {+ success+}++unittest test {+ Int foo <- 1+ scoped {+ } in {+ foo <- 2+ $Hidden[foo]$+ }+ \ Testing.checkEquals<?>(foo,2)+ foo <- 3+ \ Testing.checkEquals<?>(foo,3)+}+++testcase "Hidden does not allow reusing a variable name" {+ error+ require "foo.+already defined"+}++unittest test {+ Int foo <- 1+ $Hidden[foo]$+ Int foo <- 1+}
tests/module-only3/README.md view
@@ -18,7 +18,6 @@ ^~~~~~~~~~~~~~~~~~~~ 1 error generated. Execution of /usr/bin/clang++ failed- ``` Importantly, there *should not* be any errors related to `Type2`; only `Type1`.
tests/module-only4/common-source.cpp view
@@ -1,5 +1,5 @@ /* ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -17,6 +17,8 @@ // Author: Kevin P. Barry [ta0kira@gmail.com] #include "category-source.hpp"+#include "Streamlined_Type1.hpp"+#include "Streamlined_Type3.hpp" #include "Category_Formatted.hpp" #include "Category_String.hpp" #include "Category_Type1.hpp"@@ -27,135 +29,43 @@ namespace ZEOLITE_PRIVATE_NAMESPACE { #endif // ZEOLITE_PRIVATE_NAMESPACE -namespace {--const int collection_Type1 = 0;-} // namespace--const void* const Functions_Type1 = &collection_Type1;-const TypeFunction& Function_Type1_create = (*new TypeFunction{ 0, 0, 1, "Type1", "create", Functions_Type1, 0 });-const ValueFunction& Function_Type1_get = (*new ValueFunction{ 0, 0, 1, "Type1", "get", Functions_Type1, 0 });--namespace {--class Category_Type1;-class Type_Type1;-S<Type_Type1> CreateType_Type1(Params<0>::Type params);-class Value_Type1;-S<TypeValue> CreateValue_Type1(Type_Type1& parent, const ParamTuple& params, const ValueTuple& args);+S<TypeValue> CreateValue_Type1(S<Type_Type1> parent, const ParamTuple& params, const ValueTuple& args); -struct Category_Type1 : public TypeCategory {- std::string CategoryName() const final { return "Type1"; }- Category_Type1() {- CycleCheck<Category_Type1>::Check();- CycleCheck<Category_Type1> marker(*this);- TRACE_FUNCTION("Type1 (init @category)")- }- ReturnTuple Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Category_Type1::*)(const ParamTuple&, const ValueTuple&);- return TypeCategory::Dispatch(label, params, args);- }+struct ExtCategory_Type1 : public Category_Type1 { }; -Category_Type1& CreateCategory_Type1() {- static auto& category = *new Category_Type1();- return category;-}+struct ExtType_Type1 : public Type_Type1 {+ inline ExtType_Type1(Category_Type1& p, Params<0>::Type params) : Type_Type1(p, params) {} -struct Type_Type1 : public TypeInstance {- std::string CategoryName() const final { return parent.CategoryName(); }- void BuildTypeName(std::ostream& output) const final {- return TypeInstance::TypeNameFrom(output, parent);- }- Category_Type1& parent;- bool CanConvertFrom(const S<const TypeInstance>& from) const final {- std::vector<S<const TypeInstance>> args;- if (!from->TypeArgsForParent(parent, args)) return false;- if(args.size() != 0) {- FAIL() << "Wrong number of args (" << args.size() << ") for " << CategoryName();- }- return true;- }- bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {- if (&category == &GetCategory_Type1()) {- args = std::vector<S<const TypeInstance>>{};- return true;- }- return false;- }- Type_Type1(Category_Type1& p, Params<0>::Type params) : parent(p) {- CycleCheck<Type_Type1>::Check();- CycleCheck<Type_Type1> marker(*this);- TRACE_FUNCTION("Type1 (init @type)")- }- ReturnTuple Dispatch(const S<TypeInstance>& self, const TypeFunction& label,- const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Type_Type1::*)(const S<TypeInstance>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_Type1[] = {- &Type_Type1::Call_create,- };- if (label.collection == Functions_Type1) {- if (label.function_num < 0 || label.function_num >= 1) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_Type1[label.function_num])(self, params, args);- }- return TypeInstance::Dispatch(self, label, params, args);+ ReturnTuple Call_create(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("Type1.create")+ return ReturnTuple(CreateValue_Type1(CreateType_Type1(Params<0>::Type()), ParamTuple(),+ TypeInstance::Call(GetType_Type2(Params<0>::Type()), Function_Type2_create, ParamTuple(), ArgTuple()))); }- ReturnTuple Call_create(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args); }; -S<Type_Type1> CreateType_Type1(Params<0>::Type params) {- static const auto cached = S_get(new Type_Type1(CreateCategory_Type1(), Params<0>::Type()));- return cached;-}--struct Value_Type1 : public TypeValue {- Value_Type1(Type_Type1& p, const ParamTuple& params, const ValueTuple& args)- : parent(p), value(args.Only()) {}+struct ExtValue_Type1 : public Value_Type1 {+ inline ExtValue_Type1(S<Type_Type1> p, const ParamTuple& params, const ValueTuple& args)+ : Value_Type1(p, params), value(args.At(0)) {} - ReturnTuple Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params,const ValueTuple& args) final {- using CallType = ReturnTuple(Value_Type1::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_Type1[] = {- &Value_Type1::Call_get,- };- if (label.collection == Functions_Type1) {- if (label.function_num < 0 || label.function_num >= 1) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_Type1[label.function_num])(self, params, args);- }- return TypeValue::Dispatch(self, label, params, args);+ ReturnTuple Call_get(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("Type1.get")+ return ReturnTuple(TypeValue::Call(value, Function_Type2_get, ParamTuple(), ArgTuple())); }- std::string CategoryName() const final { return parent.CategoryName(); }- ReturnTuple Call_get(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- Type_Type1& parent;+ const S<TypeValue> value; }; -S<TypeValue> CreateValue_Type1(Type_Type1& parent, const ParamTuple& params, const ValueTuple& args) {- return S_get(new Value_Type1(parent, params, args));-}--ReturnTuple Type_Type1::Call_create(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("Type1.create")- return ReturnTuple(CreateValue_Type1(*this, ParamTuple(),- TypeInstance::Call(GetType_Type2(Params<0>::Type()), Function_Type2_create, ParamTuple(), ArgTuple())));-}--ReturnTuple Value_Type1::Call_get(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("Type1.get")- return ReturnTuple(TypeValue::Call(value, Function_Type2_get, ParamTuple(), ArgTuple()));+Category_Type1& CreateCategory_Type1() {+ static auto& category = *new ExtCategory_Type1();+ return category; }--} // namespace--TypeCategory& GetCategory_Type1() {- return CreateCategory_Type1();+S<Type_Type1> CreateType_Type1(Params<0>::Type params) {+ static const auto cached = S_get(new ExtType_Type1(CreateCategory_Type1(), Params<0>::Type()));+ return cached; }--S<TypeInstance> GetType_Type1(Params<0>::Type params) {- return CreateType_Type1(params);+S<TypeValue> CreateValue_Type1(S<Type_Type1> parent, const ParamTuple& params, const ValueTuple& args) {+ return S_get(new ExtValue_Type1(parent, params, args)); } #ifdef ZEOLITE_PRIVATE_NAMESPACE@@ -168,135 +78,43 @@ namespace ZEOLITE_PUBLIC_NAMESPACE { #endif // ZEOLITE_PUBLIC_NAMESPACE -namespace {--const int collection_Type3 = 0;-} // namespace--const void* const Functions_Type3 = &collection_Type3;-const TypeFunction& Function_Type3_create = (*new TypeFunction{ 0, 0, 1, "Type3", "create", Functions_Type3, 0 });-const ValueFunction& Function_Type3_get = (*new ValueFunction{ 0, 0, 1, "Type3", "get", Functions_Type3, 0 });--namespace {--class Category_Type3;-class Type_Type3;-S<Type_Type3> CreateType_Type3(Params<0>::Type params);-class Value_Type3;-S<TypeValue> CreateValue_Type3(Type_Type3& parent, const ParamTuple& params, const ValueTuple& args);+S<TypeValue> CreateValue_Type3(S<Type_Type3> parent, const ParamTuple& params, const ValueTuple& args); -struct Category_Type3 : public TypeCategory {- std::string CategoryName() const final { return "Type3"; }- Category_Type3() {- CycleCheck<Category_Type3>::Check();- CycleCheck<Category_Type3> marker(*this);- TRACE_FUNCTION("Type3 (init @category)")- }- ReturnTuple Dispatch(const CategoryFunction& label, const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Category_Type3::*)(const ParamTuple&, const ValueTuple&);- return TypeCategory::Dispatch(label, params, args);- }+struct ExtCategory_Type3 : public Category_Type3 { }; -Category_Type3& CreateCategory_Type3() {- static auto& category = *new Category_Type3();- return category;-}+struct ExtType_Type3 : public Type_Type3 {+ inline ExtType_Type3(Category_Type3& p, Params<0>::Type params) : Type_Type3(p, params) {} -struct Type_Type3 : public TypeInstance {- std::string CategoryName() const final { return parent.CategoryName(); }- void BuildTypeName(std::ostream& output) const final {- return TypeInstance::TypeNameFrom(output, parent);- }- Category_Type3& parent;- bool CanConvertFrom(const S<const TypeInstance>& from) const final {- std::vector<S<const TypeInstance>> args;- if (!from->TypeArgsForParent(parent, args)) return false;- if(args.size() != 0) {- FAIL() << "Wrong number of args (" << args.size() << ") for " << CategoryName();- }- return true;- }- bool TypeArgsForParent(const TypeCategory& category, std::vector<S<const TypeInstance>>& args) const final {- if (&category == &GetCategory_Type3()) {- args = std::vector<S<const TypeInstance>>{};- return true;- }- return false;- }- Type_Type3(Category_Type3& p, Params<0>::Type params) : parent(p) {- CycleCheck<Type_Type3>::Check();- CycleCheck<Type_Type3> marker(*this);- TRACE_FUNCTION("Type3 (init @type)")- }- ReturnTuple Dispatch(const S<TypeInstance>& self, const TypeFunction& label,- const ParamTuple& params, const ValueTuple& args) final {- using CallType = ReturnTuple(Type_Type3::*)(const S<TypeInstance>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_Type3[] = {- &Type_Type3::Call_create,- };- if (label.collection == Functions_Type3) {- if (label.function_num < 0 || label.function_num >= 1) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_Type3[label.function_num])(self, params, args);- }- return TypeInstance::Dispatch(self, label, params, args);+ ReturnTuple Call_create(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("Type3.create")+ return ReturnTuple(CreateValue_Type3(CreateType_Type3(Params<0>::Type()), ParamTuple(),+ TypeInstance::Call(GetType_Type2(Params<0>::Type()), Function_Type2_create, ParamTuple(), ArgTuple()))); }- ReturnTuple Call_create(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args); }; -S<Type_Type3> CreateType_Type3(Params<0>::Type params) {- static const auto cached = S_get(new Type_Type3(CreateCategory_Type3(), Params<0>::Type()));- return cached;-}--struct Value_Type3 : public TypeValue {- Value_Type3(Type_Type3& p, const ParamTuple& params, const ValueTuple& args)- : parent(p), value(args.Only()) {}+struct ExtValue_Type3 : public Value_Type3 {+ inline ExtValue_Type3(S<Type_Type3> p, const ParamTuple& params, const ValueTuple& args)+ : Value_Type3(p, params), value(args.At(0)) {} - ReturnTuple Dispatch(const S<TypeValue>& self, const ValueFunction& label, const ParamTuple& params,const ValueTuple& args) final {- using CallType = ReturnTuple(Value_Type3::*)(const S<TypeValue>&, const ParamTuple&, const ValueTuple&);- static const CallType Table_Type3[] = {- &Value_Type3::Call_get,- };- if (label.collection == Functions_Type3) {- if (label.function_num < 0 || label.function_num >= 1) {- FAIL() << "Bad function call " << label;- }- return (this->*Table_Type3[label.function_num])(self, params, args);- }- return TypeValue::Dispatch(self, label, params, args);+ ReturnTuple Call_get(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {+ TRACE_FUNCTION("Type3.get")+ return ReturnTuple(TypeValue::Call(value, Function_Type2_get, ParamTuple(), ArgTuple())); }- std::string CategoryName() const final { return parent.CategoryName(); }- ReturnTuple Call_get(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args);- Type_Type3& parent;+ const S<TypeValue> value; }; -S<TypeValue> CreateValue_Type3(Type_Type3& parent, const ParamTuple& params, const ValueTuple& args) {- return S_get(new Value_Type3(parent, params, args));-}--ReturnTuple Type_Type3::Call_create(const S<TypeInstance>& self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("Type3.create")- return ReturnTuple(CreateValue_Type3(*this, ParamTuple(),- TypeInstance::Call(GetType_Type2(Params<0>::Type()), Function_Type2_create, ParamTuple(), ArgTuple())));-}--ReturnTuple Value_Type3::Call_get(const S<TypeValue>& Var_self, const ParamTuple& params, const ValueTuple& args) {- TRACE_FUNCTION("Type3.get")- return ReturnTuple(TypeValue::Call(value, Function_Type2_get, ParamTuple(), ArgTuple()));+Category_Type3& CreateCategory_Type3() {+ static auto& category = *new ExtCategory_Type3();+ return category; }--} // namespace--TypeCategory& GetCategory_Type3() {- return CreateCategory_Type3();+S<Type_Type3> CreateType_Type3(Params<0>::Type params) {+ static const auto cached = S_get(new ExtType_Type3(CreateCategory_Type3(), Params<0>::Type()));+ return cached; }--S<TypeInstance> GetType_Type3(Params<0>::Type params) {- return CreateType_Type3(params);+S<TypeValue> CreateValue_Type3(S<Type_Type3> parent, const ParamTuple& params, const ValueTuple& args) {+ return S_get(new ExtValue_Type3(parent, params, args)); } #ifdef ZEOLITE_PUBLIC_NAMESPACE
tests/reduce.0rt view
@@ -1,5 +1,5 @@ /* ------------------------------------------------------------------------------Copyright 2020 Kevin P. Barry+Copyright 2020-2021 Kevin P. Barry Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.@@ -755,4 +755,53 @@ create () { return Value{ } }+}+++testcase "partial matches in nested types" {+ success+}++@value interface A {}+@value interface B {}+@value interface C {}++concrete AB {+ refines A+ refines B+ @type create () -> (AB)+}++define AB {+ create () { return AB{ } }+}++concrete AC {+ refines A+ refines C+ @type create () -> (AC)+}++define AC {+ create () { return AC{ } }+}++unittest leftNestedInRight {+ \ Testing.checkEquals<?>(present(reduce<[A&B],[[A&B]|C]>(AB.create())),true)+}++unittest rightNestedInLeft {+ \ Testing.checkEquals<?>(present(reduce<[[A|B]&C],[A|B]>(AC.create())),true)+}++unittest unionToUnion {+ \ Testing.checkEquals<?>(present(reduce<[[A&B]|C],[[A&B]|C]>(AB.create())),true)+}++unittest intersectToIntersect {+ \ Testing.checkEquals<?>(present(reduce<[[A|B]&C],[[A|B]&C]>(AC.create())),true)+}++unittest unionToIntersect {+ \ Testing.checkEquals<?>(present(reduce<[A|B],[A&B]>(AB.create())),false) }
tests/simple.0rt view
@@ -89,6 +89,17 @@ define String {} +testcase "attempt to define interface" {+ error+ require "Type"+ require "concrete"+}++@value interface Type {}++define Type {}++ testcase "no deadlock with recursive type" { success }
tests/templates/.zeolite-module view
@@ -2,7 +2,7 @@ path: "tests/templates" extra_files: [ category_source {- source: "tests/templates/Category_Templated.cpp"+ source: "tests/templates/Extension_Templated.cpp" categories: [Templated] } ]
tests/templates/README.md view
@@ -6,10 +6,10 @@ ```shell ZEOLITE_PATH=$(zeolite --get-path)-rm -f $ZEOLITE_PATH/tests/templates/Category_Templated.cpp # Remove the old template.-zeolite -p $ZEOLITE_PATH --templates tests/templates # Create a new template.-zeolite -p $ZEOLITE_PATH -r tests/templates # Recompile.-zeolite -p $ZEOLITE_PATH -t tests/templates # Run the test.+rm -f $ZEOLITE_PATH/tests/templates/Extension_Templated.cpp # Remove the old template.+zeolite -p $ZEOLITE_PATH --templates tests/templates # Create a new template.+zeolite -p $ZEOLITE_PATH -r tests/templates # Recompile.+zeolite -p $ZEOLITE_PATH -t tests/templates # Run the test. ``` The most important step above is to delete the *old* template first.
+ tests/tests-only4/.zeolite-module view
@@ -0,0 +1,13 @@+root: "../.."+path: "tests/tests-only4"+extra_files: [+ category_source {+ source: "tests/tests-only4/source1.cpp"+ categories: [Type1]+ }+ category_source {+ source: "tests/tests-only4/source2.cpp"+ categories: [Type3]+ }+]+mode: incremental {}
+ tests/tests-only4/README.md view
@@ -0,0 +1,25 @@+# `$TestsOnly$` Pragma Test - Enforcement in C++++Compiling this module should **always fail**. It tests that the `$TestsOnly$`+pragma is enforced even in C++ source files.++To compile:++```shell+ZEOLITE_PATH=$(zeolite --get-path)+zeolite -p $ZEOLITE_PATH -R tests/tests-only4+```++The compiler errors should look something like this:++```text+In file included from tests/tests-only4/source2.cpp:20:+Category_Type2.hpp:4:2: error: Category Type2 can only be used by $TestsOnly$ categories+#error Category Type2 can only be used by $TestsOnly$ categories+ ^+1 error generated.+Execution of /usr/bin/clang++ failed+```++Importantly, there *should not* be any errors related to `source1.cpp`; only+`source2.cpp`.
+ tests/tests-only4/normal.0rp view
@@ -0,0 +1,19 @@+/* -----------------------------------------------------------------------------+Copyright 2021 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++concrete Type3 {}
+ tests/tests-only4/source1.cpp view
@@ -0,0 +1,20 @@+/* -----------------------------------------------------------------------------+Copyright 2021 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++#include "Streamlined_Type1.hpp" // $TestsOnly$+#include "Category_Type2.hpp"
+ tests/tests-only4/source2.cpp view
@@ -0,0 +1,20 @@+/* -----------------------------------------------------------------------------+Copyright 2021 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++#include "Streamlined_Type3.hpp" // NOT $TestsOnly$+#include "Category_Type2.hpp"
+ tests/tests-only4/testing.0rp view
@@ -0,0 +1,23 @@+/* -----------------------------------------------------------------------------+Copyright 2021 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- */++// Author: Kevin P. Barry [ta0kira@gmail.com]++$TestsOnly$++concrete Type1 {}++@value interface Type2 {}
zeolite-lang.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: zeolite-lang-version: 0.12.0.0+version: 0.13.0.0 synopsis: Zeolite is a statically-typed, general-purpose programming language. description:@@ -49,7 +49,7 @@ license-file: LICENSE author: Kevin P. Barry maintainer: Kevin P. Barry <ta0kira@gmail.com>-copyright: (c) Kevin P. Barry 2019-2020+copyright: (c) Kevin P. Barry 2019-2021 category: Compiler build-type: Simple @@ -93,7 +93,6 @@ lib/math/*.0rp, lib/math/*.0rt, lib/math/*.cpp,- lib/math/*.hpp, lib/testing/.zeolite-module, lib/testing/*.0rp, lib/testing/*.0rt,@@ -148,6 +147,10 @@ tests/tests-only3/.zeolite-module, tests/tests-only3/*.0rp, tests/tests-only3/*.0rx,+ tests/tests-only4/README.md,+ tests/tests-only4/.zeolite-module,+ tests/tests-only4/*.cpp,+ tests/tests-only4/*.0rp, tests/visibility/.zeolite-module, tests/visibility/*.0rp, tests/visibility/*.0rx,@@ -195,9 +198,10 @@ Compilation.CompilerState, Compilation.ProcedureContext, Compilation.ScopeContext,- CompilerCxx.Category, CompilerCxx.CategoryContext, CompilerCxx.Code,+ CompilerCxx.CxxFiles,+ CompilerCxx.LanguageModule, CompilerCxx.Naming, CompilerCxx.Procedure, Config.LoadConfig,@@ -231,7 +235,6 @@ Types.DefinedCategory, Types.Function, Types.IntegrationTest,- Types.Pragma, Types.Procedure, Types.TypeCategory, Types.TypeInstance,@@ -259,6 +262,8 @@ filepath >= 1.0 && < 1.5, hashable >= 1.0 && < 1.4, megaparsec >= 7.0 && < 9.1,+ microlens >= 0.4.9 && < 0.5,+ microlens-th >= 0.1.0.0 && < 0.5, mtl >= 1.0 && < 2.3, parser-combinators >= 0.2 && < 2.0, regex-tdfa >= 1.0 && < 1.4,