diff options
Diffstat (limited to 'old-examples/tutorial')
87 files changed, 2861 insertions, 0 deletions
diff --git a/old-examples/tutorial/calculator/Calculator.gf b/old-examples/tutorial/calculator/Calculator.gf new file mode 100644 index 000000000..65192e226 --- /dev/null +++ b/old-examples/tutorial/calculator/Calculator.gf @@ -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)) ; + +} diff --git a/old-examples/tutorial/calculator/CalculatorC.gf b/old-examples/tutorial/calculator/CalculatorC.gf new file mode 100644 index 000000000..53eade357 --- /dev/null +++ b/old-examples/tutorial/calculator/CalculatorC.gf @@ -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 ; + +} diff --git a/old-examples/tutorial/calculator/CalculatorE.gf b/old-examples/tutorial/calculator/CalculatorE.gf new file mode 100644 index 000000000..f432d371a --- /dev/null +++ b/old-examples/tutorial/calculator/CalculatorE.gf @@ -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" ; +} diff --git a/old-examples/tutorial/calculator/CalculatorJ.gf b/old-examples/tutorial/calculator/CalculatorJ.gf new file mode 100644 index 000000000..68ff5342c --- /dev/null +++ b/old-examples/tutorial/calculator/CalculatorJ.gf @@ -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) ; +} diff --git a/old-examples/tutorial/calculator/CalculatorP.gf b/old-examples/tutorial/calculator/CalculatorP.gf new file mode 100644 index 000000000..57ac549c1 --- /dev/null +++ b/old-examples/tutorial/calculator/CalculatorP.gf @@ -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 ++ ")") ; +} diff --git a/old-examples/tutorial/embedded/LexMath.gf b/old-examples/tutorial/embedded/LexMath.gf new file mode 100644 index 000000000..25bfe8846 --- /dev/null +++ b/old-examples/tutorial/embedded/LexMath.gf @@ -0,0 +1,8 @@ +interface LexMath = open Syntax in { + + oper + even_A : A ; + odd_A : A ; + prime_A : A ; + +} diff --git a/old-examples/tutorial/embedded/LexMathEng.gf b/old-examples/tutorial/embedded/LexMathEng.gf new file mode 100644 index 000000000..183fa520f --- /dev/null +++ b/old-examples/tutorial/embedded/LexMathEng.gf @@ -0,0 +1,8 @@ +instance LexMathEng of LexMath = open SyntaxEng, ParadigmsEng in { + + oper + even_A = mkA "even" ; + odd_A = mkA "odd" ; + prime_A = mkA "prime" ; + +} diff --git a/old-examples/tutorial/embedded/LexMathFre.gf b/old-examples/tutorial/embedded/LexMathFre.gf new file mode 100644 index 000000000..7407b410f --- /dev/null +++ b/old-examples/tutorial/embedded/LexMathFre.gf @@ -0,0 +1,8 @@ +instance LexMathFre of LexMath = open SyntaxFre, ParadigmsFre in { + + oper + even_A = mkA "pair" ; + odd_A = mkA "impair" ; + prime_A = mkA "premier" ; + +} diff --git a/old-examples/tutorial/embedded/Makefile b/old-examples/tutorial/embedded/Makefile new file mode 100644 index 000000000..119d5d0fe --- /dev/null +++ b/old-examples/tutorial/embedded/Makefile @@ -0,0 +1,11 @@ +all: + gfc --make -haskell MathEng.gf MathFre.gf + ghc --make -o ./math TransferLoop.hs + strip math + +clean: + rm -f *.gfo *.o *.hi + +distclean: + rm -f GSyntax.hs math Math.gfcc *.gfo *.o *.hi + diff --git a/old-examples/tutorial/embedded/Math.gf b/old-examples/tutorial/embedded/Math.gf new file mode 100644 index 000000000..95f5d5d1c --- /dev/null +++ b/old-examples/tutorial/embedded/Math.gf @@ -0,0 +1,14 @@ +abstract Math = { + + cat Answer ; Question ; Object ; + + fun + Even : Object -> Question ; + Odd : Object -> Question ; + Prime : Object -> Question ; + Number : Int -> Object ; + + Yes : Answer ; + No : Answer ; + +} diff --git a/old-examples/tutorial/embedded/MathEng.gf b/old-examples/tutorial/embedded/MathEng.gf new file mode 100644 index 000000000..ac332fef7 --- /dev/null +++ b/old-examples/tutorial/embedded/MathEng.gf @@ -0,0 +1,6 @@ +--# -path=.:present:prelude:mathematical + +concrete MathEng of Math = MathI with + (Syntax = SyntaxEng), + (Symbol = SymbolEng), + (LexMath = LexMathEng) ; diff --git a/old-examples/tutorial/embedded/MathFre.gf b/old-examples/tutorial/embedded/MathFre.gf new file mode 100644 index 000000000..456db8084 --- /dev/null +++ b/old-examples/tutorial/embedded/MathFre.gf @@ -0,0 +1,6 @@ +--# -path=.:present:prelude:mathematical + +concrete MathFre of Math = MathI with + (Syntax = SyntaxFre), + (Symbol = SymbolFre), + (LexMath = LexMathFre) ; diff --git a/old-examples/tutorial/embedded/MathI.gf b/old-examples/tutorial/embedded/MathI.gf new file mode 100644 index 000000000..aaac7b98f --- /dev/null +++ b/old-examples/tutorial/embedded/MathI.gf @@ -0,0 +1,23 @@ +incomplete concrete MathI of Math = + open Syntax, Symbol, LexMath in { + + flags startcat = Question ; lexer = textlit ; unlexer = text ; + + lincat + Answer = Text ; + Question = Text ; + Object = NP ; + + lin + Even = questAdj even_A ; + Odd = questAdj odd_A ; + Prime = questAdj prime_A ; + Number n = mkNP (IntPN n) ; + + Yes = mkText yes_Phr ; + No = mkText no_Phr ; + + oper + questAdj : A -> NP -> Text = \adj,x -> mkText (mkQS (mkCl x adj)) ; + +} diff --git a/old-examples/tutorial/embedded/TransferDef.hs b/old-examples/tutorial/embedded/TransferDef.hs new file mode 100644 index 000000000..8be39107d --- /dev/null +++ b/old-examples/tutorial/embedded/TransferDef.hs @@ -0,0 +1,26 @@ +module TransferDef where + +import GF.GFCC.API (Tree) +import GSyntax + +transfer :: Tree -> Tree +transfer = gf . answer . fg + +answer :: GQuestion -> GAnswer +answer p = case p of + GOdd x -> test odd x + GEven x -> test even x + GPrime x -> test prime x + +value :: GObject -> Int +value e = case e of + GNumber (GInt i) -> fromInteger i + +test :: (Int -> Bool) -> GObject -> GAnswer +test f x = if f (value x) then GYes else GNo + +prime :: Int -> Bool +prime x = elem x primes where + primes = sieve [2 .. x] + sieve (p:xs) = p : sieve [ n | n <- xs, n `mod` p > 0 ] + sieve [] = [] diff --git a/old-examples/tutorial/embedded/TransferLoop.hs b/old-examples/tutorial/embedded/TransferLoop.hs new file mode 100644 index 000000000..708578156 --- /dev/null +++ b/old-examples/tutorial/embedded/TransferLoop.hs @@ -0,0 +1,23 @@ +module Main where + +import GF.GFCC.API +import TransferDef (transfer) + +main :: IO () +main = do + gr <- file2grammar "Math.gfcc" + loop (translate transfer gr) + +loop :: (String -> String) -> IO () +loop trans = do + s <- getLine + if s == "quit" then putStrLn "bye" else do + putStrLn $ trans s + loop trans + +translate :: (Tree -> Tree) -> MultiGrammar -> String -> String +translate tr gr = unlines . map transLine . lines where + transLine s = case parseAllLang gr "Question" s of + (lg,t:_):_ -> linearize gr lg (tr t) + _ -> "NO PARSE" + diff --git a/old-examples/tutorial/embedded/Translator.hs b/old-examples/tutorial/embedded/Translator.hs new file mode 100644 index 000000000..c227420f6 --- /dev/null +++ b/old-examples/tutorial/embedded/Translator.hs @@ -0,0 +1,16 @@ +module Main where + +import GF.Embed.EmbedAPI +import System (getArgs) + +main :: IO () +main = do + file:_ <- getArgs + gr <- file2grammar file + interact (translate gr) + +translate :: MultiGrammar -> String -> String +translate gr = unlines . map transLine . lines where + transLine s = + let (lang,tree:_):_ = parseAllLang gr (startCat gr) s + in unlines [linearize gr lg tree | lg <- languages gr, lg /= lang] diff --git a/old-examples/tutorial/embedded/TranslatorLoop.hs b/old-examples/tutorial/embedded/TranslatorLoop.hs new file mode 100644 index 000000000..18b20146e --- /dev/null +++ b/old-examples/tutorial/embedded/TranslatorLoop.hs @@ -0,0 +1,23 @@ +module Main where + +import GF.Embed.EmbedAPI +import System (getArgs) + +main :: IO () +main = do + file:_ <- getArgs + gr <- file2grammar file + loop (translate gr) + +loop :: (String -> String) -> IO () +loop trans = do + s <- getLine + if s == "quit" then putStrLn "bye" else do + putStrLn $ trans s + loop trans + +translate :: MultiGrammar -> String -> String +translate gr = unlines . map transLine . lines where + transLine s = case parseAllLang gr (startCat gr) s of + (lg,t:_):_ -> unlines [linearize gr l t | l <- languages gr, l /= lg] + _ -> "NO PARSE" diff --git a/old-examples/tutorial/embedded/haskell/GSyntax.hs b/old-examples/tutorial/embedded/haskell/GSyntax.hs new file mode 100644 index 000000000..28469e7da --- /dev/null +++ b/old-examples/tutorial/embedded/haskell/GSyntax.hs @@ -0,0 +1,100 @@ +module GSyntax where + +import GF.Infra.Ident +import GF.Grammar.Grammar +import GF.Grammar.PrGrammar +import GF.Grammar.Macros +import GF.Data.Operations +---------------------------------------------------- +-- automatic translation from GF to Haskell +---------------------------------------------------- + +class Gf a where gf :: a -> Trm +class Fg a where fg :: Trm -> a + +newtype GString = GString String deriving Show + +instance Gf GString where + gf (GString s) = K s + +instance Fg GString where + fg t = + case termForm t of + Ok ([], K s ,[]) -> GString s + _ -> error ("no GString " ++ prt t) + +newtype GInt = GInt Integer deriving Show + +instance Gf GInt where + gf (GInt s) = EInt s + +instance Fg GInt where + fg t = + case termForm t of + Ok ([], EInt s ,[]) -> GInt s + _ -> error ("no GInt " ++ prt t) + +newtype GFloat = GFloat Double deriving Show + +instance Gf GFloat where + gf (GFloat s) = EFloat s + +instance Fg GFloat where + fg t = + case termForm t of + Ok ([], EFloat s ,[]) -> GFloat s + _ -> error ("no GFloat " ++ prt t) + +---------------------------------------------------- +-- below this line machine-generated +---------------------------------------------------- + +data GAnswer = + GYes + | GNo + deriving Show + +data GObject = GNumber GInt + deriving Show + +data GQuestion = + GPrime GObject + | GOdd GObject + | GEven GObject + deriving Show + + +instance Gf GAnswer where + gf GYes = appqc "Math" "Yes" [] + gf GNo = appqc "Math" "No" [] + +instance Gf GObject where gf (GNumber x1) = appqc "Math" "Number" [gf x1] + +instance Gf GQuestion where + gf (GPrime x1) = appqc "Math" "Prime" [gf x1] + gf (GOdd x1) = appqc "Math" "Odd" [gf x1] + gf (GEven x1) = appqc "Math" "Even" [gf x1] + + +instance Fg GAnswer where + fg t = + case termForm t of + Ok ([], Q (IC "Math") (IC "Yes"),[]) -> GYes + Ok ([], Q (IC "Math") (IC "No"),[]) -> GNo + _ -> error ("no Answer " ++ prt t) + +instance Fg GObject where + fg t = + case termForm t of + Ok ([], Q (IC "Math") (IC "Number"),[x1]) -> GNumber (fg x1) + _ -> error ("no Object " ++ prt t) + +instance Fg GQuestion where + fg t = + case termForm t of + Ok ([], Q (IC "Math") (IC "Prime"),[x1]) -> GPrime (fg x1) + Ok ([], Q (IC "Math") (IC "Odd"),[x1]) -> GOdd (fg x1) + Ok ([], Q (IC "Math") (IC "Even"),[x1]) -> GEven (fg x1) + _ -> error ("no Question " ++ prt t) + + diff --git a/old-examples/tutorial/embedded/haskell/Run.hs b/old-examples/tutorial/embedded/haskell/Run.hs new file mode 100644 index 000000000..c3fd87466 --- /dev/null +++ b/old-examples/tutorial/embedded/haskell/Run.hs @@ -0,0 +1,38 @@ +module Main where + +import GSyntax +import GF.Embed.EmbedAPI + +main :: IO () +main = do + gr <- file2grammar "math.gfcm" + loop gr + +loop :: MultiGrammar -> IO () +loop gr = do + s <- getLine + interpret gr s + loop gr + +interpret :: MultiGrammar -> String -> IO () +interpret gr s = do + let ltss = parseAllLang gr "Question" s + case ltss of + [] -> putStrLn "no parse" + (l,t:_):_ -> putStrLn $ linearize gr l $ gf $ answer $ fg t + +answer :: GQuestion -> GAnswer +answer p = case p of + GOdd x -> test odd x + GEven x -> test even x + GPrime x -> test prime x + +value :: GObject -> Int +value e = case e of + GNumber (GInt i) -> fromInteger i + +test :: (Int -> Bool) -> GObject -> GAnswer +test f x = if f (value x) then GYes else GNo + +prime :: Int -> Bool +prime = (< 8) ---- diff --git a/old-examples/tutorial/food/Food.gf b/old-examples/tutorial/food/Food.gf new file mode 100644 index 000000000..c4efd5950 --- /dev/null +++ b/old-examples/tutorial/food/Food.gf @@ -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 ; + +}
\ No newline at end of file diff --git a/old-examples/tutorial/food/FoodEng.gf b/old-examples/tutorial/food/FoodEng.gf new file mode 100644 index 000000000..a4f5907be --- /dev/null +++ b/old-examples/tutorial/food/FoodEng.gf @@ -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"} ; + +} +
\ No newline at end of file diff --git a/old-examples/tutorial/food/FoodIta.gf b/old-examples/tutorial/food/FoodIta.gf new file mode 100644 index 000000000..fc59e1294 --- /dev/null +++ b/old-examples/tutorial/food/FoodIta.gf @@ -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"} ; + +} diff --git a/old-examples/tutorial/food/food.ebnf b/old-examples/tutorial/food/food.ebnf new file mode 100644 index 000000000..d85739dad --- /dev/null +++ b/old-examples/tutorial/food/food.ebnf @@ -0,0 +1,4 @@ +Phrase ::= + ("this" | "that") Quality* ("wine" | "cheese" | "fish") "is" Quality ; +Quality ::= + ("very"* ("fresh" | "warm" | "boring" | "Italian" | "expensive")) ; diff --git a/old-examples/tutorial/foods/Foods.gf b/old-examples/tutorial/foods/Foods.gf new file mode 100644 index 000000000..35779a76d --- /dev/null +++ b/old-examples/tutorial/foods/Foods.gf @@ -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 ; + +} diff --git a/old-examples/tutorial/foods/FoodsEng.gf b/old-examples/tutorial/foods/FoodsEng.gf new file mode 100644 index 000000000..69a427006 --- /dev/null +++ b/old-examples/tutorial/foods/FoodsEng.gf @@ -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" + } ; +} + diff --git a/old-examples/tutorial/foods/FoodsIta.gf b/old-examples/tutorial/foods/FoodsIta.gf new file mode 100644 index 000000000..0099058d0 --- /dev/null +++ b/old-examples/tutorial/foods/FoodsIta.gf @@ -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" + } ; +} diff --git a/old-examples/tutorial/hello/Hello.gf b/old-examples/tutorial/hello/Hello.gf new file mode 100644 index 000000000..769be5cbf --- /dev/null +++ b/old-examples/tutorial/hello/Hello.gf @@ -0,0 +1,10 @@ +abstract Hello = { + + cat Greeting ; Recipient ; + + flags startcat = Greeting ; + + fun + Hello : Recipient -> Greeting ; + World, Mum, Friends : Recipient ; +}
\ No newline at end of file diff --git a/old-examples/tutorial/hello/HelloEng.gf b/old-examples/tutorial/hello/HelloEng.gf new file mode 100644 index 000000000..69efba6b4 --- /dev/null +++ b/old-examples/tutorial/hello/HelloEng.gf @@ -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"} ; +}
\ No newline at end of file diff --git a/old-examples/tutorial/hello/HelloFin.gf b/old-examples/tutorial/hello/HelloFin.gf new file mode 100644 index 000000000..969142a91 --- /dev/null +++ b/old-examples/tutorial/hello/HelloFin.gf @@ -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"} ; +}
\ No newline at end of file diff --git a/old-examples/tutorial/hello/HelloIta.gf b/old-examples/tutorial/hello/HelloIta.gf new file mode 100644 index 000000000..f1465a867 --- /dev/null +++ b/old-examples/tutorial/hello/HelloIta.gf @@ -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"} ; +}
\ No newline at end of file diff --git a/old-examples/tutorial/hello/hello.gfs b/old-examples/tutorial/hello/hello.gfs new file mode 100644 index 000000000..783919e0e --- /dev/null +++ b/old-examples/tutorial/hello/hello.gfs @@ -0,0 +1,4 @@ +import HelloEng.gf +import HelloFin.gf +import HelloIta.gf +linearize -multi Hello World diff --git a/old-examples/tutorial/resource-foods/ExtFoods.gf b/old-examples/tutorial/resource-foods/ExtFoods.gf new file mode 100644 index 000000000..22b65a3c0 --- /dev/null +++ b/old-examples/tutorial/resource-foods/ExtFoods.gf @@ -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 ; + +} diff --git a/old-examples/tutorial/resource-foods/ExtFoodsEng.gf b/old-examples/tutorial/resource-foods/ExtFoodsEng.gf new file mode 100644 index 000000000..70ba26b74 --- /dev/null +++ b/old-examples/tutorial/resource-foods/ExtFoodsEng.gf @@ -0,0 +1,5 @@ +--# -path=.:../foods:present:prelude + +concrete ExtFoodsEng of ExtFoods = FoodsEni ** ExtFoodsI with + (Syntax = SyntaxEng), + (LexFoods = LexFoodsEng) ; diff --git a/old-examples/tutorial/resource-foods/ExtFoodsFin.gf b/old-examples/tutorial/resource-foods/ExtFoodsFin.gf new file mode 100644 index 000000000..9cf90dfa0 --- /dev/null +++ b/old-examples/tutorial/resource-foods/ExtFoodsFin.gf @@ -0,0 +1,5 @@ +--# -path=.:../foods:present:prelude + +concrete ExtFoodsFin of ExtFoods = FoodsFin ** ExtFoodsI with + (Syntax = SyntaxFin), + (LexFoods = LexFoodsFin) ; diff --git a/old-examples/tutorial/resource-foods/ExtFoodsGer.gf b/old-examples/tutorial/resource-foods/ExtFoodsGer.gf new file mode 100644 index 000000000..62285e3ae --- /dev/null +++ b/old-examples/tutorial/resource-foods/ExtFoodsGer.gf @@ -0,0 +1,5 @@ +--# -path=.:../foods:present:prelude + +concrete ExtFoodsGer of ExtFoods = FoodsGer ** ExtFoodsI with + (Syntax = SyntaxGer), + (LexFoods = LexFoodsGer) ; diff --git a/old-examples/tutorial/resource-foods/ExtFoodsI.gf b/old-examples/tutorial/resource-foods/ExtFoodsI.gf new file mode 100644 index 000000000..586f3e42b --- /dev/null +++ b/old-examples/tutorial/resource-foods/ExtFoodsI.gf @@ -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 ; + +} diff --git a/old-examples/tutorial/resource-foods/FoodsEng.gf b/old-examples/tutorial/resource-foods/FoodsEng.gf new file mode 100644 index 000000000..90ae07f01 --- /dev/null +++ b/old-examples/tutorial/resource-foods/FoodsEng.gf @@ -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") ; +} diff --git a/old-examples/tutorial/resource-foods/FoodsEni.gf b/old-examples/tutorial/resource-foods/FoodsEni.gf new file mode 100644 index 000000000..cf1156ea6 --- /dev/null +++ b/old-examples/tutorial/resource-foods/FoodsEni.gf @@ -0,0 +1,5 @@ +--# -path=.:../foods:present:prelude + +concrete FoodsEni of Foods = FoodsI with + (Syntax = SyntaxEng), + (LexFoods = LexFoodsEng) ; diff --git a/old-examples/tutorial/resource-foods/FoodsFin.gf b/old-examples/tutorial/resource-foods/FoodsFin.gf new file mode 100644 index 000000000..2c76ee4a0 --- /dev/null +++ b/old-examples/tutorial/resource-foods/FoodsFin.gf @@ -0,0 +1,5 @@ +--# -path=.:../foods:present:prelude + +concrete FoodsFin of Foods = FoodsI with + (Syntax = SyntaxFin), + (LexFoods = LexFoodsFin) ; diff --git a/old-examples/tutorial/resource-foods/FoodsFre.gf b/old-examples/tutorial/resource-foods/FoodsFre.gf new file mode 100644 index 000000000..f10a60e63 --- /dev/null +++ b/old-examples/tutorial/resource-foods/FoodsFre.gf @@ -0,0 +1,5 @@ +--# -path=.:../foods:present:prelude + +concrete FoodsFre of Foods = FoodsI with + (Syntax = SyntaxFre), + (LexFoods = LexFoodsFre) ; diff --git a/old-examples/tutorial/resource-foods/FoodsGer.gf b/old-examples/tutorial/resource-foods/FoodsGer.gf new file mode 100644 index 000000000..1c5090ff6 --- /dev/null +++ b/old-examples/tutorial/resource-foods/FoodsGer.gf @@ -0,0 +1,5 @@ +--# -path=.:../foods:present:prelude + +concrete FoodsGer of Foods = FoodsI with + (Syntax = SyntaxGer), + (LexFoods = LexFoodsGer) ; diff --git a/old-examples/tutorial/resource-foods/FoodsI.gf b/old-examples/tutorial/resource-foods/FoodsI.gf new file mode 100644 index 000000000..e19e3c6a4 --- /dev/null +++ b/old-examples/tutorial/resource-foods/FoodsI.gf @@ -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 ; +} diff --git a/old-examples/tutorial/resource-foods/FoodsIta.gf b/old-examples/tutorial/resource-foods/FoodsIta.gf new file mode 100644 index 000000000..7158d77f9 --- /dev/null +++ b/old-examples/tutorial/resource-foods/FoodsIta.gf @@ -0,0 +1,5 @@ +--# -path=.:../foods:present:prelude + +concrete FoodsIta of Foods = FoodsI with + (Syntax = SyntaxIta), + (LexFoods = LexFoodsIta) ; diff --git a/old-examples/tutorial/resource-foods/LexFoods.gf b/old-examples/tutorial/resource-foods/LexFoods.gf new file mode 100644 index 000000000..875427b77 --- /dev/null +++ b/old-examples/tutorial/resource-foods/LexFoods.gf @@ -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 ; +} diff --git a/old-examples/tutorial/resource-foods/LexFoodsEng.gf b/old-examples/tutorial/resource-foods/LexFoodsEng.gf new file mode 100644 index 000000000..01024b356 --- /dev/null +++ b/old-examples/tutorial/resource-foods/LexFoodsEng.gf @@ -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" ; + +} diff --git a/old-examples/tutorial/resource-foods/LexFoodsFin.gf b/old-examples/tutorial/resource-foods/LexFoodsFin.gf new file mode 100644 index 000000000..513c541b4 --- /dev/null +++ b/old-examples/tutorial/resource-foods/LexFoodsFin.gf @@ -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" ; + +} diff --git a/old-examples/tutorial/resource-foods/LexFoodsFre.gf b/old-examples/tutorial/resource-foods/LexFoodsFre.gf new file mode 100644 index 000000000..5e7f72442 --- /dev/null +++ b/old-examples/tutorial/resource-foods/LexFoodsFre.gf @@ -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" ; +} diff --git a/old-examples/tutorial/resource-foods/LexFoodsGer.gf b/old-examples/tutorial/resource-foods/LexFoodsGer.gf new file mode 100644 index 000000000..15c5d94ca --- /dev/null +++ b/old-examples/tutorial/resource-foods/LexFoodsGer.gf @@ -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 ; + +} diff --git a/old-examples/tutorial/resource-foods/LexFoodsIta.gf b/old-examples/tutorial/resource-foods/LexFoodsIta.gf new file mode 100644 index 000000000..be120a24e --- /dev/null +++ b/old-examples/tutorial/resource-foods/LexFoodsIta.gf @@ -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" ; +} diff --git a/old-examples/tutorial/semantics/Answer.hs b/old-examples/tutorial/semantics/Answer.hs new file mode 100644 index 000000000..08a76c5f1 --- /dev/null +++ b/old-examples/tutorial/semantics/Answer.hs @@ -0,0 +1,21 @@ +module Main where + +import GSyntax +import AnswerBase +import GF.GFCC.API + +main :: IO () +main = do + gr <- file2grammar "base.gfcc" + loop gr + +loop :: MultiGrammar -> IO () +loop gr = do + s <- getLine + case parse gr "BaseEng" "Question" s of + [] -> putStrLn "no parse" + ts -> mapM_ answer ts + loop gr + where + answer t = putStrLn $ linearize gr "BaseEng" $ gf $ question2answer $ fg t + diff --git a/old-examples/tutorial/semantics/AnswerBase.hs b/old-examples/tutorial/semantics/AnswerBase.hs new file mode 100644 index 000000000..56e2b5451 --- /dev/null +++ b/old-examples/tutorial/semantics/AnswerBase.hs @@ -0,0 +1,90 @@ +module AnswerBase where + +import GSyntax + +-- interpretation of Base + +type Prop = Bool +type Ent = Int +domain = [0 .. 100] + +iS :: GS -> Prop +iS s = case s of + GPredAP np ap -> iNP np (iAP ap) + +iNP :: GNP -> (Ent -> Prop) -> Prop +iNP np p = case np of + GEvery cn -> all (\x -> not (iCN cn x) || p x) domain + GSome cn -> any (\x -> iCN cn x && p x) domain + GNone -> not (any (\x -> p x) domain) + GMany pns -> and (map p (iListPN pns)) + GConjNP c np1 np2 -> iConj c (iNP np1 p) (iNP np2 p) + GUsePN a -> p (iPN a) + +iPN :: GPN -> Ent +iPN pn = case pn of + GUseInt i -> iInt i + GSum pns -> sum (iListPN pns) + GProduct pns -> product (iListPN pns) + GGCD pns -> foldl1 gcd (iListPN pns) + +iAP :: GAP -> Ent -> Prop +iAP ap e = case ap of + GComplA2 a2 np -> iNP np (iA2 a2 e) + GConjAP c ap1 ap2 -> iConj c (iAP ap1 e) (iAP ap2 e) + GEven -> even e + GOdd -> odd e + GPrime -> prime e + +iCN :: GCN -> Ent -> Prop +iCN cn e = case cn of + GModCN ap cn0 -> (iCN cn0 e) && (iAP ap e) + GNumber -> True + +iConj :: GConj -> Prop -> Prop -> Prop +iConj c = case c of + GAnd -> (&&) + GOr -> (||) + +iA2 :: GA2 -> Ent -> Ent -> Prop +iA2 a2 e1 e2 = case a2 of + GGreater -> e1 > e2 + GSmaller -> e1 < e2 + GEqual -> e1 == e2 + GDivisible -> e2 /= 0 && mod e1 e2 == 0 + +iListPN :: GListPN -> [Ent] +iListPN gls = case gls of + GListPN pns -> map iPN pns + +iInt :: GInt -> Ent +iInt gi = case gi of + GInt i -> fromInteger i + +-- questions and answers + +iQuestion :: GQuestion -> Either Bool [Ent] +iQuestion q = case q of + GWhatIs pn -> Right [iPN pn] -- computes the value + GWhichAre cn ap -> Right [e | e <- domain, iCN cn e, iAP ap e] + GQuestS s -> Left (iS s) + +question2answer :: GQuestion -> GAnswer +question2answer q = case iQuestion q of + Left True -> GYes + Left False -> GNo + Right [] -> GValue GNone + Right [v] -> GValue (GUsePN (ent2pn v)) + Right vs -> GValue (GMany (GListPN (map ent2pn vs))) + +ent2pn :: Ent -> GPN +ent2pn e = GUseInt (GInt (toInteger e)) + + +-- auxiliary + +prime :: Int -> Bool +prime x = elem x primes where + primes = sieve [2 .. x] + sieve (p:xs) = p : sieve [ n | n <- xs, n `mod` p > 0 ] + sieve [] = [] diff --git a/old-examples/tutorial/semantics/Base.gf b/old-examples/tutorial/semantics/Base.gf new file mode 100644 index 000000000..4586c3106 --- /dev/null +++ b/old-examples/tutorial/semantics/Base.gf @@ -0,0 +1,60 @@ +-- abstract syntax of a query language + +abstract Base = { + +cat + S ; + NP ; + PN ; + CN ; + AP ; + A2 ; + Conj ; +fun + +-- sentence syntax + PredAP : NP -> AP -> S ; + + ComplA2 : A2 -> NP -> AP ; + + ModCN : AP -> CN -> CN ; + + ConjAP : Conj -> AP -> AP -> AP ; + ConjNP : Conj -> NP -> NP -> NP ; + + UsePN : PN -> NP ; + Every : CN -> NP ; + Some : CN -> NP ; + + And, Or : Conj ; + +-- lexicon + + UseInt : Int -> PN ; + + Number : CN ; + Even, Odd, Prime : AP ; + Equal, Greater, Smaller, Divisible : A2 ; + + Sum, Product, GCD : ListPN -> PN ; + +-- adding questions + +cat + Question ; + Answer ; + ListPN ; +fun + WhatIs : PN -> Question ; + WhichAre : CN -> AP -> Question ; + QuestS : S -> Question ; + + Yes : Answer ; + No : Answer ; + Value : NP -> Answer ; + + None : NP ; + Many : ListPN -> NP ; + BasePN : PN -> PN -> ListPN ; + ConsPN : PN -> ListPN -> ListPN ; +} diff --git a/old-examples/tutorial/semantics/BaseEng.gf b/old-examples/tutorial/semantics/BaseEng.gf new file mode 100644 index 000000000..bd79bc98c --- /dev/null +++ b/old-examples/tutorial/semantics/BaseEng.gf @@ -0,0 +1,56 @@ +--# -path=.:prelude + +concrete BaseEng of Base = open Prelude in { + +flags lexer=literals ; unlexer=text ; + +-- English concrete syntax; greatly simplified - just for demo purposes + +lin + PredAP = infixSS "is" ; + + ComplA2 = cc2 ; + + ModCN = cc2 ; + + ConjAP c = infixSS c.s ; + ConjNP c = infixSS c.s ; + + UsePN a = a ; + Every = prefixSS "every" ; + Some = prefixSS "some" ; + + And = ss "and" ; + Or = ss "or" ; + + UseInt n = n ; + + Number = ss "number" ; + + Even = ss "even" ; + Odd = ss "odd" ; + Prime = ss "prime" ; + Equal = ss ("equal" ++ "to") ; + Greater = ss ("greater" ++ "than") ; + Smaller = ss ("smaller" ++ "than") ; + Divisible = ss ("divisible" ++ "by") ; + + Sum = prefixSS ["the sum of"] ; + Product = prefixSS ["the product of"] ; + GCD = prefixSS ["the greatest common divisor of"] ; + + WhatIs = prefixSS ["what is"] ; + WhichAre cn ap = ss ("which" ++ cn.s ++ "is" ++ ap.s) ; ---- are + QuestS s = s ; ---- inversion + + Yes = ss "yes" ; + No = ss "no" ; + + Value np = np ; + None = ss "none" ; + Many list = list ; + + BasePN = infixSS "and" ; + ConsPN = infixSS "," ; + +} diff --git a/old-examples/tutorial/semantics/BaseI.gf b/old-examples/tutorial/semantics/BaseI.gf new file mode 100644 index 000000000..ec967e443 --- /dev/null +++ b/old-examples/tutorial/semantics/BaseI.gf @@ -0,0 +1,70 @@ +incomplete concrete BaseI of Base = + open Syntax, (G = Grammar), Symbolic, LexBase in { + +flags lexer=literals ; unlexer=text ; + +lincat + Question = G.Phr ; + Answer = G.Phr ; + S = G.Cl ; + NP = G.NP ; + PN = G.NP ; + CN = G.CN ; + AP = G.AP ; + A2 = G.A2 ; + Conj = G.Conj ; + ListPN = G.ListNP ; + +lin + PredAP = mkCl ; + + ComplA2 = mkAP ; + + ModCN = mkCN ; + + ConjAP = mkAP ; + ConjNP = mkNP ; + + UsePN p = p ; + Every = mkNP every_Det ; + Some = mkNP someSg_Det ; + + And = and_Conj ; + Or = or_Conj ; + + UseInt i = symb i ; + + Number = mkCN number_N ; + + Even = mkAP even_A ; + Odd = mkAP odd_A ; + Prime = mkAP prime_A ; + Equal = equal_A2 ; + Greater = greater_A2 ; + Smaller = smaller_A2 ; + Divisible = divisible_A2 ; + + Sum = prefix sum_N2 ; + Product = prefix product_N2 ; + GCD nps = mkNP (mkDet (mkQuantSg defQuant) (mkOrd great_A)) + (mkCN common_A (mkCN divisor_N2 (mkNP and_Conj nps))) ; + + WhatIs np = mkPhr (mkQS (mkQCl whatSg_IP (mkVP np))) ; + WhichAre cn ap = mkPhr (mkQS (mkQCl (mkIP whichPl_IDet cn) (mkVP ap))) ; + QuestS s = mkPhr (mkQS (mkQCl s)) ; + + Yes = yes_Phr ; + No = no_Phr ; + + Value np = mkPhr (mkUtt np) ; + Many list = mkNP and_Conj list ; + None = none_NP ; + + BasePN = G.BaseNP ; + ConsPN = G.ConsNP ; + +oper + prefix : G.N2 -> G.ListNP -> G.NP = \n2,nps -> + mkNP defSgDet (mkCN n2 (mkNP and_Conj nps)) ; + +} diff --git a/old-examples/tutorial/semantics/BaseIEng.gf b/old-examples/tutorial/semantics/BaseIEng.gf new file mode 100644 index 000000000..a73bd44c6 --- /dev/null +++ b/old-examples/tutorial/semantics/BaseIEng.gf @@ -0,0 +1,8 @@ +--# -path=.:prelude:present:api:mathematical + +concrete BaseIEng of Base = BaseI with + (Syntax = SyntaxEng), + (Grammar = GrammarEng), + (G = GrammarEng), + (Symbolic = SymbolicEng), + (LexBase = LexBaseEng) ; diff --git a/old-examples/tutorial/semantics/BaseSwe.gf b/old-examples/tutorial/semantics/BaseSwe.gf new file mode 100644 index 000000000..6329c1c9c --- /dev/null +++ b/old-examples/tutorial/semantics/BaseSwe.gf @@ -0,0 +1,8 @@ +--# -path=.:prelude:present:api:mathematical + +concrete BaseSwe of Base = BaseI with + (Syntax = SyntaxSwe), + (Grammar = GrammarSwe), + (G = GrammarSwe), + (Symbolic = SymbolicSwe), + (LexBase = LexBaseSwe) ; diff --git a/old-examples/tutorial/semantics/Core.gf b/old-examples/tutorial/semantics/Core.gf new file mode 100644 index 000000000..975cf827f --- /dev/null +++ b/old-examples/tutorial/semantics/Core.gf @@ -0,0 +1,6 @@ +abstract Core = { + + cat + + +} diff --git a/old-examples/tutorial/semantics/GSyntax.hs b/old-examples/tutorial/semantics/GSyntax.hs new file mode 100644 index 000000000..6c67e40aa --- /dev/null +++ b/old-examples/tutorial/semantics/GSyntax.hs @@ -0,0 +1,242 @@ +module GSyntax where + +import GF.GFCC.DataGFCC +import GF.GFCC.AbsGFCC +---------------------------------------------------- +-- automatic translation from GF to Haskell +---------------------------------------------------- + +class Gf a where gf :: a -> Exp +class Fg a where fg :: Exp -> a + +newtype GString = GString String deriving Show + +instance Gf GString where + gf (GString s) = DTr [] (AS s) [] + +instance Fg GString where + fg t = + case t of + DTr [] (AS s) [] -> GString s + _ -> error ("no GString " ++ show t) + +newtype GInt = GInt Integer deriving Show + +instance Gf GInt where + gf (GInt s) = DTr [] (AI s) [] + +instance Fg GInt where + fg t = + case t of + DTr [] (AI s) [] -> GInt s + _ -> error ("no GInt " ++ show t) + +newtype GFloat = GFloat Double deriving Show + +instance Gf GFloat where + gf (GFloat s) = DTr [] (AF s) [] + +instance Fg GFloat where + fg t = + case t of + DTr [] (AF s) [] -> GFloat s + _ -> error ("no GFloat " ++ show t) + +---------------------------------------------------- +-- below this line machine-generated +---------------------------------------------------- + +data GA2 = + GDivisible + | GEqual + | GGreater + | GSmaller + deriving Show + +data GAP = + GComplA2 GA2 GNP + | GConjAP GConj GAP GAP + | GEven + | GOdd + | GPrime + deriving Show + +data GAnswer = + GNo + | GValue GNP + | GYes + deriving Show + +data GCN = + GModCN GAP GCN + | GNumber + deriving Show + +data GConj = + GAnd + | GOr + deriving Show + +newtype GListPN = GListPN [GPN] deriving Show + +data GNP = + GConjNP GConj GNP GNP + | GEvery GCN + | GMany GListPN + | GNone + | GSome GCN + | GUsePN GPN + deriving Show + +data GPN = + GGCD GListPN + | GProduct GListPN + | GSum GListPN + | GUseInt GInt + deriving Show + +data GQuestion = + GQuestS GS + | GWhatIs GPN + | GWhichAre GCN GAP + deriving Show + +data GS = GPredAP GNP GAP + deriving Show + + +instance Gf GA2 where + gf GDivisible = DTr [] (AC (CId "Divisible")) [] + gf GEqual = DTr [] (AC (CId "Equal")) [] + gf GGreater = DTr [] (AC (CId "Greater")) [] + gf GSmaller = DTr [] (AC (CId "Smaller")) [] + +instance Gf GAP where + gf (GComplA2 x1 x2) = DTr [] (AC (CId "ComplA2")) [gf x1, gf x2] + gf (GConjAP x1 x2 x3) = DTr [] (AC (CId "ConjAP")) [gf x1, gf x2, gf x3] + gf GEven = DTr [] (AC (CId "Even")) [] + gf GOdd = DTr [] (AC (CId "Odd")) [] + gf GPrime = DTr [] (AC (CId "Prime")) [] + +instance Gf GAnswer where + gf GNo = DTr [] (AC (CId "No")) [] + gf (GValue x1) = DTr [] (AC (CId "Value")) [gf x1] + gf GYes = DTr [] (AC (CId "Yes")) [] + +instance Gf GCN where + gf (GModCN x1 x2) = DTr [] (AC (CId "ModCN")) [gf x1, gf x2] + gf GNumber = DTr [] (AC (CId "Number")) [] + +instance Gf GConj where + gf GAnd = DTr [] (AC (CId "And")) [] + gf GOr = DTr [] (AC (CId "Or")) [] + +instance Gf GListPN where + gf (GListPN [x1,x2]) = DTr [] (AC (CId "BasePN")) [gf x1, gf x2] + gf (GListPN (x:xs)) = DTr [] (AC (CId "ConsPN")) [gf x, gf (GListPN xs)] + +instance Gf GNP where + gf (GConjNP x1 x2 x3) = DTr [] (AC (CId "ConjNP")) [gf x1, gf x2, gf x3] + gf (GEvery x1) = DTr [] (AC (CId "Every")) [gf x1] + gf (GMany x1) = DTr [] (AC (CId "Many")) [gf x1] + gf GNone = DTr [] (AC (CId "None")) [] + gf (GSome x1) = DTr [] (AC (CId "Some")) [gf x1] + gf (GUsePN x1) = DTr [] (AC (CId "UsePN")) [gf x1] + +instance Gf GPN where + gf (GGCD x1) = DTr [] (AC (CId "GCD")) [gf x1] + gf (GProduct x1) = DTr [] (AC (CId "Product")) [gf x1] + gf (GSum x1) = DTr [] (AC (CId "Sum")) [gf x1] + gf (GUseInt x1) = DTr [] (AC (CId "UseInt")) [gf x1] + +instance Gf GQuestion where + gf (GQuestS x1) = DTr [] (AC (CId "QuestS")) [gf x1] + gf (GWhatIs x1) = DTr [] (AC (CId "WhatIs")) [gf x1] + gf (GWhichAre x1 x2) = DTr [] (AC (CId "WhichAre")) [gf x1, gf x2] + +instance Gf GS where gf (GPredAP x1 x2) = DTr [] (AC (CId "PredAP")) [gf x1, gf x2] + + +instance Fg GA2 where + fg t = + case t of + DTr [] (AC (CId "Divisible")) [] -> GDivisible + DTr [] (AC (CId "Equal")) [] -> GEqual + DTr [] (AC (CId "Greater")) [] -> GGreater + DTr [] (AC (CId "Smaller")) [] -> GSmaller + _ -> error ("no A2 " ++ show t) + +instance Fg GAP where + fg t = + case t of + DTr [] (AC (CId "ComplA2")) [x1,x2] -> GComplA2 (fg x1) (fg x2) + DTr [] (AC (CId "ConjAP")) [x1,x2,x3] -> GConjAP (fg x1) (fg x2) (fg x3) + DTr [] (AC (CId "Even")) [] -> GEven + DTr [] (AC (CId "Odd")) [] -> GOdd + DTr [] (AC (CId "Prime")) [] -> GPrime + _ -> error ("no AP " ++ show t) + +instance Fg GAnswer where + fg t = + case t of + DTr [] (AC (CId "No")) [] -> GNo + DTr [] (AC (CId "Value")) [x1] -> GValue (fg x1) + DTr [] (AC (CId "Yes")) [] -> GYes + _ -> error ("no Answer " ++ show t) + +instance Fg GCN where + fg t = + case t of + DTr [] (AC (CId "ModCN")) [x1,x2] -> GModCN (fg x1) (fg x2) + DTr [] (AC (CId "Number")) [] -> GNumber + _ -> error ("no CN " ++ show t) + +instance Fg GConj where + fg t = + case t of + DTr [] (AC (CId "And")) [] -> GAnd + DTr [] (AC (CId "Or")) [] -> GOr + _ -> error ("no Conj " ++ show t) + +instance Fg GListPN where + fg t = + case t of + DTr [] (AC (CId "BasePN")) [x1,x2] -> GListPN [fg x1, fg x2] + DTr [] (AC (CId "ConsPN")) [x1,x2] -> let GListPN xs = fg x2 in GListPN (fg x1:xs) + _ -> error ("no ListPN " ++ show t) + +instance Fg GNP where + fg t = + case t of + DTr [] (AC (CId "ConjNP")) [x1,x2,x3] -> GConjNP (fg x1) (fg x2) (fg x3) + DTr [] (AC (CId "Every")) [x1] -> GEvery (fg x1) + DTr [] (AC (CId "Many")) [x1] -> GMany (fg x1) + DTr [] (AC (CId "None")) [] -> GNone + DTr [] (AC (CId "Some")) [x1] -> GSome (fg x1) + DTr [] (AC (CId "UsePN")) [x1] -> GUsePN (fg x1) + _ -> error ("no NP " ++ show t) + +instance Fg GPN where + fg t = + case t of + DTr [] (AC (CId "GCD")) [x1] -> GGCD (fg x1) + DTr [] (AC (CId "Product")) [x1] -> GProduct (fg x1) + DTr [] (AC (CId "Sum")) [x1] -> GSum (fg x1) + DTr [] (AC (CId "UseInt")) [x1] -> GUseInt (fg x1) + _ -> error ("no PN " ++ show t) + +instance Fg GQuestion where + fg t = + case t of + DTr [] (AC (CId "QuestS")) [x1] -> GQuestS (fg x1) + DTr [] (AC (CId "WhatIs")) [x1] -> GWhatIs (fg x1) + DTr [] (AC (CId "WhichAre")) [x1,x2] -> GWhichAre (fg x1) (fg x2) + _ -> error ("no Question " ++ show t) + +instance Fg GS where + fg t = + case t of + DTr [] (AC (CId "PredAP")) [x1,x2] -> GPredAP (fg x1) (fg x2) + _ -> error ("no S " ++ show t) + + diff --git a/old-examples/tutorial/semantics/LexBase.gf b/old-examples/tutorial/semantics/LexBase.gf new file mode 100644 index 000000000..83713a35f --- /dev/null +++ b/old-examples/tutorial/semantics/LexBase.gf @@ -0,0 +1,19 @@ +interface LexBase = open Syntax in { + +oper + even_A : A ; + odd_A : A ; + prime_A : A ; + common_A : A ; + great_A : A ; + equal_A2 : A2 ; + greater_A2 : A2 ; + smaller_A2 : A2 ; + divisible_A2 : A2 ; + number_N : N ; + sum_N2 : N2 ; + product_N2 : N2 ; + divisor_N2 : N2 ; + + none_NP : NP ; --- +} diff --git a/old-examples/tutorial/semantics/LexBaseEng.gf b/old-examples/tutorial/semantics/LexBaseEng.gf new file mode 100644 index 000000000..aea3a838b --- /dev/null +++ b/old-examples/tutorial/semantics/LexBaseEng.gf @@ -0,0 +1,20 @@ +instance LexBaseEng of LexBase = open SyntaxEng, ParadigmsEng in { + +oper + even_A = mkA "even" ; + odd_A = mkA "odd" ; + prime_A = mkA "prime" ; + great_A = mkA "great" ; + common_A = mkA "common" ; + equal_A2 = mkA2 (mkA "equal") (mkPrep "to") ; + greater_A2 = mkA2 (mkA "greater") (mkPrep "than") ; --- + smaller_A2 = mkA2 (mkA "smaller") (mkPrep "than") ; --- + divisible_A2 = mkA2 (mkA "divisible") (mkPrep "by") ; + number_N = mkN "number" ; + sum_N2 = mkN2 (mkN "sum") (mkPrep "of") ; + product_N2 = mkN2 (mkN "product") (mkPrep "of") ; + divisor_N2 = mkN2 (mkN "divisor") (mkPrep "of") ; + + none_NP = mkNP (mkPN "none") ; --- + +} diff --git a/old-examples/tutorial/semantics/LexBaseSwe.gf b/old-examples/tutorial/semantics/LexBaseSwe.gf new file mode 100644 index 000000000..6ac1904aa --- /dev/null +++ b/old-examples/tutorial/semantics/LexBaseSwe.gf @@ -0,0 +1,22 @@ +instance LexBaseSwe of LexBase = open SyntaxSwe, ParadigmsSwe in { + +oper + even_A = mkA "jämn" ; + odd_A = invarA "udda" ; + prime_A = mkA "prim" ; + great_A = mkA "stor" "större" "störst" ; + common_A = mkA "gemensam" ; + equal_A2 = mkA2 (invarA "lika") (mkPrep "med") ; + greater_A2 = mkA2 (invarA "större") (mkPrep "än") ; --- + smaller_A2 = mkA2 (invarA "mindre") (mkPrep "än") ; --- + divisible_A2 = mkA2 (mkA "delbar") (mkPrep "med") ; + number_N = mkN "tal" "tal" ; + sum_N2 = mkN2 (mkN "summa") (mkPrep "av") ; + product_N2 = mkN2 (mkN "produkt") (mkPrep "av") ; + divisor_N2 = mkN2 (mkN "delare") (mkPrep "av") ; + + none_NP = mkNP (mkPN "inget" neutrum) ; --- + + invarA : Str -> A = \x -> mkA x x x x x ; --- + +} diff --git a/old-examples/tutorial/semantics/Logic.hs b/old-examples/tutorial/semantics/Logic.hs new file mode 100644 index 000000000..b5c615da5 --- /dev/null +++ b/old-examples/tutorial/semantics/Logic.hs @@ -0,0 +1,101 @@ +module Logic where + +data Prop = + Pred Ident [Exp] + | And Prop Prop + | Or Prop Prop + | If Prop Prop + | Not Prop + | All Prop + | Exist Prop + deriving Show + +data Exp = + App Ident [Exp] + | Var Int -- de Bruijn index + deriving Show + +type Ident = String + +data Model a = Model { + app :: Ident -> [a] -> a, + prd :: Ident -> [a] -> Bool, + dom :: [a] + } + +type Assignment a = [a] + +update :: a -> Assignment a -> Assignment a +update x assign = x : assign + +look :: Int -> Assignment a -> a +look i assign = assign !! i + +valExp :: Model a -> Assignment a -> Exp -> a +valExp model assign exp = case exp of + App f xs -> app model f (map (valExp model assign) xs) + Var i -> look i assign + +valProp :: Model a -> Assignment a -> Prop -> Bool +valProp model assign prop = case prop of + Pred f xs -> prd model f (map (valExp model assign) xs) + And a b -> v a && v b + Or a b -> v a || v b + If a b -> if v a then v b else True + Not a -> not (v a) + All p -> all (\x -> valProp model (update x assign) p) (dom model) + Exist p -> any (\x -> valProp model (update x assign) p) (dom model) + where + v = valProp model assign + +liftProp :: Int -> Prop -> Prop +liftProp i p = case p of + Pred f xs -> Pred f (map liftExp xs) + And a b -> And (lift a) (lift b) + Or a b -> Or (lift a) (lift b) + If a b -> If (lift a) (lift b) + Not a -> Not (lift a) + All p -> All (liftProp (i+1) p) + Exist p -> Exist (liftProp (i+1) p) + where + lift = liftProp i + liftExp e = case e of + App f xs -> App f (map liftExp xs) + Var j -> Var (j + i) + _ -> e + + +-- example: initial segments of integers + +intModel :: Int -> Model Int +intModel mx = Model { + app = \f xs -> case (f,xs) of + ("+",_) -> sum xs + (_,[]) -> read f, + prd = \f xs -> case (f,xs) of + ("E",[x]) -> even x + ("<",[x,y]) -> x < y + ("=",[x,y]) -> x == y + _ -> error "undefined val", + dom = [0 .. mx] + } + +exModel = intModel 100 + +ev x = Pred "E" [x] +lt x y = Pred "<" [x,y] +eq x y = Pred "=" [x,y] +int i = App (show i) [] + +ex1 :: Prop +ex1 = Exist (ev (Var 0)) + +ex2 :: Prop +ex2 = All (Exist (lt (Var 1) (Var 0))) + +ex3 :: Prop +ex3 = All (If (lt (Var 0) (int 100)) (Exist (lt (Var 1) (Var 0)))) + +ex4 :: Prop +ex4 = All (All (If (lt (Var 1) (Var 0)) (Not (lt (Var 0) (Var 1))))) + diff --git a/old-examples/tutorial/semantics/SemBase.hs b/old-examples/tutorial/semantics/SemBase.hs new file mode 100644 index 000000000..24073894b --- /dev/null +++ b/old-examples/tutorial/semantics/SemBase.hs @@ -0,0 +1,43 @@ +module SemBase where + +import GSyntax +import Logic + +-- translation of Base syntax to Logic + +iS :: GS -> Prop +iS s = case s of + GPredAP np ap -> iNP np (iAP ap) + GConjS c s t -> iConj c (iS s) (iS t) + +iNP :: GNP -> (Exp -> Prop) -> Prop +iNP np p = case np of + GEvery cn -> All (If (iCN cn var) (liftProp 0 (p var))) ---- + GSome cn -> Exist (And (iCN cn var) (p var)) ---- + GConjNP c np1 np2 -> iConj c (iNP np1 p) (iNP np2 p) + GUseInt (GInt i) -> p (int i) + +iAP :: GAP -> Exp -> Prop +iAP ap e = case ap of + GComplA2 a2 np -> iNP np (iA2 a2 e) + GConjAP c ap1 ap2 -> iConj c (iAP ap1 e) (iAP ap2 e) + GEven -> ev e + GOdd -> Not (ev e) + +iCN :: GCN -> Exp -> Prop +iCN cn e = case cn of + GModCN ap cn0 -> And (iCN cn0 e) (iAP ap e) + GNumber -> eq e e + +iConj :: GConj -> Prop -> Prop -> Prop +iConj c = case c of + GAnd -> And + GOr -> Or + +iA2 :: GA2 -> Exp -> Exp -> Prop +iA2 a2 e1 e2 = case a2 of + GGreater -> lt e2 e1 + GSmaller -> lt e1 e2 + GEqual -> eq e1 e2 + +var = Var 0 diff --git a/old-examples/tutorial/semantics/Top.hs b/old-examples/tutorial/semantics/Top.hs new file mode 100644 index 000000000..6027b238c --- /dev/null +++ b/old-examples/tutorial/semantics/Top.hs @@ -0,0 +1,23 @@ +module Main where + +import GSyntax +import SemBase +import Logic +import GF.GFCC.API + +main :: IO () +main = do + gr <- file2grammar "base.gfcc" + loop gr + +loop :: MultiGrammar -> IO () +loop gr = do + s <- getLine + let t:_ = parse gr "BaseEng" "S" s + putStrLn $ showTree t + let p = iS $ fg t + putStrLn $ show p + let v = valProp exModel [] p + putStrLn $ show v + loop gr + diff --git a/old-examples/tutorial/smart/House.gf b/old-examples/tutorial/smart/House.gf new file mode 100644 index 000000000..e156792f1 --- /dev/null +++ b/old-examples/tutorial/smart/House.gf @@ -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 ; + + +} + diff --git a/old-examples/tutorial/smart/HouseEng.gf b/old-examples/tutorial/smart/HouseEng.gf new file mode 100644 index 000000000..d36122c51 --- /dev/null +++ b/old-examples/tutorial/smart/HouseEng.gf @@ -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" + } ; + + +} + diff --git a/old-examples/tutorial/smart/LexSmart.gf b/old-examples/tutorial/smart/LexSmart.gf new file mode 100644 index 000000000..0bbe7aa7c --- /dev/null +++ b/old-examples/tutorial/smart/LexSmart.gf @@ -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 ; + +} diff --git a/old-examples/tutorial/smart/LexSmartSwe.gf b/old-examples/tutorial/smart/LexSmartSwe.gf new file mode 100644 index 000000000..6a9ea38ef --- /dev/null +++ b/old-examples/tutorial/smart/LexSmartSwe.gf @@ -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" ; + +} diff --git a/old-examples/tutorial/smart/Smart.gf b/old-examples/tutorial/smart/Smart.gf new file mode 100644 index 000000000..f88b40f12 --- /dev/null +++ b/old-examples/tutorial/smart/Smart.gf @@ -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) ; + +} + diff --git a/old-examples/tutorial/smart/SmartEng.gf b/old-examples/tutorial/smart/SmartEng.gf new file mode 100644 index 000000000..384e50060 --- /dev/null +++ b/old-examples/tutorial/smart/SmartEng.gf @@ -0,0 +1,84 @@ +--# -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 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 ; + +} + diff --git a/old-examples/tutorial/smart/SmartFre.gf b/old-examples/tutorial/smart/SmartFre.gf new file mode 100644 index 000000000..c5d903519 --- /dev/null +++ b/old-examples/tutorial/smart/SmartFre.gf @@ -0,0 +1,95 @@ +--# -path=.:prelude + +concrete Toy1Fre of Toy1 = 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 [] ; + +} + diff --git a/old-examples/tutorial/smart/SmartI.gf b/old-examples/tutorial/smart/SmartI.gf new file mode 100644 index 000000000..2b46ba0fe --- /dev/null +++ b/old-examples/tutorial/smart/SmartI.gf @@ -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 [] ; + + +} diff --git a/old-examples/tutorial/smart/SmartSwe.gf b/old-examples/tutorial/smart/SmartSwe.gf new file mode 100644 index 000000000..a537639d6 --- /dev/null +++ b/old-examples/tutorial/smart/SmartSwe.gf @@ -0,0 +1,5 @@ +--# -path=.:alltenses:prelude + +concrete SmartSwe of Smart = SmartI with + (Syntax = SyntaxSwe), + (LexSmart = LexSmartSwe) ; diff --git a/old-examples/tutorial/syntax/FoodsEng.gf b/old-examples/tutorial/syntax/FoodsEng.gf new file mode 100644 index 000000000..fb8c44610 --- /dev/null +++ b/old-examples/tutorial/syntax/FoodsEng.gf @@ -0,0 +1,5 @@ +--# -path=.:../foods:prelude + +concrete FoodsEng of Foods = FoodsI with + (Syntax = SyntaxEng), + (Test = TestEng) ; diff --git a/old-examples/tutorial/syntax/FoodsI.gf b/old-examples/tutorial/syntax/FoodsI.gf new file mode 100644 index 000000000..d67302235 --- /dev/null +++ b/old-examples/tutorial/syntax/FoodsI.gf @@ -0,0 +1,26 @@ +incomplete concrete FoodsI of Foods = open Syntax, Test in { + lincat + Phrase = S ; + Item = NP ; + Kind = CN ; + Quality = AP ; + lin + Is = mkS ; + This = mkNP this_Det ; + That = mkNP that_Det ; + These = mkNP these_Det ; + Those = mkNP those_Det ; + QKind = mkCN ; + Very = mkAP very_AdA ; + + 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 ; +} diff --git a/old-examples/tutorial/syntax/FoodsIta.gf b/old-examples/tutorial/syntax/FoodsIta.gf new file mode 100644 index 000000000..57beab918 --- /dev/null +++ b/old-examples/tutorial/syntax/FoodsIta.gf @@ -0,0 +1,5 @@ +--# -path=.:../foods:prelude + +concrete FoodsIta of Foods = FoodsI with + (Syntax = SyntaxIta), + (Test = TestIta) ; diff --git a/old-examples/tutorial/syntax/Grammar.gf b/old-examples/tutorial/syntax/Grammar.gf new file mode 100644 index 000000000..c48e89a21 --- /dev/null +++ b/old-examples/tutorial/syntax/Grammar.gf @@ -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 ; + +} diff --git a/old-examples/tutorial/syntax/GrammarEng.gf b/old-examples/tutorial/syntax/GrammarEng.gf new file mode 100644 index 000000000..4b4c53a73 --- /dev/null +++ b/old-examples/tutorial/syntax/GrammarEng.gf @@ -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"}} ; + +} diff --git a/old-examples/tutorial/syntax/GrammarIta.gf b/old-examples/tutorial/syntax/GrammarIta.gf new file mode 100644 index 000000000..04b112ed9 --- /dev/null +++ b/old-examples/tutorial/syntax/GrammarIta.gf @@ -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"} ; + + +} diff --git a/old-examples/tutorial/syntax/MorphoEng.gf b/old-examples/tutorial/syntax/MorphoEng.gf new file mode 100644 index 000000000..b2255d0d4 --- /dev/null +++ b/old-examples/tutorial/syntax/MorphoEng.gf @@ -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 ; + } diff --git a/old-examples/tutorial/syntax/MorphoIta.gf b/old-examples/tutorial/syntax/MorphoIta.gf new file mode 100644 index 000000000..7bf4de1a1 --- /dev/null +++ b/old-examples/tutorial/syntax/MorphoIta.gf @@ -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 + } ; + + } diff --git a/old-examples/tutorial/syntax/Syntax.gf b/old-examples/tutorial/syntax/Syntax.gf new file mode 100644 index 000000000..31f3fc127 --- /dev/null +++ b/old-examples/tutorial/syntax/Syntax.gf @@ -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 + = PredVP ; + mkS : NP -> VP -> S + = PredVP PPos ; + mkS : Pol -> NP -> V2 -> NP -> S + = \p,np,v,o -> PredVP p np (ComplV2 v o) ; + mkS : NP -> V2 -> NP -> S + = \np,v,o -> PredVP PPos np (ComplV2 v o) ; + mkS : Pol -> NP -> AP -> S + = \p,np,ap -> PredVP p np (ComplAP ap) ; + mkS : NP -> AP -> S + = \np,ap -> PredVP PPos 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 ; + } ; + +} diff --git a/old-examples/tutorial/syntax/SyntaxEng.gf b/old-examples/tutorial/syntax/SyntaxEng.gf new file mode 100644 index 000000000..72e3d599a --- /dev/null +++ b/old-examples/tutorial/syntax/SyntaxEng.gf @@ -0,0 +1,3 @@ +--# -path=.:resource:prelude + +instance SyntaxEng of Syntax = open Prelude, GrammarEng in {} ; diff --git a/old-examples/tutorial/syntax/SyntaxIta.gf b/old-examples/tutorial/syntax/SyntaxIta.gf new file mode 100644 index 000000000..76e231a8e --- /dev/null +++ b/old-examples/tutorial/syntax/SyntaxIta.gf @@ -0,0 +1,3 @@ +--# -path=.:resource:prelude + +instance SyntaxIta of Syntax = open Prelude, GrammarIta in {} ; diff --git a/old-examples/tutorial/syntax/Test.gf b/old-examples/tutorial/syntax/Test.gf new file mode 100644 index 000000000..3284d5246 --- /dev/null +++ b/old-examples/tutorial/syntax/Test.gf @@ -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 ; +} diff --git a/old-examples/tutorial/syntax/TestEng.gf b/old-examples/tutorial/syntax/TestEng.gf new file mode 100644 index 000000000..32491c000 --- /dev/null +++ b/old-examples/tutorial/syntax/TestEng.gf @@ -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" ; +} + diff --git a/old-examples/tutorial/syntax/TestIta.gf b/old-examples/tutorial/syntax/TestIta.gf new file mode 100644 index 000000000..5e05cdcab --- /dev/null +++ b/old-examples/tutorial/syntax/TestIta.gf @@ -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"} ; +} + |