restructure Raw to separate import directives
This commit is contained in:
4
TODO.md
4
TODO.md
@@ -4,7 +4,7 @@
|
|||||||
I may be done with `U` - I keep typing `Type`.
|
I may be done with `U` - I keep typing `Type`.
|
||||||
|
|
||||||
- [ ] Generate some programs that do stuff
|
- [ ] Generate some programs that do stuff
|
||||||
- [ ] import
|
- [x] import
|
||||||
- [ ] consider making meta application implicit in term, so its more readable when printed
|
- [ ] consider making meta application implicit in term, so its more readable when printed
|
||||||
- Currently we have explicit `App` surrounding `Meta` when inserting metas. Some people
|
- Currently we have explicit `App` surrounding `Meta` when inserting metas. Some people
|
||||||
leave that implicit for efficiency. I think it would also make printing more readable.
|
leave that implicit for efficiency. I think it would also make printing more readable.
|
||||||
@@ -49,3 +49,5 @@ I may be done with `U` - I keep typing `Type`.
|
|||||||
- [ ] records / copatterns
|
- [ ] records / copatterns
|
||||||
|
|
||||||
- [ ] Read Ulf Norell thesis
|
- [ ] Read Ulf Norell thesis
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -242,8 +242,8 @@ export
|
|||||||
parseSig : Parser Decl
|
parseSig : Parser Decl
|
||||||
parseSig = TypeSig <$> getPos <*> (ident <|> uident) <* keyword ":" <*> typeExpr
|
parseSig = TypeSig <$> getPos <*> (ident <|> uident) <* keyword ":" <*> typeExpr
|
||||||
|
|
||||||
parseImport : Parser Decl
|
parseImport : Parser Import
|
||||||
parseImport = DImport <$> getPos <* keyword "import" <*> uident
|
parseImport = MkImport <$> getPos <* keyword "import" <*> uident
|
||||||
|
|
||||||
-- Do we do pattern stuff now? or just name = lambda?
|
-- Do we do pattern stuff now? or just name = lambda?
|
||||||
|
|
||||||
@@ -335,15 +335,17 @@ parseNorm = DCheck <$> getPos <* keyword "#check" <*> typeExpr <* keyword ":" <*
|
|||||||
|
|
||||||
export
|
export
|
||||||
parseDecl : Parser Decl
|
parseDecl : Parser Decl
|
||||||
parseDecl = parseMixfix <|> parsePType <|> parsePFunc <|> parseImport <|> parseNorm <|> parseData <|> (try $ parseSig) <|> parseDef
|
parseDecl = parseMixfix <|> parsePType <|> parsePFunc <|> parseNorm <|> parseData <|> (try $ parseSig) <|> parseDef
|
||||||
|
|
||||||
export
|
export
|
||||||
parseMod : Parser Module
|
parseMod : Parser Module
|
||||||
parseMod = do
|
parseMod = do
|
||||||
keyword "module"
|
keyword "module"
|
||||||
name <- uident
|
name <- uident
|
||||||
decls <- startBlock $ manySame $ parseDecl
|
startBlock $ do
|
||||||
pure $ MkModule name decls
|
imports <- manySame $ parseImport
|
||||||
|
decls <- manySame $ parseDecl
|
||||||
|
pure $ MkModule name imports decls
|
||||||
|
|
||||||
public export
|
public export
|
||||||
data ReplCmd =
|
data ReplCmd =
|
||||||
|
|||||||
@@ -107,8 +107,6 @@ processDecl (DCheck fc tm ty) = do
|
|||||||
putStrLn "norm \{pprint [] norm}"
|
putStrLn "norm \{pprint [] norm}"
|
||||||
putStrLn "NF "
|
putStrLn "NF "
|
||||||
|
|
||||||
processDecl (DImport fc str) = pure ()
|
|
||||||
|
|
||||||
processDecl (Data fc nm ty cons) = do
|
processDecl (Data fc nm ty cons) = do
|
||||||
ctx <- get
|
ctx <- get
|
||||||
tyty <- check (mkCtx ctx.metas fc) ty (VU fc)
|
tyty <- check (mkCtx ctx.metas fc) ty (VU fc)
|
||||||
|
|||||||
@@ -12,8 +12,6 @@ data Raw : Type where
|
|||||||
public export
|
public export
|
||||||
data RigCount = Rig0 | RigW
|
data RigCount = Rig0 | RigW
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
public export
|
public export
|
||||||
data Pattern
|
data Pattern
|
||||||
= PatVar FC Icit Name
|
= PatVar FC Icit Name
|
||||||
@@ -92,14 +90,16 @@ HasFC Raw where
|
|||||||
getFC (RParseError fc str) = fc
|
getFC (RParseError fc str) = fc
|
||||||
-- derive some stuff - I'd like json, eq, show, ...
|
-- derive some stuff - I'd like json, eq, show, ...
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
public export
|
||||||
|
data Import = MkImport FC Name
|
||||||
|
|
||||||
-- FIXME - I think I don't want "where" here, but the parser has an issue
|
-- FIXME - I think I don't want "where" here, but the parser has an issue
|
||||||
public export
|
public export
|
||||||
data Decl : Type where
|
|
||||||
|
|
||||||
data Decl
|
data Decl
|
||||||
= TypeSig FC Name Raw
|
= TypeSig FC Name Raw
|
||||||
| Def FC Name (List (Raw,Raw)) -- (List Clause)
|
| Def FC Name (List (Raw,Raw)) -- (List Clause)
|
||||||
| DImport FC Name
|
|
||||||
| DCheck FC Raw Raw
|
| DCheck FC Raw Raw
|
||||||
| Data FC Name Raw (List Decl)
|
| Data FC Name Raw (List Decl)
|
||||||
| PType FC Name (Maybe Raw)
|
| PType FC Name (Maybe Raw)
|
||||||
@@ -111,17 +111,16 @@ public export
|
|||||||
record Module where
|
record Module where
|
||||||
constructor MkModule
|
constructor MkModule
|
||||||
name : Name
|
name : Name
|
||||||
|
imports : List Import
|
||||||
decls : List Decl
|
decls : List Decl
|
||||||
|
|
||||||
foo : List String -> String
|
foo : List String -> String
|
||||||
foo ts = "(" ++ unwords ts ++ ")"
|
foo ts = "(" ++ unwords ts ++ ")"
|
||||||
|
|
||||||
|
|
||||||
Show Literal where
|
Show Literal where
|
||||||
show (LString str) = foo [ "LString", show str]
|
show (LString str) = foo [ "LString", show str]
|
||||||
show (LInt i) = foo [ "LInt", show i]
|
show (LInt i) = foo [ "LInt", show i]
|
||||||
|
|
||||||
|
|
||||||
export
|
export
|
||||||
covering
|
covering
|
||||||
implementation Show Raw
|
implementation Show Raw
|
||||||
@@ -135,12 +134,14 @@ export covering
|
|||||||
Show Clause where
|
Show Clause where
|
||||||
show (MkClause fc cons pats expr) = show (fc, cons, pats, expr)
|
show (MkClause fc cons pats expr) = show (fc, cons, pats, expr)
|
||||||
|
|
||||||
|
Show Import where
|
||||||
|
show (MkImport _ str) = foo ["MkImport", show str]
|
||||||
|
|
||||||
covering
|
covering
|
||||||
Show Decl where
|
Show Decl where
|
||||||
show (TypeSig _ str x) = foo ["TypeSig", show str, show x]
|
show (TypeSig _ str x) = foo ["TypeSig", show str, show x]
|
||||||
show (Def _ str clauses) = foo ["Def", show str, show clauses]
|
show (Def _ str clauses) = foo ["Def", show str, show clauses]
|
||||||
show (Data _ str xs ys) = foo ["Data", show str, show xs, show ys]
|
show (Data _ str xs ys) = foo ["Data", show str, show xs, show ys]
|
||||||
show (DImport _ str) = foo ["DImport", show str]
|
|
||||||
show (DCheck _ x y) = foo ["DCheck", show x, show y]
|
show (DCheck _ x y) = foo ["DCheck", show x, show y]
|
||||||
show (PType _ name ty) = foo ["PType", name, show ty]
|
show (PType _ name ty) = foo ["PType", name, show ty]
|
||||||
show (PFunc _ nm ty src) = foo ["PFunc", nm, show ty, show src]
|
show (PFunc _ nm ty src) = foo ["PFunc", nm, show ty, show src]
|
||||||
@@ -148,7 +149,7 @@ Show Decl where
|
|||||||
|
|
||||||
export covering
|
export covering
|
||||||
Show Module where
|
Show Module where
|
||||||
show (MkModule name decls) = foo ["MkModule", show name, show decls]
|
show (MkModule name imports decls) = foo ["MkModule", show name, show imports, show decls]
|
||||||
|
|
||||||
Show RigCount where
|
Show RigCount where
|
||||||
show Rig0 = "Rig0"
|
show Rig0 = "Rig0"
|
||||||
@@ -226,13 +227,17 @@ Pretty Raw where
|
|||||||
|
|
||||||
export
|
export
|
||||||
Pretty Module where
|
Pretty Module where
|
||||||
pretty (MkModule name decls) =
|
pretty (MkModule name imports decls) =
|
||||||
text "module" <+> text name </> stack (map doDecl decls)
|
text "module" <+> text name
|
||||||
|
</> stack (map doImport imports)
|
||||||
|
</> stack (map doDecl decls)
|
||||||
where
|
where
|
||||||
|
doImport : Import -> Doc
|
||||||
|
doImport (MkImport _ nm) = text "import" <+> text nm ++ line
|
||||||
|
|
||||||
doDecl : Decl -> Doc
|
doDecl : Decl -> Doc
|
||||||
doDecl (TypeSig _ nm ty) = text nm <+> text ":" <+> nest 2 (pretty ty)
|
doDecl (TypeSig _ nm ty) = text nm <+> text ":" <+> nest 2 (pretty ty)
|
||||||
doDecl (Def _ nm clauses) = stack $ map (\(a,b) => pretty a <+> "=" <+> pretty b) clauses
|
doDecl (Def _ nm clauses) = stack $ map (\(a,b) => pretty a <+> "=" <+> pretty b) clauses
|
||||||
doDecl (DImport _ nm) = text "import" <+> text nm ++ line
|
|
||||||
-- the behavior of nest is kinda weird, I have to do the nest before/around the </>.
|
-- the behavior of nest is kinda weird, I have to do the nest before/around the </>.
|
||||||
doDecl (Data _ nm x xs) = text "data" <+> text nm <+> text ":" <+> pretty x <+> (nest 2 $ text "where" </> stack (map doDecl xs))
|
doDecl (Data _ nm x xs) = text "data" <+> text nm <+> text ":" <+> pretty x <+> (nest 2 $ text "where" </> stack (map doDecl xs))
|
||||||
doDecl (DCheck _ x y) = text "#check" <+> pretty x <+> ":" <+> pretty y
|
doDecl (DCheck _ x y) = text "#check" <+> pretty x <+> ":" <+> pretty y
|
||||||
|
|||||||
@@ -74,12 +74,10 @@ loadModule base name = do
|
|||||||
putStrLn "module \{res.name}"
|
putStrLn "module \{res.name}"
|
||||||
let True = name == res.name
|
let True = name == res.name
|
||||||
| _ => fail "module name \{show res.name} doesn't match file name \{show fn}"
|
| _ => fail "module name \{show res.name} doesn't match file name \{show fn}"
|
||||||
-- TODO separate imports and detect loops / redundant
|
-- TODO separate imports and detect loops / redundant
|
||||||
for_ res.decls $ \ decl => case decl of
|
for_ res.imports $ \ (MkImport fc name) => loadModule base name
|
||||||
(DImport x str) => loadModule base str
|
|
||||||
_ => pure ()
|
|
||||||
|
|
||||||
|
|
||||||
|
-- TODO Lift the error exit, so import errors can get a FC in current file
|
||||||
putStrLn "process Decls"
|
putStrLn "process Decls"
|
||||||
Right _ <- tryError $ traverse_ processDecl (collectDecl res.decls)
|
Right _ <- tryError $ traverse_ processDecl (collectDecl res.decls)
|
||||||
| Left y => fail (showError src y)
|
| Left y => fail (showError src y)
|
||||||
|
|||||||
Reference in New Issue
Block a user