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

Define termConstructor without construct.

Browse Source
This commit is contained in:
Rob Rix 2016-08-25 16:14:21 -04:00
parent 91762f1c76
commit f80e06900e
1 changed files with 84 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Parser.hs
View File

@ -30,14 +30,7 @@ termConstructor :: forall fields. (Show (Record fields), HasField fields Categor
-> Record fields -- ^ The annotation for the term.
-> [Term Text (Record fields)] -- ^ The child nodes of the term.
-> IO (Term Text (Record fields)) -- ^ The resulting term, in IO.
termConstructor source sourceSpan info = construct
where
withDefaultInfo syntax = pure $! cofree (info :< syntax)
errorWith children = do
sourceSpan' <- sourceSpan
withDefaultInfo (S.Error sourceSpan' children)
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
termConstructor source sourceSpan info children = case category info of
Return -> withDefaultInfo $ S.Return (listToMaybe children)
Assignment -> case children of
[ identifier, value ] -> withDefaultInfo $ S.Assignment identifier value
@ -53,7 +46,7 @@ termConstructor source sourceSpan info = construct
_ -> errorWith children
op | isOperator op -> withDefaultInfo $ S.Operator children
CommaOperator -> withDefaultInfo $ case children of
[ child, rest ] | S.Indexed cs <- unwrap rest -> S.Indexed $ child : cs
[ child, rest ] | S.Indexed cs <- unwrap rest -> S.Indexed $ child : toList cs
_ -> S.Indexed children
Function -> case children of
[ body ] -> withDefaultInfo $ S.AnonymousFunction Nothing body
@ -121,6 +114,10 @@ termConstructor source sourceSpan info = construct
_ -> case children of
[] -> withDefaultInfo . S.Leaf . pack . toString $ slice (characterRange info) source
_ -> withDefaultInfo $ S.Indexed children
where withDefaultInfo syntax = pure $! cofree (info :< syntax)
errorWith children = do
sourceSpan' <- sourceSpan
withDefaultInfo (S.Error sourceSpan' children)
toVarDecl :: (HasField fields Category) => Term Text (Record fields) -> Term Text (Record fields)
toVarDecl child = cofree $ (setCategory (extract child) VarDecl :< S.VarDecl child)