From cb3bfc601a9179431299e206bf2f92fffb4c097c Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Thu, 16 Jul 2026 21:08:19 +0100 Subject: [PATCH 01/13] cleanup of elaboration --- manual/templates/plain.tree | 0 manual/theme/tree.xsl | 34 +-- manual/trees/0001.tree | 14 +- manual/trees/0002.tree | 6 +- manual/trees/000I.tree | 3 + manual/trees/002K.tree | 1 + packages/coln-compiler/coln-compiler.cabal | 4 + .../coln-compiler/src/Coln/Core/Globals.hs | 1 + .../coln-compiler/src/Coln/Core/Memoed.hs | 6 +- .../coln-compiler/src/Coln/Core/Params.hs | 6 + .../src/Coln/Elaborator/Coercion.hs | 32 +++ .../src/Coln/Elaborator/Judgment.hs | 52 ---- .../src/Coln/Elaborator/Rules/Polarity.hs | 22 ++ .../src/Coln/Elaborator/Rules/Universe.hs | 30 +++ .../coln-compiler/src/Coln/Frontend/Parser.hs | 244 +----------------- .../src/Coln/Frontend/Parser/Expr.hs | 137 ++++++++++ .../src/Coln/Frontend/Parser/Top.hs | 119 +++++++++ packages/coln-compiler/test/Main.hs | 2 +- packages/coln-repl/src/Coln/REPL.hs | 2 +- 19 files changed, 392 insertions(+), 323 deletions(-) create mode 100644 manual/templates/plain.tree create mode 100644 manual/trees/000I.tree create mode 100644 manual/trees/002K.tree create mode 100644 packages/coln-compiler/src/Coln/Elaborator/Coercion.hs create mode 100644 packages/coln-compiler/src/Coln/Elaborator/Rules/Polarity.hs create mode 100644 packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs create mode 100644 packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs diff --git a/manual/templates/plain.tree b/manual/templates/plain.tree new file mode 100644 index 00000000..e69de29b diff --git a/manual/theme/tree.xsl b/manual/theme/tree.xsl index a9984226..2b8e2589 100644 --- a/manual/theme/tree.xsl +++ b/manual/theme/tree.xsl @@ -27,18 +27,18 @@
- - - - + + + + + + + + + + + +
@@ -167,11 +167,11 @@ - -
    - -
- + + + + + diff --git a/manual/trees/0001.tree b/manual/trees/0001.tree index 38184706..d6d04343 100644 --- a/manual/trees/0001.tree +++ b/manual/trees/0001.tree @@ -2,9 +2,11 @@ \p{Coln is a database with an expressive language for schemas, queries, and migrations. This document forms the manual for Coln.} -\transclude{002H} -\transclude{0002} -\transclude{000K} -\transclude{000L} -\transclude{000M} -\transclude{0003} +\ol{ + \li{[[002H]]} + \li{[[0002]]} + \li{[[000K]]} + \li{[[000L]]} + \li{[[000M]]} + \li{[[0003]]} +} diff --git a/manual/trees/0002.tree b/manual/trees/0002.tree index 3e4ac337..31903d18 100644 --- a/manual/trees/0002.tree +++ b/manual/trees/0002.tree @@ -72,8 +72,4 @@ \transclude{000B} -\subtree[000I]{ - \title{Organization} - - \p{} -} +\transclude{000I} diff --git a/manual/trees/000I.tree b/manual/trees/000I.tree new file mode 100644 index 00000000..082e2790 --- /dev/null +++ b/manual/trees/000I.tree @@ -0,0 +1,3 @@ +\title{Organization} + +\p{} diff --git a/manual/trees/002K.tree b/manual/trees/002K.tree new file mode 100644 index 00000000..f54be495 --- /dev/null +++ b/manual/trees/002K.tree @@ -0,0 +1 @@ +\title{Developer documentation} diff --git a/packages/coln-compiler/coln-compiler.cabal b/packages/coln-compiler/coln-compiler.cabal index d2817239..ca6b8ffb 100644 --- a/packages/coln-compiler/coln-compiler.cabal +++ b/packages/coln-compiler/coln-compiler.cabal @@ -30,6 +30,7 @@ library Coln.Core.Syntax Coln.Core.Value Coln.Diagnostics + Coln.Elaborator.Coercion Coln.Elaborator.Debug Coln.Elaborator.Diagnostics Coln.Elaborator.Environment @@ -38,11 +39,14 @@ library Coln.Elaborator.Rules.Equality Coln.Elaborator.Rules.Function Coln.Elaborator.Rules.Record + Coln.Elaborator.Rules.Polarity Coln.Elaborator.Rules.Universe Coln.Elaborator.Rules.Variable Coln.Frontend.Diagnostics Coln.Frontend.Notation Coln.Frontend.Parser + Coln.Frontend.Parser.Top + Coln.Frontend.Parser.Expr Coln.Report hs-source-dirs: src diff --git a/packages/coln-compiler/src/Coln/Core/Globals.hs b/packages/coln-compiler/src/Coln/Core/Globals.hs index e6946b05..907d739a 100644 --- a/packages/coln-compiler/src/Coln/Core/Globals.hs +++ b/packages/coln-compiler/src/Coln/Core/Globals.hs @@ -17,6 +17,7 @@ data GlobalEntry = GlobalEntry { syn :: S.El D , val :: V.El N , ty :: V.Ty N + , mode :: Mode } data Globals = Globals diff --git a/packages/coln-compiler/src/Coln/Core/Memoed.hs b/packages/coln-compiler/src/Coln/Core/Memoed.hs index 7da6002e..57346227 100644 --- a/packages/coln-compiler/src/Coln/Core/Memoed.hs +++ b/packages/coln-compiler/src/Coln/Core/Memoed.hs @@ -94,7 +94,7 @@ instance (V.HasEvaluation c) => LevelOf (Ty c) where instance Readback (Memoed a b c) (a c) where readb _ m = m.stx -mkGlobal :: Name -> V.Ty N -> El D -> GlobalEntry -mkGlobal n ty x = do +mkGlobal :: Name -> V.Ty N -> El D -> Mode -> GlobalEntry +mkGlobal n ty x m = do let neu = V.reflect (V.GlobalVar n neu) V.Id ty (Just x.val) - GlobalEntry x.stx neu ty + GlobalEntry x.stx neu ty m diff --git a/packages/coln-compiler/src/Coln/Core/Params.hs b/packages/coln-compiler/src/Coln/Core/Params.hs index 93913b81..fb3023a6 100644 --- a/packages/coln-compiler/src/Coln/Core/Params.hs +++ b/packages/coln-compiler/src/Coln/Core/Params.hs @@ -183,3 +183,9 @@ data TableName = TableName {realm :: RealmId, path :: Path} instance DPretty TableName where dpretty tn = concatWith (surround dot) (dpretty <$> toList tn.path) + +-- Mode +-------------------------------------------------------------------------------- + +data Mode = Inductive | Conjunctive + deriving (Show, Eq, Ord) diff --git a/packages/coln-compiler/src/Coln/Elaborator/Coercion.hs b/packages/coln-compiler/src/Coln/Elaborator/Coercion.hs new file mode 100644 index 00000000..2ea4b67d --- /dev/null +++ b/packages/coln-compiler/src/Coln/Elaborator/Coercion.hs @@ -0,0 +1,32 @@ +module Coln.Elaborator.Coercion where + +import Coln.Common +import Coln.Core +import Coln.Core.Memoed qualified as M +import Coln.Core.Value qualified as V +import Coln.Elaborator.Judgment +import Coln.Elaborator.Rules.Universe qualified as Universe +import Coln.Elaborator.Rules.Polarity qualified as Polarity + +intoTyp :: Span -> Judgment N -> Typ N +intoTyp _ (FromTyp t) = t +intoTyp sp (FromSyn s) = Universe.elimSyn sp s +intoTyp _ (FromChk _ c) = Universe.elim TheoryU c + +intoSyn :: (V.HasEvaluation c) => DDoc -> Span -> Judgment c -> Syn c +intoSyn _ sp (FromTyp t) = Syn $ \e -> do + raw <- t.elab e + case universeFor (levelOf raw) of + Nothing -> do + let msg = "type" <+> prtIn e raw <+> "too large to fit in a universe" + failWith e.diagEnv sp TypeTooLarge msg + Just u -> pure (V.U u, M.code raw) +intoSyn _ _ (FromSyn s) = s +intoSyn use sp (FromChk nd _) = Syn $ \e -> do + let msg = "Type annotation required when using a" <+> nd <+> "as" <+> use + failWith e.diagEnv sp AnnotationRequired msg + +intoChk :: (V.HasEvaluation c) => Span -> Judgment c -> Chk c +intoChk sp (FromTyp t) = Universe.intro sp t +intoChk sp (FromSyn s) = Polarity.conv sp s +intoChk _ (FromChk _ c) = c diff --git a/packages/coln-compiler/src/Coln/Elaborator/Judgment.hs b/packages/coln-compiler/src/Coln/Elaborator/Judgment.hs index d6473c5d..9ccb38d2 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Judgment.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Judgment.hs @@ -11,10 +11,6 @@ module Coln.Elaborator.Judgment ( Chk (..), Judgment (..), useIs, - intoTyp, - intoSyn, - intoChk, - annotate, ) where @@ -43,54 +39,6 @@ useIs @c f e = fmap change $ f e{target = TargetAnonymous} SNominative -> id SDescriptive -> M.is -intoTyp :: Span -> Judgment N -> Typ N -intoTyp _ (FromTyp t) = t -intoTyp sp (FromSyn s) = Typ $ \e -> do - (ty, el) <- s.elab e - case V.behavior ty of - V.LikeU _ -> pure $ M.decode el - _ -> do - let msg = "tried to use a value of type" <+> prtIn e ty <+> "as a type" - failWith e.diagEnv sp TypeMismatch msg -intoTyp _ (FromChk _ c) = Typ $ \e -> do - el <- c.elab e $ V.U TheoryU - pure $ M.decode el - -intoSyn :: (V.HasEvaluation c) => DDoc -> Span -> Judgment c -> Syn c -intoSyn _ sp (FromTyp t) = Syn $ \e -> do - raw <- t.elab e - case universeFor (levelOf raw) of - Nothing -> do - let msg = "type" <+> prtIn e raw <+> "too large to fit in a universe" - failWith e.diagEnv sp TypeTooLarge msg - Just u -> pure (V.U u, M.code raw) -intoSyn _ _ (FromSyn s) = s -intoSyn use sp (FromChk nd _) = Syn $ \e -> do - let msg = "Type annotation required when using a" <+> nd <+> "as" <+> use - failWith e.diagEnv sp AnnotationRequired msg - -intoChk :: (V.HasEvaluation c) => Span -> Judgment c -> Chk c -intoChk sp (FromTyp t) = Chk $ \e ty -> do - raw <- t.elab e - case V.behavior ty of - V.LikeU u -> do - case leq (levelOf raw) (decodesInto u) of - True -> pure $ M.code raw - False -> do - let msg = "type" <+> prtIn e raw <+> "too large for universe" <+> pretty u - failWith e.diagEnv sp TypeTooLarge msg - _ -> do - let msg = "cannot check type" <+> prtIn e raw <+> "at non-universe type" <+> prtIn e.scope ty - failWith e.diagEnv sp TypeAtNonUniverse msg -intoChk sp (FromSyn s) = Chk $ \e ty -> do - (ty', el) <- s.elab e - case defEq (shape e) ty ty' of - Right _ -> pure el - Left err -> do - let msg = "expected type" <+> prtIn e.scope ty <> ", but got type" <+> prtIn e.scope ty' - let note = Just $ dpretty err - failWithNote e.diagEnv sp TypeMismatch msg note -intoChk _ (FromChk _ c) = c annotate :: Typ N -> Chk c -> Syn c annotate t c = Syn \e -> do diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Polarity.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Polarity.hs new file mode 100644 index 00000000..af131c87 --- /dev/null +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Polarity.hs @@ -0,0 +1,22 @@ +module Coln.Elaborator.Rules.Polarity where + +import Coln.Common +import Coln.Core +import Coln.Core.Value qualified as V +import Coln.Elaborator.Judgment + +conv :: (V.HasEvaluation c) => Span -> Syn c -> Chk c +conv sp s = Chk \e a -> do + (a', m) <- s.elab e + case defEq (shape e) a a' of + Right _ -> pure m + Left err -> do + let msg = "expected type" <+> prtIn e.scope a <> ", but got type" <+> prtIn e.scope a' + let note = Just $ dpretty err + failWithNote e.diagEnv sp TypeMismatch msg note + +annot :: (V.HasEvaluation c) => Chk c -> Typ N -> Syn c +annot c t = Syn \e -> do + a <- t.elab (e { target = TargetAnonymous }) + m <- c.elab e a.val + pure (a.val, m) diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Universe.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Universe.hs index 2c3ecc46..dca6d2e4 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Rules/Universe.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Universe.hs @@ -4,8 +4,38 @@ module Coln.Elaborator.Rules.Universe where +import Coln.Common import Coln.Core +import Coln.Core.Value qualified as V import Coln.Elaborator.Judgment formation :: Universe -> Typ N formation u = Typ \_ -> pure $ univ u + +intro :: (V.HasEvaluation c) => Span -> Typ c -> Chk c +intro sp t = Chk $ \e ty -> do + raw <- t.elab e + case V.behavior ty of + V.LikeU u -> do + case leq (levelOf raw) (decodesInto u) of + True -> pure $ code raw + False -> do + let msg = "type" <+> prtIn e raw <+> "too large for universe" <+> pretty u + failWith e.diagEnv sp TypeTooLarge msg + _ -> do + let msg = "cannot check type" <+> prtIn e raw <+> "at non-universe type" <+> prtIn e.scope ty + failWith e.diagEnv sp TypeAtNonUniverse msg + +elim :: Universe -> Chk N -> Typ N +elim u c = Typ \e -> do + el <- c.elab e $ V.U u + pure $ decode el + +elimSyn :: Span -> Syn N -> Typ N +elimSyn sp s = Typ \e -> do + (a, el) <- s.elab e + case V.behavior a of + V.LikeU u -> pure $ decode el + _ -> do + let msg = "expected element of universe type" + failWith e.diagEnv sp TypeAtNonUniverse msg diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser.hs b/packages/coln-compiler/src/Coln/Frontend/Parser.hs index 7fe780c5..717a40ef 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser.hs @@ -1,243 +1,11 @@ -- SPDX-FileCopyrightText: 2026 Coln contributors -- -- SPDX-License-Identifier: Apache-2.0 OR MIT -{-# LANGUAGE TypeAbstractions #-} -module Coln.Frontend.Parser where +module Coln.Frontend.Parser( + module Coln.Frontend.Parser.Expr, + module Coln.Frontend.Parser.Top +) where -import Control.Exception (try) -import Data.Foldable -import Data.Functor.Contravariant (contramap) -import Data.List.NonEmpty (NonEmpty (..)) -import FNotation (Ntn) -import FNotation qualified as N - -import Coln.Common -import Coln.Core -import Coln.Core.Layout -import Coln.Core.Memoed qualified as M -import Coln.Core.Value qualified as V -import Coln.Diagnostics -import Coln.Elaborator.Debug -import Coln.Elaborator.Environment -import Coln.Elaborator.Judgment -import Coln.Elaborator.Rules.Builtin qualified as Builtin -import Coln.Elaborator.Rules.Equality qualified as Equality -import Coln.Elaborator.Rules.Function qualified as Function -import Coln.Elaborator.Rules.Record qualified as Record -import Coln.Elaborator.Rules.Universe qualified as Universe -import Coln.Elaborator.Rules.Variable qualified as Variable -import Coln.Frontend.Diagnostics -import Coln.Frontend.Notation - -type ParseEnv = DiagnosticEnv ColnCode - -top :: ParseEnv -> [Ntn] -> IO Globals -top e = foldlM (decl' e) emptyGlobals - -topFromText :: Reporter ColnCode -> File -> IO Globals -topFromText r f = do - ts <- N.lex lexConfig (contramap LexerCode r) f - ns <- N.read readConfig (contramap ReaderCode r) f ts - top (DiagnosticEnv r f) ns - -decl' :: ParseEnv -> Globals -> Ntn -> IO Globals -decl' e g n = do - try (decl e g n) >>= \case - Right g' -> pure g' - Left (_ :: FailException) -> pure g - -decl :: ParseEnv -> Globals -> Ntn -> IO Globals -decl e g (N.Decl "theory" n _) = do - (x, ge) <- idef e g (M.univ TheoryU) n - pure $ addGlobalEntry x ge g -decl e g (N.Decl "def" n _) = do - (x, ge) <- def e g n - pure $ addGlobalEntry x ge g -decl e g (N.Block "realm" (Just head) body _) = do - (x, r) <- realm e g head body - pure $ addRealm x r g -decl e _ n = unexpectedNotation e n "top-level declaration" - -definition :: ParseEnv -> Ntn -> IO (Ntn, Ntn) -definition _ (N.Infix n0 (N.Keyword ":=" _) n1) = pure (n0, n1) -definition e n = unexpectedNotation e n "notation of the form ` := `" - -annot :: ParseEnv -> Ntn -> IO (Ntn, Ntn) -annot _ (N.Infix n0 (N.Keyword ":" _) n1) = pure (n0, n1) -annot e n = unexpectedNotation e n "type-annotated expression, e.g. ` : `" - -debugCommand :: ParseEnv -> Span -> Name -> Ntn -> IO DebugCommand -debugCommand e _ "showtype" n = do - s <- syn e "argument to showtype" n - pure $ ShowType (N.span n) s -debugCommand e _ "showtypeb" n = do - s <- syn e "argument to showtypeb" n - pure $ ShowTypeBehavior (N.span n) s -debugCommand e _ "showlevel" n = do - ty <- typ e n - pure $ ShowLevel (N.span n) ty -debugCommand e _ "expand" n = do - s <- syn e "argument to expand" n - pure $ Expand (N.span n) s -debugCommand e sp x _ = unknownCommand e sp x - -fieldDecl :: ParseEnv -> Ntn -> IO Record.FieldDeclaration -fieldDecl e (N.Infix (N.Ident x _) (N.Keyword ":" _) n) = - Record.FieldDeclaration x <$> typ e n -fieldDecl e (N.Decl c n sp) = - Record.FieldDeclarationDebug <$> debugCommand e sp c n -fieldDecl e n = unexpectedNotation e n "field declaration of the form ` : `" - -fieldSetting :: (V.HasEvaluation c) => ParseEnv -> Ntn -> IO (Record.FieldSetting c) -fieldSetting e (N.Infix (N.Ident x sp) (N.Keyword ":=" _) body) = - Record.FieldSetting x <$> chk e body <*> pure sp -fieldSetting e n = unexpectedNotation e n "field setting of the form ` := `" - -ident :: ParseEnv -> Ntn -> IO Name -ident _ (N.Ident x _) = pure x -ident e n = unexpectedNotation e n "identifier" - -argBinding :: ParseEnv -> Ntn -> IO (Span, Name, Ntn) -argBinding e n@(N.Infix n0 (N.Keyword ":" _) n1) = do - x <- ident e n0 - pure (N.span n, x, n1) -argBinding e n = unexpectedNotation e n "argument binding of the form ` : `" - -unpackArgs :: ParseEnv -> Ntn -> IO (Name, [(Span, Name, Ntn)]) -unpackArgs e (N.Group (xN :| argsN)) = do - x <- ident e xN - args <- mapM (argBinding e) argsN - pure (x, args) - -def :: ParseEnv -> Globals -> Ntn -> IO (Name, GlobalEntry) -def e g n = do - (head_n, body_n) <- definition e n - (pat_n, ty_n) <- annot e head_n - (name, args) <- unpackArgs e pat_n - ret_typ <- typ e ty_n - body_chk <- chk e body_n - (ty_j, term_j) <- withArgs e args (ret_typ, body_chk) - let tyElabE = emptyElabEnv (contramap ElaboratorCode e) g - ty <- ty_j.elab tyElabE - let elabE = emptyElabEnvFor (contramap ElaboratorCode e) g name ty.val - term <- term_j.elab elabE ty.val - let entry = M.mkGlobal name ty.val term - pure (name, entry) - -idef :: ParseEnv -> Globals -> M.Ty N -> Ntn -> IO (Name, GlobalEntry) -idef e g ret_ty n = do - (pat_n, body_n) <- definition e n - (name, args) <- unpackArgs e pat_n - body_chk <- chk e body_n - (ty_j, term_j) <- withArgs e args $ (Typ \_ -> pure ret_ty, body_chk) - let tyElabE = emptyElabEnv (contramap ElaboratorCode e) g - ty <- ty_j.elab tyElabE - let elabE = emptyElabEnvFor (contramap ElaboratorCode e) g name ty.val - term <- term_j.elab elabE ty.val - let entry = M.mkGlobal name ty.val term - pure (name, entry) - -realmHead :: ParseEnv -> Ntn -> IO (Name, Ntn) -realmHead _ (N.Infix (N.Ident x _) (N.Keyword "@" _) n) = pure (x, n) -realmHead e n = unexpectedNotation e n "realm head" - -realm :: ParseEnv -> Globals -> Ntn -> [Ntn] -> IO (Name, Realm) -realm e g head _defs = do - (x, theory_n) <- realmHead e head - theory_typ <- typ e theory_n - theory <- theory_typ.elab (emptyElabEnv (contramap ElaboratorCode e) g) - let (gt, root) = layoutTop x theory.val - pure (x, Realm gt root.val theory.val) - -withArgs :: (V.HasEvaluation c) => ParseEnv -> [(Span, Name, Ntn)] -> (Typ N, Chk c) -> IO (Typ N, Chk c) -withArgs e args base = foldrM go base args - where - go :: (V.HasEvaluation c) => (Span, Name, Ntn) -> (Typ N, Chk c) -> IO (Typ N, Chk c) - go (sp, name, n) (t, c) = do - argtyp <- typ e n - pure $ - ( Function.formation sp (Function.Named name argtyp) t - , Function.intro sp name c - ) - -fromSynN :: (V.HasEvaluation c) => Syn N -> Judgment c -fromSynN @c s = case V.scase @c of - SNominative -> FromSyn s - SDescriptive -> FromSyn $ Syn \e -> do - (a, m) <- s.elab (e{target = TargetAnonymous}) - pure (a, M.is m) - -fromTypN :: (V.HasEvaluation c) => Typ N -> Judgment c -fromTypN @c t = case V.scase @c of - SNominative -> FromTyp t - SDescriptive -> FromTyp $ Typ \e -> do - m <- t.elab (e{target = TargetAnonymous}) - pure $ M.isTy m - -fromTypD :: (V.HasEvaluation c) => ParseEnv -> Span -> Typ D -> IO (Judgment c) -fromTypD @c e sp t = case V.scase @c of - SNominative -> do - let msg = "expected nominative type, got descriptive type" - failWith e sp (ParserCode UnexpectedDescriptive) msg - SDescriptive -> pure $ FromTyp t - -expr :: (V.HasEvaluation c) => ParseEnv -> Ntn -> IO (Judgment c) -expr e n = case n of - N.Ident name s -> pure $ fromSynN $ Variable.find s name - N.Juxt n0 n1 -> do - s <- syn e "target of elimination" n0 - fromSynN <$> elim e s n1 - N.Keyword "Set" _ -> pure $ fromTypN $ Universe.formation SetU - N.Keyword "Prop" _ -> pure $ fromTypN $ Universe.formation PropU - N.Keyword "Int" _ -> pure $ fromTypN $ Builtin.formation BuiltinInt - N.Keyword "String" _ -> pure $ fromTypN $ Builtin.formation BuiltinString - N.Infix arg n@(N.Keyword "->" _) body -> - fromTypN <$> (Function.formation (N.span n) <$> binder e arg <*> typ e body) - N.Infix arg n@(N.Keyword "=>" _) body -> - FromChk "lambda expression" - <$> (Function.intro (N.span n) <$> ident e arg <*> chk e body) - n@(N.Infix lhs (N.Keyword "=" _) rhs) -> - fromTypN - <$> ( Equality.formation (N.span n) - <$> syn e "term in equality" lhs - <*> syn e "term in equality" rhs - ) - N.Block "sig" Nothing ns _ -> do - t <- Record.formation <$> traverse (fieldDecl e) ns - fromTypD e (N.span n) t - N.Block "struct" Nothing ns s -> - FromChk "struct expression" <$> (Record.intro s <$> traverse (fieldSetting e) ns) - N.Int i _ -> pure $ fromSynN $ Builtin.intro $ LitInt i - N.String s _ -> pure $ fromSynN $ Builtin.intro $ LitString s - n -> unexpectedNotation e n "expression" - -syn :: (V.HasEvaluation c) => ParseEnv -> DDoc -> Ntn -> IO (Syn c) -syn e use n = intoSyn use (N.span n) <$> expr e n - -chk :: (V.HasEvaluation c) => ParseEnv -> Ntn -> IO (Chk c) -chk e n = intoChk (N.span n) <$> expr e n - -typ :: ParseEnv -> Ntn -> IO (Typ N) -typ e n = intoTyp (N.span n) <$> expr e n - -elim :: ParseEnv -> Syn N -> Ntn -> IO (Syn N) -elim e j = \case - N.Field x s -> pure $ Record.elim s j x - arg -> Function.elim (N.span arg) j <$> chk e arg - -binder :: ParseEnv -> Ntn -> IO Function.Binder -binder e = \case - N.Infix name (N.Keyword ":" _) arg -> - Function.Named <$> ident e name <*> typ e arg - n -> Function.Anonymous <$> typ e n - -unexpectedNotation :: ParseEnv -> Ntn -> DDoc -> IO a -unexpectedNotation e n c = do - let msg = "unexpected notation for" <+> c <> ":" <+> N.head n - failWith e (N.span n) (ParserCode UnexpectedNotation) msg - -unknownCommand :: ParseEnv -> Span -> Name -> IO a -unknownCommand e sp x = do - let msg = "unknown command:" <+> dpretty x - failWith e sp (ParserCode UnknownCommand) msg +import Coln.Frontend.Parser.Expr +import Coln.Frontend.Parser.Top diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs new file mode 100644 index 00000000..a284494c --- /dev/null +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE TypeAbstractions #-} +module Coln.Frontend.Parser.Expr where + +import FNotation (Ntn) +import FNotation qualified as N + +import Coln.Common +import Coln.Core +import Coln.Core.Memoed qualified as M +import Coln.Core.Value qualified as V +import Coln.Elaborator.Coercion +import Coln.Elaborator.Debug +import Coln.Elaborator.Environment +import Coln.Elaborator.Judgment +import Coln.Elaborator.Rules.Builtin qualified as Builtin +import Coln.Elaborator.Rules.Equality qualified as Equality +import Coln.Elaborator.Rules.Function qualified as Function +import Coln.Elaborator.Rules.Record qualified as Record +import Coln.Elaborator.Rules.Universe qualified as Universe +import Coln.Elaborator.Rules.Variable qualified as Variable + +import Coln.Frontend.Diagnostics + +type ParserEnv = DiagnosticEnv ParserCode + +debugCommand :: ParserEnv -> Span -> Name -> Ntn -> IO DebugCommand +debugCommand e _ "showtype" n = do + s <- syn e "argument to showtype" n + pure $ ShowType (N.span n) s +debugCommand e _ "showtypeb" n = do + s <- syn e "argument to showtypeb" n + pure $ ShowTypeBehavior (N.span n) s +debugCommand e _ "showlevel" n = do + ty <- typ e n + pure $ ShowLevel (N.span n) ty +debugCommand e _ "expand" n = do + s <- syn e "argument to expand" n + pure $ Expand (N.span n) s +debugCommand e sp x _ = unknownCommand e sp x + +binder :: ParserEnv -> Ntn -> IO Function.Binder +binder e = \case + N.Infix name (N.Keyword ":" _) arg -> + Function.Named <$> ident e name <*> typ e arg + n -> Function.Anonymous <$> typ e n + +fieldDecl :: ParserEnv -> Ntn -> IO Record.FieldDeclaration +fieldDecl e (N.Infix (N.Ident x _) (N.Keyword ":" _) n) = + Record.FieldDeclaration x <$> typ e n +fieldDecl e (N.Decl c n sp) = + Record.FieldDeclarationDebug <$> debugCommand e sp c n +fieldDecl e n = unexpectedNotation e n "field declaration of the form ` : `" + +fieldSetting :: (V.HasEvaluation c) => ParserEnv -> Ntn -> IO (Record.FieldSetting c) +fieldSetting e (N.Infix (N.Ident x sp) (N.Keyword ":=" _) body) = + Record.FieldSetting x <$> chk e body <*> pure sp +fieldSetting e n = unexpectedNotation e n "field setting of the form ` := `" + +ident :: ParserEnv -> Ntn -> IO Name +ident _ (N.Ident x _) = pure x +ident e n = unexpectedNotation e n "identifier" + +unexpectedNotation :: ParserEnv -> Ntn -> DDoc -> IO a +unexpectedNotation e n c = do + let msg = "unexpected notation for" <+> c <> ":" <+> N.head n + failWith e (N.span n) UnexpectedNotation msg + +unknownCommand :: ParserEnv -> Span -> Name -> IO a +unknownCommand e sp x = do + let msg = "unknown command:" <+> dpretty x + failWith e sp UnknownCommand msg + +fromSynN :: (V.HasEvaluation c) => Syn N -> Judgment c +fromSynN @c s = case V.scase @c of + SNominative -> FromSyn s + SDescriptive -> FromSyn $ Syn \e -> do + (a, m) <- s.elab (e{target = TargetAnonymous}) + pure (a, M.is m) + +fromTypN :: (V.HasEvaluation c) => Typ N -> Judgment c +fromTypN @c t = case V.scase @c of + SNominative -> FromTyp t + SDescriptive -> FromTyp $ Typ \e -> do + m <- t.elab (e{target = TargetAnonymous}) + pure $ M.isTy m + +fromTypD :: (V.HasEvaluation c) => ParserEnv -> Span -> Typ D -> IO (Judgment c) +fromTypD @c e sp t = case V.scase @c of + SNominative -> do + let msg = "expected nominative type, got descriptive type" + failWith e sp UnexpectedDescriptive msg + SDescriptive -> pure $ FromTyp t + +expr :: (V.HasEvaluation c) => ParserEnv -> Ntn -> IO (Judgment c) +expr e n = case n of + N.Ident name s -> pure $ fromSynN $ Variable.find s name + N.Juxt n0 n1 -> do + s <- syn e "target of elimination" n0 + fromSynN <$> elim e s n1 + N.Keyword "Set" _ -> pure $ fromTypN $ Universe.formation SetU + N.Keyword "Prop" _ -> pure $ fromTypN $ Universe.formation PropU + N.Keyword "Int" _ -> pure $ fromTypN $ Builtin.formation BuiltinInt + N.Keyword "String" _ -> pure $ fromTypN $ Builtin.formation BuiltinString + N.Infix arg n@(N.Keyword "->" _) body -> + fromTypN <$> (Function.formation (N.span n) <$> binder e arg <*> typ e body) + N.Infix arg n@(N.Keyword "=>" _) body -> + FromChk "lambda expression" + <$> (Function.intro (N.span n) <$> ident e arg <*> chk e body) + n@(N.Infix lhs (N.Keyword "=" _) rhs) -> + fromTypN + <$> ( Equality.formation (N.span n) + <$> syn e "term in equality" lhs + <*> syn e "term in equality" rhs + ) + N.Block "sig" Nothing ns _ -> do + t <- Record.formation <$> traverse (fieldDecl e) ns + fromTypD e (N.span n) t + N.Block "struct" Nothing ns s -> + FromChk "struct expression" <$> (Record.intro s <$> traverse (fieldSetting e) ns) + N.Int i _ -> pure $ fromSynN $ Builtin.intro $ LitInt i + N.String s _ -> pure $ fromSynN $ Builtin.intro $ LitString s + n -> unexpectedNotation e n "expression" + +syn :: (V.HasEvaluation c) => ParserEnv -> DDoc -> Ntn -> IO (Syn c) +syn e use n = intoSyn use (N.span n) <$> expr e n + +chk :: (V.HasEvaluation c) => ParserEnv -> Ntn -> IO (Chk c) +chk e n = intoChk (N.span n) <$> expr e n + +typ :: ParserEnv -> Ntn -> IO (Typ N) +typ e n = intoTyp (N.span n) <$> expr e n + +elim :: ParserEnv -> Syn N -> Ntn -> IO (Syn N) +elim e j = \case + N.Field x s -> pure $ Record.elim s j x + arg -> Function.elim (N.span arg) j <$> chk e arg + diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs new file mode 100644 index 00000000..b9e0fbe6 --- /dev/null +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs @@ -0,0 +1,119 @@ +module Coln.Frontend.Parser.Top where + +import Control.Exception (try) +import Data.Foldable +import Data.Functor.Contravariant (contramap) +import Data.List.NonEmpty (NonEmpty (..)) +import FNotation (Ntn) +import FNotation qualified as N + +import Coln.Common +import Coln.Core +import Coln.Core.Layout +import Coln.Core.Memoed qualified as M +import Coln.Core.Value qualified as V +import Coln.Diagnostics +import Coln.Elaborator.Environment +import Coln.Elaborator.Judgment +import Coln.Elaborator.Rules.Function qualified as Function +import Coln.Frontend.Parser.Expr +import Coln.Frontend.Notation + +definition :: ParserEnv -> Ntn -> IO (Ntn, Ntn) +definition _ (N.Infix n0 (N.Keyword ":=" _) n1) = pure (n0, n1) +definition e n = unexpectedNotation e n "notation of the form ` := `" + +annot :: ParserEnv -> Ntn -> IO (Ntn, Ntn) +annot _ (N.Infix n0 (N.Keyword ":" _) n1) = pure (n0, n1) +annot e n = unexpectedNotation e n "type-annotated expression, e.g. ` : `" + +argBinding :: ParserEnv -> Ntn -> IO (Span, Name, Typ N) +argBinding e n@(N.Infix n0 (N.Keyword ":" _) n1) = do + x <- ident e n0 + a <- typ e n1 + pure (N.span n, x, a) +argBinding e n = unexpectedNotation e n "argument binding of the form ` : `" + +unpackArgs :: ParserEnv -> Ntn -> IO (Name, [(Span, Name, Typ N)]) +unpackArgs e (N.Group (xN :| argsN)) = do + x <- ident e xN + args <- mapM (argBinding e) argsN + pure (x, args) + +withArgs :: (V.HasEvaluation c) => [(Span, Name, Typ N)] -> (Typ N, Chk c) -> (Typ N, Chk c) +withArgs args base = foldr go base args + where + go :: (V.HasEvaluation c) => (Span, Name, Typ N) -> (Typ N, Chk c) -> (Typ N, Chk c) + go (sp, name, a) (t, c) = + ( Function.formation sp (Function.Named name a) t + , Function.intro sp name c + ) + +theory :: ParserEnv -> Ntn -> IO (Name, Typ N, Chk D) +theory e n = do + (pat_n, body_n) <- definition e n + (name, args) <- unpackArgs e pat_n + body <- chk e body_n + let (ty, tm) = withArgs args (Typ $ \_ -> pure $ M.univ TheoryU, body) + pure $ (name, ty, tm) + +def :: ParserEnv -> Ntn -> IO (Name, Typ N, Chk D) +def e n = do + (head_n, body_n) <- definition e n + (pat_n, ty_n) <- annot e head_n + (name, args) <- unpackArgs e pat_n + returnTyp <- typ e ty_n + body <- chk e body_n + let (ty, tm) = withArgs args (returnTyp, body) + pure (name, ty, tm) + +elabEntry :: DiagnosticEnv ElaboratorCode -> Globals -> (Name, Typ N, Chk D) -> IO GlobalEntry +elabEntry e g (x, ty, tm) = do + let tyE = emptyElabEnv e g + a <- ty.elab tyE + let tmE = emptyElabEnvFor e g x a.val + t <- tm.elab tmE a.val + let v = V.reflect (V.GlobalVar x v) V.Id a.val (Just t.val) + let entry = GlobalEntry t.stx v a.val Conjunctive + pure entry + +realmHead :: ParserEnv -> Ntn -> IO (Name, Ntn) +realmHead _ (N.Infix (N.Ident x _) (N.Keyword "@" _) n) = pure (x, n) +realmHead e n = unexpectedNotation e n "realm head" + +realm :: DiagnosticEnv ColnCode -> Globals -> Ntn -> [Ntn] -> IO (Name, Realm) +realm e g head _defs = do + (x, theory_n) <- realmHead (contramap ParserCode e) head + theory_typ <- typ (contramap ParserCode e) theory_n + theory <- theory_typ.elab (emptyElabEnv (contramap ElaboratorCode e) g) + let (gt, root) = layoutTop x theory.val + pure (x, Realm gt root.val theory.val) + +decl :: DiagnosticEnv ColnCode -> Globals -> Ntn -> IO Globals +decl e g (N.Decl "theory" n _) = do + (x, t, c) <- theory (contramap ParserCode e) n + ge <- elabEntry (contramap ElaboratorCode e) g (x, t, c) + pure $ addGlobalEntry x ge g +decl e g (N.Decl "def" n _) = do + (x, t, c) <- def (contramap ParserCode e) n + ge <- elabEntry (contramap ElaboratorCode e) g (x, t, c) + pure $ addGlobalEntry x ge g +decl e g (N.Block "realm" (Just head) body _) = do + (x, r) <- realm e g head body + pure $ addRealm x r g +decl e _ n = unexpectedNotation (contramap ParserCode e) n "top-level declaration" + +tryDecl :: DiagnosticEnv ColnCode -> Globals -> Ntn -> IO Globals +tryDecl e g n = do + try (decl e g n) >>= \case + Right g' -> pure g' + Left (_ :: FailException) -> pure g + +top :: DiagnosticEnv ColnCode -> [Ntn] -> IO Globals +top e = foldlM (tryDecl e) emptyGlobals + +topFromText :: Reporter ColnCode -> File -> IO Globals +topFromText r f = do + ts <- N.lex lexConfig (contramap LexerCode r) f + ns <- N.read readConfig (contramap ReaderCode r) f ts + top (DiagnosticEnv r f) ns diff --git a/packages/coln-compiler/test/Main.hs b/packages/coln-compiler/test/Main.hs index 713dc5f3..aa9e65be 100644 --- a/packages/coln-compiler/test/Main.hs +++ b/packages/coln-compiler/test/Main.hs @@ -49,7 +49,7 @@ render :: DDoc -> LBS.ByteString render = TLE.encodeUtf8 . renderLazy . layoutPretty defaultLayoutOptions prettyEntry :: (Name, GlobalEntry) -> DDoc -prettyEntry (x, (GlobalEntry t _ a)) = +prettyEntry (x, (GlobalEntry t _ a _)) = vsep [ "global entry named" <+> dpretty x , "type:" <+> prtIn (CtxShape 0 BwdNil) a diff --git a/packages/coln-repl/src/Coln/REPL.hs b/packages/coln-repl/src/Coln/REPL.hs index 6e7a6d93..c42d5cde 100644 --- a/packages/coln-repl/src/Coln/REPL.hs +++ b/packages/coln-repl/src/Coln/REPL.hs @@ -100,7 +100,7 @@ eval file = do reporter translator = contramap translator $ terminalReporter stdout prettyEntry :: (Name, GlobalEntry) -> DDoc -prettyEntry (x, GlobalEntry t _ a) = +prettyEntry (x, GlobalEntry t _ a _) = vsep [ "global entry named" <+> dpretty x , "type:" <+> prtIn (CtxShape 0 BwdNil) a From 9f15dbcda931d22f21857e8c11a62758ef5e1b72 Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Sat, 18 Jul 2026 16:37:04 -0400 Subject: [PATCH 02/13] wip initial --- .../coln-compiler/src/Coln/Core/Evaluation.hs | 3 + .../coln-compiler/src/Coln/Core/Layout.hs | 2 +- .../coln-compiler/src/Coln/Core/Params.hs | 3 + packages/coln-compiler/src/Coln/Core/Print.hs | 1 + .../coln-compiler/src/Coln/Core/Readback.hs | 1 + .../coln-compiler/src/Coln/Core/Syntax.hs | 1 + packages/coln-compiler/src/Coln/Core/Value.hs | 15 +- .../src/Coln/Elaborator/Diagnostics.hs | 2 + .../src/Coln/Elaborator/Environment.hs | 59 ++++--- .../src/Coln/Elaborator/Rules/Function.hs | 10 +- .../src/Coln/Elaborator/Rules/Initial.hs | 13 ++ .../src/Coln/Elaborator/Rules/Record.hs | 2 +- .../src/Coln/Elaborator/Rules/Variable.hs | 13 +- .../src/Coln/Frontend/Diagnostics.hs | 2 + .../src/Coln/Frontend/Notation.hs | 1 + .../src/Coln/Frontend/Parser/Top.hs | 31 ++-- packages/coln-compiler/test/Main.hs | 3 +- .../coln-compiler/test/golden/ancestor.output | 1 + packages/coln-compiler/test/golden/fb3.output | 13 +- .../test/golden/graph-of-graphs.output | 160 ++---------------- .../coln-compiler/test/golden/graph.output | 1 + .../coln-compiler/test/golden/hlevel.output | 33 +--- packages/coln-compiler/test/golden/ind.coln | 18 ++ packages/coln-compiler/test/golden/ind.output | 30 ++++ .../coln-compiler/test/golden/lambda.output | 1 + .../coln-compiler/test/golden/magma.output | 1 + .../test/golden/modular-lattice.output | 21 +-- .../test/golden/monoid-glog.output | 15 +- .../coln-compiler/test/golden/nominal.output | 3 + packages/coln-compiler/test/golden/paths.coln | 2 + .../coln-compiler/test/golden/paths.output | 30 ++-- packages/coln-compiler/test/golden/ssa.output | 88 ++++------ 32 files changed, 257 insertions(+), 322 deletions(-) create mode 100644 packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs create mode 100644 packages/coln-compiler/test/golden/ind.coln create mode 100644 packages/coln-compiler/test/golden/ind.output diff --git a/packages/coln-compiler/src/Coln/Core/Evaluation.hs b/packages/coln-compiler/src/Coln/Core/Evaluation.hs index 4ee38f13..976882b2 100644 --- a/packages/coln-compiler/src/Coln/Core/Evaluation.hs +++ b/packages/coln-compiler/src/Coln/Core/Evaluation.hs @@ -43,6 +43,9 @@ instance Compile S.El V.El where S.Proj t x -> do let k = compile t \vs -> V.proj (k vs) x + S.Init t -> do + let k = compile t + \vs -> V.Describe $ V.Init (k vs) V.Id S.Lit l -> \_ -> V.Lit l S.Is t -> do let k = compile t diff --git a/packages/coln-compiler/src/Coln/Core/Layout.hs b/packages/coln-compiler/src/Coln/Core/Layout.hs index 387630db..e43ffcb3 100644 --- a/packages/coln-compiler/src/Coln/Core/Layout.hs +++ b/packages/coln-compiler/src/Coln/Core/Layout.hs @@ -71,7 +71,7 @@ layout p sc a let a = V.EltOf (TableName sc.realm p) (fromList $ zip (toList sc.names) (toList sc.bound)) (gt, M.code (M.fromVTy sc.len a)) V.NoRules -> panic "cannot layout type with no rules" - V.LikeBuiltinTy _; V.LikeU _ -> panic "non-theory type" + V.LikeBuiltinTy _; V.LikeU _; V.LikeInductive _ -> panic "non-theory type" | (levelOf a).mlevel == Set = do let gt = Leaf (Fun (toList sc.names) (toList sc.ctx) (readb sc.len a)) let v = V.tableLookup (TableName sc.realm p) (fromList $ zip (toList sc.names) (toList sc.bound)) a diff --git a/packages/coln-compiler/src/Coln/Core/Params.hs b/packages/coln-compiler/src/Coln/Core/Params.hs index fb3023a6..4fab4e1a 100644 --- a/packages/coln-compiler/src/Coln/Core/Params.hs +++ b/packages/coln-compiler/src/Coln/Core/Params.hs @@ -189,3 +189,6 @@ instance DPretty TableName where data Mode = Inductive | Conjunctive deriving (Show, Eq, Ord) + +instance DPretty Mode where + dpretty = pretty . show diff --git a/packages/coln-compiler/src/Coln/Core/Print.hs b/packages/coln-compiler/src/Coln/Core/Print.hs index 365df236..fc8b93d2 100644 --- a/packages/coln-compiler/src/Coln/Core/Print.hs +++ b/packages/coln-compiler/src/Coln/Core/Print.hs @@ -55,6 +55,7 @@ instance ToNotation (El e) where N.Tuple [field y t | (y, t) <- toList d] () where field y t = N.Infix (N.Ident y ()) (N.Keyword ":=" ()) (toNotation xs t) + Init t -> N.Juxt (N.Keyword "init" ()) (toNotation xs t) Lit (LitInt i) -> N.Int i () Lit (LitString s) -> N.String s () Is t -> toNotation xs t -- invisible diff --git a/packages/coln-compiler/src/Coln/Core/Readback.hs b/packages/coln-compiler/src/Coln/Core/Readback.hs index 42953090..b5a0273b 100644 --- a/packages/coln-compiler/src/Coln/Core/Readback.hs +++ b/packages/coln-compiler/src/Coln/Core/Readback.hs @@ -52,6 +52,7 @@ instance (V.HasEvaluation c) => Readback (V.El c) (S.El c) where V.Cons d -> S.Cons $ case V.scase @c of SNominative -> readb n <$> d SDescriptive -> readb n <$> d + V.Init a sp -> readb n sp $ S.Init (readb n a) V.Lit l -> S.Lit l instance Readback V.FunctionType (S.FunctionType S.Ty) where diff --git a/packages/coln-compiler/src/Coln/Core/Syntax.hs b/packages/coln-compiler/src/Coln/Core/Syntax.hs index e8dc774e..5c4a3141 100644 --- a/packages/coln-compiler/src/Coln/Core/Syntax.hs +++ b/packages/coln-compiler/src/Coln/Core/Syntax.hs @@ -23,6 +23,7 @@ data El :: Case -> Type where App :: El N -> El N -> El N Cons :: Dict (El c) -> El c Proj :: El N -> Name -> El N + Init :: Ty N -> El D Lit :: Literal -> El N Is :: El N -> El D Lookup :: TableName -> Dict (El N) -> Ty N -> El N diff --git a/packages/coln-compiler/src/Coln/Core/Value.hs b/packages/coln-compiler/src/Coln/Core/Value.hs index 5fc0ffee..be25d7af 100644 --- a/packages/coln-compiler/src/Coln/Core/Value.hs +++ b/packages/coln-compiler/src/Coln/Core/Value.hs @@ -157,6 +157,7 @@ data El :: Case -> Type where Code :: Ty c -> El c Lam :: ~(Ty N) -> Clo El c -> El c Cons :: Dict (Evaluation El c) -> El c + Init :: Ty N -> Spine -> El D Lit :: Literal -> El N app :: El c -> El N -> Evaluation El c @@ -190,6 +191,11 @@ data RecordType = RecordType , fieldTypes :: Dict (Locals -> Ty N) } +data InductiveType = InductiveType + { initialOf :: Ty N + , spine :: Spine + } + data EqualityType = EqualityType { at :: Ty N , lhs :: El N @@ -208,6 +214,7 @@ data Ty :: Case -> Type where Decode :: DecodedNeutral -> Ty N Function :: FunctionType -> Ty N Record :: RecordType -> Ty D + Ind :: InductiveType -> Ty D Eq :: EqualityType -> Ty N BuiltinTy :: BuiltinTy -> Ty N EltOf :: TableName -> Dict (El N) -> Ty N @@ -218,6 +225,7 @@ instance DebugVal (Ty c) where Decode _ -> "Decode" Function _ -> "Function" Record _ -> "Record" + Ind _ -> "Inductive" Eq _ -> "Eq" BuiltinTy _ -> "BuiltinTy" EltOf _ _ -> "EltOf" @@ -228,6 +236,7 @@ instance LevelOf (Ty c) where Decode n -> decodesInto n.universe Function ft -> levelOf ft.variant Record rt -> rt.level + Ind _ -> Level Set HSet Eq ety -> Level (levelOf ety.at).mlevel (equalityHLevelOf (levelOf ety.at).hlevel) BuiltinTy _ -> Level Set HSet -- Only Int/String so far EltOf _ _ -> Level Set HSet -- TODO @@ -236,10 +245,11 @@ behavior :: Ty c -> TypeBehavior behavior = \case U u -> LikeU u Decode n -> case n.description of - Just (Record rt) -> LikeRecord rt + Just t -> behavior t Nothing -> NoRules Function ft -> LikeFunction ft Record rt -> LikeRecord rt + Ind it -> LikeInductive it Eq _ -> NoRules BuiltinTy bty -> LikeBuiltinTy bty EltOf _ _ -> NoRules @@ -255,6 +265,7 @@ decode (Neu n) = do Just (Describe desc) -> k (Just desc) Just (Become ty) -> ty Nothing -> k Nothing +decode (Init a sp) = Describe $ Ind $ InductiveType a sp decode _ = panic "ill-typed decoding" -- Type behavior @@ -264,6 +275,7 @@ data TypeBehavior = LikeU Universe | LikeFunction FunctionType | LikeRecord RecordType + | LikeInductive InductiveType | LikeBuiltinTy BuiltinTy | NoRules @@ -272,6 +284,7 @@ instance DebugVal TypeBehavior where LikeU _ -> "LikeU" LikeFunction _ -> "LikeFunction" LikeRecord _ -> "LikeRecord" + LikeInductive _ -> "LikeInductive" LikeBuiltinTy _ -> "LikeBuiltinTy" NoRules -> "NoRules" diff --git a/packages/coln-compiler/src/Coln/Elaborator/Diagnostics.hs b/packages/coln-compiler/src/Coln/Elaborator/Diagnostics.hs index dc47885b..5e0e18e5 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Diagnostics.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Diagnostics.hs @@ -29,6 +29,7 @@ data ElaboratorCode | MismatchedRecordField | VariableNotInScope | DebugMisc + | InductiveInConjunctive deriving (Eq, Ord) elaboratorCodeTable :: Map ElaboratorCode CodeMeta @@ -50,4 +51,5 @@ elaboratorCodeTable = , (MismatchedRecordField, CodeMeta 13 SError Nothing) , (VariableNotInScope, CodeMeta 14 SError Nothing) , (DebugMisc, CodeMeta 15 SDebug Nothing) + , (InductiveInConjunctive, CodeMeta 16 SDebug Nothing) ] diff --git a/packages/coln-compiler/src/Coln/Elaborator/Environment.hs b/packages/coln-compiler/src/Coln/Elaborator/Environment.hs index 2f5508ce..9264fde7 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Environment.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Environment.hs @@ -5,7 +5,7 @@ module Coln.Elaborator.Environment where import Coln.Common -import Coln.Core +import Coln.Core hiding (GlobalEntry (..)) import Coln.Core.Value qualified as BN (BareNeutral (..)) import Coln.Core.Value qualified as V import Coln.Elaborator.Diagnostics @@ -17,48 +17,57 @@ data Scope = Scope { len :: Int , names :: Bwd Name , locals :: V.Locals - , ctx :: Bwd (V.Ty N) + , ctx :: Bwd (V.Ty N, Mode) + , mode :: Mode } -emptyScope :: Scope +lock :: Scope -> Scope +lock sc = sc { mode = Conjunctive, ctx = fmap (\(a, _) -> (a, Inductive)) sc.ctx } + +unlock :: Scope -> Scope +unlock sc = sc { mode = Inductive } + +emptyScope :: Mode -> Scope emptyScope = Scope 0 BwdNil V.LNil BwdNil instance HasShape Scope where shape :: Scope -> CtxShape shape c = CtxShape c.len c.names -bind :: Name -> V.Ty N -> Scope -> Scope -bind x a c = do +bind :: Name -> V.Ty N -> Mode -> Scope -> Scope +bind x a m c = do let v = V.local (FId c.len) a - let_ x v a c + let_ x v a m c -let_ :: Name -> V.El N -> V.Ty N -> Scope -> Scope -let_ x v a c = +let_ :: Name -> V.El N -> V.Ty N -> Mode -> Scope -> Scope +let_ x v a m c = Scope (c.len + 1) (c.names :> x) (V.LSnoc c.locals v) - (c.ctx :> a) + (c.ctx :> (a, m)) + c.mode -withBound :: Name -> V.Ty N -> Scope -> (V.El N -> Scope -> a) -> a -withBound x a c body = do +withBound :: Name -> V.Ty N -> Mode -> Scope -> (V.El N -> Scope -> a) -> a +withBound x a m c body = do let v = V.local (FId c.len) a - let c' = let_ x v a c + let c' = let_ x v a m c body v c' -instance Lookup Scope Name (BId, V.El N, V.Ty N) where +instance Lookup Scope Name (BId, V.El N, V.Ty N, Mode) where lookup sc x = go sc.len sc.len sc.names sc.locals sc.ctx 0 where + go :: Int -> Int -> Bwd Name -> V.Locals -> Bwd (V.Ty N, Mode) -> Int -> Maybe (BId, V.El N, V.Ty N, Mode) go 0 0 BwdNil V.LNil BwdNil _ = Nothing go 0 0 BwdNil (V.LSnocChunk vs chunk) BwdNil i | Vector.length chunk == 0 = go 0 0 BwdNil vs BwdNil i - go n _ (xs :> x') (V.LSnoc vs v) (ts :> t) i - | x' == x = Just (BId i, v, t) + go n _ (xs :> x') (V.LSnoc vs v) (ts :> (t, m)) i + | x' == x = Just (BId i, v, t, m) | otherwise = go (n - 1) (n - 1) xs vs ts (i + 1) - go n m xs@(xs' :> x') vs@(V.LSnocChunk vs' chunk) ts@(ts' :> t) i - | m - n == Vector.length chunk = go n n xs vs' ts i - | x' == x = Just (BId i, chunk Vector.! (Vector.length chunk + n - m - 1), t) - | otherwise = go n m xs' vs ts' (i + 1) + go n n' xs@(xs' :> x') vs@(V.LSnocChunk vs' chunk) ts@(ts' :> (t, m)) i + | n' - n == Vector.length chunk = go n n xs vs' ts i + | x' == x = Just (BId i, chunk Vector.! (Vector.length chunk + n - n' - 1), t, m) + | otherwise = go n n' xs' vs ts' (i + 1) go _ _ _ _ _ _ = panic "misaligned local variable details" -- * Target @@ -91,21 +100,21 @@ data ElabEnv c = ElabEnv instance HasShape (ElabEnv c) where shape e = shape e.scope -emptyElabEnvFor :: DiagnosticEnv ElaboratorCode -> Globals -> Name -> V.Ty N -> ElabEnv D -emptyElabEnvFor diagEnv globals x ty = do +emptyElabEnvFor :: DiagnosticEnv ElaboratorCode -> Globals -> Mode -> Name -> V.Ty N -> ElabEnv D +emptyElabEnvFor diagEnv globals m x ty = do let v = V.reflect (V.GlobalVar x v) V.Id ty Nothing ElabEnv { target = (TargetNamed (V.BareNeutral (V.GlobalVar x v) V.Id)) - , scope = emptyScope + , scope = emptyScope m , globals = globals , diagEnv = diagEnv } -emptyElabEnv :: DiagnosticEnv ElaboratorCode -> Globals -> ElabEnv N -emptyElabEnv diagEnv globals = +emptyElabEnv :: DiagnosticEnv ElaboratorCode -> Globals -> Mode -> ElabEnv N +emptyElabEnv diagEnv globals m = ElabEnv { target = TargetAnonymous - , scope = emptyScope + , scope = emptyScope m , globals = globals , diagEnv = diagEnv } diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs index 16945f76..f0a57daa 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs @@ -22,13 +22,13 @@ data Binder = Anonymous (Typ N) | Named Name (Typ N) formation :: Span -> Binder -> Typ N -> Typ N formation sp (Anonymous dom) cod = Typ \e -> do - edom <- dom.elab e + edom <- dom.elab (e { scope = unlock e.scope }) ecod <- cod.elab e v <- variantFor edom ecod sp e pure $ function e.scope.locals v edom (S.AbsConst ecod) formation sp (Named x dom) cod = Typ \e -> do - edom <- dom.elab e - ecod <- cod.elab $ e{scope = bind x edom.val e.scope} + edom <- dom.elab (e { scope = unlock e.scope }) + ecod <- cod.elab $ e{scope = bind x edom.val Inductive e.scope} v <- variantFor edom ecod sp e pure $ function e.scope.locals v edom (S.Abs x ecod) @@ -36,7 +36,7 @@ intro :: (V.HasEvaluation c) => Span -> Name -> Chk c -> Chk c intro sp x body = Chk \e a -> case V.behavior a of V.LikeFunction ft -> do - ebody <- withBound x ft.dom e.scope $ \v scope' -> + ebody <- withBound x ft.dom Inductive e.scope $ \v scope' -> body.elab (e{scope = scope', target = appTarget e.target v}) (V.appClo ft.cod v) @@ -50,7 +50,7 @@ elim sp callee arg = Syn $ \e -> do (ty, ecallee) <- callee.elab e case V.behavior ty of V.LikeFunction ft -> do - earg <- arg.elab e ft.dom + earg <- arg.elab (e { scope = unlock e.scope }) ft.dom pure (V.appClo ft.cod earg.val, app ecallee earg) _ -> do let msg = "tried to apply a value that was not of a function type" diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs new file mode 100644 index 00000000..45c875b0 --- /dev/null +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs @@ -0,0 +1,13 @@ +module Coln.Elaborator.Rules.Initial where + +import Coln.Common +import Coln.Core +import Coln.Elaborator.Diagnostics +import Coln.Elaborator.Environment +import Coln.Elaborator.Judgment + +create :: Typ N -> Syn D +create t = Syn \e -> do + a <- t.elab (e { scope = lock e.scope }) + pure (a, init a) + diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Record.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Record.hs index c0af41ba..b51501b8 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Rules/Record.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Record.hs @@ -22,7 +22,7 @@ formation fieldTyps = Typ $ \e -> do let go _ [] = pure (Level Set HUnit, []) go e' ((FieldDeclaration x typ) : rest) = do ty <- typ.elab e' - (l, fieldTys) <- go (e'{scope = bind x ty.val e'.scope}) rest + (l, fieldTys) <- go (e'{scope = bind x ty.val Conjunctive e'.scope}) rest pure (maxLevel l (levelOf ty), (x, ty) : fieldTys) go e' ((FieldDeclarationDebug ds) : rest) = do runDebug e' ds diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Variable.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Variable.hs index 300e1fd5..c287beab 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Rules/Variable.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Variable.hs @@ -14,11 +14,16 @@ import Coln.Elaborator.Environment import Coln.Elaborator.Judgment find :: Span -> Name -> Syn N -find sp x = Syn \e -> - case lookup e.scope x of - Just (i, v, ty) -> pure (ty, localVar i v) +find sp x = Syn \e -> do + (ty, tm, m) <- case lookup e.scope x of + Just (i, v, ty, m) -> pure (ty, localVar i v, m) Nothing -> case lookup e.globals x of - Just ge -> pure (ge.ty, globalVar x ge.val) + Just ge -> pure (ge.ty, globalVar x ge.val, ge.mode) Nothing -> do let msg = "no such variable" <+> dpretty x <+> "in scope" failWith e.diagEnv sp VariableNotInScope msg + case (m, e.scope.mode) of + (Inductive, Conjunctive) -> do + let msg = "cannot use inductively bound variable in a conjunctive context" + failWith e.diagEnv sp InductiveInConjunctive msg + _ -> pure (ty, tm) diff --git a/packages/coln-compiler/src/Coln/Frontend/Diagnostics.hs b/packages/coln-compiler/src/Coln/Frontend/Diagnostics.hs index 095e484b..82943f55 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Diagnostics.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Diagnostics.hs @@ -14,6 +14,7 @@ data ParserCode | UnexpectedField | UnexpectedDescriptive | UnknownCommand + | UnknownModifiers deriving (Eq, Ord) parserCodeTable :: Map ParserCode CodeMeta @@ -25,4 +26,5 @@ parserCodeTable = , (UnexpectedField, CodeMeta 3 SError Nothing) , (UnexpectedDescriptive, CodeMeta 4 SError Nothing) , (UnknownCommand, CodeMeta 5 SError Nothing) + , (UnknownModifiers, CodeMeta 6 SError Nothing) ] diff --git a/packages/coln-compiler/src/Coln/Frontend/Notation.hs b/packages/coln-compiler/src/Coln/Frontend/Notation.hs index 86a9b646..41d9d6d8 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Notation.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Notation.hs @@ -22,6 +22,7 @@ lexConfig = , ("showtype", K.Decl) , ("showlevel", K.Decl) , ("expand", K.Decl) + , ("ind", K.Modifier) , ("end", K.End) , ("Set", K.AKeyword) , ("Prop", K.AKeyword) diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs index b9e0fbe6..2aa77df2 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs @@ -6,6 +6,7 @@ import Data.Functor.Contravariant (contramap) import Data.List.NonEmpty (NonEmpty (..)) import FNotation (Ntn) import FNotation qualified as N +import Prettyprinter import Coln.Common import Coln.Core @@ -18,6 +19,7 @@ import Coln.Elaborator.Judgment import Coln.Elaborator.Rules.Function qualified as Function import Coln.Frontend.Parser.Expr import Coln.Frontend.Notation +import Coln.Frontend.Diagnostics definition :: ParserEnv -> Ntn -> IO (Ntn, Ntn) definition _ (N.Infix n0 (N.Keyword ":=" _) n1) = pure (n0, n1) @@ -67,14 +69,14 @@ def e n = do let (ty, tm) = withArgs args (returnTyp, body) pure (name, ty, tm) -elabEntry :: DiagnosticEnv ElaboratorCode -> Globals -> (Name, Typ N, Chk D) -> IO GlobalEntry -elabEntry e g (x, ty, tm) = do - let tyE = emptyElabEnv e g +elabEntry :: DiagnosticEnv ElaboratorCode -> Globals -> Mode -> (Name, Typ N, Chk D) -> IO GlobalEntry +elabEntry e g m (x, ty, tm) = do + let tyE = emptyElabEnv e g m a <- ty.elab tyE - let tmE = emptyElabEnvFor e g x a.val + let tmE = emptyElabEnvFor e g m x a.val t <- tm.elab tmE a.val let v = V.reflect (V.GlobalVar x v) V.Id a.val (Just t.val) - let entry = GlobalEntry t.stx v a.val Conjunctive + let entry = GlobalEntry t.stx v a.val m pure entry realmHead :: ParserEnv -> Ntn -> IO (Name, Ntn) @@ -85,18 +87,27 @@ realm :: DiagnosticEnv ColnCode -> Globals -> Ntn -> [Ntn] -> IO (Name, Realm) realm e g head _defs = do (x, theory_n) <- realmHead (contramap ParserCode e) head theory_typ <- typ (contramap ParserCode e) theory_n - theory <- theory_typ.elab (emptyElabEnv (contramap ElaboratorCode e) g) + theory <- theory_typ.elab (emptyElabEnv (contramap ElaboratorCode e) g Inductive) let (gt, root) = layoutTop x theory.val pure (x, Realm gt root.val theory.val) +mode :: ParserEnv -> Span -> [Name] -> IO Mode +mode _ _ [] = pure Conjunctive +mode _ _ ["ind"] = pure Inductive +mode e sp ms = do + let msg = "unknown modifiers" <+> hsep (dpretty <$> ms) + failWith e sp UnknownModifiers msg + decl :: DiagnosticEnv ColnCode -> Globals -> Ntn -> IO Globals -decl e g (N.Decl "theory" n _) = do +decl e g (N.MDecl ms "theory" n sp) = do + m <- mode (contramap ParserCode e) sp ms (x, t, c) <- theory (contramap ParserCode e) n - ge <- elabEntry (contramap ElaboratorCode e) g (x, t, c) + ge <- elabEntry (contramap ElaboratorCode e) g m (x, t, c) pure $ addGlobalEntry x ge g -decl e g (N.Decl "def" n _) = do +decl e g (N.MDecl ms "def" n sp) = do + m <- mode (contramap ParserCode e) sp ms (x, t, c) <- def (contramap ParserCode e) n - ge <- elabEntry (contramap ElaboratorCode e) g (x, t, c) + ge <- elabEntry (contramap ElaboratorCode e) g m (x, t, c) pure $ addGlobalEntry x ge g decl e g (N.Block "realm" (Just head) body _) = do (x, r) <- realm e g head body diff --git a/packages/coln-compiler/test/Main.hs b/packages/coln-compiler/test/Main.hs index aa9e65be..db88e930 100644 --- a/packages/coln-compiler/test/Main.hs +++ b/packages/coln-compiler/test/Main.hs @@ -49,9 +49,10 @@ render :: DDoc -> LBS.ByteString render = TLE.encodeUtf8 . renderLazy . layoutPretty defaultLayoutOptions prettyEntry :: (Name, GlobalEntry) -> DDoc -prettyEntry (x, (GlobalEntry t _ a _)) = +prettyEntry (x, (GlobalEntry t _ a m)) = vsep [ "global entry named" <+> dpretty x + , "in mode:" <+> dpretty m , "type:" <+> prtIn (CtxShape 0 BwdNil) a , "value:" <+> dprettyWithNames mempty t ] diff --git a/packages/coln-compiler/test/golden/ancestor.output b/packages/coln-compiler/test/golden/ancestor.output index 81720679..c02f5cb4 100644 --- a/packages/coln-compiler/test/golden/ancestor.output +++ b/packages/coln-compiler/test/golden/ancestor.output @@ -1,5 +1,6 @@ -- elaborated global entry named Family +in mode: Conjunctive type: Theory value: sig person : Set diff --git a/packages/coln-compiler/test/golden/fb3.output b/packages/coln-compiler/test/golden/fb3.output index 168a03b6..6bcca169 100644 --- a/packages/coln-compiler/test/golden/fb3.output +++ b/packages/coln-compiler/test/golden/fb3.output @@ -1,11 +1,8 @@ -- elaborated -global entry named IdempotentSemigroup -type: Theory -value: sig - Element : Set - mul : (x : Element) -> (y : Element) -> Element - mul/idempotent : (x : Element) -> mul x x = x - mul/assoc : (x : Element) -> (y : Element) -> (z : Element) -> mul (mul x y) z = mul x (mul y z) -end + -- messages + +debug[D0316]: cannot use inductively bound variable in a conjunctive context +7 | mul/idempotent : (x : Element) -> mul x x = x +7 | ^ diff --git a/packages/coln-compiler/test/golden/graph-of-graphs.output b/packages/coln-compiler/test/golden/graph-of-graphs.output index 7c1c670c..324ea75a 100644 --- a/packages/coln-compiler/test/golden/graph-of-graphs.output +++ b/packages/coln-compiler/test/golden/graph-of-graphs.output @@ -1,23 +1,11 @@ -- elaborated global entry named Graph +in mode: Conjunctive type: Theory value: sig V : Set E : V -> V -> Set end -global entry named Graph/hom -type: (G0 : Graph) -> (G1 : Graph) -> Theory -value: G0 => G1 => sig - V : G0.V -> G1.V - E : (v0 : G0.V) -> (v1 : G0.V) -> G0.E v0 v1 -> G1.E (V v0) (V v1) -end -global entry named GraphOfGraphs -type: Theory -value: sig - base : Graph - fiber : base.V -> Graph - action : (v0 : base.V) -> (v1 : base.V) -> base.E v0 v1 -> Graph/hom (fiber v0) (fiber v1) -end realm named GraphRealm generators: node V = rel [] @@ -36,139 +24,17 @@ lowered: flatrealm ] ⊢ a ∈ ℜ.V [] ∧ b ∈ ℜ.V [] end end -realm named GraphOfGraphsRealm -generators: node - base = node - V = rel [] - E = rel [a : GraphOfGraphsRealm.base.V [], b : GraphOfGraphsRealm.base.V []] - end - fiber = node - V = rel [a : GraphOfGraphsRealm.base.V []] - E = rel [ - a : GraphOfGraphsRealm.base.V [], - b : GraphOfGraphsRealm.fiber.V [a := a], - c : GraphOfGraphsRealm.fiber.V [a := a] - ] - end - action = node - V = (fun [ - v0 : GraphOfGraphsRealm.base.V [], - v1 : GraphOfGraphsRealm.base.V [], - a : GraphOfGraphsRealm.base.E [a := v0, b := v1], - b : GraphOfGraphsRealm.fiber.V [a := v0] - ] -> GraphOfGraphsRealm.fiber.V [a := v1]) - E = (fun [ - v0 : GraphOfGraphsRealm.base.V [], - v1 : GraphOfGraphsRealm.base.V [], - a : GraphOfGraphsRealm.base.E [a := v0, b := v1], - v0/a : GraphOfGraphsRealm.fiber.V [a := v0], - v1/a : GraphOfGraphsRealm.fiber.V [a := v0], - b : GraphOfGraphsRealm.fiber.E [a := v0, b := v0/a, c := v1/a] - ] -> GraphOfGraphsRealm.fiber.E [ - a := v1, - b := GraphOfGraphsRealm.action.V [v0 := v0, v1 := v1, a := a, b := v0/a], - c := GraphOfGraphsRealm.action.V [v0 := v0, v1 := v1, a := a, b := v1/a] - ]) - end -end -lowered: flatrealm - entities - table ℜ.base.V := [] - table ℜ.base.E := [.a : ℜ.base.V, .b : ℜ.base.V] - table ℜ.fiber.V := [.a : ℜ.base.V] - table ℜ.fiber.E := [.a : ℜ.base.V, .b : ℜ.fiber.V, .c : ℜ.fiber.V] - table ℜ.action.V := [ - .v0 : ℜ.base.V, - .v1 : ℜ.base.V, - .a : ℜ.base.E, - .b : ℜ.fiber.V, - .c : ℜ.fiber.V - ] primarykey [.a, .b, .v0, .v1] - table ℜ.action.E := [ - .v0 : ℜ.base.V, - .v1 : ℜ.base.V, - .a : ℜ.base.E, - .v0/a : ℜ.fiber.V, - .v1/a : ℜ.fiber.V, - .b : ℜ.fiber.E, - .c : ℜ.fiber.E - ] primarykey [.a, .b, .v0, .v1, .v0/a, .v1/a] - end - rules - enforced ℜ.base.V.foreignKey := ℜ.base.V [] ⊢ ⊤ - enforced ℜ.base.E.foreignKey a b := ℜ.base.E [ - .a ↦ a, - .b ↦ b - ] ⊢ a ∈ ℜ.base.V [] ∧ b ∈ ℜ.base.V [] - enforced ℜ.fiber.V.foreignKey a := ℜ.fiber.V [.a ↦ a] ⊢ a ∈ ℜ.base.V [] - enforced ℜ.fiber.E.foreignKey a b c := ℜ.fiber.E [ - .a ↦ a, - .b ↦ b, - .c ↦ c - ] ⊢ a ∈ ℜ.base.V [] ∧ b ∈ ℜ.fiber.V [.a ↦ a] ∧ c ∈ ℜ.fiber.V [.a ↦ a] - enforced ℜ.action.V.foreignKey v0 v1 a b c := ℜ.action.V [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .b ↦ b, - .c ↦ c - ] ⊢ v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ - .a ↦ v0, - .b ↦ v1 - ] ∧ b ∈ ℜ.fiber.V [.a ↦ v0] ∧ c ∈ ℜ.fiber.V [.a ↦ v1] - monitored ℜ.action.V.total v0 v1 a b := v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ - .a ↦ v0, - .b ↦ v1 - ] ∧ b ∈ ℜ.fiber.V [.a ↦ v0] ⊢ ℜ.action.V [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .b ↦ b - ] - enforced ℜ.action.E.foreignKey v0 v1 a v0/a v1/a b c c.b c.c := ℜ.action.E [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .v0/a ↦ v0/a, - .v1/a ↦ v1/a, - .b ↦ b, - .c ↦ c - ] ∧ ℜ.action.V [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .b ↦ v0/a, - .c ↦ c.b - ] ∧ ℜ.action.V [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .b ↦ v1/a, - .c ↦ c.c - ] ⊢ v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ - .a ↦ v0, - .b ↦ v1 - ] ∧ v0/a ∈ ℜ.fiber.V [.a ↦ v0] ∧ v1/a ∈ ℜ.fiber.V [ - .a ↦ v0 - ] ∧ b ∈ ℜ.fiber.E [.a ↦ v0, .b ↦ v0/a, .c ↦ v1/a] ∧ c ∈ ℜ.fiber.E [ - .a ↦ v1, - .b ↦ c.b, - .c ↦ c.c - ] - monitored ℜ.action.E.total v0 v1 a v0/a v1/a b := v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ - .a ↦ v0, - .b ↦ v1 - ] ∧ v0/a ∈ ℜ.fiber.V [.a ↦ v0] ∧ v1/a ∈ ℜ.fiber.V [ - .a ↦ v0 - ] ∧ b ∈ ℜ.fiber.E [.a ↦ v0, .b ↦ v0/a, .c ↦ v1/a] ⊢ ℜ.action.E [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .v0/a ↦ v0/a, - .v1/a ↦ v1/a, - .b ↦ b - ] - end -end -- messages + +debug[D0316]: cannot use inductively bound variable in a conjunctive context +15 | V : G0.V -> G1.V +15 | ^^ + +error[E0314]: no such variable Graph/hom in scope +22 | action : (v0 : base.V) -> (v1 : base.V) -> base.E v0 v1 -> Graph/hom (fiber v0) (fiber v1) +22 | ^^^^^^^^^ + +error[E0314]: no such variable GraphOfGraphs in scope +25 | realm GraphOfGraphsRealm @ GraphOfGraphs +25 | ^^^^^^^^^^^^^ diff --git a/packages/coln-compiler/test/golden/graph.output b/packages/coln-compiler/test/golden/graph.output index 960be3c5..048dac1b 100644 --- a/packages/coln-compiler/test/golden/graph.output +++ b/packages/coln-compiler/test/golden/graph.output @@ -1,5 +1,6 @@ -- elaborated global entry named Graph +in mode: Conjunctive type: Theory value: sig V : Set diff --git a/packages/coln-compiler/test/golden/hlevel.output b/packages/coln-compiler/test/golden/hlevel.output index 9325a41b..c3f2ded0 100644 --- a/packages/coln-compiler/test/golden/hlevel.output +++ b/packages/coln-compiler/test/golden/hlevel.output @@ -1,18 +1,14 @@ -- elaborated global entry named Family +in mode: Conjunctive type: Theory value: sig person : Set is-parent : person -> person -> Prop happy : Prop end -global entry named Q -type: (F : Family) -> Theory -value: F => sig - son : F.person - father : F.person -end global entry named HP +in mode: Conjunctive type: Theory value: sig person : Set @@ -21,10 +17,12 @@ value: sig reveal : voldemort = tomriddle end global entry named Unit +in mode: Conjunctive type: Prop value: sig end global entry named P +in mode: Conjunctive type: Theory value: sig u : Unit @@ -60,13 +58,9 @@ debug[D0315]: type person -> happy has level Level {mlevel = Theory, hlevel = HP 13 | showlevel person -> happy 13 | ^^^^^^^^^^^^^^^ -debug[D0315]: value F.is-parent has type F.person -> F.person -> Prop -20 | showtype F.is-parent -20 | ^^^^^^^^^^^ - -debug[D0315]: value F.is-parent father son has type Prop -21 | showtype F.is-parent father son -21 | ^^^^^^^^^^^^^^^^^^^^^^ +debug[D0316]: cannot use inductively bound variable in a conjunctive context +17 | son : F.person +17 | ^ debug[D0315]: type voldemort = tomriddle has level Level {mlevel = Set, hlevel = HProp} 31 | showlevel voldemort = tomriddle @@ -96,15 +90,6 @@ debug[D0315]: type u = u has level Level {mlevel = Set, hlevel = HUnit} 48 | showlevel u = u 48 | ^^^^^ -error[E0307]: type sig - f : A -> P - a : A -end too large for universe Set -51 | def LevelJoinRecordIsNotSet (A : Set) (P : Prop) : Set := sig -51 | ^^^ +debug[D0316]: cannot use inductively bound variable in a conjunctive context 52 | f : A -> P -52 | ^^^^^^^^^^^^ -53 | a : A -53 | ^^^^^^^ -54 | end -54 | ^^^ +52 | ^ diff --git a/packages/coln-compiler/test/golden/ind.coln b/packages/coln-compiler/test/golden/ind.coln new file mode 100644 index 00000000..e789ba46 --- /dev/null +++ b/packages/coln-compiler/test/golden/ind.coln @@ -0,0 +1,18 @@ +ind theory T := Set + +theory Graph := sig + v : Set + e : v -> v -> Prop +end + +theory TransitiveExt (G : Graph) := sig + p : G.v -> G.v -> Prop + incl : (v0 : G.v) -> (v1 : G.v) -> G.e v0 v1 -> p v0 v1 + snoc : (v0 : G.v) -> (v1 : G.v) -> (v2 : G.v) -> p v0 v1 -> G.e v1 v2 -> p v0 v2 +end + +theory Point (X : Set) := X + +# ind def transitive-closure (G : Graph) := init (TransitiveExt G) + +theory S := T diff --git a/packages/coln-compiler/test/golden/ind.output b/packages/coln-compiler/test/golden/ind.output new file mode 100644 index 00000000..0180b131 --- /dev/null +++ b/packages/coln-compiler/test/golden/ind.output @@ -0,0 +1,30 @@ +-- elaborated +global entry named T +in mode: Inductive +type: Theory +value: Set +global entry named Graph +in mode: Conjunctive +type: Theory +value: sig + v : Set + e : v -> v -> Prop +end +global entry named TransitiveExt +in mode: Conjunctive +type: (G : Graph) -> Theory +value: G => sig + p : G.v -> G.v -> Prop + incl : (v0 : G.v) -> (v1 : G.v) -> G.e v0 v1 -> p v0 v1 + snoc : (v0 : G.v) -> (v1 : G.v) -> (v2 : G.v) -> p v0 v1 -> G.e v1 v2 -> p v0 v2 +end + +-- messages + +debug[D0316]: cannot use inductively bound variable in a conjunctive context +14 | theory Point (X : Set) := X +14 | ^ + +debug[D0316]: cannot use inductively bound variable in a conjunctive context +18 | theory S := T +18 | ^ diff --git a/packages/coln-compiler/test/golden/lambda.output b/packages/coln-compiler/test/golden/lambda.output index 3a944b8a..3521afb3 100644 --- a/packages/coln-compiler/test/golden/lambda.output +++ b/packages/coln-compiler/test/golden/lambda.output @@ -1,5 +1,6 @@ -- elaborated global entry named Lambda +in mode: Conjunctive type: Theory value: sig con : Set diff --git a/packages/coln-compiler/test/golden/magma.output b/packages/coln-compiler/test/golden/magma.output index 5f8fc089..273ebd56 100644 --- a/packages/coln-compiler/test/golden/magma.output +++ b/packages/coln-compiler/test/golden/magma.output @@ -1,5 +1,6 @@ -- elaborated global entry named Magma +in mode: Conjunctive type: Theory value: sig car : Set diff --git a/packages/coln-compiler/test/golden/modular-lattice.output b/packages/coln-compiler/test/golden/modular-lattice.output index add4021f..6e3f73e3 100644 --- a/packages/coln-compiler/test/golden/modular-lattice.output +++ b/packages/coln-compiler/test/golden/modular-lattice.output @@ -1,23 +1,12 @@ -- elaborated -global entry named ModularLattice -type: Theory -value: sig - Element : Set - meet : Element -> Element -> Element - meet/associative : (a : Element) -> (b : Element) -> (c : Element) -> meet (meet a b) c = meet a (meet b c) - meet/commutative : (a : Element) -> (b : Element) -> meet a b = meet b a - meet/idempotent : (a : Element) -> meet a a = a - join : Element -> Element -> Element - join/associative : (a : Element) -> (b : Element) -> (c : Element) -> join (join a b) c = join a (join b c) - join/associative : (a : Element) -> (b : Element) -> join a b = join b a - join/idempotent : (a : Element) -> join a a = a - ax/absorptive1 : (a : Element) -> (b : Element) -> meet a (join a b) = a - ax/absorptive2 : (a : Element) -> (b : Element) -> join a (meet a b) = a - ax/modular : (a : Element) -> (b : Element) -> (x : Element) -> join (meet a b) (meet x b) = meet (join (meet a b) x) b -end + -- messages +debug[D0316]: cannot use inductively bound variable in a conjunctive context +17 | meet a a = a +17 | ^ + error[E0200]: unexpected notation for field setting of the form ` := `: Infix 49 | bot : Element 49 | ^^^^^^^^^^^^^ diff --git a/packages/coln-compiler/test/golden/monoid-glog.output b/packages/coln-compiler/test/golden/monoid-glog.output index 808c3322..124560e1 100644 --- a/packages/coln-compiler/test/golden/monoid-glog.output +++ b/packages/coln-compiler/test/golden/monoid-glog.output @@ -1,13 +1,8 @@ -- elaborated -global entry named Monoid -type: Theory -value: sig - car : Set - unit : car - mul : car -> car -> car - mul/unitl : (x : car) -> mul unit x = x - mul/unitr : (x : car) -> mul x unit = x - mul/assoc : (x : car) -> (y : car) -> (z : car) -> mul (mul x y) z = mul x (mul y z) -end + -- messages + +debug[D0316]: cannot use inductively bound variable in a conjunctive context +6 | mul/unitl : (x : car) -> mul unit x = x +6 | ^ diff --git a/packages/coln-compiler/test/golden/nominal.output b/packages/coln-compiler/test/golden/nominal.output index 9ef78e08..cc083644 100644 --- a/packages/coln-compiler/test/golden/nominal.output +++ b/packages/coln-compiler/test/golden/nominal.output @@ -1,13 +1,16 @@ -- elaborated global entry named A +in mode: Conjunctive type: Theory value: sig end global entry named B +in mode: Conjunctive type: Theory value: sig end global entry named a +in mode: Conjunctive type: A value: [] diff --git a/packages/coln-compiler/test/golden/paths.coln b/packages/coln-compiler/test/golden/paths.coln index 75c44239..d5fb01ec 100644 --- a/packages/coln-compiler/test/golden/paths.coln +++ b/packages/coln-compiler/test/golden/paths.coln @@ -16,6 +16,8 @@ theory Reachability/motive (G : Graph) := sig ) end + + realm Graph @ Graph ind def reachability : Reachability/motive self := init (Reachability/motive self) end diff --git a/packages/coln-compiler/test/golden/paths.output b/packages/coln-compiler/test/golden/paths.output index a3ee8f95..24701861 100644 --- a/packages/coln-compiler/test/golden/paths.output +++ b/packages/coln-compiler/test/golden/paths.output @@ -1,26 +1,36 @@ -- elaborated global entry named Graph +in mode: Conjunctive type: Theory value: sig V : Set E : V -> V -> Prop end global entry named Reachability/motive +in mode: Conjunctive type: (G : Graph) -> Theory value: G => sig t : G.V -> G.V -> Prop empty : (x : G.V) -> t x x cons : (x : G.V) -> (y : G.V) -> (z : G.V) -> (e : G.E x y) -> t y z -> t x z end +realm named Graph +generators: node + V = rel [] + E = rel [a : Graph.V [], b : Graph.V []] +end +lowered: flatrealm + entities + table ℜ.V := [] + table ℜ.E := [.a : ℜ.V, .b : ℜ.V] + end + rules + enforced ℜ.V.foreignKey := ℜ.V [] ⊢ ⊤ + enforced ℜ.E.foreignKey a b := ℜ.E [ + .a ↦ a, + .b ↦ b + ] ⊢ a ∈ ℜ.V [] ∧ b ∈ ℜ.V [] + end +end -- messages - -error[E0104]: expected a newline, end, or eof after a statement -20 | ind def reachability : Reachability/motive self := init (Reachability/motive self) -20 | ^^^ - -error[E0200]: unexpected notation for top-level declaration: Infix -19 | realm Graph @ Graph -19 | ^^^^^^^^^^^^^^^^^^^ -20 | ind def reachability : Reachability/motive self := init (Reachability/motive self) -20 | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/packages/coln-compiler/test/golden/ssa.output b/packages/coln-compiler/test/golden/ssa.output index 46a54dae..c5037aa2 100644 --- a/packages/coln-compiler/test/golden/ssa.output +++ b/packages/coln-compiler/test/golden/ssa.output @@ -1,69 +1,39 @@ -- elaborated -global entry named IsTransClosure -type: (X : Set) -> (R : X -> X -> Set) -> (P : X -> X -> Set) -> Theory -value: X => R => P => sig - refl : (x : X) -> P x x - snoc : (x : X) -> (y : X) -> (z : X) -> P x y -> R y z -> P x z -end -global entry named LinearOrder -type: Theory -value: sig - car : Set - first : car - last : car - next : car -> car - prev : car -> car - next/prev : (x : car) -> next (prev x) = x - prev/next : (x : car) -> prev (next x) = x - follows : car -> car -> Set - follows/is-trans-closure : IsTransClosure car (x => y => next x = y) follows - acyclic : (x : car) -> (y : car) -> follows x y -> follows y x -> x = y - first-is-top : (x : car) -> follows first x - last-is-bot : (x : car) -> follows x last -end global entry named OpInfo +in mode: Conjunctive type: Theory value: sig OpType : Set inputArity : OpType -> Set outputArity : OpType -> Set end -global entry named Iso -type: (A : Set) -> (B : Set) -> Theory -value: A => B => sig - fwd : A -> B - bwd : B -> A - fwd/bwd : (a : A) -> bwd (fwd a) = a - bwd/fwd : (b : B) -> fwd (bwd b) = b -end -global entry named Operation -type: (opInfo : OpInfo) -> (val : Set) -> (outputs : Set) -> Theory -value: opInfo => val => outputs => sig - opType : opInfo.OpType - opInputs : opInfo.inputArity opType -> val - opOutputs : Iso outputs (opInfo.outputArity opType) -end -global entry named PrecedingOutput -type: (X : Set) -> (rel : X -> X -> Set) -> (x : X) -> (outputs : X -> Set) -> Set -value: X => rel => x => outputs => sig - y : X - isPreceding : rel y x - output : outputs y -end -global entry named Block -type: (opInfo : OpInfo) -> Theory -value: opInfo => sig - ops : LinearOrder - outputs : ops.car -> Set - payload : (x : ops.car) -> Operation opInfo (PrecedingOutput ops.car ops.follows x outputs) (outputs x) - args : LinearOrder -end -global entry named SSA -type: (opInfo : OpInfo) -> Theory -value: opInfo => sig - RegionId : Set - BlockId : RegionId -> Set - ops : (r : RegionId) -> BlockId r -> Block opInfo -end -- messages + +debug[D0316]: cannot use inductively bound variable in a conjunctive context +2 | refl : (x : X) -> P x x +2 | ^ + +debug[D0316]: cannot use inductively bound variable in a conjunctive context +13 | next/prev : (x : car) -> next (prev x) = x +13 | ^ + +debug[D0316]: cannot use inductively bound variable in a conjunctive context +32 | fwd : A -> B +32 | ^ + +debug[D0316]: cannot use inductively bound variable in a conjunctive context +39 | opType : opInfo.OpType +39 | ^^^^^^ + +debug[D0316]: cannot use inductively bound variable in a conjunctive context +45 | y : X +45 | ^ + +error[E0314]: no such variable LinearOrder in scope +51 | ops : LinearOrder +51 | ^^^^^^^^^^^ + +error[E0314]: no such variable Block in scope +65 | ops : (r : RegionId) -> BlockId r -> Block opInfo +65 | ^^^^^ From 0b813f08156b8535d512d1a6daec803a072a4157 Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Tue, 21 Jul 2026 08:26:48 -0400 Subject: [PATCH 03/13] init working! --- packages/coln-compiler/coln-compiler.cabal | 1 + .../coln-compiler/src/Coln/Backend/Lower.hs | 2 ++ .../src/Coln/Backend/TypeScript/Generate.hs | 2 ++ .../coln-compiler/src/Coln/Core/Conversion.hs | 6 ++++ .../coln-compiler/src/Coln/Core/Evaluation.hs | 2 +- .../coln-compiler/src/Coln/Core/Memoed.hs | 5 +++ packages/coln-compiler/src/Coln/Core/Print.hs | 1 + .../coln-compiler/src/Coln/Core/Readback.hs | 6 +++- .../coln-compiler/src/Coln/Core/Syntax.hs | 1 + packages/coln-compiler/src/Coln/Core/Value.hs | 33 +++++++++++++++---- .../src/Coln/Elaborator/Rules/Initial.hs | 8 ++--- .../src/Coln/Frontend/Parser/Expr.hs | 11 +++++++ packages/coln-compiler/test/golden/ind.coln | 6 ++-- 13 files changed, 67 insertions(+), 17 deletions(-) diff --git a/packages/coln-compiler/coln-compiler.cabal b/packages/coln-compiler/coln-compiler.cabal index ca6b8ffb..7fb85c72 100644 --- a/packages/coln-compiler/coln-compiler.cabal +++ b/packages/coln-compiler/coln-compiler.cabal @@ -38,6 +38,7 @@ library Coln.Elaborator.Rules.Builtin Coln.Elaborator.Rules.Equality Coln.Elaborator.Rules.Function + Coln.Elaborator.Rules.Initial Coln.Elaborator.Rules.Record Coln.Elaborator.Rules.Polarity Coln.Elaborator.Rules.Universe diff --git a/packages/coln-compiler/src/Coln/Backend/Lower.hs b/packages/coln-compiler/src/Coln/Backend/Lower.hs index 4dceb3fa..df1ebdfd 100644 --- a/packages/coln-compiler/src/Coln/Backend/Lower.hs +++ b/packages/coln-compiler/src/Coln/Backend/Lower.hs @@ -73,6 +73,7 @@ instance Lower (V.El N) Term where lower :: CtxLen -> V.El N -> Term lower n = \case V.Neu ne -> lower n ne + V.InitNeu _ -> panic "can't lower init yet" V.Code _ -> panic "non set-level term" V.Lam _ _ -> panic "non set-level term" V.Cons ds -> Cons (lower n <$> ds) @@ -99,6 +100,7 @@ separate n = \case let (shapes, props) = unzip $ go rt.capture (toList rt.fieldTypes) Ty (Tuple (withHead rt.fieldTypes shapes)) (And (withHead rt.fieldTypes props)) Nothing -> panic "lowering neutral type" + V.InitDecode _ -> panic "can't lower init yet" V.Function _ -> panic "lowering non-set-level type: Function" V.Eq et -> \_ -> Ty Unit (Equal (lower n et.lhs) (lower n et.rhs)) V.BuiltinTy t -> \_ -> Ty (BuiltinTy t) PTrue diff --git a/packages/coln-compiler/src/Coln/Backend/TypeScript/Generate.hs b/packages/coln-compiler/src/Coln/Backend/TypeScript/Generate.hs index 3c86fcb5..ab2a4451 100644 --- a/packages/coln-compiler/src/Coln/Backend/TypeScript/Generate.hs +++ b/packages/coln-compiler/src/Coln/Backend/TypeScript/Generate.hs @@ -117,6 +117,7 @@ genEntryModule imports a ev = go 0 a ev case V.ebind V.decode ev' of V.Become a -> TS.DTypeDef $ genTypeDef access n a V.Describe a -> TS.DInterface $ genInterface access n a + V.BecomeWith _ -> panic "can't lower becomewith yet" Just $ TS.Module imports (TS.Exported <$> definitions) go n (V.Function ft) ev' = do let v = V.local (FId n) ft.dom @@ -172,6 +173,7 @@ argName _ (V.CloConst _) = panic "closures from the layout process should have a genEl :: Access -> TSCtxShape -> V.El N -> TS.El genEl access cs = \case V.Neu n -> genSp cs n.spine $ genHead access cs n.head + V.InitNeu _ -> panic "can't lower init yet" V.Code a -> genTyVal access cs a V.Lam dom clo -> do let v = V.local (FId cs.len) dom diff --git a/packages/coln-compiler/src/Coln/Core/Conversion.hs b/packages/coln-compiler/src/Coln/Core/Conversion.hs index 5ca80c0c..a8bb762e 100644 --- a/packages/coln-compiler/src/Coln/Core/Conversion.hs +++ b/packages/coln-compiler/src/Coln/Core/Conversion.hs @@ -62,6 +62,9 @@ instance DefEq (V.Ty N) where V.Decode n -> case a' of V.Decode n' -> defEq cs n n' _ -> throwUnequalTys cs a a' Nothing + V.InitDecode n -> case a' of + V.InitDecode n' -> defEq cs n n' + _ -> throwUnequalTys cs a a' Nothing V.Function f -> case a' of V.Function f' -> do unless (f.variant == f'.variant) $ @@ -123,6 +126,9 @@ instance DefEq V.DecodedNeutral where instance DefEq V.Neutral where defEq cs n n' = defEq cs (V.toBare n) (V.toBare n') +instance DefEq V.InitNeutral where + defEq cs n n' = defEq cs (V.fullNeu n) (V.fullNeu n') + canon :: V.El N -> V.El N canon v@(V.Neu n) = case V.behavior n.ty of V.LikeRecord _ -> V.Cons (V.unwrap n.expansion) diff --git a/packages/coln-compiler/src/Coln/Core/Evaluation.hs b/packages/coln-compiler/src/Coln/Core/Evaluation.hs index 976882b2..d5bdab05 100644 --- a/packages/coln-compiler/src/Coln/Core/Evaluation.hs +++ b/packages/coln-compiler/src/Coln/Core/Evaluation.hs @@ -45,7 +45,7 @@ instance Compile S.El V.El where \vs -> V.proj (k vs) x S.Init t -> do let k = compile t - \vs -> V.Describe $ V.Init (k vs) V.Id + \vs -> V.BecomeWith $ \n -> V.InitNeu (V.InitNeutral n (k vs) V.Id) S.Lit l -> \_ -> V.Lit l S.Is t -> do let k = compile t diff --git a/packages/coln-compiler/src/Coln/Core/Memoed.hs b/packages/coln-compiler/src/Coln/Core/Memoed.hs index 57346227..a492e0e7 100644 --- a/packages/coln-compiler/src/Coln/Core/Memoed.hs +++ b/packages/coln-compiler/src/Coln/Core/Memoed.hs @@ -30,6 +30,7 @@ class Core el ty | el -> ty, ty -> el where lam :: (V.HasEvaluation c) => V.Locals -> ty N -> S.Abs el c -> el c cons :: (V.HasEvaluation c) => Dict (el c) -> el c proj :: el N -> Name -> el N + init :: ty N -> el D lit :: Literal -> el N is :: el N -> el D univ :: Universe -> ty N @@ -55,6 +56,8 @@ instance Core El Ty where (V.epure $ V.Lam dom.val (V.CloConst body.val)) cons d = M (S.Cons $ (.stx) <$> d) (V.epure $ V.Cons $ (.val) <$> d) proj x f = M (S.Proj x.stx f) (V.proj x.val f) + init a = + M (S.Init a.stx) (V.BecomeWith $ \n -> V.InitNeu (V.InitNeutral n a.val V.Id)) lit l = M (S.Lit l) (V.Lit l) is x = M (S.Is x.stx) (V.Become x.val) univ u = M (S.U u) (V.U u) @@ -90,6 +93,8 @@ instance (V.HasEvaluation c) => LevelOf (Ty c) where SDescriptive -> case ty.val of V.Describe ty' -> levelOf ty' V.Become ty' -> levelOf ty' + -- This is kind of a hack, but shouldn't appear in practice in any case + V.BecomeWith f -> levelOf (f $ V.BareNeutral (V.LocalVar (FId 0)) V.Id) instance Readback (Memoed a b c) (a c) where readb _ m = m.stx diff --git a/packages/coln-compiler/src/Coln/Core/Print.hs b/packages/coln-compiler/src/Coln/Core/Print.hs index fc8b93d2..dbf6f34a 100644 --- a/packages/coln-compiler/src/Coln/Core/Print.hs +++ b/packages/coln-compiler/src/Coln/Core/Print.hs @@ -103,6 +103,7 @@ instance ToNotation TypeBehavior where LikeFunction ft -> toNotation xs (Function ft) LikeRecord rt -> toNotation xs (Record rt) LikeBuiltinTy bt -> toNotation xs (BuiltinTy bt) + LikeInductive t -> toNotation xs t NoRules -> N.Keyword "NoRules" () toNotationTele :: [Name] -> [Ty N] -> [N.Ntn0] diff --git a/packages/coln-compiler/src/Coln/Core/Readback.hs b/packages/coln-compiler/src/Coln/Core/Readback.hs index b5a0273b..2b720af5 100644 --- a/packages/coln-compiler/src/Coln/Core/Readback.hs +++ b/packages/coln-compiler/src/Coln/Core/Readback.hs @@ -36,6 +36,8 @@ instance Readback (V.Description V.El) (S.El D) where readb n = \case V.Describe v -> readb n v V.Become v -> S.Is (readb n v) + V.BecomeWith f -> + S.Is (readb (n + 1) (f (V.BareNeutral (V.LocalVar (FId n)) V.Id))) readbClo :: (Readback (V.Evaluation a c) (b c)) => CtxLen -> V.Ty N -> V.Clo a c -> S.Abs b c readbClo n dom = \case @@ -45,6 +47,7 @@ readbClo n dom = \case instance (V.HasEvaluation c) => Readback (V.El c) (S.El c) where readb n = \case V.Neu ne -> readb n ne.spine $ readb n ne.head + V.InitNeu ne -> readb n ne.spine $ readb n ne.name V.Code a -> S.Code (readb n a) V.Lam dom body -> S.Lam (readb n dom) $ case V.scase @c of SNominative -> readbClo n dom body @@ -52,7 +55,6 @@ instance (V.HasEvaluation c) => Readback (V.El c) (S.El c) where V.Cons d -> S.Cons $ case V.scase @c of SNominative -> readb n <$> d SDescriptive -> readb n <$> d - V.Init a sp -> readb n sp $ S.Init (readb n a) V.Lit l -> S.Lit l instance Readback V.FunctionType (S.FunctionType S.Ty) where @@ -93,6 +95,7 @@ instance (V.HasEvaluation c) => Readback (V.Ty c) (S.Ty c) where readb n = \case V.U u -> S.U u V.Decode ne -> S.Decode $ readb n ne.spine $ readb n ne.head + V.InitDecode ne -> S.Decode $ readb n ne.spine $ readb n ne.name V.Function f -> S.Function $ readb n f V.Record r -> S.Record $ readb n r V.Eq eq -> S.Eq $ readb n eq @@ -104,5 +107,6 @@ instance Readback V.TypeBehavior S.TypeBehavior where V.LikeU u -> S.LikeU u V.LikeRecord rt -> S.LikeRecord $ readb n rt V.LikeFunction ft -> S.LikeFunction $ readb n ft + V.LikeInductive ne -> S.LikeInductive $ readb n ne.spine $ readb n ne.name V.LikeBuiltinTy bt -> S.LikeBuiltinTy bt V.NoRules -> S.NoRules diff --git a/packages/coln-compiler/src/Coln/Core/Syntax.hs b/packages/coln-compiler/src/Coln/Core/Syntax.hs index 5c4a3141..813ceb0b 100644 --- a/packages/coln-compiler/src/Coln/Core/Syntax.hs +++ b/packages/coln-compiler/src/Coln/Core/Syntax.hs @@ -59,5 +59,6 @@ data TypeBehavior = LikeU Universe | LikeFunction (FunctionType Ty) | LikeRecord (RecordType Ty) + | LikeInductive (El N) | LikeBuiltinTy BuiltinTy | NoRules diff --git a/packages/coln-compiler/src/Coln/Core/Value.hs b/packages/coln-compiler/src/Coln/Core/Value.hs index be25d7af..d08c76ae 100644 --- a/packages/coln-compiler/src/Coln/Core/Value.hs +++ b/packages/coln-compiler/src/Coln/Core/Value.hs @@ -36,6 +36,7 @@ type family Evaluation (f :: Case -> Type) (c :: Case) = r | r -> c f where data Description :: (Case -> Type) -> Type where Describe :: f D -> Description f Become :: f N -> Description f + BecomeWith :: (BareNeutral -> f N) -> Description f class HasEvaluation (c :: Case) where epure :: a c -> Evaluation a c @@ -53,8 +54,10 @@ instance HasEvaluation D where epure = Describe emap f (Describe x) = Describe (f x) emap f (Become x) = Become (f x) + emap f (BecomeWith g) = BecomeWith (f . g) ebind f (Describe x) = f x ebind f (Become x) = Become (f x) + ebind f (BecomeWith g) = BecomeWith (f . g) scase = SDescriptive -- Abstractions @@ -76,6 +79,11 @@ data Spine | App Spine (El N) | Proj Spine Name +composeSpines :: Spine -> Spine -> Spine +composeSpines s Id = s +composeSpines s (App s' v) = App (composeSpines s s') v +composeSpines s (Proj s' x) = Proj (composeSpines s s') x + data Head = LocalVar FId | GlobalVar Name ~(El N) @@ -120,6 +128,7 @@ reflect head spine ~ty edesc = do case edesc of Just (Describe desc) -> k (Just desc) Just (Become v) -> v + Just (BecomeWith f) -> f (BareNeutral head spine) Nothing -> k Nothing local :: FId -> Ty N -> El N @@ -152,12 +161,21 @@ instance ToBare DecodedNeutral where -- Elements -------------------------------------------------------------------------------- +data InitNeutral = InitNeutral + { name :: BareNeutral + , initialOf :: Ty N + , spine :: Spine + } + +fullNeu :: InitNeutral -> BareNeutral +fullNeu n = BareNeutral n.name.head (composeSpines n.name.spine n.spine) + data El :: Case -> Type where Neu :: Neutral -> El N + InitNeu :: InitNeutral -> El N Code :: Ty c -> El c Lam :: ~(Ty N) -> Clo El c -> El c Cons :: Dict (Evaluation El c) -> El c - Init :: Ty N -> Spine -> El D Lit :: Literal -> El N app :: El c -> El N -> Evaluation El c @@ -212,9 +230,9 @@ typeForProjection rt x fields = do data Ty :: Case -> Type where U :: Universe -> Ty N Decode :: DecodedNeutral -> Ty N + InitDecode :: InitNeutral -> Ty N Function :: FunctionType -> Ty N Record :: RecordType -> Ty D - Ind :: InductiveType -> Ty D Eq :: EqualityType -> Ty N BuiltinTy :: BuiltinTy -> Ty N EltOf :: TableName -> Dict (El N) -> Ty N @@ -223,9 +241,9 @@ instance DebugVal (Ty c) where debugVal = \case U _ -> "U" Decode _ -> "Decode" + InitDecode _ -> "InitDecode" Function _ -> "Function" Record _ -> "Record" - Ind _ -> "Inductive" Eq _ -> "Eq" BuiltinTy _ -> "BuiltinTy" EltOf _ _ -> "EltOf" @@ -236,7 +254,7 @@ instance LevelOf (Ty c) where Decode n -> decodesInto n.universe Function ft -> levelOf ft.variant Record rt -> rt.level - Ind _ -> Level Set HSet + InitDecode _ -> Level Set HSet Eq ety -> Level (levelOf ety.at).mlevel (equalityHLevelOf (levelOf ety.at).hlevel) BuiltinTy _ -> Level Set HSet -- Only Int/String so far EltOf _ _ -> Level Set HSet -- TODO @@ -247,9 +265,9 @@ behavior = \case Decode n -> case n.description of Just t -> behavior t Nothing -> NoRules + InitDecode n -> LikeInductive n Function ft -> LikeFunction ft Record rt -> LikeRecord rt - Ind it -> LikeInductive it Eq _ -> NoRules BuiltinTy bty -> LikeBuiltinTy bty EltOf _ _ -> NoRules @@ -264,8 +282,9 @@ decode (Neu n) = do case decode <$> n.description of Just (Describe desc) -> k (Just desc) Just (Become ty) -> ty + Just (BecomeWith f) -> f (BareNeutral n.head n.spine) Nothing -> k Nothing -decode (Init a sp) = Describe $ Ind $ InductiveType a sp +decode (InitNeu n) = InitDecode n decode _ = panic "ill-typed decoding" -- Type behavior @@ -275,7 +294,7 @@ data TypeBehavior = LikeU Universe | LikeFunction FunctionType | LikeRecord RecordType - | LikeInductive InductiveType + | LikeInductive InitNeutral | LikeBuiltinTy BuiltinTy | NoRules diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs index 45c875b0..ea6c7e76 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs @@ -1,13 +1,13 @@ module Coln.Elaborator.Rules.Initial where -import Coln.Common +import Prelude hiding (init) + import Coln.Core -import Coln.Elaborator.Diagnostics import Coln.Elaborator.Environment import Coln.Elaborator.Judgment create :: Typ N -> Syn D create t = Syn \e -> do - a <- t.elab (e { scope = lock e.scope }) - pure (a, init a) + a <- t.elab (e { scope = lock e.scope, target = TargetAnonymous }) + pure (a.val, init a) diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs index a284494c..7ec29176 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs @@ -15,6 +15,7 @@ import Coln.Elaborator.Judgment import Coln.Elaborator.Rules.Builtin qualified as Builtin import Coln.Elaborator.Rules.Equality qualified as Equality import Coln.Elaborator.Rules.Function qualified as Function +import Coln.Elaborator.Rules.Initial qualified as Initial import Coln.Elaborator.Rules.Record qualified as Record import Coln.Elaborator.Rules.Universe qualified as Universe import Coln.Elaborator.Rules.Variable qualified as Variable @@ -76,6 +77,13 @@ fromSynN @c s = case V.scase @c of SDescriptive -> FromSyn $ Syn \e -> do (a, m) <- s.elab (e{target = TargetAnonymous}) pure (a, M.is m) + +fromSynD :: (V.HasEvaluation c) => ParserEnv -> Span -> Syn D -> IO (Judgment c) +fromSynD @c e sp s = case V.scase @c of + SNominative -> do + let msg = "expected nominative expression, got descriptive expression" + failWith e sp UnexpectedDescriptive msg + SDescriptive -> pure $ FromSyn s fromTypN :: (V.HasEvaluation c) => Typ N -> Judgment c fromTypN @c t = case V.scase @c of @@ -94,6 +102,9 @@ fromTypD @c e sp t = case V.scase @c of expr :: (V.HasEvaluation c) => ParserEnv -> Ntn -> IO (Judgment c) expr e n = case n of N.Ident name s -> pure $ fromSynN $ Variable.find s name + N.Juxt (N.Keyword "init" _) n -> do + t <- typ e n + fromSynD e (N.span n) (Initial.create t) N.Juxt n0 n1 -> do s <- syn e "target of elimination" n0 fromSynN <$> elim e s n1 diff --git a/packages/coln-compiler/test/golden/ind.coln b/packages/coln-compiler/test/golden/ind.coln index e789ba46..bd70886d 100644 --- a/packages/coln-compiler/test/golden/ind.coln +++ b/packages/coln-compiler/test/golden/ind.coln @@ -11,8 +11,6 @@ theory TransitiveExt (G : Graph) := sig snoc : (v0 : G.v) -> (v1 : G.v) -> (v2 : G.v) -> p v0 v1 -> G.e v1 v2 -> p v0 v2 end -theory Point (X : Set) := X +ind def transitive-closure (G : Graph) : TransitiveExt G := init (TransitiveExt G) -# ind def transitive-closure (G : Graph) := init (TransitiveExt G) - -theory S := T +ind def freept (X : Set) : X := init X From 3e15dda1cd5a07810bb08f258284268c32e2ab50 Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Thu, 23 Jul 2026 16:05:06 -0400 Subject: [PATCH 04/13] restrict init to only be used in inductive mode --- .../src/Coln/Elaborator/Diagnostics.hs | 4 +++- .../src/Coln/Elaborator/Rules/Initial.hs | 10 ++++++++-- .../coln-compiler/src/Coln/Frontend/Parser/Expr.hs | 2 +- packages/coln-compiler/test/golden/equality.coln | 6 ++++++ packages/coln-compiler/test/golden/equality.output | 14 ++++++++++++++ packages/coln-compiler/test/golden/fb3.output | 2 +- .../test/golden/graph-of-graphs.output | 2 +- packages/coln-compiler/test/golden/hlevel.output | 4 ++-- packages/coln-compiler/test/golden/ind.output | 14 +++++++------- .../test/golden/modular-lattice.output | 2 +- .../coln-compiler/test/golden/monoid-glog.output | 2 +- packages/coln-compiler/test/golden/ssa.output | 10 +++++----- 12 files changed, 50 insertions(+), 22 deletions(-) create mode 100644 packages/coln-compiler/test/golden/equality.coln create mode 100644 packages/coln-compiler/test/golden/equality.output diff --git a/packages/coln-compiler/src/Coln/Elaborator/Diagnostics.hs b/packages/coln-compiler/src/Coln/Elaborator/Diagnostics.hs index 5e0e18e5..7bfe9ee8 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Diagnostics.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Diagnostics.hs @@ -30,6 +30,7 @@ data ElaboratorCode | VariableNotInScope | DebugMisc | InductiveInConjunctive + | InitInConjunctive deriving (Eq, Ord) elaboratorCodeTable :: Map ElaboratorCode CodeMeta @@ -51,5 +52,6 @@ elaboratorCodeTable = , (MismatchedRecordField, CodeMeta 13 SError Nothing) , (VariableNotInScope, CodeMeta 14 SError Nothing) , (DebugMisc, CodeMeta 15 SDebug Nothing) - , (InductiveInConjunctive, CodeMeta 16 SDebug Nothing) + , (InductiveInConjunctive, CodeMeta 16 SError Nothing) + , (InitInConjunctive, CodeMeta 17 SError Nothing) ] diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs index ea6c7e76..3eb8b75d 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs @@ -2,12 +2,18 @@ module Coln.Elaborator.Rules.Initial where import Prelude hiding (init) +import Coln.Common import Coln.Core import Coln.Elaborator.Environment import Coln.Elaborator.Judgment -create :: Typ N -> Syn D -create t = Syn \e -> do +create :: Span -> Typ N -> Syn D +create sp t = Syn \e -> do + case e.scope.mode of + Inductive -> pure () + Conjunctive -> do + let msg = "cannot create initial model in conjunctive mode" + failWith e.diagEnv sp InitInConjunctive msg a <- t.elab (e { scope = lock e.scope, target = TargetAnonymous }) pure (a.val, init a) diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs index 7ec29176..cc1abcf9 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs @@ -104,7 +104,7 @@ expr e n = case n of N.Ident name s -> pure $ fromSynN $ Variable.find s name N.Juxt (N.Keyword "init" _) n -> do t <- typ e n - fromSynD e (N.span n) (Initial.create t) + fromSynD e (N.span n) (Initial.create (N.span n) t) N.Juxt n0 n1 -> do s <- syn e "target of elimination" n0 fromSynN <$> elim e s n1 diff --git a/packages/coln-compiler/test/golden/equality.coln b/packages/coln-compiler/test/golden/equality.coln new file mode 100644 index 00000000..e352505f --- /dev/null +++ b/packages/coln-compiler/test/golden/equality.coln @@ -0,0 +1,6 @@ +theory ReflexiveRelation (X : Set) := sig + rel : X -> X -> Prop + refl : (x : X) -> rel x x +end + +ind def Eq (X : Set) : ReflexiveRelation X := init (ReflexiveRelation X) diff --git a/packages/coln-compiler/test/golden/equality.output b/packages/coln-compiler/test/golden/equality.output new file mode 100644 index 00000000..dc8a867b --- /dev/null +++ b/packages/coln-compiler/test/golden/equality.output @@ -0,0 +1,14 @@ +-- elaborated +global entry named ReflexiveRelation +in mode: Conjunctive +type: (X : Set) -> Theory +value: X => sig + rel : X -> X -> Prop + refl : (x : X) -> rel x x +end +global entry named Eq +in mode: Inductive +type: (X : Set) -> ReflexiveRelation X +value: X => init (ReflexiveRelation X) + +-- messages diff --git a/packages/coln-compiler/test/golden/fb3.output b/packages/coln-compiler/test/golden/fb3.output index 6bcca169..7d714b29 100644 --- a/packages/coln-compiler/test/golden/fb3.output +++ b/packages/coln-compiler/test/golden/fb3.output @@ -3,6 +3,6 @@ -- messages -debug[D0316]: cannot use inductively bound variable in a conjunctive context +error[E0316]: cannot use inductively bound variable in a conjunctive context 7 | mul/idempotent : (x : Element) -> mul x x = x 7 | ^ diff --git a/packages/coln-compiler/test/golden/graph-of-graphs.output b/packages/coln-compiler/test/golden/graph-of-graphs.output index 324ea75a..98ebf916 100644 --- a/packages/coln-compiler/test/golden/graph-of-graphs.output +++ b/packages/coln-compiler/test/golden/graph-of-graphs.output @@ -27,7 +27,7 @@ end -- messages -debug[D0316]: cannot use inductively bound variable in a conjunctive context +error[E0316]: cannot use inductively bound variable in a conjunctive context 15 | V : G0.V -> G1.V 15 | ^^ diff --git a/packages/coln-compiler/test/golden/hlevel.output b/packages/coln-compiler/test/golden/hlevel.output index c3f2ded0..c1e8b8b3 100644 --- a/packages/coln-compiler/test/golden/hlevel.output +++ b/packages/coln-compiler/test/golden/hlevel.output @@ -58,7 +58,7 @@ debug[D0315]: type person -> happy has level Level {mlevel = Theory, hlevel = HP 13 | showlevel person -> happy 13 | ^^^^^^^^^^^^^^^ -debug[D0316]: cannot use inductively bound variable in a conjunctive context +error[E0316]: cannot use inductively bound variable in a conjunctive context 17 | son : F.person 17 | ^ @@ -90,6 +90,6 @@ debug[D0315]: type u = u has level Level {mlevel = Set, hlevel = HUnit} 48 | showlevel u = u 48 | ^^^^^ -debug[D0316]: cannot use inductively bound variable in a conjunctive context +error[E0316]: cannot use inductively bound variable in a conjunctive context 52 | f : A -> P 52 | ^ diff --git a/packages/coln-compiler/test/golden/ind.output b/packages/coln-compiler/test/golden/ind.output index 0180b131..6fbe783b 100644 --- a/packages/coln-compiler/test/golden/ind.output +++ b/packages/coln-compiler/test/golden/ind.output @@ -18,13 +18,13 @@ value: G => sig incl : (v0 : G.v) -> (v1 : G.v) -> G.e v0 v1 -> p v0 v1 snoc : (v0 : G.v) -> (v1 : G.v) -> (v2 : G.v) -> p v0 v1 -> G.e v1 v2 -> p v0 v2 end +global entry named transitive-closure +in mode: Inductive +type: (G : Graph) -> TransitiveExt G +value: G => init (TransitiveExt G) -- messages -debug[D0316]: cannot use inductively bound variable in a conjunctive context -14 | theory Point (X : Set) := X -14 | ^ - -debug[D0316]: cannot use inductively bound variable in a conjunctive context -18 | theory S := T -18 | ^ +error[E0316]: cannot use inductively bound variable in a conjunctive context +16 | ind def freept (X : Set) : X := init X +16 | ^ diff --git a/packages/coln-compiler/test/golden/modular-lattice.output b/packages/coln-compiler/test/golden/modular-lattice.output index 6e3f73e3..d77628e3 100644 --- a/packages/coln-compiler/test/golden/modular-lattice.output +++ b/packages/coln-compiler/test/golden/modular-lattice.output @@ -3,7 +3,7 @@ -- messages -debug[D0316]: cannot use inductively bound variable in a conjunctive context +error[E0316]: cannot use inductively bound variable in a conjunctive context 17 | meet a a = a 17 | ^ diff --git a/packages/coln-compiler/test/golden/monoid-glog.output b/packages/coln-compiler/test/golden/monoid-glog.output index 124560e1..83ab7ebc 100644 --- a/packages/coln-compiler/test/golden/monoid-glog.output +++ b/packages/coln-compiler/test/golden/monoid-glog.output @@ -3,6 +3,6 @@ -- messages -debug[D0316]: cannot use inductively bound variable in a conjunctive context +error[E0316]: cannot use inductively bound variable in a conjunctive context 6 | mul/unitl : (x : car) -> mul unit x = x 6 | ^ diff --git a/packages/coln-compiler/test/golden/ssa.output b/packages/coln-compiler/test/golden/ssa.output index c5037aa2..f5534860 100644 --- a/packages/coln-compiler/test/golden/ssa.output +++ b/packages/coln-compiler/test/golden/ssa.output @@ -10,23 +10,23 @@ end -- messages -debug[D0316]: cannot use inductively bound variable in a conjunctive context +error[E0316]: cannot use inductively bound variable in a conjunctive context 2 | refl : (x : X) -> P x x 2 | ^ -debug[D0316]: cannot use inductively bound variable in a conjunctive context +error[E0316]: cannot use inductively bound variable in a conjunctive context 13 | next/prev : (x : car) -> next (prev x) = x 13 | ^ -debug[D0316]: cannot use inductively bound variable in a conjunctive context +error[E0316]: cannot use inductively bound variable in a conjunctive context 32 | fwd : A -> B 32 | ^ -debug[D0316]: cannot use inductively bound variable in a conjunctive context +error[E0316]: cannot use inductively bound variable in a conjunctive context 39 | opType : opInfo.OpType 39 | ^^^^^^ -debug[D0316]: cannot use inductively bound variable in a conjunctive context +error[E0316]: cannot use inductively bound variable in a conjunctive context 45 | y : X 45 | ^ From 205f01708c3a7ad93391519e2725e0e5fb23689f Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Thu, 23 Jul 2026 16:06:38 -0400 Subject: [PATCH 05/13] formatting, license headers --- packages/coln-compiler/coln-compiler.cabal | 4 +-- .../src/Coln/Elaborator/Coercion.hs | 6 ++++- .../src/Coln/Elaborator/Environment.hs | 4 +-- .../src/Coln/Elaborator/Judgment.hs | 1 - .../src/Coln/Elaborator/Rules/Function.hs | 6 ++--- .../src/Coln/Elaborator/Rules/Initial.hs | 7 +++-- .../src/Coln/Elaborator/Rules/Polarity.hs | 6 ++++- .../coln-compiler/src/Coln/Frontend/Parser.hs | 4 +-- .../src/Coln/Frontend/Parser/Expr.hs | 8 ++++-- .../src/Coln/Frontend/Parser/Top.hs | 26 +++++++++++-------- 10 files changed, 45 insertions(+), 27 deletions(-) diff --git a/packages/coln-compiler/coln-compiler.cabal b/packages/coln-compiler/coln-compiler.cabal index 7fb85c72..763c7318 100644 --- a/packages/coln-compiler/coln-compiler.cabal +++ b/packages/coln-compiler/coln-compiler.cabal @@ -39,15 +39,15 @@ library Coln.Elaborator.Rules.Equality Coln.Elaborator.Rules.Function Coln.Elaborator.Rules.Initial - Coln.Elaborator.Rules.Record Coln.Elaborator.Rules.Polarity + Coln.Elaborator.Rules.Record Coln.Elaborator.Rules.Universe Coln.Elaborator.Rules.Variable Coln.Frontend.Diagnostics Coln.Frontend.Notation Coln.Frontend.Parser - Coln.Frontend.Parser.Top Coln.Frontend.Parser.Expr + Coln.Frontend.Parser.Top Coln.Report hs-source-dirs: src diff --git a/packages/coln-compiler/src/Coln/Elaborator/Coercion.hs b/packages/coln-compiler/src/Coln/Elaborator/Coercion.hs index 2ea4b67d..12a74a6b 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Coercion.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Coercion.hs @@ -1,3 +1,7 @@ +-- SPDX-FileCopyrightText: 2026 Coln contributors +-- +-- SPDX-License-Identifier: Apache-2.0 OR MIT + module Coln.Elaborator.Coercion where import Coln.Common @@ -5,8 +9,8 @@ import Coln.Core import Coln.Core.Memoed qualified as M import Coln.Core.Value qualified as V import Coln.Elaborator.Judgment -import Coln.Elaborator.Rules.Universe qualified as Universe import Coln.Elaborator.Rules.Polarity qualified as Polarity +import Coln.Elaborator.Rules.Universe qualified as Universe intoTyp :: Span -> Judgment N -> Typ N intoTyp _ (FromTyp t) = t diff --git a/packages/coln-compiler/src/Coln/Elaborator/Environment.hs b/packages/coln-compiler/src/Coln/Elaborator/Environment.hs index 9264fde7..5f94e5a8 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Environment.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Environment.hs @@ -22,10 +22,10 @@ data Scope = Scope } lock :: Scope -> Scope -lock sc = sc { mode = Conjunctive, ctx = fmap (\(a, _) -> (a, Inductive)) sc.ctx } +lock sc = sc{mode = Conjunctive, ctx = fmap (\(a, _) -> (a, Inductive)) sc.ctx} unlock :: Scope -> Scope -unlock sc = sc { mode = Inductive } +unlock sc = sc{mode = Inductive} emptyScope :: Mode -> Scope emptyScope = Scope 0 BwdNil V.LNil BwdNil diff --git a/packages/coln-compiler/src/Coln/Elaborator/Judgment.hs b/packages/coln-compiler/src/Coln/Elaborator/Judgment.hs index 9ccb38d2..ceb58a42 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Judgment.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Judgment.hs @@ -39,7 +39,6 @@ useIs @c f e = fmap change $ f e{target = TargetAnonymous} SNominative -> id SDescriptive -> M.is - annotate :: Typ N -> Chk c -> Syn c annotate t c = Syn \e -> do a <- t.elab (e{target = TargetAnonymous}) diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs index f0a57daa..9c73044e 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs @@ -22,12 +22,12 @@ data Binder = Anonymous (Typ N) | Named Name (Typ N) formation :: Span -> Binder -> Typ N -> Typ N formation sp (Anonymous dom) cod = Typ \e -> do - edom <- dom.elab (e { scope = unlock e.scope }) + edom <- dom.elab (e{scope = unlock e.scope}) ecod <- cod.elab e v <- variantFor edom ecod sp e pure $ function e.scope.locals v edom (S.AbsConst ecod) formation sp (Named x dom) cod = Typ \e -> do - edom <- dom.elab (e { scope = unlock e.scope }) + edom <- dom.elab (e{scope = unlock e.scope}) ecod <- cod.elab $ e{scope = bind x edom.val Inductive e.scope} v <- variantFor edom ecod sp e pure $ function e.scope.locals v edom (S.Abs x ecod) @@ -50,7 +50,7 @@ elim sp callee arg = Syn $ \e -> do (ty, ecallee) <- callee.elab e case V.behavior ty of V.LikeFunction ft -> do - earg <- arg.elab (e { scope = unlock e.scope }) ft.dom + earg <- arg.elab (e{scope = unlock e.scope}) ft.dom pure (V.appClo ft.cod earg.val, app ecallee earg) _ -> do let msg = "tried to apply a value that was not of a function type" diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs index 3eb8b75d..b2fc2919 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Initial.hs @@ -1,3 +1,7 @@ +-- SPDX-FileCopyrightText: 2026 Coln contributors +-- +-- SPDX-License-Identifier: Apache-2.0 OR MIT + module Coln.Elaborator.Rules.Initial where import Prelude hiding (init) @@ -14,6 +18,5 @@ create sp t = Syn \e -> do Conjunctive -> do let msg = "cannot create initial model in conjunctive mode" failWith e.diagEnv sp InitInConjunctive msg - a <- t.elab (e { scope = lock e.scope, target = TargetAnonymous }) + a <- t.elab (e{scope = lock e.scope, target = TargetAnonymous}) pure (a.val, init a) - diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Polarity.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Polarity.hs index af131c87..8ee54055 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Rules/Polarity.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Polarity.hs @@ -1,3 +1,7 @@ +-- SPDX-FileCopyrightText: 2026 Coln contributors +-- +-- SPDX-License-Identifier: Apache-2.0 OR MIT + module Coln.Elaborator.Rules.Polarity where import Coln.Common @@ -17,6 +21,6 @@ conv sp s = Chk \e a -> do annot :: (V.HasEvaluation c) => Chk c -> Typ N -> Syn c annot c t = Syn \e -> do - a <- t.elab (e { target = TargetAnonymous }) + a <- t.elab (e{target = TargetAnonymous}) m <- c.elab e a.val pure (a.val, m) diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser.hs b/packages/coln-compiler/src/Coln/Frontend/Parser.hs index 717a40ef..21ef6a68 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser.hs @@ -2,9 +2,9 @@ -- -- SPDX-License-Identifier: Apache-2.0 OR MIT -module Coln.Frontend.Parser( +module Coln.Frontend.Parser ( module Coln.Frontend.Parser.Expr, - module Coln.Frontend.Parser.Top + module Coln.Frontend.Parser.Top, ) where import Coln.Frontend.Parser.Expr diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs index cc1abcf9..0f09edbf 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs @@ -1,4 +1,9 @@ +-- SPDX-FileCopyrightText: 2026 Coln contributors +-- +-- SPDX-License-Identifier: Apache-2.0 OR MIT + {-# LANGUAGE TypeAbstractions #-} + module Coln.Frontend.Parser.Expr where import FNotation (Ntn) @@ -77,7 +82,7 @@ fromSynN @c s = case V.scase @c of SDescriptive -> FromSyn $ Syn \e -> do (a, m) <- s.elab (e{target = TargetAnonymous}) pure (a, M.is m) - + fromSynD :: (V.HasEvaluation c) => ParserEnv -> Span -> Syn D -> IO (Judgment c) fromSynD @c e sp s = case V.scase @c of SNominative -> do @@ -145,4 +150,3 @@ elim :: ParserEnv -> Syn N -> Ntn -> IO (Syn N) elim e j = \case N.Field x s -> pure $ Record.elim s j x arg -> Function.elim (N.span arg) j <$> chk e arg - diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs index 2aa77df2..d04e5f78 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs @@ -1,3 +1,7 @@ +-- SPDX-FileCopyrightText: 2026 Coln contributors +-- +-- SPDX-License-Identifier: Apache-2.0 OR MIT + module Coln.Frontend.Parser.Top where import Control.Exception (try) @@ -17,9 +21,9 @@ import Coln.Diagnostics import Coln.Elaborator.Environment import Coln.Elaborator.Judgment import Coln.Elaborator.Rules.Function qualified as Function -import Coln.Frontend.Parser.Expr -import Coln.Frontend.Notation import Coln.Frontend.Diagnostics +import Coln.Frontend.Notation +import Coln.Frontend.Parser.Expr definition :: ParserEnv -> Ntn -> IO (Ntn, Ntn) definition _ (N.Infix n0 (N.Keyword ":=" _) n1) = pure (n0, n1) @@ -38,18 +42,18 @@ argBinding e n = unexpectedNotation e n "argument binding of the form ` : unpackArgs :: ParserEnv -> Ntn -> IO (Name, [(Span, Name, Typ N)]) unpackArgs e (N.Group (xN :| argsN)) = do - x <- ident e xN - args <- mapM (argBinding e) argsN - pure (x, args) + x <- ident e xN + args <- mapM (argBinding e) argsN + pure (x, args) withArgs :: (V.HasEvaluation c) => [(Span, Name, Typ N)] -> (Typ N, Chk c) -> (Typ N, Chk c) withArgs args base = foldr go base args - where - go :: (V.HasEvaluation c) => (Span, Name, Typ N) -> (Typ N, Chk c) -> (Typ N, Chk c) - go (sp, name, a) (t, c) = - ( Function.formation sp (Function.Named name a) t - , Function.intro sp name c - ) + where + go :: (V.HasEvaluation c) => (Span, Name, Typ N) -> (Typ N, Chk c) -> (Typ N, Chk c) + go (sp, name, a) (t, c) = + ( Function.formation sp (Function.Named name a) t + , Function.intro sp name c + ) theory :: ParserEnv -> Ntn -> IO (Name, Typ N, Chk D) theory e n = do From ed645a238c2f3dc106465dc2f4c284c05ccc4b59 Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Thu, 23 Jul 2026 16:41:15 -0400 Subject: [PATCH 06/13] fixed tests --- .../coln-compiler/src/Coln/Core/Params.hs | 6 +- .../src/Coln/Elaborator/Rules/Function.hs | 30 ++-- .../src/Coln/Frontend/Diagnostics.hs | 2 + .../src/Coln/Frontend/Parser/Expr.hs | 14 +- .../src/Coln/Frontend/Parser/Top.hs | 16 +- .../test/golden/basic-ir/builtin-root.output | 1 + .../test/golden/basic-ir/builtin.output | 1 + .../golden/basic-ir/empty-prop-record.output | 2 + .../test/golden/basic-ir/empty-record.output | 2 + .../test/golden/basic-ir/empty-theory.output | 1 + .../test/golden/basic-ir/equality-prop.output | 1 + .../test/golden/basic-ir/equality.output | 1 + .../basic-ir/foreign-key-prop-prop.output | 1 + .../basic-ir/foreign-key-prop-set.output | 1 + .../basic-ir/foreign-key-set-prop.output | 1 + .../test/golden/basic-ir/foreign-key.output | 1 + .../basic-ir/function-mixed-prop-set.output | 1 + .../basic-ir/function-multi-argument.output | 1 + .../golden/basic-ir/function-prop-prop.output | 1 + .../golden/basic-ir/function-prop-set.output | 1 + .../golden/basic-ir/function-set-prop.output | 1 + .../test/golden/basic-ir/function.output | 1 + .../golden/basic-ir/lookup-builtin.output | 1 + .../basic-ir/lookup-composition-prop.output | 1 + .../golden/basic-ir/lookup-composition.output | 1 + .../basic-ir/lookup-literal-prop.output | 1 + .../golden/basic-ir/lookup-literal.output | 1 + .../lookup-projection-prop-prop-prop.output | 1 + .../lookup-projection-prop-prop-set.output | 1 + .../lookup-projection-prop-set-prop.output | 1 + .../lookup-projection-prop-set-set.output | 1 + .../lookup-projection-set-prop-prop.output | 1 + .../lookup-projection-set-prop-set.output | 1 + .../lookup-projection-set-set-prop.output | 1 + .../golden/basic-ir/lookup-projection.output | 1 + .../basic-ir/lookup-record-composition.output | 3 + .../basic-ir/lookup-record-expansion.output | 2 + .../basic-ir/lookup-record-field.output | 2 + .../test/golden/basic-ir/lookup-record.output | 3 + .../basic-ir/param-record-concrete.output | 3 + .../golden/basic-ir/param-record-model.output | 4 + .../basic-ir/param-record-nested.output | 3 + .../test/golden/basic-ir/param-record.output | 2 + .../golden/basic-ir/param-theory-model.output | 3 + .../basic-ir/param-theory-nested.output | 3 + .../test/golden/basic-ir/param-theory.output | 2 + .../test/golden/basic-ir/projection.output | 2 + .../golden/basic-ir/proof-record-mixed.output | 2 + .../basic-ir/proof-record-parameter.output | 2 + .../test/golden/basic-ir/proof-record.output | 2 + .../basic-ir/prop-multi-argument.output | 1 + .../test/golden/basic-ir/prop-record.output | 2 + .../test/golden/basic-ir/prop.output | 1 + .../golden/basic-ir/record-field-order.output | 2 + .../test/golden/basic-ir/record.output | 2 + .../golden/basic-ir/repeated-binders.output | 1 + .../test/golden/basic-ir/rule-literals.output | 1 + .../test/golden/basic-ir/set.output | 1 + .../test/golden/basic-ir/theory-alias.output | 2 + .../test/golden/elaborator-errors.output | 6 + .../coln-compiler/test/golden/equality.coln | 6 +- .../coln-compiler/test/golden/equality.output | 2 +- packages/coln-compiler/test/golden/fb3.output | 14 +- .../test/golden/graph-of-graphs.output | 161 ++++++++++++++++-- .../coln-compiler/test/golden/hlevel.output | 30 +++- packages/coln-compiler/test/golden/ind.output | 8 +- .../test/golden/modular-lattice.output | 22 ++- .../test/golden/monoid-glog.output | 16 +- packages/coln-compiler/test/golden/ssa.output | 94 +++++++--- packages/coln-repl/src/Coln/REPL.hs | 10 +- packages/fnotation/src/FNotation/Kinds.hs | 1 + packages/fnotation/src/FNotation/Lexer.hs | 1 + packages/fnotation/src/FNotation/Pretty.hs | 1 + packages/fnotation/src/FNotation/Reader.hs | 4 + packages/fnotation/src/FNotation/Trees.hs | 5 + 75 files changed, 434 insertions(+), 98 deletions(-) diff --git a/packages/coln-compiler/src/Coln/Core/Params.hs b/packages/coln-compiler/src/Coln/Core/Params.hs index 4fab4e1a..3a5655a9 100644 --- a/packages/coln-compiler/src/Coln/Core/Params.hs +++ b/packages/coln-compiler/src/Coln/Core/Params.hs @@ -109,7 +109,11 @@ functionMLevelFor v1 v2 = case (v1, v2) of (Theory, _) -> pure TheoryTop (Top, _) -> Nothing -data FunctionVariant = FunctionVariant {mlevel :: FunctionVariantMLevel, hlevel :: HLevel} +data FunctionVariant = FunctionVariant + { mlevel :: FunctionVariantMLevel + , hlevel :: HLevel + , domainMode :: Mode + } deriving (Eq, Show) instance Pretty FunctionVariant where diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs index 9c73044e..ca3ed349 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Function.hs @@ -10,33 +10,37 @@ import Coln.Core.Syntax qualified as S import Coln.Core.Value qualified as V import Coln.Elaborator.Judgment -variantFor :: Ty N -> Ty N -> Span -> ElabEnv c -> IO FunctionVariant -variantFor dom cod sp e = +variantFor :: Mode -> Ty N -> Ty N -> Span -> ElabEnv c -> IO FunctionVariant +variantFor m dom cod sp e = case functionMLevelFor (levelOf dom).mlevel (levelOf cod).mlevel of - Just l -> pure (FunctionVariant l (levelOf cod).hlevel) + Just l -> pure (FunctionVariant l (levelOf cod).hlevel m) Nothing -> do let msg = "higher-order theories are not supported" failWith e.diagEnv sp FunctionDomainTooLarge msg -data Binder = Anonymous (Typ N) | Named Name (Typ N) +data Binder = Anonymous Mode (Typ N) | Named Mode Name (Typ N) + +shiftToMode :: Mode -> Scope -> Scope +shiftToMode Conjunctive sc = sc +shiftToMode Inductive sc = unlock sc formation :: Span -> Binder -> Typ N -> Typ N -formation sp (Anonymous dom) cod = Typ \e -> do - edom <- dom.elab (e{scope = unlock e.scope}) +formation sp (Anonymous m dom) cod = Typ \e -> do + edom <- dom.elab (e{scope = shiftToMode m e.scope}) ecod <- cod.elab e - v <- variantFor edom ecod sp e + v <- variantFor m edom ecod sp e pure $ function e.scope.locals v edom (S.AbsConst ecod) -formation sp (Named x dom) cod = Typ \e -> do - edom <- dom.elab (e{scope = unlock e.scope}) - ecod <- cod.elab $ e{scope = bind x edom.val Inductive e.scope} - v <- variantFor edom ecod sp e +formation sp (Named m x dom) cod = Typ \e -> do + edom <- dom.elab (e{scope = shiftToMode m e.scope}) + ecod <- cod.elab $ e{scope = bind x edom.val m e.scope} + v <- variantFor m edom ecod sp e pure $ function e.scope.locals v edom (S.Abs x ecod) intro :: (V.HasEvaluation c) => Span -> Name -> Chk c -> Chk c intro sp x body = Chk \e a -> case V.behavior a of V.LikeFunction ft -> do - ebody <- withBound x ft.dom Inductive e.scope $ \v scope' -> + ebody <- withBound x ft.dom ft.variant.domainMode e.scope $ \v scope' -> body.elab (e{scope = scope', target = appTarget e.target v}) (V.appClo ft.cod v) @@ -50,7 +54,7 @@ elim sp callee arg = Syn $ \e -> do (ty, ecallee) <- callee.elab e case V.behavior ty of V.LikeFunction ft -> do - earg <- arg.elab (e{scope = unlock e.scope}) ft.dom + earg <- arg.elab (e{scope = shiftToMode ft.variant.domainMode e.scope}) ft.dom pure (V.appClo ft.cod earg.val, app ecallee earg) _ -> do let msg = "tried to apply a value that was not of a function type" diff --git a/packages/coln-compiler/src/Coln/Frontend/Diagnostics.hs b/packages/coln-compiler/src/Coln/Frontend/Diagnostics.hs index 82943f55..7f37db5f 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Diagnostics.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Diagnostics.hs @@ -15,6 +15,7 @@ data ParserCode | UnexpectedDescriptive | UnknownCommand | UnknownModifiers + | UnknownMode deriving (Eq, Ord) parserCodeTable :: Map ParserCode CodeMeta @@ -27,4 +28,5 @@ parserCodeTable = , (UnexpectedDescriptive, CodeMeta 4 SError Nothing) , (UnknownCommand, CodeMeta 5 SError Nothing) , (UnknownModifiers, CodeMeta 6 SError Nothing) + , (UnknownMode, CodeMeta 7 SError Nothing) ] diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs index 0f09edbf..cdcd1d21 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs @@ -46,9 +46,10 @@ debugCommand e sp x _ = unknownCommand e sp x binder :: ParserEnv -> Ntn -> IO Function.Binder binder e = \case - N.Infix name (N.Keyword ":" _) arg -> - Function.Named <$> ident e name <*> typ e arg - n -> Function.Anonymous <$> typ e n + N.Infix name (N.Keyword ":" _) arg -> do + (mode, x) <- modalIdent e name + Function.Named mode x <$> typ e arg + n -> Function.Anonymous Conjunctive <$> typ e n fieldDecl :: ParserEnv -> Ntn -> IO Record.FieldDeclaration fieldDecl e (N.Infix (N.Ident x _) (N.Keyword ":" _) n) = @@ -66,6 +67,13 @@ ident :: ParserEnv -> Ntn -> IO Name ident _ (N.Ident x _) = pure x ident e n = unexpectedNotation e n "identifier" +modalIdent :: ParserEnv -> Ntn -> IO (Mode, Name) +modalIdent _ (N.Ident x _) = pure (Conjunctive, x) +modalIdent _ (N.Juxt (N.Mode "i" _) (N.Ident x _)) = pure (Inductive, x) +modalIdent e (N.Juxt (N.Mode _ sp) (N.Ident _ _)) = + failWith e sp UnknownMode "unknown mode" +modalIdent e n = unexpectedNotation e n "identifier, possibly with mode annotation" + unexpectedNotation :: ParserEnv -> Ntn -> DDoc -> IO a unexpectedNotation e n c = do let msg = "unexpected notation for" <+> c <> ":" <+> N.head n diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs index d04e5f78..4840c6ec 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs @@ -33,25 +33,25 @@ annot :: ParserEnv -> Ntn -> IO (Ntn, Ntn) annot _ (N.Infix n0 (N.Keyword ":" _) n1) = pure (n0, n1) annot e n = unexpectedNotation e n "type-annotated expression, e.g. ` : `" -argBinding :: ParserEnv -> Ntn -> IO (Span, Name, Typ N) +argBinding :: ParserEnv -> Ntn -> IO (Span, Mode, Name, Typ N) argBinding e n@(N.Infix n0 (N.Keyword ":" _) n1) = do - x <- ident e n0 + (m, x) <- modalIdent e n0 a <- typ e n1 - pure (N.span n, x, a) + pure (N.span n, m, x, a) argBinding e n = unexpectedNotation e n "argument binding of the form ` : `" -unpackArgs :: ParserEnv -> Ntn -> IO (Name, [(Span, Name, Typ N)]) +unpackArgs :: ParserEnv -> Ntn -> IO (Name, [(Span, Mode, Name, Typ N)]) unpackArgs e (N.Group (xN :| argsN)) = do x <- ident e xN args <- mapM (argBinding e) argsN pure (x, args) -withArgs :: (V.HasEvaluation c) => [(Span, Name, Typ N)] -> (Typ N, Chk c) -> (Typ N, Chk c) +withArgs :: (V.HasEvaluation c) => [(Span, Mode, Name, Typ N)] -> (Typ N, Chk c) -> (Typ N, Chk c) withArgs args base = foldr go base args where - go :: (V.HasEvaluation c) => (Span, Name, Typ N) -> (Typ N, Chk c) -> (Typ N, Chk c) - go (sp, name, a) (t, c) = - ( Function.formation sp (Function.Named name a) t + go :: (V.HasEvaluation c) => (Span, Mode, Name, Typ N) -> (Typ N, Chk c) -> (Typ N, Chk c) + go (sp, m, name, a) (t, c) = + ( Function.formation sp (Function.Named m name a) t , Function.intro sp name c ) diff --git a/packages/coln-compiler/test/golden/basic-ir/builtin-root.output b/packages/coln-compiler/test/golden/basic-ir/builtin-root.output index ff6d8ac2..e7361b47 100644 --- a/packages/coln-compiler/test/golden/basic-ir/builtin-root.output +++ b/packages/coln-compiler/test/golden/basic-ir/builtin-root.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig count : Int diff --git a/packages/coln-compiler/test/golden/basic-ir/builtin.output b/packages/coln-compiler/test/golden/basic-ir/builtin.output index a12f33d8..a3869139 100644 --- a/packages/coln-compiler/test/golden/basic-ir/builtin.output +++ b/packages/coln-compiler/test/golden/basic-ir/builtin.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig V : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/empty-prop-record.output b/packages/coln-compiler/test/golden/basic-ir/empty-prop-record.output index 797dd05c..4890161d 100644 --- a/packages/coln-compiler/test/golden/basic-ir/empty-prop-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/empty-prop-record.output @@ -1,9 +1,11 @@ -- elaborated global entry named Truth +in mode: Conjunctive type: Prop value: sig end global entry named T +in mode: Conjunctive type: Theory value: sig truth : Truth diff --git a/packages/coln-compiler/test/golden/basic-ir/empty-record.output b/packages/coln-compiler/test/golden/basic-ir/empty-record.output index f22be40e..c0c5b519 100644 --- a/packages/coln-compiler/test/golden/basic-ir/empty-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/empty-record.output @@ -1,9 +1,11 @@ -- elaborated global entry named Unit +in mode: Conjunctive type: Set value: sig end global entry named T +in mode: Conjunctive type: Theory value: sig unit : Unit diff --git a/packages/coln-compiler/test/golden/basic-ir/empty-theory.output b/packages/coln-compiler/test/golden/basic-ir/empty-theory.output index 9b3bdce1..7bb1832e 100644 --- a/packages/coln-compiler/test/golden/basic-ir/empty-theory.output +++ b/packages/coln-compiler/test/golden/basic-ir/empty-theory.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig end diff --git a/packages/coln-compiler/test/golden/basic-ir/equality-prop.output b/packages/coln-compiler/test/golden/basic-ir/equality-prop.output index 978fcd5e..8cc6e1c4 100644 --- a/packages/coln-compiler/test/golden/basic-ir/equality-prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/equality-prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig P : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/equality.output b/packages/coln-compiler/test/golden/basic-ir/equality.output index 63a31ab1..0c0586ac 100644 --- a/packages/coln-compiler/test/golden/basic-ir/equality.output +++ b/packages/coln-compiler/test/golden/basic-ir/equality.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig V : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/foreign-key-prop-prop.output b/packages/coln-compiler/test/golden/basic-ir/foreign-key-prop-prop.output index 86d11401..b0977e79 100644 --- a/packages/coln-compiler/test/golden/basic-ir/foreign-key-prop-prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/foreign-key-prop-prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig V : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/foreign-key-prop-set.output b/packages/coln-compiler/test/golden/basic-ir/foreign-key-prop-set.output index 79b5d018..982cd26b 100644 --- a/packages/coln-compiler/test/golden/basic-ir/foreign-key-prop-set.output +++ b/packages/coln-compiler/test/golden/basic-ir/foreign-key-prop-set.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig V : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/foreign-key-set-prop.output b/packages/coln-compiler/test/golden/basic-ir/foreign-key-set-prop.output index f6042360..ccfae4b4 100644 --- a/packages/coln-compiler/test/golden/basic-ir/foreign-key-set-prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/foreign-key-set-prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig V : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/foreign-key.output b/packages/coln-compiler/test/golden/basic-ir/foreign-key.output index f5b93506..3db52628 100644 --- a/packages/coln-compiler/test/golden/basic-ir/foreign-key.output +++ b/packages/coln-compiler/test/golden/basic-ir/foreign-key.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig V : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/function-mixed-prop-set.output b/packages/coln-compiler/test/golden/basic-ir/function-mixed-prop-set.output index 15cf11c3..7b209e87 100644 --- a/packages/coln-compiler/test/golden/basic-ir/function-mixed-prop-set.output +++ b/packages/coln-compiler/test/golden/basic-ir/function-mixed-prop-set.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/function-multi-argument.output b/packages/coln-compiler/test/golden/basic-ir/function-multi-argument.output index f870d9ec..2b424006 100644 --- a/packages/coln-compiler/test/golden/basic-ir/function-multi-argument.output +++ b/packages/coln-compiler/test/golden/basic-ir/function-multi-argument.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/function-prop-prop.output b/packages/coln-compiler/test/golden/basic-ir/function-prop-prop.output index 78462a24..c10c115c 100644 --- a/packages/coln-compiler/test/golden/basic-ir/function-prop-prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/function-prop-prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig X : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/function-prop-set.output b/packages/coln-compiler/test/golden/basic-ir/function-prop-set.output index bf875d89..9dc2aa9e 100644 --- a/packages/coln-compiler/test/golden/basic-ir/function-prop-set.output +++ b/packages/coln-compiler/test/golden/basic-ir/function-prop-set.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig X : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/function-set-prop.output b/packages/coln-compiler/test/golden/basic-ir/function-set-prop.output index 3cd5ce06..75659a87 100644 --- a/packages/coln-compiler/test/golden/basic-ir/function-set-prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/function-set-prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/function.output b/packages/coln-compiler/test/golden/basic-ir/function.output index 0d46eb77..94516841 100644 --- a/packages/coln-compiler/test/golden/basic-ir/function.output +++ b/packages/coln-compiler/test/golden/basic-ir/function.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-builtin.output b/packages/coln-compiler/test/golden/basic-ir/lookup-builtin.output index e4b33221..cd18a07c 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-builtin.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-builtin.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-composition-prop.output b/packages/coln-compiler/test/golden/basic-ir/lookup-composition-prop.output index ceec7b16..c3ff7136 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-composition-prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-composition-prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig A : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-composition.output b/packages/coln-compiler/test/golden/basic-ir/lookup-composition.output index ede8104b..58b20987 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-composition.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-composition.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig A : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-literal-prop.output b/packages/coln-compiler/test/golden/basic-ir/lookup-literal-prop.output index fc668834..11ca4a26 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-literal-prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-literal-prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig IntFact : Int -> Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-literal.output b/packages/coln-compiler/test/golden/basic-ir/lookup-literal.output index 53a8a6e8..a46dff39 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-literal.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-literal.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig IntEdge : Int -> Set diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-prop-prop.output b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-prop-prop.output index 7e1d98a3..e8bf3176 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-prop-prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-prop-prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig A : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-prop-set.output b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-prop-set.output index 8b099309..f355b95b 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-prop-set.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-prop-set.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig A : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-set-prop.output b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-set-prop.output index 2423f783..481b16fd 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-set-prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-set-prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig A : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-set-set.output b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-set-set.output index 59dc0dd5..9cc681da 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-set-set.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-prop-set-set.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig A : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-prop-prop.output b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-prop-prop.output index 565b5a6b..eddc419e 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-prop-prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-prop-prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig A : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-prop-set.output b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-prop-set.output index ba638feb..f92c6586 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-prop-set.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-prop-set.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig A : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-set-prop.output b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-set-prop.output index 9e4137e2..01e37dc6 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-set-prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-projection-set-set-prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig A : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-projection.output b/packages/coln-compiler/test/golden/basic-ir/lookup-projection.output index 31f12076..412d60c6 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-projection.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-projection.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig A : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-record-composition.output b/packages/coln-compiler/test/golden/basic-ir/lookup-record-composition.output index afc5c9fb..a38f6a85 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-record-composition.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-record-composition.output @@ -1,15 +1,18 @@ -- elaborated global entry named Key +in mode: Conjunctive type: Set value: sig rank : Int end global entry named Payload +in mode: Conjunctive type: Set value: sig name : String end global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-record-expansion.output b/packages/coln-compiler/test/golden/basic-ir/lookup-record-expansion.output index f87ded8b..bf60c3c2 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-record-expansion.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-record-expansion.output @@ -1,11 +1,13 @@ -- elaborated global entry named Payload +in mode: Conjunctive type: Set value: sig name : String rank : Int end global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-record-field.output b/packages/coln-compiler/test/golden/basic-ir/lookup-record-field.output index 5da48038..c709f749 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-record-field.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-record-field.output @@ -1,11 +1,13 @@ -- elaborated global entry named Payload +in mode: Conjunctive type: Set value: sig name : String rank : Int end global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/lookup-record.output b/packages/coln-compiler/test/golden/basic-ir/lookup-record.output index 39e28cb6..343bc716 100644 --- a/packages/coln-compiler/test/golden/basic-ir/lookup-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/lookup-record.output @@ -1,14 +1,17 @@ -- elaborated global entry named Payload +in mode: Conjunctive type: Set value: sig name : String rank : Int end global entry named fixed +in mode: Conjunctive type: Payload value: [name := "fixed", rank := 1] global entry named T +in mode: Conjunctive type: Theory value: sig E : Payload -> Set diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output b/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output index 2ca90fd4..5e902b42 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output @@ -1,15 +1,18 @@ -- elaborated global entry named Payload +in mode: Conjunctive type: Set value: sig name : String end global entry named Box +in mode: Conjunctive type: (X : Set) -> Set value: X => sig value : X end global entry named T +in mode: Conjunctive type: Theory value: sig boxed : Box Payload -> Set diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record-model.output b/packages/coln-compiler/test/golden/basic-ir/param-record-model.output index 0f4b510f..dfb83e32 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record-model.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record-model.output @@ -1,21 +1,25 @@ -- elaborated global entry named Model +in mode: Conjunctive type: Theory value: sig X : Set end global entry named Payload +in mode: Conjunctive type: Set value: sig name : String end global entry named Box +in mode: Conjunctive type: (M : Model) -> (Y : Set) -> Set value: M => Y => sig modelValue : M.X value : Y end global entry named T +in mode: Conjunctive type: Theory value: sig model : Model diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output b/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output index 43af4248..9de21eae 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output @@ -1,16 +1,19 @@ -- elaborated global entry named Box +in mode: Conjunctive type: (X : Set) -> Set value: X => sig value : X end global entry named Nested +in mode: Conjunctive type: (X : Set) -> Set value: X => sig inner : Box X sibling : X end global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record.output b/packages/coln-compiler/test/golden/basic-ir/param-record.output index 1fd96246..e0234631 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record.output @@ -1,10 +1,12 @@ -- elaborated global entry named Box +in mode: Conjunctive type: (X : Set) -> Set value: X => sig value : X end global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output b/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output index a3e83bf5..50f9933d 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output @@ -1,15 +1,18 @@ -- elaborated global entry named Model +in mode: Conjunctive type: Theory value: sig X : Set end global entry named PointOf +in mode: Conjunctive type: (M : Model) -> Theory value: M => sig point : M.X end global entry named T +in mode: Conjunctive type: Theory value: sig model : Model diff --git a/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output b/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output index 9cbece3f..6df8abd0 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output @@ -1,15 +1,18 @@ -- elaborated global entry named PointOf +in mode: Conjunctive type: (X : Set) -> Theory value: X => sig point : X end global entry named Pointed +in mode: Conjunctive type: (X : Set) -> Theory value: X => sig inner : PointOf X end global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/param-theory.output b/packages/coln-compiler/test/golden/basic-ir/param-theory.output index fc890cbc..f16fc075 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-theory.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-theory.output @@ -1,10 +1,12 @@ -- elaborated global entry named PointOf +in mode: Conjunctive type: (X : Set) -> Theory value: X => sig point : X end global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/projection.output b/packages/coln-compiler/test/golden/basic-ir/projection.output index e7ec4a1e..7fb6bbd7 100644 --- a/packages/coln-compiler/test/golden/basic-ir/projection.output +++ b/packages/coln-compiler/test/golden/basic-ir/projection.output @@ -1,11 +1,13 @@ -- elaborated global entry named Payload +in mode: Conjunctive type: (X : Set) -> Set value: X => sig first : X second : X end global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output b/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output index 240caa01..1db84b7f 100644 --- a/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output +++ b/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output @@ -1,5 +1,6 @@ -- elaborated global entry named EqualTriple +in mode: Conjunctive type: (X : Set) -> Set value: X => sig first : X @@ -8,6 +9,7 @@ value: X => sig trailing : X end global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output b/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output index 82de7ce1..ca155bc8 100644 --- a/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output +++ b/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output @@ -1,5 +1,6 @@ -- elaborated global entry named EqualTriple +in mode: Conjunctive type: (X : Set) -> Set value: X => sig first : X @@ -8,6 +9,7 @@ value: X => sig trailing : X end global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/proof-record.output b/packages/coln-compiler/test/golden/basic-ir/proof-record.output index bbe47ee9..d0be92b4 100644 --- a/packages/coln-compiler/test/golden/basic-ir/proof-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/proof-record.output @@ -1,10 +1,12 @@ -- elaborated global entry named Witness +in mode: Conjunctive type: (X : Set) -> (x : X) -> Set value: X => x => sig proof : x = x end global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/prop-multi-argument.output b/packages/coln-compiler/test/golden/basic-ir/prop-multi-argument.output index 2c0df80e..9b51f62a 100644 --- a/packages/coln-compiler/test/golden/basic-ir/prop-multi-argument.output +++ b/packages/coln-compiler/test/golden/basic-ir/prop-multi-argument.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/prop-record.output b/packages/coln-compiler/test/golden/basic-ir/prop-record.output index 0b1afcb4..26c83c86 100644 --- a/packages/coln-compiler/test/golden/basic-ir/prop-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/prop-record.output @@ -1,11 +1,13 @@ -- elaborated global entry named And +in mode: Conjunctive type: (P : Prop) -> (Q : Prop) -> Prop value: P => Q => sig left : P right : Q end global entry named T +in mode: Conjunctive type: Theory value: sig P : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/prop.output b/packages/coln-compiler/test/golden/basic-ir/prop.output index e54fbb16..00286c00 100644 --- a/packages/coln-compiler/test/golden/basic-ir/prop.output +++ b/packages/coln-compiler/test/golden/basic-ir/prop.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig V : Prop diff --git a/packages/coln-compiler/test/golden/basic-ir/record-field-order.output b/packages/coln-compiler/test/golden/basic-ir/record-field-order.output index c2db09cf..776f7187 100644 --- a/packages/coln-compiler/test/golden/basic-ir/record-field-order.output +++ b/packages/coln-compiler/test/golden/basic-ir/record-field-order.output @@ -1,11 +1,13 @@ -- elaborated global entry named Pair +in mode: Conjunctive type: Set value: sig first : Int second : Int end global entry named T +in mode: Conjunctive type: Theory value: sig E : Int -> Int -> Set diff --git a/packages/coln-compiler/test/golden/basic-ir/record.output b/packages/coln-compiler/test/golden/basic-ir/record.output index 5b1ea068..ee5e7338 100644 --- a/packages/coln-compiler/test/golden/basic-ir/record.output +++ b/packages/coln-compiler/test/golden/basic-ir/record.output @@ -1,11 +1,13 @@ -- elaborated global entry named Payload +in mode: Conjunctive type: Set value: sig name : String rank : Int end global entry named T +in mode: Conjunctive type: Theory value: sig point : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/repeated-binders.output b/packages/coln-compiler/test/golden/basic-ir/repeated-binders.output index ed5d0ee0..08a33de8 100644 --- a/packages/coln-compiler/test/golden/basic-ir/repeated-binders.output +++ b/packages/coln-compiler/test/golden/basic-ir/repeated-binders.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/rule-literals.output b/packages/coln-compiler/test/golden/basic-ir/rule-literals.output index 30ac2203..7b2ad8a5 100644 --- a/packages/coln-compiler/test/golden/basic-ir/rule-literals.output +++ b/packages/coln-compiler/test/golden/basic-ir/rule-literals.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig X : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/set.output b/packages/coln-compiler/test/golden/basic-ir/set.output index 02750de5..b7a9cccb 100644 --- a/packages/coln-compiler/test/golden/basic-ir/set.output +++ b/packages/coln-compiler/test/golden/basic-ir/set.output @@ -1,5 +1,6 @@ -- elaborated global entry named T +in mode: Conjunctive type: Theory value: sig V : Set diff --git a/packages/coln-compiler/test/golden/basic-ir/theory-alias.output b/packages/coln-compiler/test/golden/basic-ir/theory-alias.output index bbaa0e75..a4b174a1 100644 --- a/packages/coln-compiler/test/golden/basic-ir/theory-alias.output +++ b/packages/coln-compiler/test/golden/basic-ir/theory-alias.output @@ -1,10 +1,12 @@ -- elaborated global entry named Base +in mode: Conjunctive type: Theory value: sig X : Set end global entry named Alias +in mode: Conjunctive type: Theory value: Base realm named TRealm diff --git a/packages/coln-compiler/test/golden/elaborator-errors.output b/packages/coln-compiler/test/golden/elaborator-errors.output index 89a00509..f0aa305d 100644 --- a/packages/coln-compiler/test/golden/elaborator-errors.output +++ b/packages/coln-compiler/test/golden/elaborator-errors.output @@ -1,26 +1,32 @@ -- elaborated global entry named Pair +in mode: Conjunctive type: Set value: sig first : Int second : Int end global entry named pair +in mode: Conjunctive type: Pair value: [first := 1, second := 2] global entry named Dependent +in mode: Conjunctive type: Theory value: sig A : Set value : A end global entry named dependent +in mode: Conjunctive type: Dependent value: [A := Int, value := 1] global entry named identity +in mode: Conjunctive type: Int -> Int value: x => x global entry named shadow +in mode: Conjunctive type: (x : String) -> Int -> Int value: x => x => x diff --git a/packages/coln-compiler/test/golden/equality.coln b/packages/coln-compiler/test/golden/equality.coln index e352505f..118bc1f7 100644 --- a/packages/coln-compiler/test/golden/equality.coln +++ b/packages/coln-compiler/test/golden/equality.coln @@ -1,6 +1,6 @@ -theory ReflexiveRelation (X : Set) := sig - rel : X -> X -> Prop - refl : (x : X) -> rel x x +theory ReflexiveRelation (^i X : Set) := sig + rel : (^i x : X) -> (^i y : X) -> Prop + refl : (^i x : X) -> rel x x end ind def Eq (X : Set) : ReflexiveRelation X := init (ReflexiveRelation X) diff --git a/packages/coln-compiler/test/golden/equality.output b/packages/coln-compiler/test/golden/equality.output index dc8a867b..0826d3f6 100644 --- a/packages/coln-compiler/test/golden/equality.output +++ b/packages/coln-compiler/test/golden/equality.output @@ -3,7 +3,7 @@ global entry named ReflexiveRelation in mode: Conjunctive type: (X : Set) -> Theory value: X => sig - rel : X -> X -> Prop + rel : (x : X) -> (y : X) -> Prop refl : (x : X) -> rel x x end global entry named Eq diff --git a/packages/coln-compiler/test/golden/fb3.output b/packages/coln-compiler/test/golden/fb3.output index 7d714b29..9aece229 100644 --- a/packages/coln-compiler/test/golden/fb3.output +++ b/packages/coln-compiler/test/golden/fb3.output @@ -1,8 +1,12 @@ -- elaborated - +global entry named IdempotentSemigroup +in mode: Conjunctive +type: Theory +value: sig + Element : Set + mul : (x : Element) -> (y : Element) -> Element + mul/idempotent : (x : Element) -> mul x x = x + mul/assoc : (x : Element) -> (y : Element) -> (z : Element) -> mul (mul x y) z = mul x (mul y z) +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -7 | mul/idempotent : (x : Element) -> mul x x = x -7 | ^ diff --git a/packages/coln-compiler/test/golden/graph-of-graphs.output b/packages/coln-compiler/test/golden/graph-of-graphs.output index 98ebf916..63d1ce8d 100644 --- a/packages/coln-compiler/test/golden/graph-of-graphs.output +++ b/packages/coln-compiler/test/golden/graph-of-graphs.output @@ -6,6 +6,21 @@ value: sig V : Set E : V -> V -> Set end +global entry named Graph/hom +in mode: Conjunctive +type: (G0 : Graph) -> (G1 : Graph) -> Theory +value: G0 => G1 => sig + V : G0.V -> G1.V + E : (v0 : G0.V) -> (v1 : G0.V) -> G0.E v0 v1 -> G1.E (V v0) (V v1) +end +global entry named GraphOfGraphs +in mode: Conjunctive +type: Theory +value: sig + base : Graph + fiber : base.V -> Graph + action : (v0 : base.V) -> (v1 : base.V) -> base.E v0 v1 -> Graph/hom (fiber v0) (fiber v1) +end realm named GraphRealm generators: node V = rel [] @@ -24,17 +39,139 @@ lowered: flatrealm ] ⊢ a ∈ ℜ.V [] ∧ b ∈ ℜ.V [] end end +realm named GraphOfGraphsRealm +generators: node + base = node + V = rel [] + E = rel [a : GraphOfGraphsRealm.base.V [], b : GraphOfGraphsRealm.base.V []] + end + fiber = node + V = rel [a : GraphOfGraphsRealm.base.V []] + E = rel [ + a : GraphOfGraphsRealm.base.V [], + b : GraphOfGraphsRealm.fiber.V [a := a], + c : GraphOfGraphsRealm.fiber.V [a := a] + ] + end + action = node + V = (fun [ + v0 : GraphOfGraphsRealm.base.V [], + v1 : GraphOfGraphsRealm.base.V [], + a : GraphOfGraphsRealm.base.E [a := v0, b := v1], + b : GraphOfGraphsRealm.fiber.V [a := v0] + ] -> GraphOfGraphsRealm.fiber.V [a := v1]) + E = (fun [ + v0 : GraphOfGraphsRealm.base.V [], + v1 : GraphOfGraphsRealm.base.V [], + a : GraphOfGraphsRealm.base.E [a := v0, b := v1], + v0/a : GraphOfGraphsRealm.fiber.V [a := v0], + v1/a : GraphOfGraphsRealm.fiber.V [a := v0], + b : GraphOfGraphsRealm.fiber.E [a := v0, b := v0/a, c := v1/a] + ] -> GraphOfGraphsRealm.fiber.E [ + a := v1, + b := GraphOfGraphsRealm.action.V [v0 := v0, v1 := v1, a := a, b := v0/a], + c := GraphOfGraphsRealm.action.V [v0 := v0, v1 := v1, a := a, b := v1/a] + ]) + end +end +lowered: flatrealm + entities + table ℜ.base.V := [] + table ℜ.base.E := [.a : ℜ.base.V, .b : ℜ.base.V] + table ℜ.fiber.V := [.a : ℜ.base.V] + table ℜ.fiber.E := [.a : ℜ.base.V, .b : ℜ.fiber.V, .c : ℜ.fiber.V] + table ℜ.action.V := [ + .v0 : ℜ.base.V, + .v1 : ℜ.base.V, + .a : ℜ.base.E, + .b : ℜ.fiber.V, + .c : ℜ.fiber.V + ] primarykey [.a, .b, .v0, .v1] + table ℜ.action.E := [ + .v0 : ℜ.base.V, + .v1 : ℜ.base.V, + .a : ℜ.base.E, + .v0/a : ℜ.fiber.V, + .v1/a : ℜ.fiber.V, + .b : ℜ.fiber.E, + .c : ℜ.fiber.E + ] primarykey [.a, .b, .v0, .v1, .v0/a, .v1/a] + end + rules + enforced ℜ.base.V.foreignKey := ℜ.base.V [] ⊢ ⊤ + enforced ℜ.base.E.foreignKey a b := ℜ.base.E [ + .a ↦ a, + .b ↦ b + ] ⊢ a ∈ ℜ.base.V [] ∧ b ∈ ℜ.base.V [] + enforced ℜ.fiber.V.foreignKey a := ℜ.fiber.V [.a ↦ a] ⊢ a ∈ ℜ.base.V [] + enforced ℜ.fiber.E.foreignKey a b c := ℜ.fiber.E [ + .a ↦ a, + .b ↦ b, + .c ↦ c + ] ⊢ a ∈ ℜ.base.V [] ∧ b ∈ ℜ.fiber.V [.a ↦ a] ∧ c ∈ ℜ.fiber.V [.a ↦ a] + enforced ℜ.action.V.foreignKey v0 v1 a b c := ℜ.action.V [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .b ↦ b, + .c ↦ c + ] ⊢ v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ + .a ↦ v0, + .b ↦ v1 + ] ∧ b ∈ ℜ.fiber.V [.a ↦ v0] ∧ c ∈ ℜ.fiber.V [.a ↦ v1] + monitored ℜ.action.V.total v0 v1 a b := v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ + .a ↦ v0, + .b ↦ v1 + ] ∧ b ∈ ℜ.fiber.V [.a ↦ v0] ⊢ ℜ.action.V [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .b ↦ b + ] + enforced ℜ.action.E.foreignKey v0 v1 a v0/a v1/a b c c.b c.c := ℜ.action.E [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .v0/a ↦ v0/a, + .v1/a ↦ v1/a, + .b ↦ b, + .c ↦ c + ] ∧ ℜ.action.V [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .b ↦ v0/a, + .c ↦ c.b + ] ∧ ℜ.action.V [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .b ↦ v1/a, + .c ↦ c.c + ] ⊢ v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ + .a ↦ v0, + .b ↦ v1 + ] ∧ v0/a ∈ ℜ.fiber.V [.a ↦ v0] ∧ v1/a ∈ ℜ.fiber.V [ + .a ↦ v0 + ] ∧ b ∈ ℜ.fiber.E [.a ↦ v0, .b ↦ v0/a, .c ↦ v1/a] ∧ c ∈ ℜ.fiber.E [ + .a ↦ v1, + .b ↦ c.b, + .c ↦ c.c + ] + monitored ℜ.action.E.total v0 v1 a v0/a v1/a b := v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ + .a ↦ v0, + .b ↦ v1 + ] ∧ v0/a ∈ ℜ.fiber.V [.a ↦ v0] ∧ v1/a ∈ ℜ.fiber.V [ + .a ↦ v0 + ] ∧ b ∈ ℜ.fiber.E [.a ↦ v0, .b ↦ v0/a, .c ↦ v1/a] ⊢ ℜ.action.E [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .v0/a ↦ v0/a, + .v1/a ↦ v1/a, + .b ↦ b + ] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -15 | V : G0.V -> G1.V -15 | ^^ - -error[E0314]: no such variable Graph/hom in scope -22 | action : (v0 : base.V) -> (v1 : base.V) -> base.E v0 v1 -> Graph/hom (fiber v0) (fiber v1) -22 | ^^^^^^^^^ - -error[E0314]: no such variable GraphOfGraphs in scope -25 | realm GraphOfGraphsRealm @ GraphOfGraphs -25 | ^^^^^^^^^^^^^ diff --git a/packages/coln-compiler/test/golden/hlevel.output b/packages/coln-compiler/test/golden/hlevel.output index c1e8b8b3..80e29d42 100644 --- a/packages/coln-compiler/test/golden/hlevel.output +++ b/packages/coln-compiler/test/golden/hlevel.output @@ -7,6 +7,13 @@ value: sig is-parent : person -> person -> Prop happy : Prop end +global entry named Q +in mode: Conjunctive +type: (F : Family) -> Theory +value: F => sig + son : F.person + father : F.person +end global entry named HP in mode: Conjunctive type: Theory @@ -58,9 +65,13 @@ debug[D0315]: type person -> happy has level Level {mlevel = Theory, hlevel = HP 13 | showlevel person -> happy 13 | ^^^^^^^^^^^^^^^ -error[E0316]: cannot use inductively bound variable in a conjunctive context -17 | son : F.person -17 | ^ +debug[D0315]: value F.is-parent has type F.person -> F.person -> Prop +20 | showtype F.is-parent +20 | ^^^^^^^^^^^ + +debug[D0315]: value F.is-parent father son has type Prop +21 | showtype F.is-parent father son +21 | ^^^^^^^^^^^^^^^^^^^^^^ debug[D0315]: type voldemort = tomriddle has level Level {mlevel = Set, hlevel = HProp} 31 | showlevel voldemort = tomriddle @@ -90,6 +101,15 @@ debug[D0315]: type u = u has level Level {mlevel = Set, hlevel = HUnit} 48 | showlevel u = u 48 | ^^^^^ -error[E0316]: cannot use inductively bound variable in a conjunctive context +error[E0307]: type sig + f : A -> P + a : A +end too large for universe Set +51 | def LevelJoinRecordIsNotSet (A : Set) (P : Prop) : Set := sig +51 | ^^^ 52 | f : A -> P -52 | ^ +52 | ^^^^^^^^^^^^ +53 | a : A +53 | ^^^^^^^ +54 | end +54 | ^^^ diff --git a/packages/coln-compiler/test/golden/ind.output b/packages/coln-compiler/test/golden/ind.output index 6fbe783b..4d77d8a8 100644 --- a/packages/coln-compiler/test/golden/ind.output +++ b/packages/coln-compiler/test/golden/ind.output @@ -18,13 +18,13 @@ value: G => sig incl : (v0 : G.v) -> (v1 : G.v) -> G.e v0 v1 -> p v0 v1 snoc : (v0 : G.v) -> (v1 : G.v) -> (v2 : G.v) -> p v0 v1 -> G.e v1 v2 -> p v0 v2 end -global entry named transitive-closure -in mode: Inductive -type: (G : Graph) -> TransitiveExt G -value: G => init (TransitiveExt G) -- messages +error[E0316]: cannot use inductively bound variable in a conjunctive context +14 | ind def transitive-closure (G : Graph) : TransitiveExt G := init (TransitiveExt G) +14 | ^ + error[E0316]: cannot use inductively bound variable in a conjunctive context 16 | ind def freept (X : Set) : X := init X 16 | ^ diff --git a/packages/coln-compiler/test/golden/modular-lattice.output b/packages/coln-compiler/test/golden/modular-lattice.output index d77628e3..6ce2c1c4 100644 --- a/packages/coln-compiler/test/golden/modular-lattice.output +++ b/packages/coln-compiler/test/golden/modular-lattice.output @@ -1,12 +1,24 @@ -- elaborated - +global entry named ModularLattice +in mode: Conjunctive +type: Theory +value: sig + Element : Set + meet : Element -> Element -> Element + meet/associative : (a : Element) -> (b : Element) -> (c : Element) -> meet (meet a b) c = meet a (meet b c) + meet/commutative : (a : Element) -> (b : Element) -> meet a b = meet b a + meet/idempotent : (a : Element) -> meet a a = a + join : Element -> Element -> Element + join/associative : (a : Element) -> (b : Element) -> (c : Element) -> join (join a b) c = join a (join b c) + join/associative : (a : Element) -> (b : Element) -> join a b = join b a + join/idempotent : (a : Element) -> join a a = a + ax/absorptive1 : (a : Element) -> (b : Element) -> meet a (join a b) = a + ax/absorptive2 : (a : Element) -> (b : Element) -> join a (meet a b) = a + ax/modular : (a : Element) -> (b : Element) -> (x : Element) -> join (meet a b) (meet x b) = meet (join (meet a b) x) b +end -- messages -error[E0316]: cannot use inductively bound variable in a conjunctive context -17 | meet a a = a -17 | ^ - error[E0200]: unexpected notation for field setting of the form ` := `: Infix 49 | bot : Element 49 | ^^^^^^^^^^^^^ diff --git a/packages/coln-compiler/test/golden/monoid-glog.output b/packages/coln-compiler/test/golden/monoid-glog.output index 83ab7ebc..b91ffdd8 100644 --- a/packages/coln-compiler/test/golden/monoid-glog.output +++ b/packages/coln-compiler/test/golden/monoid-glog.output @@ -1,8 +1,14 @@ -- elaborated - +global entry named Monoid +in mode: Conjunctive +type: Theory +value: sig + car : Set + unit : car + mul : car -> car -> car + mul/unitl : (x : car) -> mul unit x = x + mul/unitr : (x : car) -> mul x unit = x + mul/assoc : (x : car) -> (y : car) -> (z : car) -> mul (mul x y) z = mul x (mul y z) +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -6 | mul/unitl : (x : car) -> mul unit x = x -6 | ^ diff --git a/packages/coln-compiler/test/golden/ssa.output b/packages/coln-compiler/test/golden/ssa.output index f5534860..034c28a0 100644 --- a/packages/coln-compiler/test/golden/ssa.output +++ b/packages/coln-compiler/test/golden/ssa.output @@ -1,4 +1,28 @@ -- elaborated +global entry named IsTransClosure +in mode: Conjunctive +type: (X : Set) -> (R : X -> X -> Set) -> (P : X -> X -> Set) -> Theory +value: X => R => P => sig + refl : (x : X) -> P x x + snoc : (x : X) -> (y : X) -> (z : X) -> P x y -> R y z -> P x z +end +global entry named LinearOrder +in mode: Conjunctive +type: Theory +value: sig + car : Set + first : car + last : car + next : car -> car + prev : car -> car + next/prev : (x : car) -> next (prev x) = x + prev/next : (x : car) -> prev (next x) = x + follows : car -> car -> Set + follows/is-trans-closure : IsTransClosure car (x => y => next x = y) follows + acyclic : (x : car) -> (y : car) -> follows x y -> follows y x -> x = y + first-is-top : (x : car) -> follows first x + last-is-bot : (x : car) -> follows x last +end global entry named OpInfo in mode: Conjunctive type: Theory @@ -7,33 +31,47 @@ value: sig inputArity : OpType -> Set outputArity : OpType -> Set end +global entry named Iso +in mode: Conjunctive +type: (A : Set) -> (B : Set) -> Theory +value: A => B => sig + fwd : A -> B + bwd : B -> A + fwd/bwd : (a : A) -> bwd (fwd a) = a + bwd/fwd : (b : B) -> fwd (bwd b) = b +end +global entry named Operation +in mode: Conjunctive +type: (opInfo : OpInfo) -> (val : Set) -> (outputs : Set) -> Theory +value: opInfo => val => outputs => sig + opType : opInfo.OpType + opInputs : opInfo.inputArity opType -> val + opOutputs : Iso outputs (opInfo.outputArity opType) +end +global entry named PrecedingOutput +in mode: Conjunctive +type: (X : Set) -> (rel : X -> X -> Set) -> (x : X) -> (outputs : X -> Set) -> Set +value: X => rel => x => outputs => sig + y : X + isPreceding : rel y x + output : outputs y +end +global entry named Block +in mode: Conjunctive +type: (opInfo : OpInfo) -> Theory +value: opInfo => sig + ops : LinearOrder + outputs : ops.car -> Set + payload : (x : ops.car) -> Operation opInfo (PrecedingOutput ops.car ops.follows x outputs) (outputs x) + args : LinearOrder +end +global entry named SSA +in mode: Conjunctive +type: (opInfo : OpInfo) -> Theory +value: opInfo => sig + RegionId : Set + BlockId : RegionId -> Set + ops : (r : RegionId) -> BlockId r -> Block opInfo +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -2 | refl : (x : X) -> P x x -2 | ^ - -error[E0316]: cannot use inductively bound variable in a conjunctive context -13 | next/prev : (x : car) -> next (prev x) = x -13 | ^ - -error[E0316]: cannot use inductively bound variable in a conjunctive context -32 | fwd : A -> B -32 | ^ - -error[E0316]: cannot use inductively bound variable in a conjunctive context -39 | opType : opInfo.OpType -39 | ^^^^^^ - -error[E0316]: cannot use inductively bound variable in a conjunctive context -45 | y : X -45 | ^ - -error[E0314]: no such variable LinearOrder in scope -51 | ops : LinearOrder -51 | ^^^^^^^^^^^ - -error[E0314]: no such variable Block in scope -65 | ops : (r : RegionId) -> BlockId r -> Block opInfo -65 | ^^^^^ diff --git a/packages/coln-repl/src/Coln/REPL.hs b/packages/coln-repl/src/Coln/REPL.hs index c42d5cde..4b019417 100644 --- a/packages/coln-repl/src/Coln/REPL.hs +++ b/packages/coln-repl/src/Coln/REPL.hs @@ -6,14 +6,14 @@ module Coln.REPL (runRepl) where import Coln.Common import Coln.Core.Globals -import Coln.Core.Params (CtxShape (..), N) +import Coln.Core.Params (CtxShape (..), N, Mode (..)) import Coln.Core.Print (DPrettyWithNames (dprettyWithNames), prtIn) import Coln.Core.Realm (Realm) import Coln.Diagnostics import Coln.Elaborator.Environment (emptyElabEnv) import Coln.Elaborator.Judgment (Syn (..)) import Coln.Frontend.Notation -import Coln.Frontend.Parser (decl', syn) +import Coln.Frontend.Parser (decl, syn) import Control.Monad import Control.Monad.State.Strict import Control.Monad.Writer @@ -81,15 +81,15 @@ eval file = do case ntn of -- register declaration Decl name _ _ -> do - put =<< liftIO (decl' diagEnv ge ntn) + put =<< liftIO (decl diagEnv ge ntn) tell [name] -- ignore realms Block "realm" _ _ _ -> pure () -- evaluate expression _ -> liftIO do - let elabEnv = emptyElabEnv (envFor ElaboratorCode) ge - ntnSyn <- (syn @N) diagEnv "" ntn + let elabEnv = emptyElabEnv (envFor ElaboratorCode) ge Conjunctive + ntnSyn <- (syn @N) (contramap ParserCode diagEnv) "" ntn (t, m) <- ntnSyn.elab elabEnv putDoc $ prtIn elabEnv m <+> ":" <+> prtIn elabEnv t <+> "\n" diff --git a/packages/fnotation/src/FNotation/Kinds.hs b/packages/fnotation/src/FNotation/Kinds.hs index 7be62f2d..d8d5eea4 100644 --- a/packages/fnotation/src/FNotation/Kinds.hs +++ b/packages/fnotation/src/FNotation/Kinds.hs @@ -24,6 +24,7 @@ data Kind | Field | -- | No-space field, like the `x` in `f.x` FieldImmediate + | Mode | Int | String | LParen diff --git a/packages/fnotation/src/FNotation/Lexer.hs b/packages/fnotation/src/FNotation/Lexer.hs index 8408df4d..ae3892d0 100644 --- a/packages/fnotation/src/FNotation/Lexer.hs +++ b/packages/fnotation/src/FNotation/Lexer.hs @@ -320,6 +320,7 @@ run st fresh = '\"' -> string st >> run st False '.' -> advance st >> tryName st (if fresh then Field else FieldImmediate) "period" >> run st False '\'' -> advance st >> tryName st Tag "single quote" >> run st False + '^' -> advance st >> tryName st Mode "at sign" >> run st False '\0' -> emit0 st Eof '`' -> ident st >> run st False c | isDigit c -> (int st >>= emit st Int . VInt) >> run st False diff --git a/packages/fnotation/src/FNotation/Pretty.hs b/packages/fnotation/src/FNotation/Pretty.hs index 04ea4348..4ed8cb7a 100644 --- a/packages/fnotation/src/FNotation/Pretty.hs +++ b/packages/fnotation/src/FNotation/Pretty.hs @@ -92,6 +92,7 @@ prt p = \case Keyword x _ -> dpretty x Field x _ -> "." <> dprettyWithKinds ?lconfig x Tag x _ -> "'" <> dprettyWithKinds ?lconfig x + Mode x _ -> "^" <> dprettyWithKinds ?lconfig x Int i _ -> pretty i String x _ -> "\"" <> pretty x <> "\"" Tuple ns _ -> bracketedTuple $ prtTop <$> ns diff --git a/packages/fnotation/src/FNotation/Reader.hs b/packages/fnotation/src/FNotation/Reader.hs index becdb30b..b213a886 100644 --- a/packages/fnotation/src/FNotation/Reader.hs +++ b/packages/fnotation/src/FNotation/Reader.hs @@ -181,6 +181,7 @@ argStarts = , T.AKeyword , T.Field , T.Tag + , T.Mode , T.Int , T.String , T.Block @@ -236,6 +237,9 @@ argBase st = do T.Tag -> do x <- curName st advanceClose st m $ Tag x + T.Mode -> do + x <- curName st + advanceClose st m $ Mode x T.Int -> do i <- curInt st advanceClose st m $ Int i diff --git a/packages/fnotation/src/FNotation/Trees.hs b/packages/fnotation/src/FNotation/Trees.hs index 54b66c1f..ad9738c4 100644 --- a/packages/fnotation/src/FNotation/Trees.hs +++ b/packages/fnotation/src/FNotation/Trees.hs @@ -37,6 +37,7 @@ data NtnGeneric a | Keyword Name a | Field Name a | Tag Name a + | Mode Name a | Int Int a | String Text a | Error a @@ -68,6 +69,7 @@ startPos (Ident _ s) = s.start startPos (Keyword _ s) = s.start startPos (Field _ s) = s.start startPos (Tag _ s) = s.start +startPos (Mode _ s) = s.start startPos (Int _ s) = s.start startPos (String _ s) = s.start startPos (Tuple _ s) = s.start @@ -82,6 +84,7 @@ endPos (Ident _ s) = s.end endPos (Keyword _ s) = s.end endPos (Field _ s) = s.end endPos (Tag _ s) = s.end +endPos (Mode _ s) = s.end endPos (Int _ s) = s.end endPos (String _ s) = s.end endPos (Tuple _ s) = s.end @@ -102,6 +105,7 @@ head (Ident x _) = "Ident" <+> dpretty x head (Keyword x _) = "Keyword" <+> dpretty x head (Field x _) = "Field" <+> dpretty x head (Tag x _) = "Tag" <+> dpretty x +head (Mode x _) = "Mode" <+> dpretty x head (Int i _) = "Int" <+> pretty i head (String s _) = "String" <+> pretty s head (Tuple _ _) = "Tuple" @@ -116,6 +120,7 @@ children (Ident _ _) = [] children (Keyword _ _) = [] children (Field _ _) = [] children (Tag _ _) = [] +children (Mode _ _) = [] children (Int _ _) = [] children (String _ _) = [] children (Tuple ns _) = ns From 5949635003f560df37825b39b8e72a8e3bd55796 Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Thu, 23 Jul 2026 16:41:52 -0400 Subject: [PATCH 07/13] formatting --- packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs | 1 - packages/coln-repl/src/Coln/REPL.hs | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs index cdcd1d21..fd49c6a0 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs @@ -1,7 +1,6 @@ -- SPDX-FileCopyrightText: 2026 Coln contributors -- -- SPDX-License-Identifier: Apache-2.0 OR MIT - {-# LANGUAGE TypeAbstractions #-} module Coln.Frontend.Parser.Expr where diff --git a/packages/coln-repl/src/Coln/REPL.hs b/packages/coln-repl/src/Coln/REPL.hs index 4b019417..07b42a56 100644 --- a/packages/coln-repl/src/Coln/REPL.hs +++ b/packages/coln-repl/src/Coln/REPL.hs @@ -6,7 +6,7 @@ module Coln.REPL (runRepl) where import Coln.Common import Coln.Core.Globals -import Coln.Core.Params (CtxShape (..), N, Mode (..)) +import Coln.Core.Params (CtxShape (..), Mode (..), N) import Coln.Core.Print (DPrettyWithNames (dprettyWithNames), prtIn) import Coln.Core.Realm (Realm) import Coln.Diagnostics From 9a7193226b4fa7c96611ac5c604e66c5b3bf742b Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Thu, 23 Jul 2026 16:55:41 -0400 Subject: [PATCH 08/13] temporarily disable PR preview --- .github/workflows/web-demos.yml | 171 ++++++++++++++++---------------- 1 file changed, 85 insertions(+), 86 deletions(-) diff --git a/.github/workflows/web-demos.yml b/.github/workflows/web-demos.yml index e7b9c6f8..df93af1b 100644 --- a/.github/workflows/web-demos.yml +++ b/.github/workflows/web-demos.yml @@ -13,99 +13,98 @@ concurrency: group: web-demos-${{ github.event_name }}-${{ github.event.pull_request.number || github.ref }} cancel-in-progress: true -# jobs: -# build-and-deploy: -# runs-on: ubuntu-latest -# env: -# CARGO_TARGET_DIR: ${{ github.workspace }}/target -# NETLIFY_AUTH_TOKEN: ${{ secrets.NETLIFY_AUTH_TOKEN }} -# NETLIFY_SITE_ID: ${{ secrets.NETLIFY_SITE_ID }} +jobs: + build-and-deploy: + runs-on: ubuntu-latest + env: + CARGO_TARGET_DIR: ${{ github.workspace }}/target + NETLIFY_AUTH_TOKEN: ${{ secrets.NETLIFY_AUTH_TOKEN }} + NETLIFY_SITE_ID: ${{ secrets.NETLIFY_SITE_ID }} -# steps: -# - name: Checkout ⬇️ -# uses: actions/checkout@v6 + steps: + - name: Checkout ⬇️ + uses: actions/checkout@v6 -# - name: Install Nix ❄️ -# uses: cachix/install-nix-action@v31 + - name: Install Nix ❄️ + uses: cachix/install-nix-action@v31 -# - name: Set up Cachix ♻️ -# if: github.event_name != 'pull_request' || github.event.pull_request.head.repo.full_name == github.repository -# uses: cachix/cachix-action@v17 -# with: -# name: coln -# authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + - name: Set up Cachix ♻️ + if: github.event_name != 'pull_request' || github.event.pull_request.head.repo.full_name == github.repository + uses: cachix/cachix-action@v17 + with: + name: coln + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} -# - name: Restore build caches -# uses: actions/cache@v4 -# with: -# path: | -# .pnpm-store -# ~/.npm -# ~/.cargo/registry -# ~/.cargo/git -# ~/.ghc-wasm/.cabal -# target -# dist-newstyle -# key: web-demos-${{ runner.os }}-${{ hashFiles('flake.lock', 'Cargo.lock', 'cabal.project', 'packages/**/*.cabal', 'packages/coln-js-runtime/package-lock.json', 'examples/sync-demo/pnpm-lock.yaml') }} -# restore-keys: | -# web-demos-${{ runner.os }}- + - name: Restore build caches + uses: actions/cache@v4 + with: + path: | + .pnpm-store + ~/.npm + ~/.cargo/registry + ~/.cargo/git + ~/.ghc-wasm/.cabal + target + dist-newstyle + key: web-demos-${{ runner.os }}-${{ hashFiles('flake.lock', 'Cargo.lock', 'cabal.project', 'packages/**/*.cabal', 'packages/coln-js-runtime/package-lock.json', 'examples/sync-demo/pnpm-lock.yaml') }} + restore-keys: | + web-demos-${{ runner.os }}- -# - name: Build sync demo -# run: nix run --accept-flake-config .#sync-demo -- "$GITHUB_WORKSPACE" -# env: -# VITE_BASE: /sync/ + - name: Build sync demo + run: nix run --accept-flake-config .#sync-demo -- "$GITHUB_WORKSPACE" + env: + VITE_BASE: /sync/ -# - name: Build web compiler -# run: | -# nix develop --accept-flake-config --command wasm32-wasi-cabal update 'hackage.haskell.org,2026-07-15T17:07:49Z' -# nix develop --accept-flake-config --command just examples/build-web-compiler + - name: Build web compiler + run: | + nix develop --accept-flake-config --command wasm32-wasi-cabal update 'hackage.haskell.org,2026-07-15T17:07:49Z' + nix develop --accept-flake-config --command just examples/build-web-compiler -# - name: Assemble deploy directory -# run: | -# cp examples/index.html examples/style.css _build/web/ -# cp -r examples/sync-demo/dist _build/web/sync + - name: Assemble deploy directory + run: | + cp examples/index.html examples/style.css _build/web/ + cp -r examples/sync-demo/dist _build/web/sync -# - name: Deploy PR preview to Netlify -# id: deploy-preview -# if: github.event_name == 'pull_request' && env.NETLIFY_AUTH_TOKEN != '' && env.NETLIFY_SITE_ID != '' -# run: | -# npx --yes netlify-cli@latest deploy \ -# --auth "$NETLIFY_AUTH_TOKEN" \ -# --site "$NETLIFY_SITE_ID" \ -# --dir _build/web \ -# --no-build \ -# --alias "pr-${{ github.event.pull_request.number }}" \ -# --message "PR #${{ github.event.pull_request.number }} web demos" \ -# --json > netlify-deploy.json + - name: Deploy PR preview to Netlify + id: deploy-preview + if: github.event_name == 'pull_request' && env.NETLIFY_AUTH_TOKEN != '' && env.NETLIFY_SITE_ID != '' + run: | + npx --yes netlify-cli@latest deploy \ + --auth "$NETLIFY_AUTH_TOKEN" \ + --site "$NETLIFY_SITE_ID" \ + --dir _build/web \ + --no-build \ + --alias "pr-${{ github.event.pull_request.number }}" \ + --message "PR #${{ github.event.pull_request.number }} web demos" \ + --json > netlify-deploy.json -# cat netlify-deploy.json -# deploy_url=$(node -e "const d = require('./netlify-deploy.json'); console.log(d.deploy_ssl_url || d.ssl_url || d.deploy_url || d.url)") -# echo "deploy-url=$deploy_url" >> "$GITHUB_OUTPUT" + cat netlify-deploy.json + deploy_url=$(node -e "const d = require('./netlify-deploy.json'); console.log(d.deploy_ssl_url || d.ssl_url || d.deploy_url || d.url)") + echo "deploy-url=$deploy_url" >> "$GITHUB_OUTPUT" -# - name: Comment with deploy preview URL -# if: github.event_name == 'pull_request' && steps.deploy-preview.outputs.deploy-url != '' -# uses: actions/github-script@v8 -# with: -# script: | -# const marker = '' -# const body = `${marker}\nWeb demo preview: ${{ steps.deploy-preview.outputs.deploy-url }}` -# const { owner, repo } = context.repo -# const issue_number = context.issue.number -# const comments = await github.rest.issues.listComments({ owner, repo, issue_number, per_page: 100 }) -# const existing = comments.data.find(comment => comment.body?.includes(marker)) -# if (existing) { -# await github.rest.issues.updateComment({ owner, repo, comment_id: existing.id, body }) -# } else { -# await github.rest.issues.createComment({ owner, repo, issue_number, body }) -# } - -# - name: Deploy main to Netlify production -# if: github.event_name == 'push' && env.NETLIFY_AUTH_TOKEN != '' && env.NETLIFY_SITE_ID != '' -# run: | -# npx --yes netlify-cli@latest deploy \ -# --auth "$NETLIFY_AUTH_TOKEN" \ -# --site "$NETLIFY_SITE_ID" \ -# --dir _build/web \ -# --no-build \ -# --prod \ -# --message "web demos ${{ github.sha }}" + - name: Comment with deploy preview URL + if: github.event_name == 'pull_request' && steps.deploy-preview.outputs.deploy-url != '' + uses: actions/github-script@v8 + with: + script: | + const marker = '' + const body = `${marker}\nWeb demo preview: ${{ steps.deploy-preview.outputs.deploy-url }}` + const { owner, repo } = context.repo + const issue_number = context.issue.number + const comments = await github.rest.issues.listComments({ owner, repo, issue_number, per_page: 100 }) + const existing = comments.data.find(comment => comment.body?.includes(marker)) + if (existing) { + await github.rest.issues.updateComment({ owner, repo, comment_id: existing.id, body }) + } else { + await github.rest.issues.createComment({ owner, repo, issue_number, body }) + } + - name: Deploy main to Netlify production + if: github.event_name == 'push' && env.NETLIFY_AUTH_TOKEN != '' && env.NETLIFY_SITE_ID != '' + run: | + npx --yes netlify-cli@latest deploy \ + --auth "$NETLIFY_AUTH_TOKEN" \ + --site "$NETLIFY_SITE_ID" \ + --dir _build/web \ + --no-build \ + --prod \ + --message "web demos ${{ github.sha }}" From a05b525ca8d906dedd55ac5030b7357c2924a947 Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Mon, 27 Jul 2026 13:57:11 -0400 Subject: [PATCH 09/13] fix modal defaults --- .../src/Coln/Frontend/Parser/Expr.hs | 15 +- .../src/Coln/Frontend/Parser/Top.hs | 2 +- .../basic-ir/param-record-concrete.output | 38 ++--- .../golden/basic-ir/param-record-model.output | 46 ++--- .../basic-ir/param-record-nested.output | 71 ++------ .../test/golden/basic-ir/param-record.output | 43 ++--- .../golden/basic-ir/param-theory-model.output | 47 ++--- .../basic-ir/param-theory-nested.output | 58 ++----- .../test/golden/basic-ir/param-theory.output | 44 ++--- .../test/golden/basic-ir/projection.output | 57 ++----- .../golden/basic-ir/proof-record-mixed.output | 53 ++---- .../basic-ir/proof-record-parameter.output | 67 ++------ .../test/golden/basic-ir/proof-record.output | 42 ++--- .../test/golden/basic-ir/prop-record.output | 79 ++------- .../test/golden/elaborator-errors.output | 16 +- packages/coln-compiler/test/golden/fb3.output | 14 +- .../test/golden/graph-of-graphs.output | 161 ++---------------- .../coln-compiler/test/golden/hlevel.output | 30 +--- packages/coln-compiler/test/golden/ind.coln | 6 +- packages/coln-compiler/test/golden/ind.output | 20 +-- .../test/golden/modular-lattice.output | 22 +-- .../test/golden/monoid-glog.output | 16 +- packages/coln-compiler/test/golden/ssa.output | 94 +++------- 23 files changed, 250 insertions(+), 791 deletions(-) diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs index fd49c6a0..2b094e40 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Expr.hs @@ -46,9 +46,9 @@ debugCommand e sp x _ = unknownCommand e sp x binder :: ParserEnv -> Ntn -> IO Function.Binder binder e = \case N.Infix name (N.Keyword ":" _) arg -> do - (mode, x) <- modalIdent e name + (mode, x) <- modalIdent e Inductive name Function.Named mode x <$> typ e arg - n -> Function.Anonymous Conjunctive <$> typ e n + n -> Function.Anonymous Inductive <$> typ e n fieldDecl :: ParserEnv -> Ntn -> IO Record.FieldDeclaration fieldDecl e (N.Infix (N.Ident x _) (N.Keyword ":" _) n) = @@ -66,12 +66,13 @@ ident :: ParserEnv -> Ntn -> IO Name ident _ (N.Ident x _) = pure x ident e n = unexpectedNotation e n "identifier" -modalIdent :: ParserEnv -> Ntn -> IO (Mode, Name) -modalIdent _ (N.Ident x _) = pure (Conjunctive, x) -modalIdent _ (N.Juxt (N.Mode "i" _) (N.Ident x _)) = pure (Inductive, x) -modalIdent e (N.Juxt (N.Mode _ sp) (N.Ident _ _)) = +modalIdent :: ParserEnv -> Mode -> Ntn -> IO (Mode, Name) +modalIdent _ def (N.Ident x _) = pure (def, x) +modalIdent _ _ (N.Juxt (N.Mode "i" _) (N.Ident x _)) = pure (Inductive, x) +modalIdent _ _ (N.Juxt (N.Mode "c" _) (N.Ident x _)) = pure (Conjunctive, x) +modalIdent e _ (N.Juxt (N.Mode _ sp) (N.Ident _ _)) = failWith e sp UnknownMode "unknown mode" -modalIdent e n = unexpectedNotation e n "identifier, possibly with mode annotation" +modalIdent e _ n = unexpectedNotation e n "identifier, possibly with mode annotation" unexpectedNotation :: ParserEnv -> Ntn -> DDoc -> IO a unexpectedNotation e n c = do diff --git a/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs b/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs index 4840c6ec..3a241bb9 100644 --- a/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs +++ b/packages/coln-compiler/src/Coln/Frontend/Parser/Top.hs @@ -35,7 +35,7 @@ annot e n = unexpectedNotation e n "type-annotated expression, e.g. ` : argBinding :: ParserEnv -> Ntn -> IO (Span, Mode, Name, Typ N) argBinding e n@(N.Infix n0 (N.Keyword ":" _) n1) = do - (m, x) <- modalIdent e n0 + (m, x) <- modalIdent e Conjunctive n0 a <- typ e n1 pure (N.span n, m, x, a) argBinding e n = unexpectedNotation e n "argument binding of the form ` : `" diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output b/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output index 5e902b42..83663ff0 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output @@ -5,31 +5,17 @@ type: Set value: sig name : String end -global entry named Box -in mode: Conjunctive -type: (X : Set) -> Set -value: X => sig - value : X -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - boxed : Box Payload -> Set -end -realm named TRealm -generators: node - boxed = rel [a : Box Payload] -end -lowered: flatrealm - entities - table ℜ.boxed := [.a.value.name : String] - end - rules - enforced ℜ.boxed.foreignKey a.value.name := ℜ.boxed [ - .a.value.name ↦ a.value.name - ] ⊢ ⊤ - end -end -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +6 | value : X +6 | ^ + +error[E0314]: no such variable Box in scope +10 | boxed : Box Payload -> Set +10 | ^^^ + +error[E0314]: no such variable T in scope +13 | realm TRealm @ T +13 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record-model.output b/packages/coln-compiler/test/golden/basic-ir/param-record-model.output index dfb83e32..ea014589 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record-model.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record-model.output @@ -11,39 +11,17 @@ type: Set value: sig name : String end -global entry named Box -in mode: Conjunctive -type: (M : Model) -> (Y : Set) -> Set -value: M => Y => sig - modelValue : M.X - value : Y -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - model : Model - boxed : Box model Payload -> Set -end -realm named TRealm -generators: node - model = node - X = rel [] - end - boxed = rel [a : Box [X := TRealm.model.X []] Payload] -end -lowered: flatrealm - entities - table ℜ.model.X := [] - table ℜ.boxed := [.a.modelValue : ℜ.model.X, .a.value.name : String] - end - rules - enforced ℜ.model.X.foreignKey := ℜ.model.X [] ⊢ ⊤ - enforced ℜ.boxed.foreignKey a.modelValue a.value.name := ℜ.boxed [ - .a.modelValue ↦ a.modelValue, - .a.value.name ↦ a.value.name - ] ⊢ a.modelValue ∈ ℜ.model.X [] - end -end -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +10 | modelValue : M.X +10 | ^ + +error[E0314]: no such variable Box in scope +16 | boxed : Box model Payload -> Set +16 | ^^^ + +error[E0314]: no such variable T in scope +19 | realm TRealm @ T +19 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output b/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output index 9de21eae..bab4c768 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output @@ -1,57 +1,20 @@ -- elaborated -global entry named Box -in mode: Conjunctive -type: (X : Set) -> Set -value: X => sig - value : X -end -global entry named Nested -in mode: Conjunctive -type: (X : Set) -> Set -value: X => sig - inner : Box X - sibling : X -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - X : Set - nested : Nested X -> Set - selected : Nested X -> X -end -realm named TRealm -generators: node - X = rel [] - nested = rel [a : Nested (TRealm.X [])] - selected = (fun [a : Nested (TRealm.X [])] -> TRealm.X []) -end -lowered: flatrealm - entities - table ℜ.X := [] - table ℜ.nested := [.a.inner.value : ℜ.X, .a.sibling : ℜ.X] - table ℜ.selected := [ - .a.inner.value : ℜ.X, - .a.sibling : ℜ.X, - .b : ℜ.X - ] primarykey [.a.sibling, .a.inner.value] - end - rules - enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ - enforced ℜ.nested.foreignKey a.inner.value a.sibling := ℜ.nested [ - .a.inner.value ↦ a.inner.value, - .a.sibling ↦ a.sibling - ] ⊢ a.inner.value ∈ ℜ.X [] ∧ a.sibling ∈ ℜ.X [] - enforced ℜ.selected.foreignKey a.inner.value a.sibling b := ℜ.selected [ - .a.inner.value ↦ a.inner.value, - .a.sibling ↦ a.sibling, - .b ↦ b - ] ⊢ a.inner.value ∈ ℜ.X [] ∧ a.sibling ∈ ℜ.X [] ∧ b ∈ ℜ.X [] - monitored ℜ.selected.total a.inner.value a.sibling := a.inner.value ∈ ℜ.X [] ∧ a.sibling ∈ ℜ.X [] ⊢ ℜ.selected [ - .a.inner.value ↦ a.inner.value, - .a.sibling ↦ a.sibling - ] - end -end + -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +2 | value : X +2 | ^ + +error[E0314]: no such variable Box in scope +6 | inner : Box X +6 | ^^^ + +error[E0314]: no such variable Nested in scope +12 | nested : Nested X -> Set +12 | ^^^^^^ + +error[E0314]: no such variable T in scope +16 | realm TRealm @ T +16 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record.output b/packages/coln-compiler/test/golden/basic-ir/param-record.output index e0234631..19ac5b7d 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record.output @@ -1,33 +1,16 @@ -- elaborated -global entry named Box -in mode: Conjunctive -type: (X : Set) -> Set -value: X => sig - value : X -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - X : Set - boxed : Box X -> Set -end -realm named TRealm -generators: node - X = rel [] - boxed = rel [a : Box (TRealm.X [])] -end -lowered: flatrealm - entities - table ℜ.X := [] - table ℜ.boxed := [.a.value : ℜ.X] - end - rules - enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ - enforced ℜ.boxed.foreignKey a.value := ℜ.boxed [ - .a.value ↦ a.value - ] ⊢ a.value ∈ ℜ.X [] - end -end + -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +2 | value : X +2 | ^ + +error[E0314]: no such variable Box in scope +7 | boxed : Box X -> Set +7 | ^^^ + +error[E0314]: no such variable T in scope +10 | realm TRealm @ T +10 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output b/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output index 50f9933d..84bbbb64 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output @@ -5,40 +5,17 @@ type: Theory value: sig X : Set end -global entry named PointOf -in mode: Conjunctive -type: (M : Model) -> Theory -value: M => sig - point : M.X -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - model : Model - pointed : PointOf model -end -realm named TRealm -generators: node - model = node - X = rel [] - end - pointed = node - point = (fun [] -> TRealm.model.X []) - end -end -lowered: flatrealm - entities - table ℜ.model.X := [] - table ℜ.pointed.point := [.a : ℜ.model.X] primarykey [] - end - rules - enforced ℜ.model.X.foreignKey := ℜ.model.X [] ⊢ ⊤ - enforced ℜ.pointed.point.foreignKey a := ℜ.pointed.point [ - .a ↦ a - ] ⊢ a ∈ ℜ.model.X [] - monitored ℜ.pointed.point.total := ⊤ ⊢ ℜ.pointed.point [] - end -end -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +6 | point : M.X +6 | ^ + +error[E0314]: no such variable PointOf in scope +11 | pointed : PointOf model +11 | ^^^^^^^ + +error[E0314]: no such variable T in scope +14 | realm TRealm @ T +14 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output b/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output index 6df8abd0..b025dd9d 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output @@ -1,44 +1,20 @@ -- elaborated -global entry named PointOf -in mode: Conjunctive -type: (X : Set) -> Theory -value: X => sig - point : X -end -global entry named Pointed -in mode: Conjunctive -type: (X : Set) -> Theory -value: X => sig - inner : PointOf X -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - X : Set - outer : Pointed X -end -realm named TRealm -generators: node - X = rel [] - outer = node - inner = node - point = (fun [] -> TRealm.X []) - end - end -end -lowered: flatrealm - entities - table ℜ.X := [] - table ℜ.outer.inner.point := [.a : ℜ.X] primarykey [] - end - rules - enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ - enforced ℜ.outer.inner.point.foreignKey a := ℜ.outer.inner.point [ - .a ↦ a - ] ⊢ a ∈ ℜ.X [] - monitored ℜ.outer.inner.point.total := ⊤ ⊢ ℜ.outer.inner.point [] - end -end + -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +2 | point : X +2 | ^ + +error[E0314]: no such variable PointOf in scope +6 | inner : PointOf X +6 | ^^^^^^^ + +error[E0314]: no such variable Pointed in scope +11 | outer : Pointed X +11 | ^^^^^^^ + +error[E0314]: no such variable T in scope +14 | realm TRealm @ T +14 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-theory.output b/packages/coln-compiler/test/golden/basic-ir/param-theory.output index f16fc075..af13872c 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-theory.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-theory.output @@ -1,34 +1,16 @@ -- elaborated -global entry named PointOf -in mode: Conjunctive -type: (X : Set) -> Theory -value: X => sig - point : X -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - X : Set - P : PointOf X -end -realm named TRealm -generators: node - X = rel [] - P = node - point = (fun [] -> TRealm.X []) - end -end -lowered: flatrealm - entities - table ℜ.X := [] - table ℜ.P.point := [.a : ℜ.X] primarykey [] - end - rules - enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ - enforced ℜ.P.point.foreignKey a := ℜ.P.point [.a ↦ a] ⊢ a ∈ ℜ.X [] - monitored ℜ.P.point.total := ⊤ ⊢ ℜ.P.point [] - end -end + -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +2 | point : X +2 | ^ + +error[E0314]: no such variable PointOf in scope +7 | P : PointOf X +7 | ^^^^^^^ + +error[E0314]: no such variable T in scope +10 | realm TRealm @ T +10 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/projection.output b/packages/coln-compiler/test/golden/basic-ir/projection.output index 7fb6bbd7..964bbb52 100644 --- a/packages/coln-compiler/test/golden/basic-ir/projection.output +++ b/packages/coln-compiler/test/golden/basic-ir/projection.output @@ -1,47 +1,16 @@ -- elaborated -global entry named Payload -in mode: Conjunctive -type: (X : Set) -> Set -value: X => sig - first : X - second : X -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - X : Set - E : X -> Set - r : (p : Payload X) -> E p.second -end -realm named TRealm -generators: node - X = rel [] - E = rel [a : TRealm.X []] - r = (fun [p : Payload (TRealm.X [])] -> TRealm.E [a := p.second]) -end -lowered: flatrealm - entities - table ℜ.X := [] - table ℜ.E := [.a : ℜ.X] - table ℜ.r := [.p.first : ℜ.X, .p.second : ℜ.X, .a : ℜ.E] primarykey [ - .p.first, - .p.second - ] - end - rules - enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ - enforced ℜ.E.foreignKey a := ℜ.E [.a ↦ a] ⊢ a ∈ ℜ.X [] - enforced ℜ.r.foreignKey p.first p.second a := ℜ.r [ - .p.first ↦ p.first, - .p.second ↦ p.second, - .a ↦ a - ] ⊢ p.first ∈ ℜ.X [] ∧ p.second ∈ ℜ.X [] ∧ a ∈ ℜ.E [.a ↦ p.second] - monitored ℜ.r.total p.first p.second := p.first ∈ ℜ.X [] ∧ p.second ∈ ℜ.X [] ⊢ ℜ.r [ - .p.first ↦ p.first, - .p.second ↦ p.second - ] - end -end + -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +2 | first : X +2 | ^ + +error[E0314]: no such variable Payload in scope +9 | r : (p : Payload X) -> E p.second +9 | ^^^^^^^ + +error[E0314]: no such variable T in scope +12 | realm TRealm @ T +12 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output b/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output index 1db84b7f..ebf025f8 100644 --- a/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output +++ b/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output @@ -1,43 +1,16 @@ -- elaborated -global entry named EqualTriple -in mode: Conjunctive -type: (X : Set) -> Set -value: X => sig - first : X - second : X - proof : first = second - trailing : X -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - X : Set - value : EqualTriple X -end -realm named TRealm -generators: node - X = rel [] - value = (fun [] -> EqualTriple (TRealm.X [])) -end -lowered: flatrealm - entities - table ℜ.X := [] - table ℜ.value := [ - .a.first : ℜ.X, - .a.second : ℜ.X, - .a.trailing : ℜ.X - ] primarykey [] - end - rules - enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ - enforced ℜ.value.foreignKey a.first a.second a.trailing := ℜ.value [ - .a.first ↦ a.first, - .a.second ↦ a.second, - .a.trailing ↦ a.trailing - ] ⊢ a.first ∈ ℜ.X [] ∧ a.second ∈ ℜ.X [] ∧ a.first = a.second ∧ a.trailing ∈ ℜ.X [] - monitored ℜ.value.total := ⊤ ⊢ ℜ.value [] - end -end + -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +2 | first : X +2 | ^ + +error[E0314]: no such variable EqualTriple in scope +10 | value : EqualTriple X +10 | ^^^^^^^^^^^ + +error[E0314]: no such variable T in scope +13 | realm TRealm @ T +13 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output b/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output index ca155bc8..b97990e1 100644 --- a/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output +++ b/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output @@ -1,57 +1,16 @@ -- elaborated -global entry named EqualTriple -in mode: Conjunctive -type: (X : Set) -> Set -value: X => sig - first : X - second : X - proof : first = second - trailing : X -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - X : Set - Accepted : EqualTriple X -> Prop - select : EqualTriple X -> X -end -realm named TRealm -generators: node - X = rel [] - Accepted = rel [a : EqualTriple (TRealm.X [])] - select = (fun [a : EqualTriple (TRealm.X [])] -> TRealm.X []) -end -lowered: flatrealm - entities - table ℜ.X := [] - table ℜ.Accepted := [.a.first : ℜ.X, .a.second : ℜ.X, .a.trailing : ℜ.X] - table ℜ.select := [ - .a.first : ℜ.X, - .a.second : ℜ.X, - .a.trailing : ℜ.X, - .b : ℜ.X - ] primarykey [.a.first, .a.second, .a.trailing] - end - rules - enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ - enforced ℜ.Accepted.foreignKey a.first a.second a.trailing := ℜ.Accepted [ - .a.first ↦ a.first, - .a.second ↦ a.second, - .a.trailing ↦ a.trailing - ] ⊢ a.first ∈ ℜ.X [] ∧ a.second ∈ ℜ.X [] ∧ a.first = a.second ∧ a.trailing ∈ ℜ.X [] - enforced ℜ.select.foreignKey a.first a.second a.trailing b := ℜ.select [ - .a.first ↦ a.first, - .a.second ↦ a.second, - .a.trailing ↦ a.trailing, - .b ↦ b - ] ⊢ a.first ∈ ℜ.X [] ∧ a.second ∈ ℜ.X [] ∧ a.first = a.second ∧ a.trailing ∈ ℜ.X [] ∧ b ∈ ℜ.X [] - monitored ℜ.select.total a.first a.second a.trailing := a.first ∈ ℜ.X [] ∧ a.second ∈ ℜ.X [] ∧ a.first = a.second ∧ a.trailing ∈ ℜ.X [] ⊢ ℜ.select [ - .a.first ↦ a.first, - .a.second ↦ a.second, - .a.trailing ↦ a.trailing - ] - end -end + -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +2 | first : X +2 | ^ + +error[E0314]: no such variable EqualTriple in scope +10 | Accepted : EqualTriple X -> Prop +10 | ^^^^^^^^^^^ + +error[E0314]: no such variable T in scope +14 | realm TRealm @ T +14 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/proof-record.output b/packages/coln-compiler/test/golden/basic-ir/proof-record.output index d0be92b4..6da8aafb 100644 --- a/packages/coln-compiler/test/golden/basic-ir/proof-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/proof-record.output @@ -1,32 +1,16 @@ -- elaborated -global entry named Witness -in mode: Conjunctive -type: (X : Set) -> (x : X) -> Set -value: X => x => sig - proof : x = x -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - X : Set - witness : (x : X) -> Witness X x -end -realm named TRealm -generators: node - X = rel [] - witness = (fun [x : TRealm.X []] -> Witness (TRealm.X []) x) -end -lowered: flatrealm - entities - table ℜ.X := [] - table ℜ.witness := [.x : ℜ.X] primarykey [.x] - end - rules - enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ - enforced ℜ.witness.foreignKey x := ℜ.witness [.x ↦ x] ⊢ x ∈ ℜ.X [] ∧ x = x - monitored ℜ.witness.total x := x ∈ ℜ.X [] ⊢ ℜ.witness [.x ↦ x] - end -end + -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +2 | proof : x = x +2 | ^ + +error[E0314]: no such variable Witness in scope +7 | witness : (x : X) -> Witness X x +7 | ^^^^^^^ + +error[E0314]: no such variable T in scope +10 | realm TRealm @ T +10 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/prop-record.output b/packages/coln-compiler/test/golden/basic-ir/prop-record.output index 26c83c86..1d36c536 100644 --- a/packages/coln-compiler/test/golden/basic-ir/prop-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/prop-record.output @@ -1,69 +1,16 @@ -- elaborated -global entry named And -in mode: Conjunctive -type: (P : Prop) -> (Q : Prop) -> Prop -value: P => Q => sig - left : P - right : Q -end -global entry named T -in mode: Conjunctive -type: Theory -value: sig - P : Prop - Q : Prop - make : P -> Q -> And P Q - projectLeft : And P Q -> P -end -realm named TRealm -generators: node - P = rel [] - Q = rel [] - make = (fun [ - a : TRealm.P [], - b : TRealm.Q [] - ] -> And (TRealm.P []) (TRealm.Q [])) - projectLeft = (fun [a : And (TRealm.P []) (TRealm.Q [])] -> TRealm.P []) -end -lowered: flatrealm - entities - table ℜ.P := [] - table ℜ.Q := [] - table ℜ.make := [ - .a : ℜ.P, - .b : ℜ.Q, - .c.left : ℜ.P, - .c.right : ℜ.Q - ] primarykey [.a, .b] - table ℜ.projectLeft := [ - .a.left : ℜ.P, - .a.right : ℜ.Q, - .b : ℜ.P - ] primarykey [.a.left, .a.right] - end - rules - enforced ℜ.P.foreignKey := ℜ.P [] ⊢ ⊤ - enforced ℜ.Q.foreignKey := ℜ.Q [] ⊢ ⊤ - enforced ℜ.make.foreignKey a b c.left c.right := ℜ.make [ - .a ↦ a, - .b ↦ b, - .c.left ↦ c.left, - .c.right ↦ c.right - ] ⊢ a ∈ ℜ.P [] ∧ b ∈ ℜ.Q [] ∧ c.left ∈ ℜ.P [] ∧ c.right ∈ ℜ.Q [] - monitored ℜ.make.total a b := a ∈ ℜ.P [] ∧ b ∈ ℜ.Q [] ⊢ ℜ.make [ - .a ↦ a, - .b ↦ b - ] - enforced ℜ.projectLeft.foreignKey a.left a.right b := ℜ.projectLeft [ - .a.left ↦ a.left, - .a.right ↦ a.right, - .b ↦ b - ] ⊢ a.left ∈ ℜ.P [] ∧ a.right ∈ ℜ.Q [] ∧ b ∈ ℜ.P [] - monitored ℜ.projectLeft.total a.left a.right := a.left ∈ ℜ.P [] ∧ a.right ∈ ℜ.Q [] ⊢ ℜ.projectLeft [ - .a.left ↦ a.left, - .a.right ↦ a.right - ] - end -end + -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +2 | left : P +2 | ^ + +error[E0314]: no such variable And in scope +9 | make : P -> Q -> And P Q +9 | ^^^ + +error[E0314]: no such variable T in scope +13 | realm TRealm @ T +13 | ^ diff --git a/packages/coln-compiler/test/golden/elaborator-errors.output b/packages/coln-compiler/test/golden/elaborator-errors.output index f0aa305d..ed36d1c0 100644 --- a/packages/coln-compiler/test/golden/elaborator-errors.output +++ b/packages/coln-compiler/test/golden/elaborator-errors.output @@ -21,17 +21,17 @@ global entry named dependent in mode: Conjunctive type: Dependent value: [A := Int, value := 1] -global entry named identity -in mode: Conjunctive -type: Int -> Int -value: x => x -global entry named shadow -in mode: Conjunctive -type: (x : String) -> Int -> Int -value: x => x => x -- messages +error[E0316]: cannot use inductively bound variable in a conjunctive context +21 | def identity : Int -> Int := x => x +21 | ^ + +error[E0316]: cannot use inductively bound variable in a conjunctive context +23 | def shadow (x : String) : Int -> Int := x => x +23 | ^ + error[E0302]: tried to project from a value that was not of a record type 25 | def projectionOfNonRecord : Int := (1).missing 25 | ^^^^^^^^ diff --git a/packages/coln-compiler/test/golden/fb3.output b/packages/coln-compiler/test/golden/fb3.output index 9aece229..7d714b29 100644 --- a/packages/coln-compiler/test/golden/fb3.output +++ b/packages/coln-compiler/test/golden/fb3.output @@ -1,12 +1,8 @@ -- elaborated -global entry named IdempotentSemigroup -in mode: Conjunctive -type: Theory -value: sig - Element : Set - mul : (x : Element) -> (y : Element) -> Element - mul/idempotent : (x : Element) -> mul x x = x - mul/assoc : (x : Element) -> (y : Element) -> (z : Element) -> mul (mul x y) z = mul x (mul y z) -end + -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +7 | mul/idempotent : (x : Element) -> mul x x = x +7 | ^ diff --git a/packages/coln-compiler/test/golden/graph-of-graphs.output b/packages/coln-compiler/test/golden/graph-of-graphs.output index 63d1ce8d..98ebf916 100644 --- a/packages/coln-compiler/test/golden/graph-of-graphs.output +++ b/packages/coln-compiler/test/golden/graph-of-graphs.output @@ -6,21 +6,6 @@ value: sig V : Set E : V -> V -> Set end -global entry named Graph/hom -in mode: Conjunctive -type: (G0 : Graph) -> (G1 : Graph) -> Theory -value: G0 => G1 => sig - V : G0.V -> G1.V - E : (v0 : G0.V) -> (v1 : G0.V) -> G0.E v0 v1 -> G1.E (V v0) (V v1) -end -global entry named GraphOfGraphs -in mode: Conjunctive -type: Theory -value: sig - base : Graph - fiber : base.V -> Graph - action : (v0 : base.V) -> (v1 : base.V) -> base.E v0 v1 -> Graph/hom (fiber v0) (fiber v1) -end realm named GraphRealm generators: node V = rel [] @@ -39,139 +24,17 @@ lowered: flatrealm ] ⊢ a ∈ ℜ.V [] ∧ b ∈ ℜ.V [] end end -realm named GraphOfGraphsRealm -generators: node - base = node - V = rel [] - E = rel [a : GraphOfGraphsRealm.base.V [], b : GraphOfGraphsRealm.base.V []] - end - fiber = node - V = rel [a : GraphOfGraphsRealm.base.V []] - E = rel [ - a : GraphOfGraphsRealm.base.V [], - b : GraphOfGraphsRealm.fiber.V [a := a], - c : GraphOfGraphsRealm.fiber.V [a := a] - ] - end - action = node - V = (fun [ - v0 : GraphOfGraphsRealm.base.V [], - v1 : GraphOfGraphsRealm.base.V [], - a : GraphOfGraphsRealm.base.E [a := v0, b := v1], - b : GraphOfGraphsRealm.fiber.V [a := v0] - ] -> GraphOfGraphsRealm.fiber.V [a := v1]) - E = (fun [ - v0 : GraphOfGraphsRealm.base.V [], - v1 : GraphOfGraphsRealm.base.V [], - a : GraphOfGraphsRealm.base.E [a := v0, b := v1], - v0/a : GraphOfGraphsRealm.fiber.V [a := v0], - v1/a : GraphOfGraphsRealm.fiber.V [a := v0], - b : GraphOfGraphsRealm.fiber.E [a := v0, b := v0/a, c := v1/a] - ] -> GraphOfGraphsRealm.fiber.E [ - a := v1, - b := GraphOfGraphsRealm.action.V [v0 := v0, v1 := v1, a := a, b := v0/a], - c := GraphOfGraphsRealm.action.V [v0 := v0, v1 := v1, a := a, b := v1/a] - ]) - end -end -lowered: flatrealm - entities - table ℜ.base.V := [] - table ℜ.base.E := [.a : ℜ.base.V, .b : ℜ.base.V] - table ℜ.fiber.V := [.a : ℜ.base.V] - table ℜ.fiber.E := [.a : ℜ.base.V, .b : ℜ.fiber.V, .c : ℜ.fiber.V] - table ℜ.action.V := [ - .v0 : ℜ.base.V, - .v1 : ℜ.base.V, - .a : ℜ.base.E, - .b : ℜ.fiber.V, - .c : ℜ.fiber.V - ] primarykey [.a, .b, .v0, .v1] - table ℜ.action.E := [ - .v0 : ℜ.base.V, - .v1 : ℜ.base.V, - .a : ℜ.base.E, - .v0/a : ℜ.fiber.V, - .v1/a : ℜ.fiber.V, - .b : ℜ.fiber.E, - .c : ℜ.fiber.E - ] primarykey [.a, .b, .v0, .v1, .v0/a, .v1/a] - end - rules - enforced ℜ.base.V.foreignKey := ℜ.base.V [] ⊢ ⊤ - enforced ℜ.base.E.foreignKey a b := ℜ.base.E [ - .a ↦ a, - .b ↦ b - ] ⊢ a ∈ ℜ.base.V [] ∧ b ∈ ℜ.base.V [] - enforced ℜ.fiber.V.foreignKey a := ℜ.fiber.V [.a ↦ a] ⊢ a ∈ ℜ.base.V [] - enforced ℜ.fiber.E.foreignKey a b c := ℜ.fiber.E [ - .a ↦ a, - .b ↦ b, - .c ↦ c - ] ⊢ a ∈ ℜ.base.V [] ∧ b ∈ ℜ.fiber.V [.a ↦ a] ∧ c ∈ ℜ.fiber.V [.a ↦ a] - enforced ℜ.action.V.foreignKey v0 v1 a b c := ℜ.action.V [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .b ↦ b, - .c ↦ c - ] ⊢ v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ - .a ↦ v0, - .b ↦ v1 - ] ∧ b ∈ ℜ.fiber.V [.a ↦ v0] ∧ c ∈ ℜ.fiber.V [.a ↦ v1] - monitored ℜ.action.V.total v0 v1 a b := v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ - .a ↦ v0, - .b ↦ v1 - ] ∧ b ∈ ℜ.fiber.V [.a ↦ v0] ⊢ ℜ.action.V [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .b ↦ b - ] - enforced ℜ.action.E.foreignKey v0 v1 a v0/a v1/a b c c.b c.c := ℜ.action.E [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .v0/a ↦ v0/a, - .v1/a ↦ v1/a, - .b ↦ b, - .c ↦ c - ] ∧ ℜ.action.V [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .b ↦ v0/a, - .c ↦ c.b - ] ∧ ℜ.action.V [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .b ↦ v1/a, - .c ↦ c.c - ] ⊢ v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ - .a ↦ v0, - .b ↦ v1 - ] ∧ v0/a ∈ ℜ.fiber.V [.a ↦ v0] ∧ v1/a ∈ ℜ.fiber.V [ - .a ↦ v0 - ] ∧ b ∈ ℜ.fiber.E [.a ↦ v0, .b ↦ v0/a, .c ↦ v1/a] ∧ c ∈ ℜ.fiber.E [ - .a ↦ v1, - .b ↦ c.b, - .c ↦ c.c - ] - monitored ℜ.action.E.total v0 v1 a v0/a v1/a b := v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ - .a ↦ v0, - .b ↦ v1 - ] ∧ v0/a ∈ ℜ.fiber.V [.a ↦ v0] ∧ v1/a ∈ ℜ.fiber.V [ - .a ↦ v0 - ] ∧ b ∈ ℜ.fiber.E [.a ↦ v0, .b ↦ v0/a, .c ↦ v1/a] ⊢ ℜ.action.E [ - .v0 ↦ v0, - .v1 ↦ v1, - .a ↦ a, - .v0/a ↦ v0/a, - .v1/a ↦ v1/a, - .b ↦ b - ] - end -end -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +15 | V : G0.V -> G1.V +15 | ^^ + +error[E0314]: no such variable Graph/hom in scope +22 | action : (v0 : base.V) -> (v1 : base.V) -> base.E v0 v1 -> Graph/hom (fiber v0) (fiber v1) +22 | ^^^^^^^^^ + +error[E0314]: no such variable GraphOfGraphs in scope +25 | realm GraphOfGraphsRealm @ GraphOfGraphs +25 | ^^^^^^^^^^^^^ diff --git a/packages/coln-compiler/test/golden/hlevel.output b/packages/coln-compiler/test/golden/hlevel.output index 80e29d42..c1e8b8b3 100644 --- a/packages/coln-compiler/test/golden/hlevel.output +++ b/packages/coln-compiler/test/golden/hlevel.output @@ -7,13 +7,6 @@ value: sig is-parent : person -> person -> Prop happy : Prop end -global entry named Q -in mode: Conjunctive -type: (F : Family) -> Theory -value: F => sig - son : F.person - father : F.person -end global entry named HP in mode: Conjunctive type: Theory @@ -65,13 +58,9 @@ debug[D0315]: type person -> happy has level Level {mlevel = Theory, hlevel = HP 13 | showlevel person -> happy 13 | ^^^^^^^^^^^^^^^ -debug[D0315]: value F.is-parent has type F.person -> F.person -> Prop -20 | showtype F.is-parent -20 | ^^^^^^^^^^^ - -debug[D0315]: value F.is-parent father son has type Prop -21 | showtype F.is-parent father son -21 | ^^^^^^^^^^^^^^^^^^^^^^ +error[E0316]: cannot use inductively bound variable in a conjunctive context +17 | son : F.person +17 | ^ debug[D0315]: type voldemort = tomriddle has level Level {mlevel = Set, hlevel = HProp} 31 | showlevel voldemort = tomriddle @@ -101,15 +90,6 @@ debug[D0315]: type u = u has level Level {mlevel = Set, hlevel = HUnit} 48 | showlevel u = u 48 | ^^^^^ -error[E0307]: type sig - f : A -> P - a : A -end too large for universe Set -51 | def LevelJoinRecordIsNotSet (A : Set) (P : Prop) : Set := sig -51 | ^^^ +error[E0316]: cannot use inductively bound variable in a conjunctive context 52 | f : A -> P -52 | ^^^^^^^^^^^^ -53 | a : A -53 | ^^^^^^^ -54 | end -54 | ^^^ +52 | ^ diff --git a/packages/coln-compiler/test/golden/ind.coln b/packages/coln-compiler/test/golden/ind.coln index bd70886d..01b70216 100644 --- a/packages/coln-compiler/test/golden/ind.coln +++ b/packages/coln-compiler/test/golden/ind.coln @@ -1,11 +1,9 @@ -ind theory T := Set - theory Graph := sig v : Set e : v -> v -> Prop end -theory TransitiveExt (G : Graph) := sig +theory TransitiveExt (^i G : Graph) := sig p : G.v -> G.v -> Prop incl : (v0 : G.v) -> (v1 : G.v) -> G.e v0 v1 -> p v0 v1 snoc : (v0 : G.v) -> (v1 : G.v) -> (v2 : G.v) -> p v0 v1 -> G.e v1 v2 -> p v0 v2 @@ -13,4 +11,4 @@ end ind def transitive-closure (G : Graph) : TransitiveExt G := init (TransitiveExt G) -ind def freept (X : Set) : X := init X +ind def free-point (X : Set) : X := init X diff --git a/packages/coln-compiler/test/golden/ind.output b/packages/coln-compiler/test/golden/ind.output index 4d77d8a8..cbd9408a 100644 --- a/packages/coln-compiler/test/golden/ind.output +++ b/packages/coln-compiler/test/golden/ind.output @@ -10,20 +10,20 @@ value: sig v : Set e : v -> v -> Prop end -global entry named TransitiveExt -in mode: Conjunctive -type: (G : Graph) -> Theory -value: G => sig - p : G.v -> G.v -> Prop - incl : (v0 : G.v) -> (v1 : G.v) -> G.e v0 v1 -> p v0 v1 - snoc : (v0 : G.v) -> (v1 : G.v) -> (v2 : G.v) -> p v0 v1 -> G.e v1 v2 -> p v0 v2 -end -- messages -error[E0316]: cannot use inductively bound variable in a conjunctive context +error[E0100]: Unexpected token kind SKeyword, expected a token that can start an expression +8 | theory TransitiveExt (@i G : Graph) := sig +8 | ^ + +error[E0200]: unexpected notation for identifier, possibly with mode annotation: Juxt +8 | theory TransitiveExt (@i G : Graph) := sig +8 | ^^^^ + +error[E0314]: no such variable TransitiveExt in scope 14 | ind def transitive-closure (G : Graph) : TransitiveExt G := init (TransitiveExt G) -14 | ^ +14 | ^^^^^^^^^^^^^ error[E0316]: cannot use inductively bound variable in a conjunctive context 16 | ind def freept (X : Set) : X := init X diff --git a/packages/coln-compiler/test/golden/modular-lattice.output b/packages/coln-compiler/test/golden/modular-lattice.output index 6ce2c1c4..d77628e3 100644 --- a/packages/coln-compiler/test/golden/modular-lattice.output +++ b/packages/coln-compiler/test/golden/modular-lattice.output @@ -1,24 +1,12 @@ -- elaborated -global entry named ModularLattice -in mode: Conjunctive -type: Theory -value: sig - Element : Set - meet : Element -> Element -> Element - meet/associative : (a : Element) -> (b : Element) -> (c : Element) -> meet (meet a b) c = meet a (meet b c) - meet/commutative : (a : Element) -> (b : Element) -> meet a b = meet b a - meet/idempotent : (a : Element) -> meet a a = a - join : Element -> Element -> Element - join/associative : (a : Element) -> (b : Element) -> (c : Element) -> join (join a b) c = join a (join b c) - join/associative : (a : Element) -> (b : Element) -> join a b = join b a - join/idempotent : (a : Element) -> join a a = a - ax/absorptive1 : (a : Element) -> (b : Element) -> meet a (join a b) = a - ax/absorptive2 : (a : Element) -> (b : Element) -> join a (meet a b) = a - ax/modular : (a : Element) -> (b : Element) -> (x : Element) -> join (meet a b) (meet x b) = meet (join (meet a b) x) b -end + -- messages +error[E0316]: cannot use inductively bound variable in a conjunctive context +17 | meet a a = a +17 | ^ + error[E0200]: unexpected notation for field setting of the form ` := `: Infix 49 | bot : Element 49 | ^^^^^^^^^^^^^ diff --git a/packages/coln-compiler/test/golden/monoid-glog.output b/packages/coln-compiler/test/golden/monoid-glog.output index b91ffdd8..83ab7ebc 100644 --- a/packages/coln-compiler/test/golden/monoid-glog.output +++ b/packages/coln-compiler/test/golden/monoid-glog.output @@ -1,14 +1,8 @@ -- elaborated -global entry named Monoid -in mode: Conjunctive -type: Theory -value: sig - car : Set - unit : car - mul : car -> car -> car - mul/unitl : (x : car) -> mul unit x = x - mul/unitr : (x : car) -> mul x unit = x - mul/assoc : (x : car) -> (y : car) -> (z : car) -> mul (mul x y) z = mul x (mul y z) -end + -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +6 | mul/unitl : (x : car) -> mul unit x = x +6 | ^ diff --git a/packages/coln-compiler/test/golden/ssa.output b/packages/coln-compiler/test/golden/ssa.output index 034c28a0..f5534860 100644 --- a/packages/coln-compiler/test/golden/ssa.output +++ b/packages/coln-compiler/test/golden/ssa.output @@ -1,28 +1,4 @@ -- elaborated -global entry named IsTransClosure -in mode: Conjunctive -type: (X : Set) -> (R : X -> X -> Set) -> (P : X -> X -> Set) -> Theory -value: X => R => P => sig - refl : (x : X) -> P x x - snoc : (x : X) -> (y : X) -> (z : X) -> P x y -> R y z -> P x z -end -global entry named LinearOrder -in mode: Conjunctive -type: Theory -value: sig - car : Set - first : car - last : car - next : car -> car - prev : car -> car - next/prev : (x : car) -> next (prev x) = x - prev/next : (x : car) -> prev (next x) = x - follows : car -> car -> Set - follows/is-trans-closure : IsTransClosure car (x => y => next x = y) follows - acyclic : (x : car) -> (y : car) -> follows x y -> follows y x -> x = y - first-is-top : (x : car) -> follows first x - last-is-bot : (x : car) -> follows x last -end global entry named OpInfo in mode: Conjunctive type: Theory @@ -31,47 +7,33 @@ value: sig inputArity : OpType -> Set outputArity : OpType -> Set end -global entry named Iso -in mode: Conjunctive -type: (A : Set) -> (B : Set) -> Theory -value: A => B => sig - fwd : A -> B - bwd : B -> A - fwd/bwd : (a : A) -> bwd (fwd a) = a - bwd/fwd : (b : B) -> fwd (bwd b) = b -end -global entry named Operation -in mode: Conjunctive -type: (opInfo : OpInfo) -> (val : Set) -> (outputs : Set) -> Theory -value: opInfo => val => outputs => sig - opType : opInfo.OpType - opInputs : opInfo.inputArity opType -> val - opOutputs : Iso outputs (opInfo.outputArity opType) -end -global entry named PrecedingOutput -in mode: Conjunctive -type: (X : Set) -> (rel : X -> X -> Set) -> (x : X) -> (outputs : X -> Set) -> Set -value: X => rel => x => outputs => sig - y : X - isPreceding : rel y x - output : outputs y -end -global entry named Block -in mode: Conjunctive -type: (opInfo : OpInfo) -> Theory -value: opInfo => sig - ops : LinearOrder - outputs : ops.car -> Set - payload : (x : ops.car) -> Operation opInfo (PrecedingOutput ops.car ops.follows x outputs) (outputs x) - args : LinearOrder -end -global entry named SSA -in mode: Conjunctive -type: (opInfo : OpInfo) -> Theory -value: opInfo => sig - RegionId : Set - BlockId : RegionId -> Set - ops : (r : RegionId) -> BlockId r -> Block opInfo -end -- messages + +error[E0316]: cannot use inductively bound variable in a conjunctive context +2 | refl : (x : X) -> P x x +2 | ^ + +error[E0316]: cannot use inductively bound variable in a conjunctive context +13 | next/prev : (x : car) -> next (prev x) = x +13 | ^ + +error[E0316]: cannot use inductively bound variable in a conjunctive context +32 | fwd : A -> B +32 | ^ + +error[E0316]: cannot use inductively bound variable in a conjunctive context +39 | opType : opInfo.OpType +39 | ^^^^^^ + +error[E0316]: cannot use inductively bound variable in a conjunctive context +45 | y : X +45 | ^ + +error[E0314]: no such variable LinearOrder in scope +51 | ops : LinearOrder +51 | ^^^^^^^^^^^ + +error[E0314]: no such variable Block in scope +65 | ops : (r : RegionId) -> BlockId r -> Block opInfo +65 | ^^^^^ From 908626c194f407484dd92006b0cfb921127c9874 Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Mon, 27 Jul 2026 14:00:18 -0400 Subject: [PATCH 10/13] revert theme changes --- manual/theme/tree.xsl | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/manual/theme/tree.xsl b/manual/theme/tree.xsl index 2b8e2589..a9984226 100644 --- a/manual/theme/tree.xsl +++ b/manual/theme/tree.xsl @@ -27,18 +27,18 @@
- - - - - - - - - - - - + + + +
@@ -167,11 +167,11 @@ - - - - - + +
    + +
+ From 3594f36dc7ed3fc6fac32967d3b0e44636812118 Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Mon, 27 Jul 2026 19:28:53 -0400 Subject: [PATCH 11/13] update golden tests --- .../basic-ir/param-record-concrete.output | 38 +++-- .../golden/basic-ir/param-record-model.output | 46 +++-- .../basic-ir/param-record-nested.output | 71 ++++++-- .../test/golden/basic-ir/param-record.output | 43 +++-- .../golden/basic-ir/param-theory-model.output | 47 +++-- .../basic-ir/param-theory-nested.output | 58 +++++-- .../test/golden/basic-ir/param-theory.output | 44 +++-- .../test/golden/basic-ir/projection.output | 57 +++++-- .../golden/basic-ir/proof-record-mixed.output | 53 ++++-- .../basic-ir/proof-record-parameter.output | 67 ++++++-- .../test/golden/basic-ir/proof-record.coln | 2 +- .../test/golden/basic-ir/proof-record.output | 42 +++-- .../test/golden/basic-ir/prop-record.output | 79 +++++++-- .../test/golden/graph-of-graphs.output | 161 ++++++++++++++++-- .../coln-compiler/test/golden/hlevel.output | 30 +++- packages/coln-compiler/test/golden/ind.output | 32 ++-- packages/coln-compiler/test/golden/ssa.output | 33 ++-- 17 files changed, 693 insertions(+), 210 deletions(-) diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output b/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output index 83663ff0..5e902b42 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record-concrete.output @@ -5,17 +5,31 @@ type: Set value: sig name : String end +global entry named Box +in mode: Conjunctive +type: (X : Set) -> Set +value: X => sig + value : X +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + boxed : Box Payload -> Set +end +realm named TRealm +generators: node + boxed = rel [a : Box Payload] +end +lowered: flatrealm + entities + table ℜ.boxed := [.a.value.name : String] + end + rules + enforced ℜ.boxed.foreignKey a.value.name := ℜ.boxed [ + .a.value.name ↦ a.value.name + ] ⊢ ⊤ + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -6 | value : X -6 | ^ - -error[E0314]: no such variable Box in scope -10 | boxed : Box Payload -> Set -10 | ^^^ - -error[E0314]: no such variable T in scope -13 | realm TRealm @ T -13 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record-model.output b/packages/coln-compiler/test/golden/basic-ir/param-record-model.output index ea014589..dfb83e32 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record-model.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record-model.output @@ -11,17 +11,39 @@ type: Set value: sig name : String end +global entry named Box +in mode: Conjunctive +type: (M : Model) -> (Y : Set) -> Set +value: M => Y => sig + modelValue : M.X + value : Y +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + model : Model + boxed : Box model Payload -> Set +end +realm named TRealm +generators: node + model = node + X = rel [] + end + boxed = rel [a : Box [X := TRealm.model.X []] Payload] +end +lowered: flatrealm + entities + table ℜ.model.X := [] + table ℜ.boxed := [.a.modelValue : ℜ.model.X, .a.value.name : String] + end + rules + enforced ℜ.model.X.foreignKey := ℜ.model.X [] ⊢ ⊤ + enforced ℜ.boxed.foreignKey a.modelValue a.value.name := ℜ.boxed [ + .a.modelValue ↦ a.modelValue, + .a.value.name ↦ a.value.name + ] ⊢ a.modelValue ∈ ℜ.model.X [] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -10 | modelValue : M.X -10 | ^ - -error[E0314]: no such variable Box in scope -16 | boxed : Box model Payload -> Set -16 | ^^^ - -error[E0314]: no such variable T in scope -19 | realm TRealm @ T -19 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output b/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output index bab4c768..9de21eae 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record-nested.output @@ -1,20 +1,57 @@ -- elaborated - +global entry named Box +in mode: Conjunctive +type: (X : Set) -> Set +value: X => sig + value : X +end +global entry named Nested +in mode: Conjunctive +type: (X : Set) -> Set +value: X => sig + inner : Box X + sibling : X +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + X : Set + nested : Nested X -> Set + selected : Nested X -> X +end +realm named TRealm +generators: node + X = rel [] + nested = rel [a : Nested (TRealm.X [])] + selected = (fun [a : Nested (TRealm.X [])] -> TRealm.X []) +end +lowered: flatrealm + entities + table ℜ.X := [] + table ℜ.nested := [.a.inner.value : ℜ.X, .a.sibling : ℜ.X] + table ℜ.selected := [ + .a.inner.value : ℜ.X, + .a.sibling : ℜ.X, + .b : ℜ.X + ] primarykey [.a.sibling, .a.inner.value] + end + rules + enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ + enforced ℜ.nested.foreignKey a.inner.value a.sibling := ℜ.nested [ + .a.inner.value ↦ a.inner.value, + .a.sibling ↦ a.sibling + ] ⊢ a.inner.value ∈ ℜ.X [] ∧ a.sibling ∈ ℜ.X [] + enforced ℜ.selected.foreignKey a.inner.value a.sibling b := ℜ.selected [ + .a.inner.value ↦ a.inner.value, + .a.sibling ↦ a.sibling, + .b ↦ b + ] ⊢ a.inner.value ∈ ℜ.X [] ∧ a.sibling ∈ ℜ.X [] ∧ b ∈ ℜ.X [] + monitored ℜ.selected.total a.inner.value a.sibling := a.inner.value ∈ ℜ.X [] ∧ a.sibling ∈ ℜ.X [] ⊢ ℜ.selected [ + .a.inner.value ↦ a.inner.value, + .a.sibling ↦ a.sibling + ] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -2 | value : X -2 | ^ - -error[E0314]: no such variable Box in scope -6 | inner : Box X -6 | ^^^ - -error[E0314]: no such variable Nested in scope -12 | nested : Nested X -> Set -12 | ^^^^^^ - -error[E0314]: no such variable T in scope -16 | realm TRealm @ T -16 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-record.output b/packages/coln-compiler/test/golden/basic-ir/param-record.output index 19ac5b7d..e0234631 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-record.output @@ -1,16 +1,33 @@ -- elaborated - +global entry named Box +in mode: Conjunctive +type: (X : Set) -> Set +value: X => sig + value : X +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + X : Set + boxed : Box X -> Set +end +realm named TRealm +generators: node + X = rel [] + boxed = rel [a : Box (TRealm.X [])] +end +lowered: flatrealm + entities + table ℜ.X := [] + table ℜ.boxed := [.a.value : ℜ.X] + end + rules + enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ + enforced ℜ.boxed.foreignKey a.value := ℜ.boxed [ + .a.value ↦ a.value + ] ⊢ a.value ∈ ℜ.X [] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -2 | value : X -2 | ^ - -error[E0314]: no such variable Box in scope -7 | boxed : Box X -> Set -7 | ^^^ - -error[E0314]: no such variable T in scope -10 | realm TRealm @ T -10 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output b/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output index 84bbbb64..50f9933d 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-theory-model.output @@ -5,17 +5,40 @@ type: Theory value: sig X : Set end +global entry named PointOf +in mode: Conjunctive +type: (M : Model) -> Theory +value: M => sig + point : M.X +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + model : Model + pointed : PointOf model +end +realm named TRealm +generators: node + model = node + X = rel [] + end + pointed = node + point = (fun [] -> TRealm.model.X []) + end +end +lowered: flatrealm + entities + table ℜ.model.X := [] + table ℜ.pointed.point := [.a : ℜ.model.X] primarykey [] + end + rules + enforced ℜ.model.X.foreignKey := ℜ.model.X [] ⊢ ⊤ + enforced ℜ.pointed.point.foreignKey a := ℜ.pointed.point [ + .a ↦ a + ] ⊢ a ∈ ℜ.model.X [] + monitored ℜ.pointed.point.total := ⊤ ⊢ ℜ.pointed.point [] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -6 | point : M.X -6 | ^ - -error[E0314]: no such variable PointOf in scope -11 | pointed : PointOf model -11 | ^^^^^^^ - -error[E0314]: no such variable T in scope -14 | realm TRealm @ T -14 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output b/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output index b025dd9d..6df8abd0 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-theory-nested.output @@ -1,20 +1,44 @@ -- elaborated - +global entry named PointOf +in mode: Conjunctive +type: (X : Set) -> Theory +value: X => sig + point : X +end +global entry named Pointed +in mode: Conjunctive +type: (X : Set) -> Theory +value: X => sig + inner : PointOf X +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + X : Set + outer : Pointed X +end +realm named TRealm +generators: node + X = rel [] + outer = node + inner = node + point = (fun [] -> TRealm.X []) + end + end +end +lowered: flatrealm + entities + table ℜ.X := [] + table ℜ.outer.inner.point := [.a : ℜ.X] primarykey [] + end + rules + enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ + enforced ℜ.outer.inner.point.foreignKey a := ℜ.outer.inner.point [ + .a ↦ a + ] ⊢ a ∈ ℜ.X [] + monitored ℜ.outer.inner.point.total := ⊤ ⊢ ℜ.outer.inner.point [] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -2 | point : X -2 | ^ - -error[E0314]: no such variable PointOf in scope -6 | inner : PointOf X -6 | ^^^^^^^ - -error[E0314]: no such variable Pointed in scope -11 | outer : Pointed X -11 | ^^^^^^^ - -error[E0314]: no such variable T in scope -14 | realm TRealm @ T -14 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/param-theory.output b/packages/coln-compiler/test/golden/basic-ir/param-theory.output index af13872c..f16fc075 100644 --- a/packages/coln-compiler/test/golden/basic-ir/param-theory.output +++ b/packages/coln-compiler/test/golden/basic-ir/param-theory.output @@ -1,16 +1,34 @@ -- elaborated - +global entry named PointOf +in mode: Conjunctive +type: (X : Set) -> Theory +value: X => sig + point : X +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + X : Set + P : PointOf X +end +realm named TRealm +generators: node + X = rel [] + P = node + point = (fun [] -> TRealm.X []) + end +end +lowered: flatrealm + entities + table ℜ.X := [] + table ℜ.P.point := [.a : ℜ.X] primarykey [] + end + rules + enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ + enforced ℜ.P.point.foreignKey a := ℜ.P.point [.a ↦ a] ⊢ a ∈ ℜ.X [] + monitored ℜ.P.point.total := ⊤ ⊢ ℜ.P.point [] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -2 | point : X -2 | ^ - -error[E0314]: no such variable PointOf in scope -7 | P : PointOf X -7 | ^^^^^^^ - -error[E0314]: no such variable T in scope -10 | realm TRealm @ T -10 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/projection.output b/packages/coln-compiler/test/golden/basic-ir/projection.output index 964bbb52..7fb6bbd7 100644 --- a/packages/coln-compiler/test/golden/basic-ir/projection.output +++ b/packages/coln-compiler/test/golden/basic-ir/projection.output @@ -1,16 +1,47 @@ -- elaborated - +global entry named Payload +in mode: Conjunctive +type: (X : Set) -> Set +value: X => sig + first : X + second : X +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + X : Set + E : X -> Set + r : (p : Payload X) -> E p.second +end +realm named TRealm +generators: node + X = rel [] + E = rel [a : TRealm.X []] + r = (fun [p : Payload (TRealm.X [])] -> TRealm.E [a := p.second]) +end +lowered: flatrealm + entities + table ℜ.X := [] + table ℜ.E := [.a : ℜ.X] + table ℜ.r := [.p.first : ℜ.X, .p.second : ℜ.X, .a : ℜ.E] primarykey [ + .p.first, + .p.second + ] + end + rules + enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ + enforced ℜ.E.foreignKey a := ℜ.E [.a ↦ a] ⊢ a ∈ ℜ.X [] + enforced ℜ.r.foreignKey p.first p.second a := ℜ.r [ + .p.first ↦ p.first, + .p.second ↦ p.second, + .a ↦ a + ] ⊢ p.first ∈ ℜ.X [] ∧ p.second ∈ ℜ.X [] ∧ a ∈ ℜ.E [.a ↦ p.second] + monitored ℜ.r.total p.first p.second := p.first ∈ ℜ.X [] ∧ p.second ∈ ℜ.X [] ⊢ ℜ.r [ + .p.first ↦ p.first, + .p.second ↦ p.second + ] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -2 | first : X -2 | ^ - -error[E0314]: no such variable Payload in scope -9 | r : (p : Payload X) -> E p.second -9 | ^^^^^^^ - -error[E0314]: no such variable T in scope -12 | realm TRealm @ T -12 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output b/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output index ebf025f8..1db84b7f 100644 --- a/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output +++ b/packages/coln-compiler/test/golden/basic-ir/proof-record-mixed.output @@ -1,16 +1,43 @@ -- elaborated - +global entry named EqualTriple +in mode: Conjunctive +type: (X : Set) -> Set +value: X => sig + first : X + second : X + proof : first = second + trailing : X +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + X : Set + value : EqualTriple X +end +realm named TRealm +generators: node + X = rel [] + value = (fun [] -> EqualTriple (TRealm.X [])) +end +lowered: flatrealm + entities + table ℜ.X := [] + table ℜ.value := [ + .a.first : ℜ.X, + .a.second : ℜ.X, + .a.trailing : ℜ.X + ] primarykey [] + end + rules + enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ + enforced ℜ.value.foreignKey a.first a.second a.trailing := ℜ.value [ + .a.first ↦ a.first, + .a.second ↦ a.second, + .a.trailing ↦ a.trailing + ] ⊢ a.first ∈ ℜ.X [] ∧ a.second ∈ ℜ.X [] ∧ a.first = a.second ∧ a.trailing ∈ ℜ.X [] + monitored ℜ.value.total := ⊤ ⊢ ℜ.value [] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -2 | first : X -2 | ^ - -error[E0314]: no such variable EqualTriple in scope -10 | value : EqualTriple X -10 | ^^^^^^^^^^^ - -error[E0314]: no such variable T in scope -13 | realm TRealm @ T -13 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output b/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output index b97990e1..ca155bc8 100644 --- a/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output +++ b/packages/coln-compiler/test/golden/basic-ir/proof-record-parameter.output @@ -1,16 +1,57 @@ -- elaborated - +global entry named EqualTriple +in mode: Conjunctive +type: (X : Set) -> Set +value: X => sig + first : X + second : X + proof : first = second + trailing : X +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + X : Set + Accepted : EqualTriple X -> Prop + select : EqualTriple X -> X +end +realm named TRealm +generators: node + X = rel [] + Accepted = rel [a : EqualTriple (TRealm.X [])] + select = (fun [a : EqualTriple (TRealm.X [])] -> TRealm.X []) +end +lowered: flatrealm + entities + table ℜ.X := [] + table ℜ.Accepted := [.a.first : ℜ.X, .a.second : ℜ.X, .a.trailing : ℜ.X] + table ℜ.select := [ + .a.first : ℜ.X, + .a.second : ℜ.X, + .a.trailing : ℜ.X, + .b : ℜ.X + ] primarykey [.a.first, .a.second, .a.trailing] + end + rules + enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ + enforced ℜ.Accepted.foreignKey a.first a.second a.trailing := ℜ.Accepted [ + .a.first ↦ a.first, + .a.second ↦ a.second, + .a.trailing ↦ a.trailing + ] ⊢ a.first ∈ ℜ.X [] ∧ a.second ∈ ℜ.X [] ∧ a.first = a.second ∧ a.trailing ∈ ℜ.X [] + enforced ℜ.select.foreignKey a.first a.second a.trailing b := ℜ.select [ + .a.first ↦ a.first, + .a.second ↦ a.second, + .a.trailing ↦ a.trailing, + .b ↦ b + ] ⊢ a.first ∈ ℜ.X [] ∧ a.second ∈ ℜ.X [] ∧ a.first = a.second ∧ a.trailing ∈ ℜ.X [] ∧ b ∈ ℜ.X [] + monitored ℜ.select.total a.first a.second a.trailing := a.first ∈ ℜ.X [] ∧ a.second ∈ ℜ.X [] ∧ a.first = a.second ∧ a.trailing ∈ ℜ.X [] ⊢ ℜ.select [ + .a.first ↦ a.first, + .a.second ↦ a.second, + .a.trailing ↦ a.trailing + ] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -2 | first : X -2 | ^ - -error[E0314]: no such variable EqualTriple in scope -10 | Accepted : EqualTriple X -> Prop -10 | ^^^^^^^^^^^ - -error[E0314]: no such variable T in scope -14 | realm TRealm @ T -14 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/proof-record.coln b/packages/coln-compiler/test/golden/basic-ir/proof-record.coln index 89844234..3ac8728f 100644 --- a/packages/coln-compiler/test/golden/basic-ir/proof-record.coln +++ b/packages/coln-compiler/test/golden/basic-ir/proof-record.coln @@ -4,7 +4,7 @@ end theory T := sig X : Set - witness : (x : X) -> Witness X x + witness : (^c x : X) -> Witness X x end realm TRealm @ T diff --git a/packages/coln-compiler/test/golden/basic-ir/proof-record.output b/packages/coln-compiler/test/golden/basic-ir/proof-record.output index 6da8aafb..d0be92b4 100644 --- a/packages/coln-compiler/test/golden/basic-ir/proof-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/proof-record.output @@ -1,16 +1,32 @@ -- elaborated - +global entry named Witness +in mode: Conjunctive +type: (X : Set) -> (x : X) -> Set +value: X => x => sig + proof : x = x +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + X : Set + witness : (x : X) -> Witness X x +end +realm named TRealm +generators: node + X = rel [] + witness = (fun [x : TRealm.X []] -> Witness (TRealm.X []) x) +end +lowered: flatrealm + entities + table ℜ.X := [] + table ℜ.witness := [.x : ℜ.X] primarykey [.x] + end + rules + enforced ℜ.X.foreignKey := ℜ.X [] ⊢ ⊤ + enforced ℜ.witness.foreignKey x := ℜ.witness [.x ↦ x] ⊢ x ∈ ℜ.X [] ∧ x = x + monitored ℜ.witness.total x := x ∈ ℜ.X [] ⊢ ℜ.witness [.x ↦ x] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -2 | proof : x = x -2 | ^ - -error[E0314]: no such variable Witness in scope -7 | witness : (x : X) -> Witness X x -7 | ^^^^^^^ - -error[E0314]: no such variable T in scope -10 | realm TRealm @ T -10 | ^ diff --git a/packages/coln-compiler/test/golden/basic-ir/prop-record.output b/packages/coln-compiler/test/golden/basic-ir/prop-record.output index 1d36c536..26c83c86 100644 --- a/packages/coln-compiler/test/golden/basic-ir/prop-record.output +++ b/packages/coln-compiler/test/golden/basic-ir/prop-record.output @@ -1,16 +1,69 @@ -- elaborated - +global entry named And +in mode: Conjunctive +type: (P : Prop) -> (Q : Prop) -> Prop +value: P => Q => sig + left : P + right : Q +end +global entry named T +in mode: Conjunctive +type: Theory +value: sig + P : Prop + Q : Prop + make : P -> Q -> And P Q + projectLeft : And P Q -> P +end +realm named TRealm +generators: node + P = rel [] + Q = rel [] + make = (fun [ + a : TRealm.P [], + b : TRealm.Q [] + ] -> And (TRealm.P []) (TRealm.Q [])) + projectLeft = (fun [a : And (TRealm.P []) (TRealm.Q [])] -> TRealm.P []) +end +lowered: flatrealm + entities + table ℜ.P := [] + table ℜ.Q := [] + table ℜ.make := [ + .a : ℜ.P, + .b : ℜ.Q, + .c.left : ℜ.P, + .c.right : ℜ.Q + ] primarykey [.a, .b] + table ℜ.projectLeft := [ + .a.left : ℜ.P, + .a.right : ℜ.Q, + .b : ℜ.P + ] primarykey [.a.left, .a.right] + end + rules + enforced ℜ.P.foreignKey := ℜ.P [] ⊢ ⊤ + enforced ℜ.Q.foreignKey := ℜ.Q [] ⊢ ⊤ + enforced ℜ.make.foreignKey a b c.left c.right := ℜ.make [ + .a ↦ a, + .b ↦ b, + .c.left ↦ c.left, + .c.right ↦ c.right + ] ⊢ a ∈ ℜ.P [] ∧ b ∈ ℜ.Q [] ∧ c.left ∈ ℜ.P [] ∧ c.right ∈ ℜ.Q [] + monitored ℜ.make.total a b := a ∈ ℜ.P [] ∧ b ∈ ℜ.Q [] ⊢ ℜ.make [ + .a ↦ a, + .b ↦ b + ] + enforced ℜ.projectLeft.foreignKey a.left a.right b := ℜ.projectLeft [ + .a.left ↦ a.left, + .a.right ↦ a.right, + .b ↦ b + ] ⊢ a.left ∈ ℜ.P [] ∧ a.right ∈ ℜ.Q [] ∧ b ∈ ℜ.P [] + monitored ℜ.projectLeft.total a.left a.right := a.left ∈ ℜ.P [] ∧ a.right ∈ ℜ.Q [] ⊢ ℜ.projectLeft [ + .a.left ↦ a.left, + .a.right ↦ a.right + ] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -2 | left : P -2 | ^ - -error[E0314]: no such variable And in scope -9 | make : P -> Q -> And P Q -9 | ^^^ - -error[E0314]: no such variable T in scope -13 | realm TRealm @ T -13 | ^ diff --git a/packages/coln-compiler/test/golden/graph-of-graphs.output b/packages/coln-compiler/test/golden/graph-of-graphs.output index 98ebf916..63d1ce8d 100644 --- a/packages/coln-compiler/test/golden/graph-of-graphs.output +++ b/packages/coln-compiler/test/golden/graph-of-graphs.output @@ -6,6 +6,21 @@ value: sig V : Set E : V -> V -> Set end +global entry named Graph/hom +in mode: Conjunctive +type: (G0 : Graph) -> (G1 : Graph) -> Theory +value: G0 => G1 => sig + V : G0.V -> G1.V + E : (v0 : G0.V) -> (v1 : G0.V) -> G0.E v0 v1 -> G1.E (V v0) (V v1) +end +global entry named GraphOfGraphs +in mode: Conjunctive +type: Theory +value: sig + base : Graph + fiber : base.V -> Graph + action : (v0 : base.V) -> (v1 : base.V) -> base.E v0 v1 -> Graph/hom (fiber v0) (fiber v1) +end realm named GraphRealm generators: node V = rel [] @@ -24,17 +39,139 @@ lowered: flatrealm ] ⊢ a ∈ ℜ.V [] ∧ b ∈ ℜ.V [] end end +realm named GraphOfGraphsRealm +generators: node + base = node + V = rel [] + E = rel [a : GraphOfGraphsRealm.base.V [], b : GraphOfGraphsRealm.base.V []] + end + fiber = node + V = rel [a : GraphOfGraphsRealm.base.V []] + E = rel [ + a : GraphOfGraphsRealm.base.V [], + b : GraphOfGraphsRealm.fiber.V [a := a], + c : GraphOfGraphsRealm.fiber.V [a := a] + ] + end + action = node + V = (fun [ + v0 : GraphOfGraphsRealm.base.V [], + v1 : GraphOfGraphsRealm.base.V [], + a : GraphOfGraphsRealm.base.E [a := v0, b := v1], + b : GraphOfGraphsRealm.fiber.V [a := v0] + ] -> GraphOfGraphsRealm.fiber.V [a := v1]) + E = (fun [ + v0 : GraphOfGraphsRealm.base.V [], + v1 : GraphOfGraphsRealm.base.V [], + a : GraphOfGraphsRealm.base.E [a := v0, b := v1], + v0/a : GraphOfGraphsRealm.fiber.V [a := v0], + v1/a : GraphOfGraphsRealm.fiber.V [a := v0], + b : GraphOfGraphsRealm.fiber.E [a := v0, b := v0/a, c := v1/a] + ] -> GraphOfGraphsRealm.fiber.E [ + a := v1, + b := GraphOfGraphsRealm.action.V [v0 := v0, v1 := v1, a := a, b := v0/a], + c := GraphOfGraphsRealm.action.V [v0 := v0, v1 := v1, a := a, b := v1/a] + ]) + end +end +lowered: flatrealm + entities + table ℜ.base.V := [] + table ℜ.base.E := [.a : ℜ.base.V, .b : ℜ.base.V] + table ℜ.fiber.V := [.a : ℜ.base.V] + table ℜ.fiber.E := [.a : ℜ.base.V, .b : ℜ.fiber.V, .c : ℜ.fiber.V] + table ℜ.action.V := [ + .v0 : ℜ.base.V, + .v1 : ℜ.base.V, + .a : ℜ.base.E, + .b : ℜ.fiber.V, + .c : ℜ.fiber.V + ] primarykey [.a, .b, .v0, .v1] + table ℜ.action.E := [ + .v0 : ℜ.base.V, + .v1 : ℜ.base.V, + .a : ℜ.base.E, + .v0/a : ℜ.fiber.V, + .v1/a : ℜ.fiber.V, + .b : ℜ.fiber.E, + .c : ℜ.fiber.E + ] primarykey [.a, .b, .v0, .v1, .v0/a, .v1/a] + end + rules + enforced ℜ.base.V.foreignKey := ℜ.base.V [] ⊢ ⊤ + enforced ℜ.base.E.foreignKey a b := ℜ.base.E [ + .a ↦ a, + .b ↦ b + ] ⊢ a ∈ ℜ.base.V [] ∧ b ∈ ℜ.base.V [] + enforced ℜ.fiber.V.foreignKey a := ℜ.fiber.V [.a ↦ a] ⊢ a ∈ ℜ.base.V [] + enforced ℜ.fiber.E.foreignKey a b c := ℜ.fiber.E [ + .a ↦ a, + .b ↦ b, + .c ↦ c + ] ⊢ a ∈ ℜ.base.V [] ∧ b ∈ ℜ.fiber.V [.a ↦ a] ∧ c ∈ ℜ.fiber.V [.a ↦ a] + enforced ℜ.action.V.foreignKey v0 v1 a b c := ℜ.action.V [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .b ↦ b, + .c ↦ c + ] ⊢ v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ + .a ↦ v0, + .b ↦ v1 + ] ∧ b ∈ ℜ.fiber.V [.a ↦ v0] ∧ c ∈ ℜ.fiber.V [.a ↦ v1] + monitored ℜ.action.V.total v0 v1 a b := v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ + .a ↦ v0, + .b ↦ v1 + ] ∧ b ∈ ℜ.fiber.V [.a ↦ v0] ⊢ ℜ.action.V [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .b ↦ b + ] + enforced ℜ.action.E.foreignKey v0 v1 a v0/a v1/a b c c.b c.c := ℜ.action.E [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .v0/a ↦ v0/a, + .v1/a ↦ v1/a, + .b ↦ b, + .c ↦ c + ] ∧ ℜ.action.V [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .b ↦ v0/a, + .c ↦ c.b + ] ∧ ℜ.action.V [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .b ↦ v1/a, + .c ↦ c.c + ] ⊢ v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ + .a ↦ v0, + .b ↦ v1 + ] ∧ v0/a ∈ ℜ.fiber.V [.a ↦ v0] ∧ v1/a ∈ ℜ.fiber.V [ + .a ↦ v0 + ] ∧ b ∈ ℜ.fiber.E [.a ↦ v0, .b ↦ v0/a, .c ↦ v1/a] ∧ c ∈ ℜ.fiber.E [ + .a ↦ v1, + .b ↦ c.b, + .c ↦ c.c + ] + monitored ℜ.action.E.total v0 v1 a v0/a v1/a b := v0 ∈ ℜ.base.V [] ∧ v1 ∈ ℜ.base.V [] ∧ a ∈ ℜ.base.E [ + .a ↦ v0, + .b ↦ v1 + ] ∧ v0/a ∈ ℜ.fiber.V [.a ↦ v0] ∧ v1/a ∈ ℜ.fiber.V [ + .a ↦ v0 + ] ∧ b ∈ ℜ.fiber.E [.a ↦ v0, .b ↦ v0/a, .c ↦ v1/a] ⊢ ℜ.action.E [ + .v0 ↦ v0, + .v1 ↦ v1, + .a ↦ a, + .v0/a ↦ v0/a, + .v1/a ↦ v1/a, + .b ↦ b + ] + end +end -- messages - -error[E0316]: cannot use inductively bound variable in a conjunctive context -15 | V : G0.V -> G1.V -15 | ^^ - -error[E0314]: no such variable Graph/hom in scope -22 | action : (v0 : base.V) -> (v1 : base.V) -> base.E v0 v1 -> Graph/hom (fiber v0) (fiber v1) -22 | ^^^^^^^^^ - -error[E0314]: no such variable GraphOfGraphs in scope -25 | realm GraphOfGraphsRealm @ GraphOfGraphs -25 | ^^^^^^^^^^^^^ diff --git a/packages/coln-compiler/test/golden/hlevel.output b/packages/coln-compiler/test/golden/hlevel.output index c1e8b8b3..80e29d42 100644 --- a/packages/coln-compiler/test/golden/hlevel.output +++ b/packages/coln-compiler/test/golden/hlevel.output @@ -7,6 +7,13 @@ value: sig is-parent : person -> person -> Prop happy : Prop end +global entry named Q +in mode: Conjunctive +type: (F : Family) -> Theory +value: F => sig + son : F.person + father : F.person +end global entry named HP in mode: Conjunctive type: Theory @@ -58,9 +65,13 @@ debug[D0315]: type person -> happy has level Level {mlevel = Theory, hlevel = HP 13 | showlevel person -> happy 13 | ^^^^^^^^^^^^^^^ -error[E0316]: cannot use inductively bound variable in a conjunctive context -17 | son : F.person -17 | ^ +debug[D0315]: value F.is-parent has type F.person -> F.person -> Prop +20 | showtype F.is-parent +20 | ^^^^^^^^^^^ + +debug[D0315]: value F.is-parent father son has type Prop +21 | showtype F.is-parent father son +21 | ^^^^^^^^^^^^^^^^^^^^^^ debug[D0315]: type voldemort = tomriddle has level Level {mlevel = Set, hlevel = HProp} 31 | showlevel voldemort = tomriddle @@ -90,6 +101,15 @@ debug[D0315]: type u = u has level Level {mlevel = Set, hlevel = HUnit} 48 | showlevel u = u 48 | ^^^^^ -error[E0316]: cannot use inductively bound variable in a conjunctive context +error[E0307]: type sig + f : A -> P + a : A +end too large for universe Set +51 | def LevelJoinRecordIsNotSet (A : Set) (P : Prop) : Set := sig +51 | ^^^ 52 | f : A -> P -52 | ^ +52 | ^^^^^^^^^^^^ +53 | a : A +53 | ^^^^^^^ +54 | end +54 | ^^^ diff --git a/packages/coln-compiler/test/golden/ind.output b/packages/coln-compiler/test/golden/ind.output index cbd9408a..28758444 100644 --- a/packages/coln-compiler/test/golden/ind.output +++ b/packages/coln-compiler/test/golden/ind.output @@ -1,8 +1,4 @@ -- elaborated -global entry named T -in mode: Inductive -type: Theory -value: Set global entry named Graph in mode: Conjunctive type: Theory @@ -10,21 +6,21 @@ value: sig v : Set e : v -> v -> Prop end +global entry named TransitiveExt +in mode: Conjunctive +type: (G : Graph) -> Theory +value: G => sig + p : G.v -> G.v -> Prop + incl : (v0 : G.v) -> (v1 : G.v) -> G.e v0 v1 -> p v0 v1 + snoc : (v0 : G.v) -> (v1 : G.v) -> (v2 : G.v) -> p v0 v1 -> G.e v1 v2 -> p v0 v2 +end +global entry named transitive-closure +in mode: Inductive +type: (G : Graph) -> TransitiveExt G +value: G => init (TransitiveExt G) -- messages -error[E0100]: Unexpected token kind SKeyword, expected a token that can start an expression -8 | theory TransitiveExt (@i G : Graph) := sig -8 | ^ - -error[E0200]: unexpected notation for identifier, possibly with mode annotation: Juxt -8 | theory TransitiveExt (@i G : Graph) := sig -8 | ^^^^ - -error[E0314]: no such variable TransitiveExt in scope -14 | ind def transitive-closure (G : Graph) : TransitiveExt G := init (TransitiveExt G) -14 | ^^^^^^^^^^^^^ - error[E0316]: cannot use inductively bound variable in a conjunctive context -16 | ind def freept (X : Set) : X := init X -16 | ^ +14 | ind def free-point (X : Set) : X := init X +14 | ^ diff --git a/packages/coln-compiler/test/golden/ssa.output b/packages/coln-compiler/test/golden/ssa.output index f5534860..e6c60421 100644 --- a/packages/coln-compiler/test/golden/ssa.output +++ b/packages/coln-compiler/test/golden/ssa.output @@ -1,4 +1,11 @@ -- elaborated +global entry named IsTransClosure +in mode: Conjunctive +type: (X : Set) -> (R : X -> X -> Set) -> (P : X -> X -> Set) -> Theory +value: X => R => P => sig + refl : (x : X) -> P x x + snoc : (x : X) -> (y : X) -> (z : X) -> P x y -> R y z -> P x z +end global entry named OpInfo in mode: Conjunctive type: Theory @@ -7,28 +14,28 @@ value: sig inputArity : OpType -> Set outputArity : OpType -> Set end +global entry named PrecedingOutput +in mode: Conjunctive +type: (X : Set) -> (rel : X -> X -> Set) -> (x : X) -> (outputs : X -> Set) -> Set +value: X => rel => x => outputs => sig + y : X + isPreceding : rel y x + output : outputs y +end -- messages -error[E0316]: cannot use inductively bound variable in a conjunctive context -2 | refl : (x : X) -> P x x -2 | ^ - error[E0316]: cannot use inductively bound variable in a conjunctive context 13 | next/prev : (x : car) -> next (prev x) = x 13 | ^ error[E0316]: cannot use inductively bound variable in a conjunctive context -32 | fwd : A -> B -32 | ^ - -error[E0316]: cannot use inductively bound variable in a conjunctive context -39 | opType : opInfo.OpType -39 | ^^^^^^ +34 | fwd/bwd : (a : A) -> bwd (fwd a) = a +34 | ^ -error[E0316]: cannot use inductively bound variable in a conjunctive context -45 | y : X -45 | ^ +error[E0314]: no such variable Iso in scope +41 | opOutputs : Iso outputs (opInfo.outputArity opType) +41 | ^^^ error[E0314]: no such variable LinearOrder in scope 51 | ops : LinearOrder From 4d2b85bdeb5e3798cf1f304b5abe6a74caeacaa2 Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Mon, 27 Jul 2026 19:33:20 -0400 Subject: [PATCH 12/13] fixed warnings --- packages/coln-compiler/src/Coln/Core/Conversion.hs | 3 +++ packages/coln-compiler/src/Coln/Elaborator/Rules/Universe.hs | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/packages/coln-compiler/src/Coln/Core/Conversion.hs b/packages/coln-compiler/src/Coln/Core/Conversion.hs index a8bb762e..a7184b70 100644 --- a/packages/coln-compiler/src/Coln/Core/Conversion.hs +++ b/packages/coln-compiler/src/Coln/Core/Conversion.hs @@ -143,6 +143,9 @@ instance DefEq (V.El N) where V.Neu n -> case canon v' of V.Neu n' -> defEq cs n n' _ -> throwUnequalEls cs v v' Nothing + V.InitNeu n -> case canon v' of + V.InitNeu n' -> defEq cs n n' + _ -> throwUnequalEls cs v v' Nothing V.Code a -> case canon v' of V.Code a' -> defEq cs a a' _ -> throwUnequalEls cs v v' Nothing diff --git a/packages/coln-compiler/src/Coln/Elaborator/Rules/Universe.hs b/packages/coln-compiler/src/Coln/Elaborator/Rules/Universe.hs index dca6d2e4..37d02cf9 100644 --- a/packages/coln-compiler/src/Coln/Elaborator/Rules/Universe.hs +++ b/packages/coln-compiler/src/Coln/Elaborator/Rules/Universe.hs @@ -35,7 +35,7 @@ elimSyn :: Span -> Syn N -> Typ N elimSyn sp s = Typ \e -> do (a, el) <- s.elab e case V.behavior a of - V.LikeU u -> pure $ decode el + V.LikeU _ -> pure $ decode el _ -> do let msg = "expected element of universe type" failWith e.diagEnv sp TypeAtNonUniverse msg From c3e5b4c62f9f2163fc5604e1fd6e32bdfa762992 Mon Sep 17 00:00:00 2001 From: Owen Lynch Date: Mon, 3 Aug 2026 11:43:05 +0100 Subject: [PATCH 13/13] re-disable web demos --- .github/workflows/web-demos.yml | 168 ++++++++++++++++---------------- 1 file changed, 84 insertions(+), 84 deletions(-) diff --git a/.github/workflows/web-demos.yml b/.github/workflows/web-demos.yml index df93af1b..6979b250 100644 --- a/.github/workflows/web-demos.yml +++ b/.github/workflows/web-demos.yml @@ -14,97 +14,97 @@ concurrency: cancel-in-progress: true jobs: - build-and-deploy: - runs-on: ubuntu-latest - env: - CARGO_TARGET_DIR: ${{ github.workspace }}/target - NETLIFY_AUTH_TOKEN: ${{ secrets.NETLIFY_AUTH_TOKEN }} - NETLIFY_SITE_ID: ${{ secrets.NETLIFY_SITE_ID }} + # build-and-deploy: + # runs-on: ubuntu-latest + # env: + # CARGO_TARGET_DIR: ${{ github.workspace }}/target + # NETLIFY_AUTH_TOKEN: ${{ secrets.NETLIFY_AUTH_TOKEN }} + # NETLIFY_SITE_ID: ${{ secrets.NETLIFY_SITE_ID }} - steps: - - name: Checkout ⬇️ - uses: actions/checkout@v6 + # steps: + # - name: Checkout ⬇️ + # uses: actions/checkout@v6 - - name: Install Nix ❄️ - uses: cachix/install-nix-action@v31 + # - name: Install Nix ❄️ + # uses: cachix/install-nix-action@v31 - - name: Set up Cachix ♻️ - if: github.event_name != 'pull_request' || github.event.pull_request.head.repo.full_name == github.repository - uses: cachix/cachix-action@v17 - with: - name: coln - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + # - name: Set up Cachix ♻️ + # if: github.event_name != 'pull_request' || github.event.pull_request.head.repo.full_name == github.repository + # uses: cachix/cachix-action@v17 + # with: + # name: coln + # authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - - name: Restore build caches - uses: actions/cache@v4 - with: - path: | - .pnpm-store - ~/.npm - ~/.cargo/registry - ~/.cargo/git - ~/.ghc-wasm/.cabal - target - dist-newstyle - key: web-demos-${{ runner.os }}-${{ hashFiles('flake.lock', 'Cargo.lock', 'cabal.project', 'packages/**/*.cabal', 'packages/coln-js-runtime/package-lock.json', 'examples/sync-demo/pnpm-lock.yaml') }} - restore-keys: | - web-demos-${{ runner.os }}- + # - name: Restore build caches + # uses: actions/cache@v4 + # with: + # path: | + # .pnpm-store + # ~/.npm + # ~/.cargo/registry + # ~/.cargo/git + # ~/.ghc-wasm/.cabal + # target + # dist-newstyle + # key: web-demos-${{ runner.os }}-${{ hashFiles('flake.lock', 'Cargo.lock', 'cabal.project', 'packages/**/*.cabal', 'packages/coln-js-runtime/package-lock.json', 'examples/sync-demo/pnpm-lock.yaml') }} + # restore-keys: | + # web-demos-${{ runner.os }}- - - name: Build sync demo - run: nix run --accept-flake-config .#sync-demo -- "$GITHUB_WORKSPACE" - env: - VITE_BASE: /sync/ + # - name: Build sync demo + # run: nix run --accept-flake-config .#sync-demo -- "$GITHUB_WORKSPACE" + # env: + # VITE_BASE: /sync/ - - name: Build web compiler - run: | - nix develop --accept-flake-config --command wasm32-wasi-cabal update 'hackage.haskell.org,2026-07-15T17:07:49Z' - nix develop --accept-flake-config --command just examples/build-web-compiler + # - name: Build web compiler + # run: | + # nix develop --accept-flake-config --command wasm32-wasi-cabal update 'hackage.haskell.org,2026-07-15T17:07:49Z' + # nix develop --accept-flake-config --command just examples/build-web-compiler - - name: Assemble deploy directory - run: | - cp examples/index.html examples/style.css _build/web/ - cp -r examples/sync-demo/dist _build/web/sync + # - name: Assemble deploy directory + # run: | + # cp examples/index.html examples/style.css _build/web/ + # cp -r examples/sync-demo/dist _build/web/sync - - name: Deploy PR preview to Netlify - id: deploy-preview - if: github.event_name == 'pull_request' && env.NETLIFY_AUTH_TOKEN != '' && env.NETLIFY_SITE_ID != '' - run: | - npx --yes netlify-cli@latest deploy \ - --auth "$NETLIFY_AUTH_TOKEN" \ - --site "$NETLIFY_SITE_ID" \ - --dir _build/web \ - --no-build \ - --alias "pr-${{ github.event.pull_request.number }}" \ - --message "PR #${{ github.event.pull_request.number }} web demos" \ - --json > netlify-deploy.json + # - name: Deploy PR preview to Netlify + # id: deploy-preview + # if: github.event_name == 'pull_request' && env.NETLIFY_AUTH_TOKEN != '' && env.NETLIFY_SITE_ID != '' + # run: | + # npx --yes netlify-cli@latest deploy \ + # --auth "$NETLIFY_AUTH_TOKEN" \ + # --site "$NETLIFY_SITE_ID" \ + # --dir _build/web \ + # --no-build \ + # --alias "pr-${{ github.event.pull_request.number }}" \ + # --message "PR #${{ github.event.pull_request.number }} web demos" \ + # --json > netlify-deploy.json - cat netlify-deploy.json - deploy_url=$(node -e "const d = require('./netlify-deploy.json'); console.log(d.deploy_ssl_url || d.ssl_url || d.deploy_url || d.url)") - echo "deploy-url=$deploy_url" >> "$GITHUB_OUTPUT" + # cat netlify-deploy.json + # deploy_url=$(node -e "const d = require('./netlify-deploy.json'); console.log(d.deploy_ssl_url || d.ssl_url || d.deploy_url || d.url)") + # echo "deploy-url=$deploy_url" >> "$GITHUB_OUTPUT" - - name: Comment with deploy preview URL - if: github.event_name == 'pull_request' && steps.deploy-preview.outputs.deploy-url != '' - uses: actions/github-script@v8 - with: - script: | - const marker = '' - const body = `${marker}\nWeb demo preview: ${{ steps.deploy-preview.outputs.deploy-url }}` - const { owner, repo } = context.repo - const issue_number = context.issue.number - const comments = await github.rest.issues.listComments({ owner, repo, issue_number, per_page: 100 }) - const existing = comments.data.find(comment => comment.body?.includes(marker)) - if (existing) { - await github.rest.issues.updateComment({ owner, repo, comment_id: existing.id, body }) - } else { - await github.rest.issues.createComment({ owner, repo, issue_number, body }) - } - - name: Deploy main to Netlify production - if: github.event_name == 'push' && env.NETLIFY_AUTH_TOKEN != '' && env.NETLIFY_SITE_ID != '' - run: | - npx --yes netlify-cli@latest deploy \ - --auth "$NETLIFY_AUTH_TOKEN" \ - --site "$NETLIFY_SITE_ID" \ - --dir _build/web \ - --no-build \ - --prod \ - --message "web demos ${{ github.sha }}" + # - name: Comment with deploy preview URL + # if: github.event_name == 'pull_request' && steps.deploy-preview.outputs.deploy-url != '' + # uses: actions/github-script@v8 + # with: + # script: | + # const marker = '' + # const body = `${marker}\nWeb demo preview: ${{ steps.deploy-preview.outputs.deploy-url }}` + # const { owner, repo } = context.repo + # const issue_number = context.issue.number + # const comments = await github.rest.issues.listComments({ owner, repo, issue_number, per_page: 100 }) + # const existing = comments.data.find(comment => comment.body?.includes(marker)) + # if (existing) { + # await github.rest.issues.updateComment({ owner, repo, comment_id: existing.id, body }) + # } else { + # await github.rest.issues.createComment({ owner, repo, issue_number, body }) + # } + # - name: Deploy main to Netlify production + # if: github.event_name == 'push' && env.NETLIFY_AUTH_TOKEN != '' && env.NETLIFY_SITE_ID != '' + # run: | + # npx --yes netlify-cli@latest deploy \ + # --auth "$NETLIFY_AUTH_TOKEN" \ + # --site "$NETLIFY_SITE_ID" \ + # --dir _build/web \ + # --no-build \ + # --prod \ + # --message "web demos ${{ github.sha }}"