mirror of
https://github.com/anoma/juvix.git
synced 2024-08-16 19:50:26 +03:00
parent
60a191b786
commit
407a74004c
@ -101,12 +101,8 @@ goModuleNoVisit ::
|
|||||||
Sem r ()
|
Sem r ()
|
||||||
goModuleNoVisit (Internal.ModuleIndex m) = do
|
goModuleNoVisit (Internal.ModuleIndex m) = do
|
||||||
mapM_ goImport (m ^. Internal.moduleBody . Internal.moduleImports)
|
mapM_ goImport (m ^. Internal.moduleBody . Internal.moduleImports)
|
||||||
mapM_ go (m ^. Internal.moduleBody . Internal.moduleStatements)
|
mapM_ goMutualBlock (m ^. Internal.moduleBody . Internal.moduleStatements)
|
||||||
where
|
where
|
||||||
go :: Internal.Statement -> Sem r ()
|
|
||||||
go = \case
|
|
||||||
Internal.StatementAxiom a -> goAxiomInductive a >> goAxiomDef a
|
|
||||||
Internal.StatementMutual f -> goMutualBlock f
|
|
||||||
goImport :: Internal.Import -> Sem r ()
|
goImport :: Internal.Import -> Sem r ()
|
||||||
goImport (Internal.Import i) = visit i
|
goImport (Internal.Import i) = visit i
|
||||||
|
|
||||||
@ -238,14 +234,17 @@ goMutualBlock (Internal.MutualBlock m) = preMutual m >>= goMutual
|
|||||||
preMutual :: NonEmpty Internal.MutualStatement -> Sem r PreMutual
|
preMutual :: NonEmpty Internal.MutualStatement -> Sem r PreMutual
|
||||||
preMutual stmts = do
|
preMutual stmts = do
|
||||||
let (inds, funs) = partition isInd (toList stmts)
|
let (inds, funs) = partition isInd (toList stmts)
|
||||||
-- inductives must be pre-registered first to avoid crashing on unknown
|
-- types must be pre-registered first to avoid crashing on unknown types
|
||||||
-- inductive types when pre-registering functions
|
-- when pre-registering functions/axioms
|
||||||
execState (PreMutual [] []) $ mapM_ step (inds ++ funs)
|
execState (PreMutual [] []) $ mapM_ step (inds ++ funs)
|
||||||
where
|
where
|
||||||
isInd :: Internal.MutualStatement -> Bool
|
isInd :: Internal.MutualStatement -> Bool
|
||||||
isInd = \case
|
isInd = \case
|
||||||
Internal.StatementInductive {} -> True
|
Internal.StatementInductive {} -> True
|
||||||
Internal.StatementFunction {} -> False
|
Internal.StatementFunction {} -> False
|
||||||
|
Internal.StatementAxiom Internal.AxiomDef {..}
|
||||||
|
| Internal.ExpressionUniverse {} <- _axiomType -> True
|
||||||
|
| otherwise -> False
|
||||||
|
|
||||||
step :: Internal.MutualStatement -> Sem (State PreMutual ': r) ()
|
step :: Internal.MutualStatement -> Sem (State PreMutual ': r) ()
|
||||||
step = \case
|
step = \case
|
||||||
@ -255,6 +254,9 @@ goMutualBlock (Internal.MutualBlock m) = preMutual m >>= goMutual
|
|||||||
Internal.StatementInductive i -> do
|
Internal.StatementInductive i -> do
|
||||||
p <- preInductiveDef i
|
p <- preInductiveDef i
|
||||||
modify' (over preInductives (p :))
|
modify' (over preInductives (p :))
|
||||||
|
Internal.StatementAxiom a -> do
|
||||||
|
goAxiomInductive a
|
||||||
|
goAxiomDef a
|
||||||
|
|
||||||
goMutual :: PreMutual -> Sem r ()
|
goMutual :: PreMutual -> Sem r ()
|
||||||
goMutual PreMutual {..} = do
|
goMutual PreMutual {..} = do
|
||||||
|
@ -79,7 +79,7 @@ computeTable recurIntoImports (ModuleIndex m) = compute
|
|||||||
mutuals :: [MutualStatement]
|
mutuals :: [MutualStatement]
|
||||||
mutuals =
|
mutuals =
|
||||||
[ d
|
[ d
|
||||||
| StatementMutual (MutualBlock b) <- ss,
|
| MutualBlock b <- ss,
|
||||||
d <- toList b
|
d <- toList b
|
||||||
]
|
]
|
||||||
|
|
||||||
@ -119,7 +119,7 @@ computeTable recurIntoImports (ModuleIndex m) = compute
|
|||||||
_infoAxioms =
|
_infoAxioms =
|
||||||
HashMap.fromList
|
HashMap.fromList
|
||||||
[ (d ^. axiomName, AxiomInfo d)
|
[ (d ^. axiomName, AxiomInfo d)
|
||||||
| StatementAxiom d <- ss
|
| StatementAxiom d <- mutuals
|
||||||
]
|
]
|
||||||
|
|
||||||
_infoInstances :: InstanceTable
|
_infoInstances :: InstanceTable
|
||||||
@ -137,7 +137,7 @@ computeTable recurIntoImports (ModuleIndex m) = compute
|
|||||||
| otherwise =
|
| otherwise =
|
||||||
Nothing
|
Nothing
|
||||||
|
|
||||||
ss :: [Statement]
|
ss :: [MutualBlock]
|
||||||
ss = m ^. moduleBody . moduleStatements
|
ss = m ^. moduleBody . moduleStatements
|
||||||
|
|
||||||
lookupConstructor :: forall r. (Member (Reader InfoTable) r) => Name -> Sem r ConstructorInfo
|
lookupConstructor :: forall r. (Member (Reader InfoTable) r) => Name -> Sem r ConstructorInfo
|
||||||
|
@ -183,6 +183,18 @@ instance HasExpressions MutualStatement where
|
|||||||
leafExpressions f = \case
|
leafExpressions f = \case
|
||||||
StatementFunction d -> StatementFunction <$> leafExpressions f d
|
StatementFunction d -> StatementFunction <$> leafExpressions f d
|
||||||
StatementInductive d -> StatementInductive <$> leafExpressions f d
|
StatementInductive d -> StatementInductive <$> leafExpressions f d
|
||||||
|
StatementAxiom d -> StatementAxiom <$> leafExpressions f d
|
||||||
|
|
||||||
|
instance HasExpressions AxiomDef where
|
||||||
|
leafExpressions f AxiomDef {..} = do
|
||||||
|
ty' <- leafExpressions f _axiomType
|
||||||
|
pure
|
||||||
|
AxiomDef
|
||||||
|
{ _axiomType = ty',
|
||||||
|
_axiomName,
|
||||||
|
_axiomBuiltin,
|
||||||
|
_axiomPragmas
|
||||||
|
}
|
||||||
|
|
||||||
instance HasExpressions InductiveParameter where
|
instance HasExpressions InductiveParameter where
|
||||||
leafExpressions _ param@InductiveParameter {} = do
|
leafExpressions _ param@InductiveParameter {} = do
|
||||||
|
@ -89,7 +89,7 @@ goModuleNoVisited :: forall r. (Members '[Reader ExportsTable, State DependencyG
|
|||||||
goModuleNoVisited (ModuleIndex m) = do
|
goModuleNoVisited (ModuleIndex m) = do
|
||||||
checkStartNode (m ^. moduleName)
|
checkStartNode (m ^. moduleName)
|
||||||
let b = m ^. moduleBody
|
let b = m ^. moduleBody
|
||||||
mapM_ (goStatement (m ^. moduleName)) (b ^. moduleStatements)
|
mapM_ (goMutual (m ^. moduleName)) (b ^. moduleStatements)
|
||||||
mapM_ goImport (b ^. moduleImports)
|
mapM_ goImport (b ^. moduleImports)
|
||||||
|
|
||||||
goImport :: (Members '[Reader ExportsTable, State DependencyGraph, State StartNodes, Visit ModuleIndex] r) => Import -> Sem r ()
|
goImport :: (Members '[Reader ExportsTable, State DependencyGraph, State StartNodes, Visit ModuleIndex] r) => Import -> Sem r ()
|
||||||
@ -105,11 +105,6 @@ goPreModule m = do
|
|||||||
-- added from definitions in M to definitions in N)
|
-- added from definitions in M to definitions in N)
|
||||||
mapM_ goImport (b ^. moduleImports)
|
mapM_ goImport (b ^. moduleImports)
|
||||||
|
|
||||||
goStatement :: forall r. (Members '[Reader ExportsTable, State DependencyGraph, State StartNodes] r) => Name -> Statement -> Sem r ()
|
|
||||||
goStatement parentModule = \case
|
|
||||||
StatementAxiom ax -> goAxiom parentModule ax
|
|
||||||
StatementMutual f -> goMutual parentModule f
|
|
||||||
|
|
||||||
goMutual :: forall r. (Members '[Reader ExportsTable, State DependencyGraph, State StartNodes] r) => Name -> MutualBlock -> Sem r ()
|
goMutual :: forall r. (Members '[Reader ExportsTable, State DependencyGraph, State StartNodes] r) => Name -> MutualBlock -> Sem r ()
|
||||||
goMutual parentModule (MutualBlock s) = mapM_ go s
|
goMutual parentModule (MutualBlock s) = mapM_ go s
|
||||||
where
|
where
|
||||||
@ -117,6 +112,7 @@ goMutual parentModule (MutualBlock s) = mapM_ go s
|
|||||||
go = \case
|
go = \case
|
||||||
StatementInductive i -> goInductive parentModule i
|
StatementInductive i -> goInductive parentModule i
|
||||||
StatementFunction i -> goTopFunctionDef parentModule i
|
StatementFunction i -> goTopFunctionDef parentModule i
|
||||||
|
StatementAxiom ax -> goAxiom parentModule ax
|
||||||
|
|
||||||
goPreLetStatement ::
|
goPreLetStatement ::
|
||||||
forall r.
|
forall r.
|
||||||
|
@ -17,11 +17,11 @@ import Juvix.Data.Universe hiding (smallUniverse)
|
|||||||
import Juvix.Data.WithLoc
|
import Juvix.Data.WithLoc
|
||||||
import Juvix.Prelude
|
import Juvix.Prelude
|
||||||
|
|
||||||
type Module = Module' Statement
|
type Module = Module' MutualBlock
|
||||||
|
|
||||||
type PreModule = Module' PreStatement
|
type PreModule = Module' PreStatement
|
||||||
|
|
||||||
type ModuleBody = ModuleBody' Statement
|
type ModuleBody = ModuleBody' MutualBlock
|
||||||
|
|
||||||
type PreModuleBody = ModuleBody' PreStatement
|
type PreModuleBody = ModuleBody' PreStatement
|
||||||
|
|
||||||
@ -52,14 +52,10 @@ data ModuleBody' stmt = ModuleBody
|
|||||||
}
|
}
|
||||||
deriving stock (Data)
|
deriving stock (Data)
|
||||||
|
|
||||||
data Statement
|
|
||||||
= StatementMutual MutualBlock
|
|
||||||
| StatementAxiom AxiomDef
|
|
||||||
deriving stock (Data)
|
|
||||||
|
|
||||||
data MutualStatement
|
data MutualStatement
|
||||||
= StatementInductive InductiveDef
|
= StatementInductive InductiveDef
|
||||||
| StatementFunction FunctionDef
|
| StatementFunction FunctionDef
|
||||||
|
| StatementAxiom AxiomDef
|
||||||
deriving stock (Generic, Data)
|
deriving stock (Generic, Data)
|
||||||
|
|
||||||
newtype MutualBlock = MutualBlock
|
newtype MutualBlock = MutualBlock
|
||||||
|
@ -275,6 +275,7 @@ instance PrettyCode MutualStatement where
|
|||||||
ppCode = \case
|
ppCode = \case
|
||||||
StatementInductive d -> ppCode d
|
StatementInductive d -> ppCode d
|
||||||
StatementFunction d -> ppCode d
|
StatementFunction d -> ppCode d
|
||||||
|
StatementAxiom d -> ppCode d
|
||||||
|
|
||||||
instance PrettyCode MutualBlock where
|
instance PrettyCode MutualBlock where
|
||||||
ppCode (MutualBlock funs) = ppMutual funs
|
ppCode (MutualBlock funs) = ppMutual funs
|
||||||
@ -283,11 +284,6 @@ instance PrettyCode MutualBlockLet where
|
|||||||
ppCode (MutualBlockLet funs) =
|
ppCode (MutualBlockLet funs) =
|
||||||
vsep2 <$> mapM ppCode funs
|
vsep2 <$> mapM ppCode funs
|
||||||
|
|
||||||
instance PrettyCode Statement where
|
|
||||||
ppCode = \case
|
|
||||||
StatementMutual f -> ppCode f
|
|
||||||
StatementAxiom f -> ppCode f
|
|
||||||
|
|
||||||
instance PrettyCode ModuleBody where
|
instance PrettyCode ModuleBody where
|
||||||
ppCode m = do
|
ppCode m = do
|
||||||
includes <- mapM ppCode (m ^. moduleImports)
|
includes <- mapM ppCode (m ^. moduleImports)
|
||||||
|
@ -260,28 +260,28 @@ fromPreModuleBody b = do
|
|||||||
let moduleStatements' = map goSCC sccs
|
let moduleStatements' = map goSCC sccs
|
||||||
return (set Internal.moduleStatements moduleStatements' b)
|
return (set Internal.moduleStatements moduleStatements' b)
|
||||||
where
|
where
|
||||||
goSCC :: SCC Internal.PreStatement -> Internal.Statement
|
goSCC :: SCC Internal.PreStatement -> Internal.MutualBlock
|
||||||
goSCC = \case
|
goSCC = \case
|
||||||
AcyclicSCC s -> goAcyclic s
|
AcyclicSCC s -> goAcyclic s
|
||||||
CyclicSCC c -> goCyclic (nonEmpty' c)
|
CyclicSCC c -> goCyclic (nonEmpty' c)
|
||||||
where
|
where
|
||||||
goCyclic :: NonEmpty Internal.PreStatement -> Internal.Statement
|
goCyclic :: NonEmpty Internal.PreStatement -> Internal.MutualBlock
|
||||||
goCyclic c = Internal.StatementMutual (Internal.MutualBlock (goMutual <$> c))
|
goCyclic c = Internal.MutualBlock (goMutual <$> c)
|
||||||
where
|
where
|
||||||
goMutual :: Internal.PreStatement -> Internal.MutualStatement
|
goMutual :: Internal.PreStatement -> Internal.MutualStatement
|
||||||
goMutual = \case
|
goMutual = \case
|
||||||
Internal.PreInductiveDef i -> Internal.StatementInductive i
|
Internal.PreInductiveDef i -> Internal.StatementInductive i
|
||||||
Internal.PreFunctionDef i -> Internal.StatementFunction i
|
Internal.PreFunctionDef i -> Internal.StatementFunction i
|
||||||
_ -> impossible
|
Internal.PreAxiomDef i -> Internal.StatementAxiom i
|
||||||
|
|
||||||
goAcyclic :: Internal.PreStatement -> Internal.Statement
|
goAcyclic :: Internal.PreStatement -> Internal.MutualBlock
|
||||||
goAcyclic = \case
|
goAcyclic = \case
|
||||||
Internal.PreInductiveDef i -> one (Internal.StatementInductive i)
|
Internal.PreInductiveDef i -> one (Internal.StatementInductive i)
|
||||||
Internal.PreFunctionDef i -> one (Internal.StatementFunction i)
|
Internal.PreFunctionDef i -> one (Internal.StatementFunction i)
|
||||||
Internal.PreAxiomDef i -> Internal.StatementAxiom i
|
Internal.PreAxiomDef i -> one (Internal.StatementAxiom i)
|
||||||
where
|
where
|
||||||
one :: Internal.MutualStatement -> Internal.Statement
|
one :: Internal.MutualStatement -> Internal.MutualBlock
|
||||||
one = Internal.StatementMutual . Internal.MutualBlock . pure
|
one = Internal.MutualBlock . pure
|
||||||
|
|
||||||
goModuleBody ::
|
goModuleBody ::
|
||||||
forall r.
|
forall r.
|
||||||
|
@ -37,7 +37,7 @@ checkModuleBody ::
|
|||||||
ModuleBody ->
|
ModuleBody ->
|
||||||
Sem r ModuleBody
|
Sem r ModuleBody
|
||||||
checkModuleBody ModuleBody {..} = do
|
checkModuleBody ModuleBody {..} = do
|
||||||
_moduleStatements' <- mapM checkStatement _moduleStatements
|
_moduleStatements' <- mapM checkMutualBlock _moduleStatements
|
||||||
_moduleImports' <- mapM checkImport _moduleImports
|
_moduleImports' <- mapM checkImport _moduleImports
|
||||||
return
|
return
|
||||||
ModuleBody
|
ModuleBody
|
||||||
@ -57,14 +57,6 @@ checkImport ::
|
|||||||
Sem r Import
|
Sem r Import
|
||||||
checkImport = traverseOf importModule checkModuleIndex
|
checkImport = traverseOf importModule checkModuleIndex
|
||||||
|
|
||||||
checkStatement ::
|
|
||||||
(Members '[Reader InfoTable, NameIdGen, Error ArityCheckerError] r) =>
|
|
||||||
Statement ->
|
|
||||||
Sem r Statement
|
|
||||||
checkStatement s = case s of
|
|
||||||
StatementMutual b -> StatementMutual <$> checkMutualBlock b
|
|
||||||
StatementAxiom a -> StatementAxiom <$> checkAxiom a
|
|
||||||
|
|
||||||
checkInductive :: forall r. (Members '[Reader InfoTable, NameIdGen, Error ArityCheckerError] r) => InductiveDef -> Sem r InductiveDef
|
checkInductive :: forall r. (Members '[Reader InfoTable, NameIdGen, Error ArityCheckerError] r) => InductiveDef -> Sem r InductiveDef
|
||||||
checkInductive d = do
|
checkInductive d = do
|
||||||
let _inductiveName = d ^. inductiveName
|
let _inductiveName = d ^. inductiveName
|
||||||
@ -111,6 +103,7 @@ checkMutualStatement ::
|
|||||||
checkMutualStatement = \case
|
checkMutualStatement = \case
|
||||||
StatementFunction f -> StatementFunction <$> checkFunctionDef f
|
StatementFunction f -> StatementFunction <$> checkFunctionDef f
|
||||||
StatementInductive f -> StatementInductive <$> checkInductive f
|
StatementInductive f -> StatementInductive <$> checkInductive f
|
||||||
|
StatementAxiom a -> StatementAxiom <$> checkAxiom a
|
||||||
|
|
||||||
checkMutualBlockLet ::
|
checkMutualBlockLet ::
|
||||||
(Members '[Reader InfoTable, NameIdGen, Error ArityCheckerError] r) =>
|
(Members '[Reader InfoTable, NameIdGen, Error ArityCheckerError] r) =>
|
||||||
|
@ -41,7 +41,7 @@ goModuleNoCache (ModuleIndex m) = do
|
|||||||
where
|
where
|
||||||
goBody :: ModuleBody -> Sem r ModuleBody
|
goBody :: ModuleBody -> Sem r ModuleBody
|
||||||
goBody body = do
|
goBody body = do
|
||||||
_moduleStatements <- mapMaybeM goStatement (body ^. moduleStatements)
|
_moduleStatements <- mapMaybeM goMutual (body ^. moduleStatements)
|
||||||
_moduleImports <- mapM goImport (body ^. moduleImports)
|
_moduleImports <- mapM goImport (body ^. moduleImports)
|
||||||
return ModuleBody {..}
|
return ModuleBody {..}
|
||||||
|
|
||||||
@ -51,16 +51,12 @@ goModule = cacheGet . ModuleIndex
|
|||||||
goModuleIndex :: (Members '[Reader NameDependencyInfo, MCache] r) => ModuleIndex -> Sem r ModuleIndex
|
goModuleIndex :: (Members '[Reader NameDependencyInfo, MCache] r) => ModuleIndex -> Sem r ModuleIndex
|
||||||
goModuleIndex = fmap ModuleIndex . cacheGet
|
goModuleIndex = fmap ModuleIndex . cacheGet
|
||||||
|
|
||||||
goStatement :: forall r. (Member (Reader NameDependencyInfo) r) => Statement -> Sem r (Maybe Statement)
|
-- note that the first mutual statement is reachable iff all are reachable
|
||||||
goStatement s = case s of
|
goMutual :: forall r. (Member (Reader NameDependencyInfo) r) => MutualBlock -> Sem r (Maybe MutualBlock)
|
||||||
StatementMutual m -> fmap StatementMutual <$> goMutual m
|
goMutual b@(MutualBlock (m :| _)) = case m of
|
||||||
StatementAxiom ax -> returnIfReachable (ax ^. axiomName) s
|
StatementFunction f -> returnIfReachable (f ^. funDefName) b
|
||||||
where
|
StatementInductive f -> returnIfReachable (f ^. inductiveName) b
|
||||||
-- note that the first mutual statement is reachable iff all are reachable
|
StatementAxiom ax -> returnIfReachable (ax ^. axiomName) b
|
||||||
goMutual :: MutualBlock -> Sem r (Maybe MutualBlock)
|
|
||||||
goMutual b@(MutualBlock (m :| _)) = case m of
|
|
||||||
StatementFunction f -> returnIfReachable (f ^. funDefName) b
|
|
||||||
StatementInductive f -> returnIfReachable (f ^. inductiveName) b
|
|
||||||
|
|
||||||
goImport :: forall r. (Members '[Reader NameDependencyInfo, MCache] r) => Import -> Sem r Import
|
goImport :: forall r. (Members '[Reader NameDependencyInfo, MCache] r) => Import -> Sem r Import
|
||||||
goImport i = do
|
goImport i = do
|
||||||
|
@ -113,12 +113,7 @@ scanModule ::
|
|||||||
scanModule m = scanModuleBody (m ^. moduleBody)
|
scanModule m = scanModuleBody (m ^. moduleBody)
|
||||||
|
|
||||||
scanModuleBody :: (Members '[State CallMap] r) => ModuleBody -> Sem r ()
|
scanModuleBody :: (Members '[State CallMap] r) => ModuleBody -> Sem r ()
|
||||||
scanModuleBody body = mapM_ scanStatement (body ^. moduleStatements)
|
scanModuleBody body = mapM_ scanMutual (body ^. moduleStatements)
|
||||||
|
|
||||||
scanStatement :: (Members '[State CallMap] r) => Statement -> Sem r ()
|
|
||||||
scanStatement = \case
|
|
||||||
StatementAxiom a -> scanAxiom a
|
|
||||||
StatementMutual m -> scanMutual m
|
|
||||||
|
|
||||||
scanMutual :: (Members '[State CallMap] r) => MutualBlock -> Sem r ()
|
scanMutual :: (Members '[State CallMap] r) => MutualBlock -> Sem r ()
|
||||||
scanMutual (MutualBlock ss) = mapM_ scanMutualStatement ss
|
scanMutual (MutualBlock ss) = mapM_ scanMutualStatement ss
|
||||||
@ -135,6 +130,7 @@ scanMutualStatement :: (Members '[State CallMap] r) => MutualStatement -> Sem r
|
|||||||
scanMutualStatement = \case
|
scanMutualStatement = \case
|
||||||
StatementInductive i -> scanInductive i
|
StatementInductive i -> scanInductive i
|
||||||
StatementFunction i -> scanFunctionDef i
|
StatementFunction i -> scanFunctionDef i
|
||||||
|
StatementAxiom a -> scanAxiom a
|
||||||
|
|
||||||
scanAxiom :: (Members '[State CallMap] r) => AxiomDef -> Sem r ()
|
scanAxiom :: (Members '[State CallMap] r) => AxiomDef -> Sem r ()
|
||||||
scanAxiom = scanTopExpression . (^. axiomType)
|
scanAxiom = scanTopExpression . (^. axiomType)
|
||||||
|
@ -72,7 +72,7 @@ checkModuleBody ::
|
|||||||
Sem r ModuleBody
|
Sem r ModuleBody
|
||||||
checkModuleBody ModuleBody {..} = do
|
checkModuleBody ModuleBody {..} = do
|
||||||
_moduleImports' <- mapM checkImport _moduleImports
|
_moduleImports' <- mapM checkImport _moduleImports
|
||||||
_moduleStatements' <- mapM checkStatement _moduleStatements
|
_moduleStatements' <- mapM checkMutualBlock _moduleStatements
|
||||||
return
|
return
|
||||||
ModuleBody
|
ModuleBody
|
||||||
{ _moduleStatements = _moduleStatements',
|
{ _moduleStatements = _moduleStatements',
|
||||||
@ -85,15 +85,11 @@ checkImport ::
|
|||||||
Sem r Import
|
Sem r Import
|
||||||
checkImport = traverseOf importModule checkModuleIndex
|
checkImport = traverseOf importModule checkModuleIndex
|
||||||
|
|
||||||
checkStatement ::
|
checkMutualBlock ::
|
||||||
(Members '[HighlightBuilder, Reader EntryPoint, State NegativeTypeParameters, Reader InfoTable, Error TypeCheckerError, NameIdGen, State TypesTable, State FunctionsTable, Output Example, Builtins, Termination] r) =>
|
(Members '[HighlightBuilder, Reader EntryPoint, State NegativeTypeParameters, Reader InfoTable, Error TypeCheckerError, NameIdGen, State TypesTable, State FunctionsTable, Output Example, Builtins, Termination] r) =>
|
||||||
Statement ->
|
MutualBlock ->
|
||||||
Sem r Statement
|
Sem r MutualBlock
|
||||||
checkStatement s = case s of
|
checkMutualBlock s = runReader emptyLocalVars (checkTopMutualBlock s)
|
||||||
StatementMutual mut -> StatementMutual <$> runReader emptyLocalVars (checkTopMutualBlock mut)
|
|
||||||
StatementAxiom ax -> do
|
|
||||||
registerNameIdType (ax ^. axiomName . nameId) (ax ^. axiomType)
|
|
||||||
return s
|
|
||||||
|
|
||||||
checkInductiveDef ::
|
checkInductiveDef ::
|
||||||
forall r.
|
forall r.
|
||||||
@ -175,6 +171,9 @@ checkMutualStatement ::
|
|||||||
checkMutualStatement = \case
|
checkMutualStatement = \case
|
||||||
StatementFunction f -> StatementFunction <$> resolveInstanceHoles (checkFunctionDef f)
|
StatementFunction f -> StatementFunction <$> resolveInstanceHoles (checkFunctionDef f)
|
||||||
StatementInductive f -> StatementInductive <$> resolveInstanceHoles (checkInductiveDef f)
|
StatementInductive f -> StatementInductive <$> resolveInstanceHoles (checkInductiveDef f)
|
||||||
|
StatementAxiom ax -> do
|
||||||
|
registerNameIdType (ax ^. axiomName . nameId) (ax ^. axiomType)
|
||||||
|
return $ StatementAxiom ax
|
||||||
|
|
||||||
checkFunctionDef ::
|
checkFunctionDef ::
|
||||||
(Members '[HighlightBuilder, Reader LocalVars, Reader InfoTable, Error TypeCheckerError, NameIdGen, State TypesTable, State FunctionsTable, Output Example, Builtins, Inference, Termination, Output TypedHole] r) =>
|
(Members '[HighlightBuilder, Reader LocalVars, Reader InfoTable, Error TypeCheckerError, NameIdGen, State TypesTable, State FunctionsTable, Output Example, Builtins, Inference, Termination, Output TypedHole] r) =>
|
||||||
|
@ -46,14 +46,14 @@ getNames m =
|
|||||||
concatMap getDeclName (m ^. Internal.moduleBody . Internal.moduleStatements)
|
concatMap getDeclName (m ^. Internal.moduleBody . Internal.moduleStatements)
|
||||||
<> concatMap (getNames . (^. Internal.importModule . Internal.moduleIxModule)) (m ^. Internal.moduleBody . Internal.moduleImports)
|
<> concatMap (getNames . (^. Internal.importModule . Internal.moduleIxModule)) (m ^. Internal.moduleBody . Internal.moduleImports)
|
||||||
where
|
where
|
||||||
getDeclName :: Internal.Statement -> [Text]
|
getDeclName :: Internal.MutualBlock -> [Text]
|
||||||
getDeclName = \case
|
getDeclName = \case
|
||||||
Internal.StatementMutual (Internal.MutualBlock f) -> map getMutualName (toList f)
|
(Internal.MutualBlock f) -> map getMutualName (toList f)
|
||||||
Internal.StatementAxiom ax -> [ax ^. (Internal.axiomName . Internal.nameText)]
|
|
||||||
getMutualName :: Internal.MutualStatement -> Text
|
getMutualName :: Internal.MutualStatement -> Text
|
||||||
getMutualName = \case
|
getMutualName = \case
|
||||||
Internal.StatementFunction f -> f ^. Internal.funDefName . Internal.nameText
|
Internal.StatementFunction f -> f ^. Internal.funDefName . Internal.nameText
|
||||||
Internal.StatementInductive f -> f ^. Internal.inductiveName . Internal.nameText
|
Internal.StatementInductive f -> f ^. Internal.inductiveName . Internal.nameText
|
||||||
|
Internal.StatementAxiom ax -> ax ^. (Internal.axiomName . Internal.nameText)
|
||||||
|
|
||||||
allTests :: TestTree
|
allTests :: TestTree
|
||||||
allTests =
|
allTests =
|
||||||
|
@ -296,7 +296,11 @@ tests =
|
|||||||
posTest
|
posTest
|
||||||
"Hole in type parameter"
|
"Hole in type parameter"
|
||||||
$(mkRelDir ".")
|
$(mkRelDir ".")
|
||||||
$(mkRelFile "HoleTypeParameter.juvix")
|
$(mkRelFile "HoleTypeParameter.juvix"),
|
||||||
|
posTest
|
||||||
|
"Instance axiom"
|
||||||
|
$(mkRelDir ".")
|
||||||
|
$(mkRelFile "InstanceAxiom.juvix")
|
||||||
]
|
]
|
||||||
<> [ compilationTest t | t <- Compilation.tests
|
<> [ compilationTest t | t <- Compilation.tests
|
||||||
]
|
]
|
||||||
|
9
tests/positive/InstanceAxiom.juvix
Normal file
9
tests/positive/InstanceAxiom.juvix
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
module InstanceAxiom;
|
||||||
|
|
||||||
|
trait
|
||||||
|
type T := t;
|
||||||
|
|
||||||
|
axiom <body> : T;
|
||||||
|
|
||||||
|
instance
|
||||||
|
inst : T := <body>;
|
Loading…
Reference in New Issue
Block a user