mirror of
https://github.com/anoma/juvix.git
synced 2024-12-03 09:41:10 +03:00
Optimize letFunctionDefs
in Juvix.Compiler.Internal.Data.InfoTable
(#2867)
* Closes #2394 * Removes the use of Uniplate in `letFunctionDefs` altogether, in favour of handwritten traversal accumulating let definitions (implemented via the new `HasLetDefs` typeclass). Benchmark results ------------------ Using Uniplate: ``` heliax@imac bench % hyperfine --prepare 'juvix clean --global' -w 1 'juvix typecheck bench.juvix -N 1' Benchmark 1: juvix typecheck bench.juvix -N 1 Time (mean ± σ): 1.399 s ± 0.023 s [User: 1.346 s, System: 0.041 s] Range (min … max): 1.374 s … 1.452 s 10 runs ``` Using `HasLetDefs`: ``` heliax@imac bench % hyperfine --prepare 'juvix clean --global' -w 1 'juvix typecheck bench.juvix -N 1' Benchmark 1: juvix typecheck bench.juvix -N 1 Time (mean ± σ): 1.098 s ± 0.015 s [User: 1.047 s, System: 0.040 s] Range (min … max): 1.074 s … 1.120 s 10 runs ``` So it's roughly 1.1s vs. 1.4s, faster by 0.2s. About 14% improvement. The benchmark file just imports the standard library: ``` module bench; import Stdlib.Prelude open; main : Nat := 0; ``` Both `juvix` binaries were compiled with optimizations, using `just install`.
This commit is contained in:
parent
69a12d0c2f
commit
fef37a86ee
@ -20,10 +20,10 @@ module Juvix.Compiler.Internal.Data.InfoTable
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.Generics.Uniplate.Data
|
|
||||||
import Data.HashMap.Strict qualified as HashMap
|
import Data.HashMap.Strict qualified as HashMap
|
||||||
import Juvix.Compiler.Internal.Extra
|
import Juvix.Compiler.Internal.Extra
|
||||||
import Juvix.Compiler.Internal.Extra.CoercionInfo
|
import Juvix.Compiler.Internal.Extra.CoercionInfo
|
||||||
|
import Juvix.Compiler.Internal.Extra.HasLetDefs
|
||||||
import Juvix.Compiler.Internal.Extra.InstanceInfo
|
import Juvix.Compiler.Internal.Extra.InstanceInfo
|
||||||
import Juvix.Compiler.Internal.Pretty (ppTrace)
|
import Juvix.Compiler.Internal.Pretty (ppTrace)
|
||||||
import Juvix.Compiler.Store.Internal.Data.FunctionsTable
|
import Juvix.Compiler.Store.Internal.Data.FunctionsTable
|
||||||
@ -69,11 +69,11 @@ extendWithReplExpression e =
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
letFunctionDefs :: (Data from) => from -> [FunctionDef]
|
letFunctionDefs :: (HasLetDefs a) => a -> [FunctionDef]
|
||||||
letFunctionDefs e =
|
letFunctionDefs e =
|
||||||
concat
|
concat
|
||||||
[ concatMap (toList . flattenClause) _letClauses
|
[ concatMap (toList . flattenClause) _letClauses
|
||||||
| Let {..} <- universeBi e
|
| Let {..} <- letDefs e
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
flattenClause :: LetClause -> NonEmpty FunctionDef
|
flattenClause :: LetClause -> NonEmpty FunctionDef
|
||||||
|
@ -1,6 +1,5 @@
|
|||||||
module Juvix.Compiler.Internal.Extra.Base where
|
module Juvix.Compiler.Internal.Extra.Base where
|
||||||
|
|
||||||
import Data.Generics.Uniplate.Data hiding (holes)
|
|
||||||
import Data.HashMap.Strict qualified as HashMap
|
import Data.HashMap.Strict qualified as HashMap
|
||||||
import Data.HashSet qualified as HashSet
|
import Data.HashSet qualified as HashSet
|
||||||
import Juvix.Compiler.Internal.Data.LocalVars
|
import Juvix.Compiler.Internal.Data.LocalVars
|
||||||
@ -766,12 +765,6 @@ isSmallUniverse' = \case
|
|||||||
ExpressionUniverse {} -> True
|
ExpressionUniverse {} -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
allTypeSignatures :: (Data a) => a -> [Expression]
|
|
||||||
allTypeSignatures a =
|
|
||||||
[f ^. funDefType | f@FunctionDef {} <- universeBi a]
|
|
||||||
<> [f ^. axiomType | f@AxiomDef {} <- universeBi a]
|
|
||||||
<> [f ^. inductiveType | f@InductiveDef {} <- universeBi a]
|
|
||||||
|
|
||||||
explicitPatternArg :: Pattern -> PatternArg
|
explicitPatternArg :: Pattern -> PatternArg
|
||||||
explicitPatternArg _patternArgPattern =
|
explicitPatternArg _patternArgPattern =
|
||||||
PatternArg
|
PatternArg
|
||||||
|
103
src/Juvix/Compiler/Internal/Extra/HasLetDefs.hs
Normal file
103
src/Juvix/Compiler/Internal/Extra/HasLetDefs.hs
Normal file
@ -0,0 +1,103 @@
|
|||||||
|
module Juvix.Compiler.Internal.Extra.HasLetDefs where
|
||||||
|
|
||||||
|
import Juvix.Compiler.Internal.Language
|
||||||
|
import Juvix.Prelude
|
||||||
|
|
||||||
|
class HasLetDefs a where
|
||||||
|
letDefs' :: [Let] -> a -> [Let]
|
||||||
|
letDefs :: a -> [Let]
|
||||||
|
letDefs = letDefs' []
|
||||||
|
|
||||||
|
instance (HasLetDefs a, Foldable f) => HasLetDefs (f a) where
|
||||||
|
letDefs' = foldl' letDefs'
|
||||||
|
|
||||||
|
instance HasLetDefs Expression where
|
||||||
|
letDefs' acc = \case
|
||||||
|
ExpressionIden {} -> acc
|
||||||
|
ExpressionApplication x -> letDefs' acc x
|
||||||
|
ExpressionFunction x -> letDefs' acc x
|
||||||
|
ExpressionLiteral {} -> acc
|
||||||
|
ExpressionHole {} -> acc
|
||||||
|
ExpressionInstanceHole {} -> acc
|
||||||
|
ExpressionLet x -> letDefs' acc x
|
||||||
|
ExpressionUniverse {} -> acc
|
||||||
|
ExpressionSimpleLambda x -> letDefs' acc x
|
||||||
|
ExpressionLambda x -> letDefs' acc x
|
||||||
|
ExpressionCase x -> letDefs' acc x
|
||||||
|
|
||||||
|
instance HasLetDefs Application where
|
||||||
|
letDefs' acc Application {..} = letDefs' (letDefs' acc _appLeft) _appRight
|
||||||
|
|
||||||
|
instance HasLetDefs Function where
|
||||||
|
letDefs' acc Function {..} = letDefs' (letDefs' acc _functionLeft) _functionRight
|
||||||
|
|
||||||
|
instance HasLetDefs FunctionParameter where
|
||||||
|
letDefs' acc FunctionParameter {..} = letDefs' acc _paramType
|
||||||
|
|
||||||
|
instance HasLetDefs Let where
|
||||||
|
letDefs' acc x@Let {..} = x : letDefs' (letDefs' acc _letExpression) _letClauses
|
||||||
|
|
||||||
|
instance HasLetDefs LetClause where
|
||||||
|
letDefs' acc = \case
|
||||||
|
LetFunDef x -> letDefs' acc x
|
||||||
|
LetMutualBlock x -> letDefs' acc x
|
||||||
|
|
||||||
|
instance HasLetDefs SimpleLambda where
|
||||||
|
letDefs' acc SimpleLambda {..} = letDefs' (letDefs' acc _slambdaBinder) _slambdaBody
|
||||||
|
|
||||||
|
instance HasLetDefs SimpleBinder where
|
||||||
|
letDefs' acc SimpleBinder {..} = letDefs' acc _sbinderType
|
||||||
|
|
||||||
|
instance HasLetDefs Lambda where
|
||||||
|
letDefs' acc Lambda {..} = letDefs' (letDefs' acc _lambdaType) _lambdaClauses
|
||||||
|
|
||||||
|
instance HasLetDefs LambdaClause where
|
||||||
|
letDefs' acc LambdaClause {..} = letDefs' (letDefs' acc _lambdaBody) _lambdaPatterns
|
||||||
|
|
||||||
|
instance HasLetDefs PatternArg where
|
||||||
|
letDefs' acc PatternArg {..} = letDefs' acc _patternArgPattern
|
||||||
|
|
||||||
|
instance HasLetDefs Pattern where
|
||||||
|
letDefs' acc = \case
|
||||||
|
PatternVariable {} -> acc
|
||||||
|
PatternConstructorApp x -> letDefs' acc x
|
||||||
|
PatternWildcardConstructor {} -> acc
|
||||||
|
|
||||||
|
instance HasLetDefs ConstructorApp where
|
||||||
|
letDefs' acc ConstructorApp {..} = letDefs' (letDefs' acc _constrAppType) _constrAppParameters
|
||||||
|
|
||||||
|
instance HasLetDefs Case where
|
||||||
|
letDefs' acc Case {..} = letDefs' (letDefs' acc _caseExpression) _caseBranches
|
||||||
|
|
||||||
|
instance HasLetDefs CaseBranch where
|
||||||
|
letDefs' acc CaseBranch {..} = letDefs' acc _caseBranchExpression
|
||||||
|
|
||||||
|
instance HasLetDefs MutualBlockLet where
|
||||||
|
letDefs' acc MutualBlockLet {..} = letDefs' acc _mutualLet
|
||||||
|
|
||||||
|
instance HasLetDefs MutualBlock where
|
||||||
|
letDefs' acc MutualBlock {..} = letDefs' acc _mutualStatements
|
||||||
|
|
||||||
|
instance HasLetDefs MutualStatement where
|
||||||
|
letDefs' acc = \case
|
||||||
|
StatementInductive x -> letDefs' acc x
|
||||||
|
StatementFunction x -> letDefs' acc x
|
||||||
|
StatementAxiom x -> letDefs' acc x
|
||||||
|
|
||||||
|
instance HasLetDefs InductiveDef where
|
||||||
|
letDefs' acc InductiveDef {..} = letDefs' (letDefs' (letDefs' acc _inductiveType) _inductiveConstructors) _inductiveParameters
|
||||||
|
|
||||||
|
instance HasLetDefs InductiveParameter where
|
||||||
|
letDefs' acc InductiveParameter {..} = letDefs' acc _inductiveParamType
|
||||||
|
|
||||||
|
instance HasLetDefs ConstructorDef where
|
||||||
|
letDefs' acc ConstructorDef {..} = letDefs' acc _inductiveConstructorType
|
||||||
|
|
||||||
|
instance HasLetDefs FunctionDef where
|
||||||
|
letDefs' acc FunctionDef {..} = letDefs' (letDefs' (letDefs' acc _funDefType) _funDefBody) _funDefArgsInfo
|
||||||
|
|
||||||
|
instance HasLetDefs ArgInfo where
|
||||||
|
letDefs' acc ArgInfo {..} = letDefs' acc _argInfoDefault
|
||||||
|
|
||||||
|
instance HasLetDefs AxiomDef where
|
||||||
|
letDefs' acc AxiomDef {..} = letDefs' acc _axiomType
|
Loading…
Reference in New Issue
Block a user