type-checker and working visualiser

This commit is contained in:
crumbtoo
2024-03-18 10:27:06 -06:00
parent 6aae979a58
commit c3017ca445
7 changed files with 212 additions and 69 deletions

View File

@@ -23,6 +23,7 @@ import Control.Exception
import GHC.IO
import Control.Lens hiding ((.=))
import Control.Comonad
import Data.Functor.Foldable
import Compiler.RLPC
@@ -74,17 +75,19 @@ doCommand conn c = do
respond :: Command -> Response
respond (Annotate s)
= s & (parseRlpProgR >=> typeCheckRlpProgR)
& fmap (\p -> p ^.. programDecls . each . _FunD <&> serialiseSc)
& fmap (\p -> p ^.. programDecls . each . _FunD
<&> serialiseSc)
& runRLPCJsonDef
& Annotated
where
serialiseSc (n,as,e) = object
[ "name" .= n
, "args" .= as
, "body" .= serialiseAnnotated e ]
, "body" .= let rootType = extract e
in serialiseAnnotated (e <&> prettyVars rootType) ]
serialiseAnnotated :: Cofree (RlpExprF PsName) (Type PsName)
-> Value
-> Value
serialiseAnnotated = cata \case
t :<$ e -> object [ "e" .= e, "type" .= rout @Text t ]