diff options
| author | bringert <bringert@cs.chalmers.se> | 2005-12-06 16:33:40 +0000 |
|---|---|---|
| committer | bringert <bringert@cs.chalmers.se> | 2005-12-06 16:33:40 +0000 |
| commit | c703a92136ce579282c63c6e31fff76cc84b37ce (patch) | |
| tree | e0dedf8972756fa1322bb4d8a0c621a629bedc1e /transfer/examples/aggregation/aggregate.tra | |
| parent | ee4adf5ba8ff50b4580a18d197f9e05d36195ede (diff) | |
Transfer: Changed transfer program file extension from .tr to .tra to avoid collision with Troff file extension.
Diffstat (limited to 'transfer/examples/aggregation/aggregate.tra')
| -rw-r--r-- | transfer/examples/aggregation/aggregate.tra | 56 |
1 files changed, 56 insertions, 0 deletions
diff --git a/transfer/examples/aggregation/aggregate.tra b/transfer/examples/aggregation/aggregate.tra new file mode 100644 index 000000000..b71ccfef2 --- /dev/null +++ b/transfer/examples/aggregation/aggregate.tra @@ -0,0 +1,56 @@ +import prelude +import tree + + +-- aggreg specialized for Tree S +aggregS : Tree S -> Tree S +aggregS = aggreg S + +-- For now, here's what we have to do: +aggreg : (A : Type) -> Tree A -> Tree A +aggreg _ t = + case t of + ConjS c s1 s2 -> + case (aggreg ? s1, aggreg ? s2) of + (Pred np1 vp1, Pred np2 vp2) | eq NP (eq_Tree NP) np1 np2 -> + Pred np1 (ConjVP c vp1 vp2) + (Pred np1 vp1, Pred np2 vp2) | eq VP (eq_Tree VP) vp1 vp2 -> + Pred (ConjNP c np1 np2) vp1 + (s1',s2') -> ConjS c s1' s2' + _ -> composOp ? ? compos_Tree ? aggreg t + + + + + +{- +-- When the Transfer compiler gets meta variable inference, +-- we can write this: +aggreg : (A : Type) -> Tree A -> Tree A +aggreg _ t = + case t of + ConjS c s1 s2 -> + case (aggreg ? s1, aggreg ? s2) of + (Pred np1 vp1, Pred np2 vp2) | np1 == np2 -> + Pred np1 (ConjVP c vp1 vp2) + (Pred np1 vp1, Pred np2 vp2) | vp1 == vp2 -> + Pred (ConjNP c np1 np2) vp1 + (s1',s2') -> ConjS c s1' s2' + _ -> composOp ? ? ? ? aggreg t +-} + + +{- +-- If we added idden arguments, we could write something like this: +aggreg : (A : Type) => Tree A -> Tree A +aggreg t = + case t of + ConjS c s1 s2 -> + case (aggreg s1, aggreg s2) of + (Pred np1 vp1, Pred np2 vp2) | np1 == np2 -> + Pred np1 (ConjVP c vp1 vp2) + (Pred np1 vp1, Pred np2 vp2) | vp1 == vp2 -> + Pred (ConjNP c np1 np2) vp1 + (s1',s2') -> ConjS c s1' s2' + _ -> composOp aggreg t +-} |
