suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added an @@ operator for Named patterns, like in the Tock presentation

Browse Source
This commit is contained in:
Neil Brown 2007-11-21 14:25:32 +00:00
parent d3c246a911
commit 7ea3d2a7f9
1 changed files with 5 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
common/TreeUtil.hs
View File

@ -21,6 +21,7 @@ module TreeUtil (
AnyDataItem(..), Items, castADI, AnyDataItem(..), Items, castADI,
assertPatternMatch, getMatchedItems, assertPatternMatch, getMatchedItems,
tag0, tag1, tag2, tag3, tag4, tag5, tag6, tag7, tag1d, tag2d, tag3d, tag4d, tag5d, tag6d, tag7d, tag0, tag1, tag2, tag3, tag4, tag5, tag6, tag7, tag1d, tag2d, tag3d, tag4d, tag5d, tag6d, tag7d,
(@@),
mkPattern, stopCaringPattern, namePattern, nameAndStopCaringPattern, mkPattern, stopCaringPattern, namePattern, nameAndStopCaringPattern,
checkTreeForConstr, checkTreeForConstr,
con0, con1, con2, con3, con4, con5, con6, con7 con0, con1, con2, con3, con4, con5, con6, con7
@ -240,6 +241,10 @@ namePattern name item = namePattern' name (mkPattern item)
nameAndStopCaringPattern :: Data a => String -> a -> Pattern -> Pattern nameAndStopCaringPattern :: Data a => String -> a -> Pattern -> Pattern
nameAndStopCaringPattern n item = (stopCaringPattern item) . (namePattern n item) nameAndStopCaringPattern n item = (stopCaringPattern item) . (namePattern n item)
(@@) :: Data a => String -> a -> Pattern
(@@) label x = Named label (mkPattern x)
--I'm not sure tag0 is ever needed, but just in case: --I'm not sure tag0 is ever needed, but just in case:
tag0 :: (Data a) => a -> Pattern tag0 :: (Data a) => a -> Pattern
tag0 con = (Match (toConstr con) []) tag0 con = (Match (toConstr con) [])