diff options
Diffstat (limited to 'src/HSVIS/Parser.hs')
| -rw-r--r-- | src/HSVIS/Parser.hs | 11 |
1 files changed, 7 insertions, 4 deletions
diff --git a/src/HSVIS/Parser.hs b/src/HSVIS/Parser.hs index e89c679..bea0524 100644 --- a/src/HSVIS/Parser.hs +++ b/src/HSVIS/Parser.hs @@ -30,6 +30,7 @@ import Control.Monad.Chronicle import Control.Monad.Reader import Control.Monad.State.Lazy import Data.Char +import Data.Bifunctor (second) import Data.Either (partitionEithers) import Data.Foldable import Data.List.NonEmpty (NonEmpty(..)) @@ -49,7 +50,9 @@ import HSVIS.Pretty data StageParsed type instance X DataDef StageParsed = Range +type instance X DataField StageParsed = () type instance X FunDef StageParsed = Range +type instance X TypeSig StageParsed = () type instance X FunEq StageParsed = Range type instance X Type StageParsed = Range type instance X Pattern StageParsed = Range @@ -233,7 +236,7 @@ pDataDef0 = do params <- famany (inlineWhite >> ranged (pIdentifier0 InBlock Lowercase WCBacktrack)) cons <- pDatacons "=" pos2 <- gets psCur - return [DataDef (Range pos1 pos2) name params cons] + return [DataDef (Range pos1 pos2) name params (map (second (map (DataField ()))) cons)] where pDatacons :: String -> IParser [(Name, [PType])] pDatacons leader = do @@ -262,20 +265,20 @@ pFunDef0 = clauses <- concat <$> famany (pFunEq (Continue name)) let clauses' = clause1 :| clauses1 ++ clauses let rng = sigrange <> foldMapne extOf clauses' - return [FunDef rng name (TypeSig typ) clauses'] + return [FunDef rng name (TypeSig () typ) clauses'] _ -> do pos <- gets psCur raise Error $ "Expected function equation for " ++ pretty name ++ " after type signature" let rng = Range pos pos - return [FunDef sigrange name (TypeSig typ) + return [FunDef sigrange name (TypeSig () typ) (FunEq rng name [] (Plain rng (EError rng)) :| [])] ,do pFunEq FirstLine >>= \case clause1@(FunEq _ name _ _) : clauses1 -> noFail $ do clauses <- concat <$> famany (pFunEq (Continue name)) let clauses' = clause1 :| clauses1 ++ clauses let rng = foldMapne extOf clauses' - return [FunDef rng name (TypeSigExt NoTypeSig) clauses'] + return [FunDef rng name (TypeSigExt () NoTypeSig) clauses'] [] -> faempty] -- | Given the name from the type signature or a previous clause, if any. |