mirror of
https://github.com/anoma/juvix.git
synced 2024-12-02 10:47:32 +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
|
||||
|
||||
import Data.Generics.Uniplate.Data
|
||||
import Data.HashMap.Strict qualified as HashMap
|
||||
import Juvix.Compiler.Internal.Extra
|
||||
import Juvix.Compiler.Internal.Extra.CoercionInfo
|
||||
import Juvix.Compiler.Internal.Extra.HasLetDefs
|
||||
import Juvix.Compiler.Internal.Extra.InstanceInfo
|
||||
import Juvix.Compiler.Internal.Pretty (ppTrace)
|
||||
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 =
|
||||
concat
|
||||
[ concatMap (toList . flattenClause) _letClauses
|
||||
| Let {..} <- universeBi e
|
||||
| Let {..} <- letDefs e
|
||||
]
|
||||
where
|
||||
flattenClause :: LetClause -> NonEmpty FunctionDef
|
||||
|
@ -1,6 +1,5 @@
|
||||
module Juvix.Compiler.Internal.Extra.Base where
|
||||
|
||||
import Data.Generics.Uniplate.Data hiding (holes)
|
||||
import Data.HashMap.Strict qualified as HashMap
|
||||
import Data.HashSet qualified as HashSet
|
||||
import Juvix.Compiler.Internal.Data.LocalVars
|
||||
@ -766,12 +765,6 @@ isSmallUniverse' = \case
|
||||
ExpressionUniverse {} -> True
|
||||
_ -> 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 _patternArgPattern =
|
||||
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