mirror of
https://github.com/github/semantic.git
synced 2024-11-28 18:23:44 +03:00
Define branchNode.
This commit is contained in:
parent
6af3f6c774
commit
4370de23fd
@ -11,8 +11,8 @@ import Prologue
|
||||
|
||||
class (Alternative f, Ord s, Show s) => Assigning s f | f -> s where
|
||||
sym :: s -> f s
|
||||
leafNode :: s -> f Text
|
||||
-- TODO: branchNode
|
||||
leafNode :: s -> f Text
|
||||
branchNode :: s -> f a -> f a
|
||||
-- TODO: toTerm
|
||||
|
||||
combine :: Ord s => Bool -> Set s -> Set s -> Set s
|
||||
@ -86,5 +86,13 @@ instance (Ord s, Show s) => Assigning s (Assignment s) where
|
||||
Left err -> Left (Error (astSpan s) [Left "valid utf-8"] (Just (Left (show err))))
|
||||
Right text -> Right (advanceState state, text))
|
||||
|
||||
branchNode s a = Assignment Nothing (Set.singleton s) (\ src state _ -> case stateInput state of
|
||||
[] -> Left (Error (stateSpan state) [Right s] Nothing)
|
||||
s:_ -> case runAssignment a src state { stateInput = astChildren s } of
|
||||
Left err -> Left err
|
||||
Right (state', a') -> case stateInput state' of
|
||||
[] -> Right (advanceState state, a')
|
||||
s':_ -> Left (Error (stateSpan state') [] (Just (Right (astSymbol s')))))
|
||||
|
||||
runAssignment :: Assignment s a -> Source -> State s -> Either (Error (Either String s)) (State s, a)
|
||||
runAssignment (Assignment _ _ p) src inp = p src inp lowerBound
|
||||
|
Loading…
Reference in New Issue
Block a user