github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-30 02:14:20 +03:00
Code Issues Projects Releases Wiki Activity

Assign parents.

Browse Source
This commit is contained in:
Rob Rix 2016-06-22 10:13:25 -04:00
parent c1f1fb71c9
commit fa760d7ae1
1 changed files with 3 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Data/Gram.hs
View File

@ -16,7 +16,9 @@ serialize gram = stem gram <> base gram
pqGrams :: Foldable.Foldable tree => Int -> Int -> (forall a. Base tree a -> (label, [a])) -> tree -> Bag (Gram label) pqGrams :: Foldable.Foldable tree => Int -> Int -> (forall a. Base tree a -> (label, [a])) -> tree -> Bag (Gram label)
pqGrams p q unpack = foldr (<>) empty . snd . cata go pqGrams p q unpack = foldr (<>) empty . snd . cata go
where go functor = let (label, children) = unpack functor in (label, []) where go functor = let (label, children) = unpack functor in
(label, children >>= assignParent label)
assignParent parentLabel (label, children) = DList.singleton (Gram [ parentLabel ] [ label ]) : children
type Bag = DList.DList type Bag = DList.DList