2020-05-18 18:57:43 +03:00
|
|
|
module Language.Reflection
|
|
|
|
|
|
|
|
import public Language.Reflection.TT
|
|
|
|
import public Language.Reflection.TTImp
|
|
|
|
|
2021-05-13 14:58:56 +03:00
|
|
|
%default total
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Elaboration scripts
|
|
|
|
||| Where types/terms are returned, binders will have unique, if not
|
|
|
|
||| necessarily human readabe, names
|
2020-05-31 16:33:34 +03:00
|
|
|
export
|
2020-05-18 18:57:43 +03:00
|
|
|
data Elab : Type -> Type where
|
|
|
|
Pure : a -> Elab a
|
|
|
|
Bind : Elab a -> (a -> Elab b) -> Elab b
|
2020-06-01 16:26:37 +03:00
|
|
|
Fail : String -> Elab a
|
|
|
|
|
2020-08-20 20:45:34 +03:00
|
|
|
LogMsg : String -> Nat -> String -> Elab ()
|
|
|
|
LogTerm : String -> Nat -> String -> TTImp -> Elab ()
|
2020-05-18 18:57:43 +03:00
|
|
|
|
2020-06-03 00:41:37 +03:00
|
|
|
-- Elaborate a TTImp term to a concrete value
|
|
|
|
Check : {expected : Type} -> TTImp -> Elab expected
|
2020-06-03 01:36:20 +03:00
|
|
|
-- Quote a concrete expression back to a TTImp
|
|
|
|
Quote : val -> Elab TTImp
|
2020-06-03 11:17:37 +03:00
|
|
|
|
|
|
|
-- Elaborate under a lambda
|
2020-06-03 22:23:36 +03:00
|
|
|
Lambda : (0 x : Type) ->
|
|
|
|
{0 ty : x -> Type} ->
|
|
|
|
((val : x) -> Elab (ty val)) -> Elab ((val : x) -> (ty val))
|
2020-06-03 11:17:37 +03:00
|
|
|
|
2020-08-20 20:45:34 +03:00
|
|
|
-- Get the current goal type, if known
|
2020-05-31 16:33:34 +03:00
|
|
|
-- (it might need to be inferred from the solution)
|
|
|
|
Goal : Elab (Maybe TTImp)
|
2020-06-02 00:16:27 +03:00
|
|
|
-- Get the names of local variables in scope
|
|
|
|
LocalVars : Elab (List Name)
|
2020-06-01 17:13:42 +03:00
|
|
|
-- Generate a new unique name, based on the given string
|
|
|
|
GenSym : String -> Elab Name
|
|
|
|
-- Put a name in the current namespace
|
|
|
|
InCurrentNS : Name -> Elab Name
|
2020-06-01 16:26:37 +03:00
|
|
|
-- Get the types of every name which matches.
|
|
|
|
-- There may be ambiguities - returns a list of fully explicit names
|
|
|
|
-- and their types. If there's no results, the name is undefined.
|
|
|
|
GetType : Name -> Elab (List (Name, TTImp))
|
2020-06-02 00:16:27 +03:00
|
|
|
-- Get the type of a local variable
|
|
|
|
GetLocalType : Name -> Elab TTImp
|
2020-06-01 17:01:52 +03:00
|
|
|
-- Get the constructors of a data type. The name must be fully resolved.
|
2020-06-01 16:26:37 +03:00
|
|
|
GetCons : Name -> Elab (List Name)
|
2020-06-01 17:01:52 +03:00
|
|
|
-- Check a group of top level declarations
|
|
|
|
Declare : List Decl -> Elab ()
|
|
|
|
|
2021-05-13 14:58:56 +03:00
|
|
|
export
|
|
|
|
Functor Elab where
|
|
|
|
map f e = Bind e $ Pure . f
|
|
|
|
|
|
|
|
export
|
|
|
|
Applicative Elab where
|
|
|
|
pure = Pure
|
|
|
|
f <*> a = Bind f (<$> a)
|
|
|
|
|
|
|
|
export
|
|
|
|
Monad Elab where
|
|
|
|
(>>=) = Bind
|
2020-05-31 16:33:34 +03:00
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Report an error in elaboration
|
2020-06-01 16:26:37 +03:00
|
|
|
export
|
|
|
|
fail : String -> Elab a
|
|
|
|
fail = Fail
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Write a log message, if the log level is >= the given level
|
2020-05-31 16:33:34 +03:00
|
|
|
export
|
2020-08-20 20:45:34 +03:00
|
|
|
logMsg : String -> Nat -> String -> Elab ()
|
2020-05-31 16:33:34 +03:00
|
|
|
logMsg = LogMsg
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Write a log message and a rendered term, if the log level is >= the given level
|
2020-05-31 16:33:34 +03:00
|
|
|
export
|
2020-08-20 20:45:34 +03:00
|
|
|
logTerm : String -> Nat -> String -> TTImp -> Elab ()
|
2020-05-31 16:33:34 +03:00
|
|
|
logTerm = LogTerm
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Log the current goal type, if the log level is >= the given level
|
2020-05-31 16:33:34 +03:00
|
|
|
export
|
2020-08-20 20:45:34 +03:00
|
|
|
logGoal : String -> Nat -> String -> Elab ()
|
|
|
|
logGoal str n msg
|
2020-05-31 16:33:34 +03:00
|
|
|
= do g <- Goal
|
|
|
|
case g of
|
|
|
|
Nothing => pure ()
|
2020-08-20 20:45:34 +03:00
|
|
|
Just t => logTerm str n msg t
|
2020-05-31 16:33:34 +03:00
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Check that some TTImp syntax has the expected type
|
|
|
|
||| Returns the type checked value
|
2020-05-31 16:33:34 +03:00
|
|
|
export
|
2020-06-03 00:41:37 +03:00
|
|
|
check : {expected : Type} -> TTImp -> Elab expected
|
2020-05-31 16:33:34 +03:00
|
|
|
check = Check
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Return TTImp syntax of a given value
|
2020-06-03 01:36:20 +03:00
|
|
|
export
|
|
|
|
quote : val -> Elab TTImp
|
|
|
|
quote = Quote
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Build a lambda expression
|
2020-06-03 11:17:37 +03:00
|
|
|
export
|
2020-06-03 22:23:36 +03:00
|
|
|
lambda : (0 x : Type) ->
|
|
|
|
{0 ty : x -> Type} ->
|
|
|
|
((val : x) -> Elab (ty val)) -> Elab ((val : x) -> (ty val))
|
2020-06-03 11:17:37 +03:00
|
|
|
lambda = Lambda
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Get the goal type of the current elaboration
|
2020-05-31 16:33:34 +03:00
|
|
|
export
|
|
|
|
goal : Elab (Maybe TTImp)
|
|
|
|
goal = Goal
|
2020-06-01 16:26:37 +03:00
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Get the names of the local variables in scope
|
2020-06-02 00:16:27 +03:00
|
|
|
export
|
|
|
|
localVars : Elab (List Name)
|
|
|
|
localVars = LocalVars
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Generate a new unique name
|
2020-06-01 17:13:42 +03:00
|
|
|
export
|
|
|
|
genSym : String -> Elab Name
|
|
|
|
genSym = GenSym
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Given a name, return the name decorated with the current namespace
|
2020-06-01 17:13:42 +03:00
|
|
|
export
|
|
|
|
inCurrentNS : Name -> Elab Name
|
|
|
|
inCurrentNS = InCurrentNS
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Given a possibly ambiguous name, get all the matching names and their types
|
2020-06-01 16:26:37 +03:00
|
|
|
export
|
|
|
|
getType : Name -> Elab (List (Name, TTImp))
|
|
|
|
getType = GetType
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Get the type of a local variable
|
2020-06-02 00:16:27 +03:00
|
|
|
export
|
|
|
|
getLocalType : Name -> Elab TTImp
|
|
|
|
getLocalType = GetLocalType
|
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Get the constructors of a fully qualified data type name
|
2020-06-01 16:26:37 +03:00
|
|
|
export
|
|
|
|
getCons : Name -> Elab (List Name)
|
|
|
|
getCons = GetCons
|
2020-06-01 17:01:52 +03:00
|
|
|
|
2020-07-17 17:18:23 +03:00
|
|
|
||| Make some top level declarations
|
2020-06-01 17:01:52 +03:00
|
|
|
export
|
|
|
|
declare : List Decl -> Elab ()
|
|
|
|
declare = Declare
|