Checkpoint some stuff so I can rollback the rest.
This commit is contained in:
@@ -252,3 +252,17 @@ parseMod = do
|
|||||||
decls <- startBlock $ someSame $ parseDecl
|
decls <- startBlock $ someSame $ parseDecl
|
||||||
pure $ MkModule name [] decls
|
pure $ MkModule name [] decls
|
||||||
|
|
||||||
|
|
||||||
|
public export
|
||||||
|
data ReplCmd =
|
||||||
|
Def Decl
|
||||||
|
| Norm Raw -- or just name?
|
||||||
|
| Check Raw
|
||||||
|
|
||||||
|
|
||||||
|
-- Eventually I'd like immediate actions in the file, like lean, but I
|
||||||
|
-- also want to REPL to work and we can do that first.
|
||||||
|
export parseRepl : Parser ReplCmd
|
||||||
|
parseRepl = Def <$> parseDecl <|> Norm <$ keyword "#nf" <*> typeExpr
|
||||||
|
<|> Check <$ keyword "#check" <*> typeExpr
|
||||||
|
|
||||||
|
|||||||
@@ -29,15 +29,22 @@ data Tm : Nat -> Type where
|
|||||||
|
|
||||||
-- TODO derive
|
-- TODO derive
|
||||||
export
|
export
|
||||||
|
Eq Icit where
|
||||||
|
Implicit == Implicit = True
|
||||||
|
Explicit == Explicit = True
|
||||||
|
_ == _ = False
|
||||||
|
|
||||||
|
||| Eq on Tm. We've got deBruijn indices, so I'm not comparing names
|
||||||
|
export
|
||||||
Eq (Tm n) where
|
Eq (Tm n) where
|
||||||
-- (Local x) == (Local y) = x == y
|
-- (Local x) == (Local y) = x == y
|
||||||
(Bnd x) == (Bnd y) = x == y
|
(Bnd x) == (Bnd y) = x == y
|
||||||
(Ref x) == (Ref y) = x == y
|
(Ref x) == (Ref y) = x == y
|
||||||
(Lam str icit t) == y = ?rhs_3
|
(Lam n icit t) == (Lam n' icit' t') = icit == icit' && t == t'
|
||||||
(App t u) == y = ?rhs_4
|
(App t u) == App t' u' = t == t' && u == u'
|
||||||
U == y = ?rhs_5
|
U == U = True
|
||||||
(Pi str icit t u) == y = ?rhs_6
|
(Pi n icit t u) == (Pi n' icit' t' u') = icit == icit' && t == t' && u == u'
|
||||||
(Let str icit t u v) == y = ?rhs_7
|
(Let n icit t u v) == (Let n' icit' t' u' v') = t == t' && u == u' && v == v'
|
||||||
_ == _ = False
|
_ == _ = False
|
||||||
|
|
||||||
-- public export
|
-- public export
|
||||||
@@ -127,11 +134,47 @@ public export
|
|||||||
Types : Nat -> Type
|
Types : Nat -> Type
|
||||||
Types n = Vect n (Name, Lazy (Val n))
|
Types n = Vect n (Name, Lazy (Val n))
|
||||||
|
|
||||||
-- public export
|
|
||||||
|
|
||||||
|
-- REVIEW indices
|
||||||
|
public export
|
||||||
|
record Context (n : Nat) where
|
||||||
|
constructor MkCtx
|
||||||
|
|
||||||
|
-- These are values, they'll be the length of the environment
|
||||||
|
env : Env n n -- Vect n (Val f)
|
||||||
|
|
||||||
|
-- fine for now, consider a map later
|
||||||
|
types : Vect n (String, Val n)
|
||||||
|
pos : SourcePos
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
||| add a binding to environment
|
||||||
|
extend : Context n n -> String -> Val n -> Context (S n) (S n)
|
||||||
|
extend (MkCtx env types pos) name ty with (length env)
|
||||||
|
_ | l =
|
||||||
|
|
||||||
|
let types' = (name,ty) :: (map $ mapSnd thinVal) types in
|
||||||
|
let l' : Fin (S n) := ?hole in
|
||||||
|
MkCtx (VVar l' :: map thinVal env) types' pos
|
||||||
|
-- ?hole_0 -- { env := (Val (length env.(Context env types pos)) :: (Context env types pos).env), types := (n, ty) :: (Context env types pos).types } (Context env types pos)
|
||||||
|
|
||||||
|
|
||||||
|
-- weirich has 'hints' to store the claims before the def is seen/checked
|
||||||
|
-- saying it is unsafe. afterwards they are mixed into the context.
|
||||||
|
-- idris essentially leaves holes, filled in later, for undefined claims
|
||||||
|
-- Is it ok to leaving them in there (if they pass checkType) as long as
|
||||||
|
-- we don't register the def if it fails checking?
|
||||||
|
|
||||||
|
-- shoot, I have another of these in Check.idr
|
||||||
|
|
||||||
|
|
||||||
|
-- -- public export
|
||||||
-- record Ctx (n : Nat) where
|
-- record Ctx (n : Nat) where
|
||||||
-- constructor MkCtx
|
-- constructor MkCtx
|
||||||
-- env : Env k n -- for eval
|
-- env : Env k n -- for eval
|
||||||
-- types : Types n -- name lookup, pp
|
-- types : Types n -- name lookup, prettyprint
|
||||||
-- bds : Vect n BD -- meta creation
|
-- bds : Vect n BD -- meta creation
|
||||||
-- lvl : Nat -- This is n, do we need it?
|
-- lvl : Nat -- This is n, do we need it?
|
||||||
-- -- Kovacs and Weirich use a position node
|
-- -- Kovacs and Weirich use a position node
|
||||||
@@ -143,6 +186,22 @@ Types n = Vect n (Name, Lazy (Val n))
|
|||||||
-- emptyCtx : Ctx Z
|
-- emptyCtx : Ctx Z
|
||||||
-- emptyCtx = MkCtx {k=0} [] [] [] 0 (0,0)
|
-- emptyCtx = MkCtx {k=0} [] [] [] 0 (0,0)
|
||||||
|
|
||||||
|
-- find out how pi-forall treats binders
|
||||||
|
-- Vars are unbound TName
|
||||||
|
|
||||||
|
-- ezoo
|
||||||
|
-- Tm has Ix
|
||||||
|
-- Val has Lvl
|
||||||
|
|
||||||
|
-- by the time we hit ezoo 5/6, there is a Map string -> (Lvl, Type) for name lookup.
|
||||||
|
|
||||||
|
-- smalltt
|
||||||
|
|
||||||
|
|
||||||
|
-- idris
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- public export
|
-- public export
|
||||||
-- bindCtx : Name -> Lazy (Val (zz + n)) -> Ctx n -> Ctx (S n)
|
-- bindCtx : Name -> Lazy (Val (zz + n)) -> Ctx n -> Ctx (S n)
|
||||||
-- bindCtx x a (MkCtx env types bds l pos) =
|
-- bindCtx x a (MkCtx env types bds l pos) =
|
||||||
|
|||||||
@@ -11,6 +11,7 @@ data Kind
|
|||||||
| Symbol
|
| Symbol
|
||||||
| Space
|
| Space
|
||||||
| Comment
|
| Comment
|
||||||
|
| Pragma
|
||||||
-- not doing Layout.idr
|
-- not doing Layout.idr
|
||||||
| LBrace
|
| LBrace
|
||||||
| Semi
|
| Semi
|
||||||
@@ -30,7 +31,7 @@ Show Kind where
|
|||||||
show RBrace = "RBrace"
|
show RBrace = "RBrace"
|
||||||
show Comment = "Comment"
|
show Comment = "Comment"
|
||||||
show EOI = "EOI"
|
show EOI = "EOI"
|
||||||
|
show Pragma = "Pragma"
|
||||||
export
|
export
|
||||||
Eq Kind where
|
Eq Kind where
|
||||||
Ident == Ident = True
|
Ident == Ident = True
|
||||||
|
|||||||
@@ -26,6 +26,7 @@ rawTokens : Tokenizer (Token Kind)
|
|||||||
rawTokens
|
rawTokens
|
||||||
= match (alpha <+> many identMore) checkKW
|
= match (alpha <+> many identMore) checkKW
|
||||||
<|> match (some digit) (Tok Number)
|
<|> match (some digit) (Tok Number)
|
||||||
|
<|> match (is '#' <+> many alpha) (Tok Pragma)
|
||||||
<|> match (lineComment (exact "--")) (Tok Space)
|
<|> match (lineComment (exact "--")) (Tok Space)
|
||||||
<|> match (some opChar) (\s => Tok Oper s)
|
<|> match (some opChar) (\s => Tok Oper s)
|
||||||
<|> match symbol (Tok Symbol)
|
<|> match symbol (Tok Symbol)
|
||||||
|
|||||||
Reference in New Issue
Block a user