github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-07 07:58:12 +03:00
Code Issues Projects Releases Wiki Activity

Wrap up constructed terms in withDefaultInfo.

Browse Source
This commit is contained in:
Rob Rix 2016-08-25 16:05:49 -04:00
parent 459c251498
commit 91762f1c76
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Parser.hs
View File

@ -30,13 +30,13 @@ termConstructor :: forall fields. (Show (Record fields), HasField fields Categor
-> Record fields -- ^ The annotation for the term. -> Record fields -- ^ The annotation for the term.
-> [Term Text (Record fields)] -- ^ The child nodes of the term. -> [Term Text (Record fields)] -- ^ The child nodes of the term.
-> IO (Term Text (Record fields)) -- ^ The resulting term, in IO. -> IO (Term Text (Record fields)) -- ^ The resulting term, in IO.
termConstructor source sourceSpan info = fmap cofree . construct termConstructor source sourceSpan info = construct
where where
withDefaultInfo syntax = pure (info :< syntax) withDefaultInfo syntax = pure $! cofree (info :< syntax)
errorWith children = do errorWith children = do
sourceSpan' <- sourceSpan sourceSpan' <- sourceSpan
withDefaultInfo (S.Error sourceSpan' children) withDefaultInfo (S.Error sourceSpan' children)
construct :: (Show (Record fields), HasField fields Category, HasField fields Range) => [Term Text (Record fields)] -> IO (CofreeF (S.Syntax Text) (Record fields) (Term Text (Record fields))) construct :: (Show (Record fields), HasField fields Category, HasField fields Range) => [Term Text (Record fields)] -> IO (Term Text (Record fields))
construct children = case category info of construct children = case category info of
Return -> withDefaultInfo $ S.Return (listToMaybe children) Return -> withDefaultInfo $ S.Return (listToMaybe children)
Assignment -> case children of Assignment -> case children of
@ -66,9 +66,9 @@ termConstructor source sourceSpan info = fmap cofree . construct
_ -> errorWith children _ -> errorWith children
FunctionCall -> case runCofree <$> children of FunctionCall -> case runCofree <$> children of
[ (_ :< S.MemberAccess{..}), (_ :< S.Args args) ] -> [ (_ :< S.MemberAccess{..}), (_ :< S.Args args) ] ->
pure $! setCategory info MethodCall :< S.MethodCall memberId property args pure $! cofree $ setCategory info MethodCall :< S.MethodCall memberId property args
[ (_ :< S.MemberAccess{..}) ] -> [ (_ :< S.MemberAccess{..}) ] ->
pure $! setCategory info MethodCall :< S.MethodCall memberId property [] pure $! cofree $ setCategory info MethodCall :< S.MethodCall memberId property []
(x:xs) -> (x:xs) ->
withDefaultInfo $ S.FunctionCall (cofree x) (cofree <$> xs) withDefaultInfo $ S.FunctionCall (cofree x) (cofree <$> xs)
_ -> errorWith children _ -> errorWith children