1
0
forked from GitHub/gf-core

started examples-3.0 with examples that are tested to work

This commit is contained in:
aarne
2008-06-17 13:16:15 +00:00
parent 9c30d94c28
commit ae171fc05f
56 changed files with 1728 additions and 6 deletions

View File

@@ -0,0 +1,25 @@
abstract Calculator = {
flags startcat = Prog ;
cat Prog ; Exp ; Var ;
fun
PEmpty : Prog ;
PInit : Exp -> (Var -> Prog) -> Prog ;
PAss : Var -> Exp -> Prog -> Prog ;
EPlus, EMinus, ETimes, EDiv : Exp -> Exp -> Exp ;
EInt : Int -> Exp ;
EVar : Var -> Exp ;
ex1 : Prog ;
def
ex1 =
PInit (EPlus (EInt 2) (EInt 3)) (\x ->
PInit (EPlus (EVar x) (EInt 1)) (\y ->
PAss x (EPlus (EVar x) (ETimes (EInt 9) (EVar y))) PEmpty)) ;
}

View File

@@ -0,0 +1,24 @@
--# -path=.:prelude
concrete CalculatorC of Calculator = open Prelude, Formal in {
flags lexer=codevars ; unlexer=code ;
lincat
Prog, Var = SS ;
Exp = TermPrec ;
lin
PEmpty = ss [] ;
PInit exp prog = ss ("int" ++ prog.$0 ++ "=" ++ top exp ++ ";" ++ prog.s) ;
PAss vr exp prog = ss (vr.s ++ "=" ++ top exp ++ ";" ++ prog.s) ;
EPlus = infixl 0 "+" ;
EMinus = infixl 0 "-" ;
ETimes = infixl 1 "*" ;
EDiv = infixl 1 "/" ;
EInt i = constant i.s ;
EVar x = constant x.s ;
}

View File

@@ -0,0 +1,27 @@
--# -path=.:prelude
concrete CalculatorE of Calculator = open Prelude in {
flags lexer=codevar ; unlexer=unwords ;
lincat
Prog, Exp, Var = SS ;
lin
PEmpty = ss [] ;
PInit exp prog = ss ("initialize" ++ prog.$0 ++ "as" ++ exp.s ++ PAUSE ++ prog.s) ;
PAss vr exp prog = ss ("redefine" ++ vr.s ++ "as" ++ exp.s ++ PAUSE ++ prog.s) ;
EPlus = infix "plus" ;
EMinus = infix "minus" ;
ETimes = infix "times" ;
EDiv = infix ["divided by"] ;
EInt i = i ;
EVar x = x ;
oper
infix : Str -> SS -> SS -> SS = \op,x,y ->
ss (x.s ++ op ++ y.s ++ PAUSE) ;
PAUSE = "PAUSE" ;
}

View File

@@ -0,0 +1,25 @@
--# -path=.:prelude
concrete CalculatorJ of Calculator = open Prelude in {
flags lexer=codevars ; unlexer=code ;
lincat
Prog, Exp, Var = SS ;
lin
PEmpty = ss [] ;
PInit exp prog = ss (exp.s ++ ";" ++ "istore" ++ prog.$0 ++ ";" ++ prog.s) ;
PAss vr exp prog = ss (exp.s ++ ";" ++ "istore" ++ vr.s ++ ";" ++ prog.s) ;
EPlus = postfix "iadd" ;
EMinus = postfix "isub" ;
ETimes = postfix "imul" ;
EDiv = postfix "idiv" ;
EInt = prefixSS "iconst" ;
EVar = prefixSS "iload" ;
oper
postfix : Str -> SS -> SS -> SS = \op,x,y -> ss (x.s ++ ";" ++ y.s ++ ";" ++ op) ;
}

View File

@@ -0,0 +1,27 @@
--# -path=.:prelude
concrete CalculatorP of Calculator = open Prelude in {
flags lexer=codevars ; unlexer=code ;
lincat
Prog, Var = SS ;
Exp = SS ;
lin
PEmpty = ss [] ;
PDecl exp prog = ss ("int" ++ prog.$0 ++ "=" ++ exp.s ++ ";" ++ prog.s) ;
PAss vr exp prog = ss (vr.s ++ "=" ++ exp.s ++ ";" ++ prog.s) ;
EPlus = infix "+" ;
EMinus = infix "-" ;
ETimes = infix "*" ;
EDiv = infix "/" ;
EInt i = i ;
EVar x = x ;
oper
infix : Str -> SS -> SS -> SS = \f,x,y ->
ss ("(" ++ x.s ++ f ++ y.s ++ ")") ;
}

View File

@@ -0,0 +1,16 @@
abstract Food = {
cat
Phrase ; Item ; Kind ; Quality ;
flags startcat = Phrase ;
fun
Is : Item -> Quality -> Phrase ;
This, That : Kind -> Item ;
QKind : Quality -> Kind -> Kind ;
Wine, Cheese, Fish : Kind ;
Very : Quality -> Quality ;
Fresh, Warm, Italian, Expensive, Delicious, Boring : Quality ;
}

View File

@@ -0,0 +1,23 @@
concrete FoodEng of Food = {
lincat
Phrase, Item, Kind, Quality = {s : Str} ;
lin
Is item quality = {s = item.s ++ "is" ++ quality.s} ;
This kind = {s = "this" ++ kind.s} ;
That kind = {s = "that" ++ kind.s} ;
QKind quality kind = {s = quality.s ++ kind.s} ;
Wine = {s = "wine"} ;
Cheese = {s = "cheese"} ;
Fish = {s = "fish"} ;
Very quality = {s = "very" ++ quality.s} ;
Fresh = {s = "fresh"} ;
Warm = {s = "warm"} ;
Italian = {s = "Italian"} ;
Expensive = {s = "expensive"} ;
Delicious = {s = "delicious"} ;
Boring = {s = "boring"} ;
}

View File

@@ -0,0 +1,22 @@
concrete FoodIta of Food = {
lincat
Phrase, Item, Kind, Quality = {s : Str} ;
lin
Is item quality = {s = item.s ++ "è" ++ quality.s} ;
This kind = {s = "questo" ++ kind.s} ;
That kind = {s = "quello" ++ kind.s} ;
QKind quality kind = {s = kind.s ++ quality.s} ;
Wine = {s = "vino"} ;
Cheese = {s = "formaggio"} ;
Fish = {s = "pesce"} ;
Very quality = {s = "molto" ++ quality.s} ;
Fresh = {s = "fresco"} ;
Warm = {s = "caldo"} ;
Italian = {s = "italiano"} ;
Expensive = {s = "caro"} ;
Delicious = {s = "delizioso"} ;
Boring = {s = "noioso"} ;
}

View File

@@ -0,0 +1,16 @@
abstract Foods = {
flags startcat=Phrase ;
cat
Phrase ; Item ; Kind ; Quality ;
fun
Is : Item -> Quality -> Phrase ;
This, That, These, Those : Kind -> Item ;
QKind : Quality -> Kind -> Kind ;
Wine, Cheese, Fish, Pizza : Kind ;
Very : Quality -> Quality ;
Fresh, Warm, Italian, Expensive, Delicious, Boring : Quality ;
}

View File

@@ -0,0 +1,52 @@
--# -path=.:prelude
concrete FoodsEng of Foods = open Prelude in {
lincat
Phrase, Quality = SS ;
Kind = {s : Number => Str} ;
Item = {s : Str ; n : Number} ;
lin
Is item quality = ss (item.s ++ copula ! item.n ++ quality.s) ;
This = det Sg "this" ;
That = det Sg "that" ;
These = det Pl "these" ;
Those = det Pl "those" ;
QKind quality kind = {s = \\n => quality.s ++ kind.s ! n} ;
Wine = regNoun "wine" ;
Cheese = regNoun "cheese" ;
Fish = noun "fish" "fish" ;
Pizza = regNoun "pizza" ;
Very = prefixSS "very" ;
Fresh = ss "fresh" ;
Warm = ss "warm" ;
Italian = ss "Italian" ;
Expensive = ss "expensive" ;
Delicious = ss "delicious" ;
Boring = ss "boring" ;
param
Number = Sg | Pl ;
oper
det : Number -> Str -> {s : Number => Str} -> {s : Str ; n : Number} =
\n,d,cn -> {
s = d ++ cn.s ! n ;
n = n
} ;
noun : Str -> Str -> {s : Number => Str} =
\man,men -> {s = table {
Sg => man ;
Pl => men
}
} ;
regNoun : Str -> {s : Number => Str} =
\car -> noun car (car + "s") ;
copula : Number => Str =
table {
Sg => "is" ;
Pl => "are"
} ;
}

View File

@@ -0,0 +1,76 @@
--# -path=.:prelude
concrete FoodsIta of Foods = open Prelude in {
lincat
Phrase = SS ;
Quality = {s : Gender => Number => Str} ;
Kind = {s : Number => Str ; g : Gender} ;
Item = {s : Str ; g : Gender ; n : Number} ;
lin
Is item quality =
ss (item.s ++ copula item.n ++ quality.s ! item.g ! item.n) ;
This = det Sg "questo" "questa" ;
That = det Sg "quello" "quella" ;
These = det Pl "questi" "queste" ;
Those = det Pl "quelli" "quelle" ;
QKind quality kind = {
s = \\n => kind.s ! n ++ quality.s ! kind.g ! n ;
g = kind.g
} ;
Wine = noun "vino" "vini" Masc ;
Cheese = noun "formaggio" "formaggi" Masc ;
Fish = noun "pesce" "pesci" Masc ;
Pizza = noun "pizza" "pizze" Fem ;
Very qual = {s = \\g,n => "molto" ++ qual.s ! g ! n} ;
Fresh = adjective "fresco" "fresca" "freschi" "fresche" ;
Warm = regAdj "caldo" ;
Italian = regAdj "italiano" ;
Expensive = regAdj "caro" ;
Delicious = regAdj "delizioso" ;
Boring = regAdj "noioso" ;
param
Number = Sg | Pl ;
Gender = Masc | Fem ;
oper
det : Number -> Str -> Str -> {s : Number => Str ; g : Gender} ->
{s : Str ; g : Gender ; n : Number} =
\n,m,f,cn -> {
s = case cn.g of {Masc => m ; Fem => f} ++ cn.s ! n ;
g = cn.g ;
n = n
} ;
noun : Str -> Str -> Gender -> {s : Number => Str ; g : Gender} =
\man,men,g -> {
s = table {
Sg => man ;
Pl => men
} ;
g = g
} ;
adjective : (_,_,_,_ : Str) -> {s : Gender => Number => Str} =
\nero,nera,neri,nere -> {
s = table {
Masc => table {
Sg => nero ;
Pl => neri
} ;
Fem => table {
Sg => nera ;
Pl => nere
}
}
} ;
regAdj : Str -> {s : Gender => Number => Str} = \nero ->
let ner = init nero
in adjective nero (ner + "a") (ner + "i") (ner + "e") ;
copula : Number -> Str =
\n -> case n of {
Sg => "è" ;
Pl => "sono"
} ;
}

View File

@@ -0,0 +1,10 @@
abstract Hello = {
cat Greeting ; Recipient ;
flags startcat = Greeting ;
fun
Hello : Recipient -> Greeting ;
World, Mum, Friends : Recipient ;
}

View File

@@ -0,0 +1,10 @@
concrete HelloEng of Hello = {
lincat Greeting, Recipient = {s : Str} ;
lin
Hello rec = {s = "hello" ++ rec.s} ;
World = {s = "world"} ;
Mum = {s = "mum"} ;
Friends = {s = "friends"} ;
}

View File

@@ -0,0 +1,10 @@
concrete HelloFin of Hello = {
lincat Greeting, Recipient = {s : Str} ;
lin
Hello rec = {s = "terve" ++ rec.s} ;
World = {s = "maailma"} ;
Mum = {s = "äiti"} ;
Friends = {s = "ystävät"} ;
}

View File

@@ -0,0 +1,10 @@
concrete HelloIta of Hello = {
lincat Greeting, Recipient = {s : Str} ;
lin
Hello rec = {s = "ciao" ++ rec.s} ;
World = {s = "mondo"} ;
Mum = {s = "mamma"} ;
Friends = {s = "amici"} ;
}

View File

@@ -0,0 +1,4 @@
import HelloEng.gf
import HelloFin.gf
import HelloIta.gf
linearize Hello World

View File

@@ -0,0 +1,35 @@
abstract ExtFoods = Foods ** {
flags startcat=Move ;
cat
Move ; -- declarative, question, or imperative
Verb ; -- transitive verb
Guest ; -- guest in restaurant
GuestKind ; -- type of guest
fun
MAssert : Phrase -> Move ; -- This pizza is warm.
MDeny : Phrase -> Move ; -- This pizza isn't warm.
MAsk : Phrase -> Move ; -- Is this pizza warm?
PVerb : Guest -> Verb -> Item -> Phrase ; -- we eat this pizza
PVerbWant : Guest -> Verb -> Item -> Phrase ; -- we want to eat this pizza
WhichVerb : Kind -> Guest -> Verb -> Move ; -- Which pizza do you eat?
WhichVerbWant : Kind -> Guest -> Verb -> Move ;
-- Which pizza do you want to eat?
WhichIs : Kind -> Quality -> Move ; -- Which wine is Italian?
Do : Verb -> Item -> Move ; -- Pay this wine!
DoPlease : Verb -> Item -> Move ; -- Pay this wine please!
I, You, We : Guest ;
GThis, GThat, GThese, GThose : GuestKind -> Guest ;
Eat, Drink, Pay : Verb ;
Lady, Gentleman : GuestKind ;
}

View File

@@ -0,0 +1,5 @@
--# -path=.:../foods:present:prelude
concrete ExtFoodsEng of ExtFoods = FoodsEni ** ExtFoodsI with
(Syntax = SyntaxEng),
(LexFoods = LexFoodsEng) ;

View File

@@ -0,0 +1,5 @@
--# -path=.:../foods:present:prelude
concrete ExtFoodsFin of ExtFoods = FoodsFin ** ExtFoodsI with
(Syntax = SyntaxFin),
(LexFoods = LexFoodsFin) ;

View File

@@ -0,0 +1,5 @@
--# -path=.:../foods:present:prelude
concrete ExtFoodsGer of ExtFoods = FoodsGer ** ExtFoodsI with
(Syntax = SyntaxGer),
(LexFoods = LexFoodsGer) ;

View File

@@ -0,0 +1,49 @@
incomplete concrete ExtFoodsI of ExtFoods = FoodsI ** open Syntax, LexFoods in {
flags lexer=text ; unlexer=text ;
lincat
Move = Text ;
Verb = V2 ;
Guest = NP ;
GuestKind = CN ;
lin
MAssert p = mkText (mkS p) ;
MDeny p = mkText (mkS negativePol p) ;
MAsk p = mkText (mkQS p) ;
PVerb = mkCl ;
PVerbWant guest verb item = mkCl guest want_VV (mkVP verb item) ;
WhichVerb kind guest verb =
mkText (mkQS (mkQCl (mkIP whichSg_IDet kind) guest verb)) ;
WhichVerbWant kind guest verb =
mkText (mkQS (mkQCl (mkIP whichSg_IDet kind)
(mkClSlash guest want_VV verb))) ;
WhichIs kind quality =
mkText (mkQS (mkQCl (mkIP whichSg_IDet kind) (mkVP quality))) ;
Do verb item =
mkText
(mkPhr (mkUtt politeImpForm (mkImp verb item))) exclMarkPunct ;
DoPlease verb item =
mkText
(mkPhr (mkUtt politeImpForm (mkImp verb item)) please_Voc)
exclMarkPunct ;
I = mkNP i_Pron ;
You = mkNP youPol_Pron ;
We = mkNP we_Pron ;
GThis = mkNP this_QuantSg ;
GThat = mkNP that_QuantSg ;
GThese = mkNP these_QuantPl ;
GThose = mkNP those_QuantPl ;
Eat = eat_V2 ;
Drink = drink_V2 ;
Pay = pay_V2 ;
Lady = mkCN lady_N ;
Gentleman = mkCN gentleman_N ;
}

View File

@@ -0,0 +1,27 @@
--# -path=.:../foods:present:prelude
concrete FoodsEng of Foods = open SyntaxEng,ParadigmsEng in {
lincat
Phrase = Cl ;
Item = NP ;
Kind = CN ;
Quality = AP ;
lin
Is item quality = mkCl item quality ;
This kind = mkNP this_QuantSg kind ;
That kind = mkNP that_QuantSg kind ;
These kind = mkNP these_QuantPl kind ;
Those kind = mkNP those_QuantPl kind ;
QKind quality kind = mkCN quality kind ;
Wine = mkCN (mkN "wine") ;
Pizza = mkCN (mkN "pizza") ;
Cheese = mkCN (mkN "cheese") ;
Fish = mkCN (mkN "fish" "fish") ;
Very quality = mkAP very_AdA quality ;
Fresh = mkAP (mkA "fresh") ;
Warm = mkAP (mkA "warm") ;
Italian = mkAP (mkA "Italian") ;
Expensive = mkAP (mkA "expensive") ;
Delicious = mkAP (mkA "delicious") ;
Boring = mkAP (mkA "boring") ;
}

View File

@@ -0,0 +1,5 @@
--# -path=.:../foods:present:prelude
concrete FoodsEni of Foods = FoodsI with
(Syntax = SyntaxEng),
(LexFoods = LexFoodsEng) ;

View File

@@ -0,0 +1,5 @@
--# -path=.:../foods:present:prelude
concrete FoodsFin of Foods = FoodsI with
(Syntax = SyntaxFin),
(LexFoods = LexFoodsFin) ;

View File

@@ -0,0 +1,5 @@
--# -path=.:../foods:present:prelude
concrete FoodsFre of Foods = FoodsI with
(Syntax = SyntaxFre),
(LexFoods = LexFoodsFre) ;

View File

@@ -0,0 +1,5 @@
--# -path=.:../foods:present:prelude
concrete FoodsGer of Foods = FoodsI with
(Syntax = SyntaxGer),
(LexFoods = LexFoodsGer) ;

View File

@@ -0,0 +1,28 @@
--# -path=.:../foods:present:prelude
incomplete concrete FoodsI of Foods = open Syntax, LexFoods in {
lincat
Phrase = Cl ;
Item = NP ;
Kind = CN ;
Quality = AP ;
lin
Is item quality = mkCl item quality ;
This kind = mkNP this_QuantSg kind ;
That kind = mkNP that_QuantSg kind ;
These kind = mkNP these_QuantPl kind ;
Those kind = mkNP those_QuantPl kind ;
QKind quality kind = mkCN quality kind ;
Very quality = mkAP very_AdA quality ;
Wine = mkCN wine_N ;
Pizza = mkCN pizza_N ;
Cheese = mkCN cheese_N ;
Fish = mkCN fish_N ;
Fresh = mkAP fresh_A ;
Warm = mkAP warm_A ;
Italian = mkAP italian_A ;
Expensive = mkAP expensive_A ;
Delicious = mkAP delicious_A ;
Boring = mkAP boring_A ;
}

View File

@@ -0,0 +1,5 @@
--# -path=.:../foods:present:prelude
concrete FoodsIta of Foods = FoodsI with
(Syntax = SyntaxIta),
(LexFoods = LexFoodsIta) ;

View File

@@ -0,0 +1,19 @@
interface LexFoods = open Syntax in {
oper
wine_N : N ;
pizza_N : N ;
cheese_N : N ;
fish_N : N ;
fresh_A : A ;
warm_A : A ;
italian_A : A ;
expensive_A : A ;
delicious_A : A ;
boring_A : A ;
eat_V2 : V2 ;
drink_V2 : V2 ;
pay_V2 : V2 ;
lady_N : N ;
gentleman_N : N ;
}

View File

@@ -0,0 +1,20 @@
instance LexFoodsEng of LexFoods = open SyntaxEng, ParadigmsEng, IrregEng in {
oper
wine_N = mkN "wine" ;
pizza_N = mkN "pizza" ;
cheese_N = mkN "cheese" ;
fish_N = mkN "fish" "fish" ;
fresh_A = mkA "fresh" ;
warm_A = mkA "warm" ;
italian_A = mkA "Italian" ;
expensive_A = mkA "expensive" ;
delicious_A = mkA "delicious" ;
boring_A = mkA "boring" ;
eat_V2 = mkV2 eat_V ;
drink_V2 = mkV2 drink_V ;
pay_V2 = mkV2 pay_V ;
lady_N = mkN "lady" ;
gentleman_N = mkN "gentleman" "gentlemen" ;
}

View File

@@ -0,0 +1,20 @@
instance LexFoodsFin of LexFoods = open SyntaxFin, ParadigmsFin in {
oper
wine_N = mkN "viini" ;
pizza_N = mkN "pizza" ;
cheese_N = mkN "juusto" ;
fish_N = mkN "kala" ;
fresh_A = mkA "tuore" ;
warm_A = mkA "lämmin" ;
italian_A = mkA "italialainen" ;
expensive_A = mkA "kallis" ;
delicious_A = mkA "herkullinen" ;
boring_A = mkA "tylsä" ;
eat_V2 = mkV2 (mkV "syödä") partitive ;
drink_V2 = mkV2 (mkV "juoda") partitive ;
pay_V2 = mkV2 (mkV "maksaa") ;
lady_N = mkN "rouva" ;
gentleman_N = mkN "herra" ;
}

View File

@@ -0,0 +1,15 @@
--# -path=.:../foods:present:prelude
instance LexFoodsFre of LexFoods = open SyntaxFre,ParadigmsFre in {
oper
wine_N = mkN "vin" ;
pizza_N = mkN "pizza" feminine ;
cheese_N = mkN "fromage" masculine ;
fish_N = mkN "poisson" ;
fresh_A = mkA "frais" "fraîche" "frais" "fraîches";
warm_A = mkA "chaud" ;
italian_A = mkA "italien" ;
expensive_A = mkA "cher" ;
delicious_A = mkA "délicieux" ;
boring_A = mkA "ennuyeux" ;
}

View File

@@ -0,0 +1,20 @@
instance LexFoodsGer of LexFoods = open SyntaxGer, ParadigmsGer, IrregGer in {
oper
wine_N = mkN "Wein" ;
pizza_N = mkN "Pizza" "Pizzen" feminine ;
cheese_N = mkN "Käse" "Käsen" masculine ;
fish_N = mkN "Fisch" ;
fresh_A = mkA "frisch" ;
warm_A = mkA "warm" "wärmer" "wärmste" ;
italian_A = mkA "italienisch" ;
expensive_A = mkA "teuer" ;
delicious_A = mkA "köstlich" ;
boring_A = mkA "langweilig" ;
eat_V2 = mkV2 essen_V ;
drink_V2 = mkV2 trinken_V ;
pay_V2 = mkV2 (mkV "bezahlen") ;
lady_N = mkN "Frau" "Frauen" feminine ;
gentleman_N = mkN "Herr" "Herren" masculine ;
}

View File

@@ -0,0 +1,15 @@
--# -path=.:../foods:present:prelude
instance LexFoodsIta of LexFoods = open SyntaxIta, ParadigmsIta in {
oper
wine_N = mkN "vino" ;
pizza_N = mkN "pizza" ;
cheese_N = mkN "formaggio" ;
fish_N = mkN "pesce" ;
fresh_A = mkA "fresco" ;
warm_A = mkA "caldo" ;
italian_A = mkA "italiano" ;
expensive_A = mkA "caro" ;
delicious_A = mkA "delizioso" ;
boring_A = mkA "noioso" ;
}

View File

@@ -0,0 +1,35 @@
abstract House = {
flags startcat = Utterance ;
cat
Utterance ;
Command ;
Question ;
Kind ;
Action Kind ;
Device Kind ;
Location ;
fun
UCommand : Command -> Utterance ;
UQuestion : Question -> Utterance ;
CAction : (k : Kind) -> Action k -> Device k -> Command ;
QAction : (k : Kind) -> Action k -> Device k -> Question ;
DKindOne : (k : Kind) -> Device k ;
DKindMany : (k : Kind) -> Device k ;
DLoc : (k : Kind) -> Device k -> Location -> Device k ;
light, fan : Kind ;
switchOn, switchOff : (k : Kind) -> Action k ;
dim : Action light ;
kitchen, livingRoom : Location ;
}

View File

@@ -0,0 +1,76 @@
--# -path=.:prelude
concrete HouseEng of House = open Prelude in {
-- grammar Toy1 from the Regulus book
flags startcat = Utterance ;
param
Number = Sg | Pl ;
VForm = VImp | VPart ;
lincat
Utterance = SS ;
Command = SS ;
Question = SS ;
Kind = {s : Number => Str} ;
Action = {s : VForm => Str ; part : Str} ;
Device = {s : Str ; n : Number} ;
Location = SS ;
lin
UCommand c = c ;
UQuestion q = q ;
CAction _ act dev = ss (act.s ! VImp ++ bothWays act.part dev.s) ;
QAction _ act dev = ss (be dev.n ++ dev.s ++ act.s ! VPart ++ act.part) ;
DKindOne k = {
s = "the" ++ k.s ! Sg ;
n = Sg
} ;
DKindMany k = {
s = "the" ++ k.s ! Pl ;
n = Pl
} ;
DLoc _ dev loc = {
s = dev.s ++ "in" ++ "the" ++ loc.s ;
n = dev.n
} ;
light = mkNoun "light" ;
fan = mkNoun "fan" ;
switchOn _ = mkVerb "switch" "switched" "on" ;
switchOff _ = mkVerb "switch" "switched" "off" ;
dim = mkVerb "dim" "dimmed" [] ;
kitchen = ss "kitchen" ;
livingRoom = ss ["living room"] ;
oper
mkNoun : Str -> {s : Number => Str} = \dog -> {
s = table {
Sg => dog ;
Pl => dog + "s"
}
} ;
mkVerb : (_,_,_ : Str) -> {s : VForm => Str ; part : Str} = \go,gone,away -> {
s = table {
VImp => go ;
VPart => gone
} ;
part = away
} ;
be : Number -> Str = \n -> case n of {
Sg => "is" ;
Pl => "are"
} ;
}

View File

@@ -0,0 +1,12 @@
interface LexSmart = open Syntax in {
oper
dim_V2 : V2 ;
fan_N : N ;
kitchen_N : N ;
light_N : N ;
livingRoom_N : N ;
switchOff_V2 : V2 ;
switchOn_V2 : V2 ;
}

View File

@@ -0,0 +1,12 @@
instance LexSmartSwe of LexSmart = open SyntaxSwe, ParadigmsSwe in {
oper
dim_V2 = mkV2 "dämpa" ;
fan_N = mkN "fläkt" ;
kitchen_N = mkN "kök" neutrum ;
light_N = mkN "lampa" ;
livingRoom_N = mkN "vardagsrum" "vardagsrummet" "vardagsrum" "vardagsrummen" ;
switchOff_V2 = mkV2 "släcker" ;
switchOn_V2 = mkV2 "tänder" ;
}

View File

@@ -0,0 +1,47 @@
abstract Smart = {
flags startcat = Utterance ;
cat
Utterance ;
Command ;
Question ;
Kind ;
Action Kind ;
Device Kind ;
Location ;
Switchable Kind ;
Dimmable Kind ;
Statelike (k : Kind) (Action k) ;
fun
UCommand : Command -> Utterance ;
UQuestion : Question -> Utterance ;
CAction : (k : Kind) -> Action k -> Device k -> Command ;
QAction : (k : Kind) -> (a : Action k) -> Statelike k a -> Device k -> Question ;
DKindOne : (k : Kind) -> Device k ;
DKindMany : (k : Kind) -> Device k ;
DLoc : (k : Kind) -> Device k -> Location -> Device k ;
light, fan : Kind ;
switchOn, switchOff : (k : Kind) -> Switchable k -> Action k ;
dim : (k : Kind) -> Dimmable k -> Action k ;
kitchen, livingRoom : Location ;
-- proof objects
switchable_light : Switchable light ;
switchable_fan : Switchable fan ;
dimmable_light : Dimmable light ;
statelike_switchOn : (k : Kind) -> (s : Switchable k) -> Statelike k (switchOn k s) ;
statelike_switchOff : (k : Kind) -> (s : Switchable k) -> Statelike k (switchOff k s) ;
}

View File

@@ -0,0 +1,84 @@
--# -path=.:prelude
concrete SmartEng of Smart = open Prelude in {
-- grammar Toy1 from the Regulus book
flags startcat = Utterance ;
param
Number = Sg | Pl ;
VForm = VImp | VPart ;
lincat
Utterance = SS ;
Command = SS ;
Question = SS ;
Kind = {s : Number => Str} ;
Action = {s : VForm => Str ; part : Str} ;
Device = {s : Str ; n : Number} ;
Location = SS ;
lin
UCommand c = c ;
UQuestion q = q ;
CAction _ act dev = ss (act.s ! VImp ++ bothWays act.part dev.s) ;
QAction _ act st dev = ss (be dev.n ++ dev.s ++ act.s ! VPart ++ act.part ++ st.s) ;
DKindOne k = {
s = "the" ++ k.s ! Sg ;
n = Sg
} ;
DKindMany k = {
s = "the" ++ k.s ! Pl ;
n = Pl
} ;
DLoc _ dev loc = {
s = dev.s ++ "in" ++ "the" ++ loc.s ;
n = dev.n
} ;
light = mkNoun "light" ;
fan = mkNoun "fan" ;
switchOn _ _ = mkVerb "switch" "swithced" "on" ;
switchOff _ _ = mkVerb "switch" "swithced" "off" ;
dim _ _ = mkVerb "dim" "dimmed" [] ;
kitchen = ss "kitchen" ;
livingRoom = ss ["living room"] ;
oper
mkNoun : Str -> {s : Number => Str} = \dog -> {
s = table {
Sg => dog ;
Pl => dog + "s"
}
} ;
mkVerb : (_,_,_ : Str) -> {s : VForm => Str ; part : Str} = \go,gone,away -> {
s = table {
VImp => go ;
VPart => gone
} ;
part = away
} ;
be : Number -> Str = \n -> case n of {
Sg => "is" ;
Pl => "are"
} ;
hidden : SS = ss [] ;
lin
switchable_light = hidden ;
switchable_fan = hidden ;
dimmable_light = hidden ;
statelike_switchOn _ _ = hidden ;
statelike_switchOff _ _ = hidden ;
}

View File

@@ -0,0 +1,95 @@
--# -path=.:prelude
concrete SmartFre of Smart = open Prelude in {
-- grammar Toy1 from the Regulus book
flags startcat = Utterance ;
param
Number = Sg | Pl ;
Gender = Masc | Fem ;
VForm = VInf | VPart Gender Number ;
lincat
Utterance = SS ;
Command = SS ;
Question = SS ;
Kind = {s : Number => Str ; g : Gender} ;
Action = {s : VForm => Str} ;
Device = {s : Str ; g : Gender ; n : Number} ;
Location = {s : Number => Str ; g : Gender} ;
lin
UCommand c = c ;
UQuestion q = q ;
CAction _ act dev = ss (act.s ! VInf ++ dev.s) ;
QAction _ act st dev =
ss (dev.s ++ est dev.g dev.n ++ act.s ! VPart dev.g dev.n ++ st.s) ;
DKindOne k = {
s = defArt k.g ++ k.s ! Sg ;
g = k.g ;
n = Sg
} ;
DKindMany k = {
s = "les" ++ k.s ! Pl ;
g = k.g ;
n = Pl
} ;
DLoc _ dev loc = {
s = dev.s ++ "dans" ++ defArt loc.g ++ loc.s ! Sg ;
g = dev.g ;
n = dev.n
} ;
light = mkNoun "lampe" Fem ;
fan = mkNoun "ventilateur" Masc ;
switchOn _ _ = mkVerb "allumer" "allumé" ;
switchOff _ _ = mkVerb "éteindre" "éteint" ;
dim _ _ = mkVerb "baisser" "baissé" ;
kitchen = mkNoun "cuisine" Fem ;
livingRoom = mkNoun "salon" Masc ;
oper
mkNoun : Str -> Gender -> {s : Number => Str ; g : Gender} = \dog,g -> {
s = table {
Sg => dog ;
Pl => dog + "s"
} ;
g = g
} ;
mkVerb : (_,_ : Str) -> {s : VForm => Str} = \venir,venu -> {
s = table {
VInf => venir ;
VPart Masc Sg => venu ;
VPart Masc Pl => venu + "s" ;
VPart Fem Sg => venu + "e" ;
VPart Fem Pl => venu + "es"
}
} ;
est : Gender -> Number -> Str = \g,n -> case <g,n> of {
<Masc,Sg> => "est-il" ;
<Fem, Sg> => "est-elle" ;
<Masc,Pl> => "sont-ils" ;
<Fem, Pl> => "sont-elles"
} ;
defArt : Gender -> Str = \g -> case g of {Masc => "le" ; Fem => "la"} ;
lin
switchable_light = ss [] ;
switchable_fan = ss [] ;
dimmable_light = ss [] ;
statelike_switchOn _ _ = ss [] ;
statelike_switchOff _ _ = ss [] ;
}

View File

@@ -0,0 +1,50 @@
--# -path=.:present:prelude
incomplete concrete SmartI of Smart = open Syntax, LexSmart, Prelude in {
-- grammar Toy1 from the Regulus book
flags startcat = Utterance ;
lincat
Utterance = Utt ;
Command = Imp ;
Question = QS ;
Kind = N ;
Action = V2 ;
Device = NP ;
Location = N ;
lin
UCommand c = mkUtt politeImpForm c ;
UQuestion q = mkUtt q ;
CAction _ act dev = mkImp act dev ;
QAction _ act st dev =
mkQS anteriorAnt (mkQCl (mkCl dev (passiveVP act))) ; ---- show empty proof
DKindOne k = mkNP defSgDet k ;
DKindMany k = mkNP defPlDet k ;
DLoc _ dev loc = mkNP dev (mkAdv in_Prep (mkNP defSgDet loc)) ;
light = light_N ;
fan = fan_N ;
switchOn _ _ = switchOn_V2 ;
switchOff _ _ = switchOff_V2 ;
dim _ _ = dim_V2 ;
kitchen = kitchen_N ;
livingRoom = livingRoom_N ;
lin
switchable_light = ss [] ;
switchable_fan = ss [] ;
dimmable_light = ss [] ;
statelike_switchOn _ _ = ss [] ;
statelike_switchOff _ _ = ss [] ;
}

View File

@@ -0,0 +1,5 @@
--# -path=.:alltenses:prelude
concrete SmartSwe of Smart = SmartI with
(Syntax = SyntaxSwe),
(LexSmart = LexSmartSwe) ;

View File

@@ -0,0 +1,86 @@
abstract Grammar = {
flags startcat=Phr ;
cat
Phr ; -- any complete sentence e.g. "Is this pizza good?"
S ; -- declarative sentence e.g. "this pizza is good"
QS ; -- question sentence e.g. "is this pizza good"
Cl ; -- declarative clause e.g. "this pizza is good"
QCl ; -- question clause e.g. "is this pizza good"
NP ; -- noun phrase e.g. "this pizza"
IP ; -- interrogative phrase e.g "which pizza"
CN ; -- common noun phrase e.g. "very good pizza"
Det ; -- determiner e.g. "this"
IDet ; -- interrog. determiner e.g. "which"
AP ; -- adjectival phrase e.g. "very good"
Adv ; -- adverb e.g. "today"
AdA ; -- adadjective e.g. "very"
VP ; -- verb phrase e.g. "is good"
N ; -- noun e.g. "pizza"
A ; -- adjective e.g. "good"
V ; -- intransitive verb e.g. "boil"
V2 ; -- two-place verb e.g. "eat"
Pol ; -- polarity (pos or neg)
Conj ; -- conjunction e.g. "and"
Subj ; -- conjunction e.g. "because"
fun
PhrS : S -> Phr ;
PhrQS : QS -> Phr ;
UseCl : Pol -> Cl -> S ;
UseQCl : Pol -> QCl -> QS ;
QuestCl : Cl -> QCl ;
SubjS : Subj -> S -> Adv ;
PredVP : NP -> VP -> Cl ;
QuestVP : IP -> VP -> QCl ;
QuestV2 : IP -> NP -> V2 -> QCl ;
ComplV2 : V2 -> NP -> VP ;
ComplAP : AP -> VP ;
DetCN : Det -> CN -> NP ;
ModCN : AP -> CN -> CN ;
AdVP : Adv -> VP -> VP ;
AdAP : AdA -> AP -> AP ;
IDetCN : IDet -> CN -> IP ;
ConjS : Conj -> S -> S -> S ;
ConjNP : Conj -> NP -> NP -> NP ;
-- lexical insertion
UseN : N -> CN ;
UseA : A -> AP ;
UseV : V -> VP ;
-- entries of the closed lexicon
this_Det : Det ;
that_Det : Det ;
these_Det : Det ;
those_Det : Det ;
every_Det : Det ;
theSg_Det : Det ;
thePl_Det : Det ;
indef_Det : Det ;
plur_Det : Det ;
two_Det : Det ;
which_IDet : IDet ;
today_Adv : Adv ;
very_AdA : AdA ;
and_Conj : Conj ;
because_Subj : Subj ;
-- polarities
PPos, PNeg : Pol ;
}

View File

@@ -0,0 +1,151 @@
--# -path=.:prelude
concrete GrammarEng of Grammar = open Prelude, MorphoEng in {
lincat
Phr = {s : Str} ;
S = {s : Str} ;
QS = {s : Str} ;
Cl = {s : Order => Bool => Str} ;
QCl = {s : Order => Bool => Str} ;
NP = NounPhrase ;
IP = NounPhrase ;
CN = Noun ;
Det = {s : Str ; n : Number} ;
IDet = {s : Str ; n : Number} ;
AP = {s : Str} ;
Adv = {s : Str} ;
AdA = {s : Str} ;
VP = VerbPhrase ;
N = Noun ;
A = {s : Str} ;
V = Verb ;
V2 = Verb2 ;
Conj = {s : Str} ;
Subj = {s : Str} ;
Pol = {s : Str ; p : Bool} ;
lin
PhrS = postfixSS "." ;
PhrQS = postfixSS "?" ;
UseCl pol cl = {s = pol.s ++ cl.s ! Dir ! pol.p} ;
UseQCl pol qcl = {s = pol.s ++ qcl.s ! Inv ! pol.p} ;
QuestCl cl = cl ;
SubjS subj s = {s = subj.s ++ s.s} ;
PredVP = predVP ;
QuestVP ip vp = let cl = predVP ip vp in {s = \\_ => cl.s ! Dir};
QuestV2 ip np v2 = {
s = \\ord,pol =>
let
vp : VerbPhrase = predVerb v2
in
bothWays (ip.s ++ (predVP np vp).s ! ord ! pol) v2.c
} ;
ComplV2 v np = insertObject (v.c ++ np.s) (predVerb v) ;
ComplAP ap = {
s = \\_,b,n => {
fin = copula b n ;
inf = ap.s
}
} ;
DetCN det cn = {s = det.s ++ cn.s ! det.n ; n = det.n} ;
ModCN ap cn = {s = \\n => ap.s ++ cn.s ! n} ;
AdVP adv = insertObject adv.s ;
AdAP ada ap = {s = ada.s ++ ap.s} ;
IDetCN det cn = {s = det.s ++ cn.s ! det.n ; n = det.n} ;
ConjS c a b = {s = a.s ++ c.s ++ b.s} ;
ConjNP c a b = {s = a.s ++ c.s ++ b.s ; n = Pl} ;
UseN n = n ;
UseA a = a ;
UseV = predVerb ;
this_Det = {s = "this" ; n = Sg} ;
that_Det = {s = "that" ; n = Sg} ;
these_Det = {s = "these" ; n = Pl} ;
those_Det = {s = "those" ; n = Pl} ;
every_Det = {s = "every" ; n = Sg} ;
theSg_Det = {s = "the" ; n = Sg} ;
thePl_Det = {s = "the" ; n = Pl} ;
indef_Det = {s = artIndef ; n = Sg} ;
plur_Det = {s = [] ; n = Pl} ;
two_Det = {s = "two" ; n = Pl} ;
today_Adv = {s = "today"} ;
very_AdA = {s = "very"} ;
which_IDet = {s = "which" ; n = Sg} ;
and_Conj = {s = "and"} ;
because_Subj = {s = "because"} ;
PPos = {s = [] ; p = True} ;
PNeg = {s = [] ; p = False} ;
param
Order = Dir | Inv ;
oper
NounPhrase = {s : Str ; n : Number} ;
VerbPhrase = {s : Order => Bool => Number => {fin,inf : Str}} ;
predVP : NounPhrase -> VerbPhrase -> {s : Order => Bool => Str} =
\np,vp -> {
s = \\q,p =>
let vps = vp.s ! q ! p ! np.n
in case q of {
Dir => np.s ++ vps.fin ++ vps.inf ;
Inv => vps.fin ++ np.s ++ vps.inf
}
} ;
copula : Bool -> Number -> Str = \b,n -> case n of {
Sg => posneg b "is" ;
Pl => posneg b "are"
} ;
do : Bool -> Number -> Str = \b,n ->
posneg b ((mkV "do").s ! n) ;
predVerb : Verb -> VerbPhrase = \verb -> {
s = \\q,b,n =>
let
inf = verb.s ! Pl ;
fin = verb.s ! n ;
aux = do b n
in
case <q,b> of {
<Dir,True> => {fin = [] ; inf = fin} ;
_ => {fin = aux ; inf = inf}
}
} ;
insertObject : Str -> VerbPhrase -> VerbPhrase =
\obj,vp -> {
s = \\q,b,n => let vps = vp.s ! q ! b! n in {
fin = vps.fin ;
inf = vps.inf ++ obj
}
} ;
posneg : Bool -> Str -> Str = \b,do -> case b of {
True => do ;
False => do + "n't"
} ;
artIndef : Str =
pre {"a" ; "an" / strs {"a" ; "e" ; "i" ; "o"}} ;
}

View File

@@ -0,0 +1,132 @@
--# -path=.:prelude
concrete GrammarIta of Grammar = open Prelude, MorphoIta in {
lincat
Phr = {s : Str} ;
S = {s : Str} ;
QS = {s : Str} ;
Cl = Clause ;
QCl = Clause ;
NP = NounPhrase ;
IP = NounPhrase ;
CN = Noun ;
Det = {s : Gender => Str ; n : Number} ;
IDet = {s : Gender => Str ; n : Number} ;
AP = {s : Gender => Number => Str} ;
AdA = {s : Str} ;
VP = VerbPhrase ;
N = Noun ;
A = Adjective ;
V = Verb ;
V2 = Verb2 ;
Conj = {s : Str} ;
Subj = {s : Str} ;
Pol = {s : Str ; p : Bool} ;
oper
Clause : Type = {s : Bool => Str} ;
NounPhrase : Type = {s : Str ; g : Gender ; n : Number} ;
VerbPhrase : Type = {s : Bool => Gender => Number => Str} ;
lin
PhrS = postfixSS "." ;
PhrQS = postfixSS "?" ;
UseCl pol cl = {s = pol.s ++ cl.s ! pol.p} ;
UseQCl pol qcl = {s = pol.s ++ qcl.s ! pol.p} ;
QuestCl cl = cl ;
SubjS subj s = {s = subj.s ++ s.s} ;
PredVP = predVP ;
QuestVP = predVP ;
QuestV2 ip np v2 =
{s = \\b => v2.c ++ ip.s ++ posneg b ++ v2.s ! np.n ++ np.s} ;
ComplV2 v2 np = {s = \\b,_,n => posneg b ++ v2.s ! n ++ v2.c ++ np.s} ;
ComplAP ap = {s = \\b,g,n => posneg b ++ copula n ++ ap.s ! g ! n} ;
DetCN det cn = {s = det.s ! cn.g ++ cn.s ! det.n ; g = cn.g ; n = det.n} ;
ModCN ap cn = {s = \\n => cn.s ! n ++ ap.s ! cn.g ! n ; g = cn.g} ;
AdVP adv vp = {s = \\p,n,g => vp.s ! p ! n ! g ++ adv.s} ;
AdAP ada ap = {s = \\n,g => ada.s ++ ap.s ! n ! g} ;
IDetCN det cn = {s = det.s ! cn.g ++ cn.s ! det.n ; g = cn.g ; n = det.n} ;
ConjS c a b = {s = a.s ++ c.s ++ b.s} ;
ConjNP c a b = {s = a.s ++ c.s ++ b.s ; n = Pl ; g = conjGender a.g b.g} ;
UseN n = n ;
UseA a = a ;
UseV v = {s = \\b,_,n => posneg b ++ v.s ! n} ;
this_Det = mkDet Sg (regAdjective "questo") ;
that_Det = mkDet Sg (regAdjective "quello") ;
these_Det = mkDet Pl (regAdjective "questo") ;
those_Det = mkDet Pl (regAdjective "quello") ;
every_Det = {s = \\_ => "ogni" ; n = Sg} ;
theSg_Det = {s = artDef Sg ; n = Sg} ;
thePl_Det = {s = artDef Pl ; n = Pl} ;
indef_Det = {s = artIndef ; n = Sg} ;
plur_Det = {s = \\_ => [] ; n = Pl} ;
two_Det = {s = \\_ => "due" ; n = Pl} ;
today_Adv = {s = "oggi"} ;
very_AdA = {s = "molto"} ;
which_IDet = {s = \\_ => "quale" ; n = Sg} ;
and_Conj = {s = "e"} ;
because_Subj = {s = "perché"} ;
PPos = {s = [] ; p = True} ;
PNeg = {s = [] ; p = False} ;
oper
predVP : NounPhrase -> VerbPhrase -> Clause = \np,vp ->
{s = \\b => np.s ++ vp.s ! b ! np.g ! np.n} ;
copula : Number -> Str = \n -> case n of {
Sg => "è" ;
Pl => "sono"
} ;
posneg : Bool -> Str = \b -> case b of {
True => [] ;
False => "non"
} ;
mkDet : Number -> Adjective -> Det = \n,adj -> {
s = \\g => adj.s ! g ! n ;
n = n ;
lock_Det = <>
} ;
artDef : Number -> Gender => Str = \n -> case n of {
Sg => table {
Masc => pre {"il" ; "lo" / sImpuro} ;
Fem => "la"
} ;
Pl => table {
Masc => pre {"i" ; "gli" / sImpuro ; "gli" / vowel} ;
Fem => "le"
}
} ;
artIndef : Gender => Str = table {
Masc => pre {"un" ; "uno" / sImpuro} ;
Fem => pre {"una" ; "un'" / vowel}
} ;
conjGender : Gender -> Gender -> Gender = \g,h -> case g of {
Masc => Masc ;
_ => h
} ;
sImpuro : Strs = strs {"sb" ; "sp" ; "sy" ; "z"} ;
vowel : Strs = strs {"a" ; "e" ; "i" ; "o" ; "u"} ;
}

View File

@@ -0,0 +1,69 @@
--# -path=.:prelude
resource MorphoEng = open Prelude in {
-- the lexicon construction API
oper
mkN : overload {
mkN : (bus : Str) -> Noun ;
mkN : (man,men : Str) -> Noun ;
} ;
mkA : (warm : Str) -> Adjective ;
mkV : overload {
mkV : (kiss : Str) -> Verb ;
mkV : (do,does : Str) -> Verb ;
} ;
mkV2 : overload {
mkV2 : (love : Verb) -> Verb2 ;
mkV2 : (talk : Verb) -> (about : Str) -> Verb2 ;
} ;
-- grammar-internal definitions
param
Number = Sg | Pl ;
oper
Noun, Verb : Type = {s : Number => Str} ;
Adjective : Type = {s : Str} ;
Verb2 : Type = Verb ** {c : Str} ;
mkN = overload {
mkN : (bus : Str) -> Noun = \s -> mkNoun s (add_s s) ;
mkN : (man,men : Str) -> Noun = mkNoun ;
} ;
mkA : (warm : Str) -> Adjective = ss ;
mkV = overload {
mkV : (kiss : Str) -> Verb = \s -> mkVerb s (add_s s) ;
mkV : (do,does : Str) -> Verb = mkVerb ;
} ;
mkV2 = overload {
mkV2 : (love : Verb) -> Verb2 = \love -> love ** {c = []} ;
mkV2 : (talk : Verb) -> (about : Str) -> Verb2 =
\talk,about -> talk ** {c = about} ;
} ;
add_s : Str -> Str = \w -> case w of {
_ + "oo" => w + "s" ; -- bamboo
_ + ("s" | "z" | "x" | "sh" | "o") => w + "es" ; -- bus, hero
_ + ("a" | "o" | "u" | "e") + "y" => w + "s" ; -- boy
x + "y" => x + "ies" ; -- fly
_ => w + "s" -- car
} ;
mkNoun : Str -> Str -> Noun = \x,y -> {
s = table {
Sg => x ;
Pl => y
}
} ;
mkVerb : Str -> Str -> Verb = \x,y -> mkNoun y x ;
}

View File

@@ -0,0 +1,100 @@
--# -path=.:prelude
-- This is a simple Italian resource morphology for the GF tutorial.
resource MorphoIta = open Prelude in {
-- the lexicographer's API
oper
masculine, feminine : Gender ;
param
Number = Sg | Pl ;
Gender = Masc | Fem ;
oper
Noun : Type = {s : Number => Str ; g : Gender} ;
Adjective : Type = {s : Gender => Number => Str} ;
-- we will only use present indicative third person verb forms
Verb : Type = {s : Number => Str} ;
-- two-place verbs have a preposition
Verb2 : Type = Verb ** {c : Str} ;
-- this function takes the gender and both singular and plural forms
mkNoun : Gender -> Str -> Str -> Noun = \g,vino,vini -> {
s = table {
Sg => vino ;
Pl => vini
} ;
g = g
} ;
-- this function takes the singular form
regNoun : Str -> Noun = \vino ->
case vino of {
vin + c@("c" | "g") + "a"
=> mkNoun Fem vino (vin + c + "he") ; -- banche
vin + "a"
=> mkNoun Fem vino (vin + "e") ; -- pizza
vin + c@("c" | "g") + "o"
=> mkNoun Masc vino (vin + c + "hi") ; -- boschi
vin + ("o" | "e")
=> mkNoun Masc vino (vin + "i") ; -- vino, pane
_ => mkNoun Masc vino vino -- tram
} ;
-- to make nouns such as "carne", "università" feminine
femNoun : Noun -> Noun = \mano -> {
s = mano.s ;
g = Fem
} ;
-- this takes both genders and numbers
mkAdjective : (x1,_,_,x4 : Str) -> Adjective = \nero,nera,neri,nere -> {
s = table {
Masc => (mkNoun Masc nero neri).s ;
Fem => (mkNoun Fem nera nere).s
}
} ;
-- this takes the masculine singular form
regAdjective : Str -> Adjective = \nero ->
let ner = init nero in
case last nero of {
"o" => mkAdjective (ner + "o") (ner + "a") (ner + "i") (ner + "e") ;
"e" => mkAdjective (ner + "e") (ner + "e") (ner + "i") (ner + "i") ;
_ => mkAdjective nero nero nero nero
} ;
-- this function takes the singular and plural forms
mkVerb : Str -> Str -> Verb = \ama,amano -> {
s = table {
Sg => ama ;
Pl => amano
}
} ;
-- this function takes the infinitive form
regVerb : Str -> Verb = \amare ->
let am = Predef.tk 3 amare in
case Predef.dp 3 amare of {
"ere" => mkVerb (am + "e") (am + "ono") ; -- premere
"ire" => mkVerb (am + "isce") (am + "iscono") ; -- finire
_ => mkVerb (am + "a") (am + "ano") -- amare
} ;
}

View File

@@ -0,0 +1,43 @@
interface Syntax = open Prelude, Grammar in {
oper
mkPhr = overload {
mkPhr : S -> Phr
= PhrS ;
mkPhr : QS -> Phr
= PhrQS ;
} ;
mkS = overload {
mkS : Pol -> NP -> VP -> S
= \p,np,vp -> UseCl p (PredVP np vp) ;
mkS : NP -> VP -> S
= \np,vp -> UseCl PPos (PredVP np vp) ;
mkS : Pol -> NP -> V2 -> NP -> S
= \p,np,v,o -> UseCl p (PredVP np (ComplV2 v o)) ;
mkS : NP -> V2 -> NP -> S
= \np,v,o -> UseCl PPos (PredVP np (ComplV2 v o)) ;
mkS : Pol -> NP -> AP -> S
= \p,np,ap -> UseCl p (PredVP np (ComplAP ap)) ;
mkS : NP -> AP -> S
= \np,ap -> UseCl PPos (PredVP np (ComplAP ap)) ;
} ;
mkNP : Det -> CN -> NP
= DetCN ;
mkCN = overload {
mkCN : AP -> CN -> CN
= ModCN ;
mkCN : N -> CN
= UseN ;
} ;
mkAP = overload {
mkAP : AdA -> AP -> AP
= AdAP ;
mkAP : A -> AP
= UseA ;
} ;
}

View File

@@ -0,0 +1,3 @@
--# -path=.:resource:prelude
instance SyntaxEng of Syntax = open Prelude, GrammarEng in {} ;

View File

@@ -0,0 +1,3 @@
--# -path=.:resource:prelude
instance SyntaxIta of Syntax = open Prelude, GrammarIta in {} ;

View File

@@ -0,0 +1,8 @@
abstract Test = Grammar ** {
fun
wine_N, cheese_N, fish_N, pizza_N, waiter_N, customer_N : N ;
fresh_A, warm_A, italian_A, expensive_A, delicious_A, boring_A : A ;
stink_V : V ;
eat_V2, love_V2, talk_V2 : V2 ;
}

View File

@@ -0,0 +1,23 @@
--# -path=.:resource:prelude
concrete TestEng of Test = GrammarEng ** open Prelude, MorphoEng in {
lin
wine_N = mkN "wine" ;
cheese_N = mkN "cheese" ;
fish_N = mkN "fish" "fish" ;
pizza_N = mkN "pizza" ;
waiter_N = mkN "waiter" ;
customer_N = mkN "customer" ;
fresh_A = mkA "fresh" ;
warm_A = mkA "warm" ;
italian_A = mkA "Italian" ;
expensive_A = mkA "expensive" ;
delicious_A = mkA "delicious" ;
boring_A = mkA "boring" ;
stink_V = mkV "stink" ;
eat_V2 = mkV2 (mkV "eat") ;
love_V2 = mkV2 (mkV "love") ;
talk_V2 = mkV2 (mkV "talk") "about" ;
}

View File

@@ -0,0 +1,23 @@
--# -path=.:resource:prelude
concrete TestIta of Test = GrammarIta ** open Prelude, MorphoIta in {
lin
wine_N = regNoun "vino" ;
cheese_N = regNoun "formaggio" ;
fish_N = regNoun "pesce" ;
pizza_N = regNoun "pizza" ;
waiter_N = regNoun "cameriere" ;
customer_N = regNoun "cliente" ;
fresh_A = regAdjective "fresco" ;
warm_A = regAdjective "caldo" ;
italian_A = regAdjective "italiano" ;
expensive_A = regAdjective "caro" ;
delicious_A = regAdjective "delizioso" ;
boring_A = regAdjective "noioso" ;
stink_V = regVerb "puzzare" ;
eat_V2 = regVerb "mangiare" ** {c = []} ;
love_V2 = regVerb "amare" ** {c = []} ;
talk_V2 = regVerb "parlare" ** {c = "di"} ;
}

View File

@@ -101,7 +101,7 @@ oper
--3 Other verbs
--
V2S, V2V, V2Q : Type = V2 ;
-- V2S, V2V, V2Q : Type = V2 ;
mkV2S : V -> Prep -> V2S ;
mkV2S v p = prepV2 v p ** {lock_V2 = <>} ;
@@ -179,4 +179,4 @@ oper
mkIAdv : Str -> IAdv ;
mkIAdv s = {s = table {QDir=>s;QIndir=>s+"ňî"}; lock_IAdv = <>} ;
}
}

View File

@@ -225,10 +225,10 @@ resource ResIna = ParamX ** open Prelude in {
};
tenseToVFrom = table {
Pres => VPres;
Past => VPast;
Fut => VFut;
Cond => VCond
Pres => VPres
;Past => VPast; --# notpresent
Fut => VFut; --# notpresent
Cond => VCond --# notpresent
};
insertInvarObj : Str -> VP -> VP = \obj -> insertObj "" Acc (mkInvarNP obj);