Added treatment of transfer modules. Aggregation is an example.

This commit is contained in:
aarne
2003-10-09 15:23:32 +00:00
parent ddd103ccd7
commit 2ee936c7e2
29 changed files with 311 additions and 50 deletions

View File

@@ -0,0 +1,57 @@
-- testing transfer: aggregation by def definitions. AR 12/4/2003 -- 9/10
-- p "Mary runs or John runs and John walks" | l -transfer=Aggregation
-- Mary runs or John runs and walks
-- Mary or John runs and John walks
-- The two results are due to ambiguity in parsing. Thus it is not spurious!
abstract Abstract = {
cat
S ; NP ; VP ; Conj ;
fun
Pred : NP -> VP -> S ;
ConjS : Conj -> S -> S -> S ;
ConjVP : Conj -> VP -> VP -> VP ;
ConjNP : Conj -> NP -> NP -> NP ;
John, Mary, Bill : NP ;
Walk, Run, Swim : VP ;
And, Or : Conj ;
fun aggreg : S -> S ;
def
aggreg (ConjS c (Pred Q F) B) = aggrAux c Q F B ;
aggreg (ConjS c A B) = ConjS c (aggreg A) (aggreg B) ;
aggreg A = A ;
-- this auxiliary makes pattern matching on NP to test equality
fun aggrAux : Conj -> NP -> VP -> S -> S ;
def
-- aggregate verbs with shared subject
aggrAux c John F (Pred John G) = Pred John (ConjVP c F G) ;
aggrAux c Mary F (Pred Mary G) = Pred Mary (ConjVP c F G) ;
aggrAux c Bill F (Pred Bill G) = Pred Bill (ConjVP c F G) ;
-- aggregate subjects with shared verbs
aggrAux c Q Run (Pred R Run) = Pred (ConjNP c Q R) Run ;
aggrAux c Q Walk (Pred R Walk) = Pred (ConjNP c Q R) Walk ;
aggrAux c Q Swim (Pred R Swim) = Pred (ConjNP c Q R) Swim ;
-- this case takes care of munching
aggrAux c Q F (ConjS e A B) = aggrAux c Q F (aggreg (ConjS e A B)) ;
aggrAux c Q F B = ConjS c (Pred Q F) (aggreg B) ;
-- unfortunately we cannot test string equality for Name : String -> NP ;
-- It would also be tedious to test the equality of complex
-- NPs and VPs, but not impossible.
-- have to add these, otherwise constants are not constructor patterns!
data NP = John | Mary | Bill ;
data VP = Run | Walk | Swim ;
}

View File

@@ -0,0 +1,5 @@
transfer Aggregation : Abstract -> Abstract = {
transfer S : S -> S = aggreg ;
}

View File

@@ -0,0 +1,18 @@
concrete English of Abstract = {
pattern
Pred np vp = np ++ vp ;
ConjS c A B = A ++ c ++ B ;
ConjVP c A B = A ++ c ++ B ;
ConjNP c A B = A ++ c ++ B ;
John = "John" ;
Mary = "Mary" ;
Bill = "Bill" ;
Walk = "walks" ;
Run = "runs" ;
Swim = "swims" ;
And = "and" ;
Or = "or" ;
}

View File

@@ -0,0 +1,75 @@
-- testing transfer: aggregation by def definitions. AR 12/4/2003
-- p "Mary runs or John runs and John walks" | wt -c aggreg | l
-- Mary runs or John runs and walks
-- Mary or John runs and John walks
-- The two results are due to ambiguity in parsing. Thus it is not spurious!
flags transfer=aggreg ;
cat
S ; NP ; VP ; Conj ;
fun
Pred : NP -> VP -> S ;
ConjS : Conj -> S -> S -> S ;
ConjVP : Conj -> VP -> VP -> VP ;
ConjNP : Conj -> NP -> NP -> NP ;
John, Mary, Bill : NP ;
Walk, Run, Swim : VP ;
And, Or : Conj ;
pattern
Pred np vp = np ++ vp ;
ConjS c A B = A ++ c ++ B ;
ConjVP c A B = A ++ c ++ B ;
ConjNP c A B = A ++ c ++ B ;
John = "John" ;
Mary = "Mary" ;
Bill = "Bill" ;
Walk = "walks" ;
Run = "runs" ;
Swim = "swims" ;
And = "and" ;
Or = "or" ;
-- aggregation transformation
fun aggreg : S -> S ;
def
aggreg (ConjS c (Pred Q F) B) = aggrAux c Q F B ;
aggreg (ConjS c A B) = ConjS c (aggreg A) (aggreg B) ;
aggreg A = A ;
-- this auxiliary makes pattern matching on NP to test equality
fun aggrAux : Conj -> NP -> VP -> S -> S ;
def
-- aggregate verbs with shared subject
aggrAux c John F (Pred John G) = Pred John (ConjVP c F G) ;
aggrAux c Mary F (Pred Mary G) = Pred Mary (ConjVP c F G) ;
aggrAux c Bill F (Pred Bill G) = Pred Bill (ConjVP c F G) ;
-- aggregate subjects with shared verbs
aggrAux c Q Run (Pred R Run) = Pred (ConjNP c Q R) Run ;
aggrAux c Q Walk (Pred R Walk) = Pred (ConjNP c Q R) Walk ;
aggrAux c Q Swim (Pred R Swim) = Pred (ConjNP c Q R) Swim ;
-- this case takes care of munching
aggrAux c Q F (ConjS e A B) = aggrAux c Q F (aggreg (ConjS e A B)) ;
aggrAux c Q F B = ConjS c (Pred Q F) (aggreg B) ;
-- unfortunately we cannot test string equality for Name : String -> NP ;
-- It would also be tedious to test the equality of complex
-- NPs and VPs, but not impossible.
-- have to add these, otherwise constants are not constructor patterns!
data NP = John | Mary | Bill ;
data VP = Run | Walk | Swim ;

View File

@@ -0,0 +1,3 @@
transfer Trans : Nat -> Nat = {
transfer Nat = nat2bin ;
}

View File

@@ -5,21 +5,21 @@ resource Predef = {
-- this type is for internal use only
param PBool = PTrue | PFalse ;
-- these operations have their definitions in AppPredefined.hs
oper Int : Type = variants {} ; ----
-- these operations have their proper definitions in AppPredefined.hs
oper length : Tok -> Int = variants {} ;
oper drop : Int -> Tok -> Tok = variants {} ;
oper take : Int -> Tok -> Tok = variants {} ;
oper tk : Int -> Tok -> Tok = variants {} ;
oper dp : Int -> Tok -> Tok = variants {} ;
oper eqInt : Int -> Int -> PBool = variants {} ;
oper plus : Int -> Int -> Int = variants {} ;
oper Int : Type = variants {} ; -- the type of integers
oper eqStr : Tok -> Tok -> PBool = variants {} ;
oper eqTok : (P : Type) -> P -> P -> PBool = variants {} ;
oper show : (P : Type) -> P -> Tok = variants {} ;
oper read : (P : Type) -> Tok -> P = variants {} ;
oper length : Tok -> Int = variants {} ; -- length of string
oper drop : Int -> Tok -> Tok = variants {} ; -- drop prefix of length
oper take : Int -> Tok -> Tok = variants {} ; -- take prefix of length
oper tk : Int -> Tok -> Tok = variants {} ; -- drop suffix of length
oper dp : Int -> Tok -> Tok = variants {} ; -- take suffix of length
oper eqInt : Int -> Int -> PBool = variants {} ; -- test if equal integers
oper plus : Int -> Int -> Int = variants {} ; -- add integers
oper eqStr : Tok -> Tok -> PBool = variants {} ; -- test if equal strings
oper occur : Tok -> Tok -> PBool = variants {} ; -- test if occurs as substring
oper show : (P : Type) -> P -> Tok = variants {} ; -- convert param to string
oper read : (P : Type) -> Tok -> P = variants {} ; -- convert string to param
} ;