Skip to content

Commit

Permalink
Optimize letFunctionDefs in Juvix.Compiler.Internal.Data.InfoTable (
Browse files Browse the repository at this point in the history
#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`.
  • Loading branch information
lukaszcz authored Jun 28, 2024
1 parent 69a12d0 commit fef37a8
Show file tree
Hide file tree
Showing 3 changed files with 106 additions and 10 deletions.
6 changes: 3 additions & 3 deletions src/Juvix/Compiler/Internal/Data/InfoTable.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
7 changes: 0 additions & 7 deletions src/Juvix/Compiler/Internal/Extra/Base.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand Down
103 changes: 103 additions & 0 deletions src/Juvix/Compiler/Internal/Extra/HasLetDefs.hs
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit fef37a8

Please sign in to comment.