1
0
forked from GitHub/gf-core

toy1 in English

This commit is contained in:
aarne
2007-06-11 08:55:32 +00:00
parent a22871d074
commit 2b438a6284
2 changed files with 111 additions and 0 deletions

View File

@@ -0,0 +1,35 @@
abstract Toy1 = {
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 Toy1Eng of Toy1 = 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" "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"
} ;
}