summaryrefslogtreecommitdiff
path: root/old-examples/tutorial/semantics
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-27 09:18:50 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-27 09:18:50 +0000
commit5c713d8f027a9b6be687ee3f7e917e8bd2115773 (patch)
tree65da19829810b753345a5b2164bef2d8876268dd /old-examples/tutorial/semantics
parentf7b2a83059697f1b36a6369e489ac276e7ff875d (diff)
took away old-examples
Diffstat (limited to 'old-examples/tutorial/semantics')
-rw-r--r--old-examples/tutorial/semantics/Answer.hs21
-rw-r--r--old-examples/tutorial/semantics/AnswerBase.hs90
-rw-r--r--old-examples/tutorial/semantics/Base.gf60
-rw-r--r--old-examples/tutorial/semantics/BaseEng.gf56
-rw-r--r--old-examples/tutorial/semantics/BaseI.gf70
-rw-r--r--old-examples/tutorial/semantics/BaseIEng.gf8
-rw-r--r--old-examples/tutorial/semantics/BaseSwe.gf8
-rw-r--r--old-examples/tutorial/semantics/Core.gf6
-rw-r--r--old-examples/tutorial/semantics/GSyntax.hs242
-rw-r--r--old-examples/tutorial/semantics/LexBase.gf19
-rw-r--r--old-examples/tutorial/semantics/LexBaseEng.gf20
-rw-r--r--old-examples/tutorial/semantics/LexBaseSwe.gf22
-rw-r--r--old-examples/tutorial/semantics/Logic.hs101
-rw-r--r--old-examples/tutorial/semantics/SemBase.hs43
-rw-r--r--old-examples/tutorial/semantics/Top.hs23
15 files changed, 0 insertions, 789 deletions
diff --git a/old-examples/tutorial/semantics/Answer.hs b/old-examples/tutorial/semantics/Answer.hs
deleted file mode 100644
index 08a76c5f1..000000000
--- a/old-examples/tutorial/semantics/Answer.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-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
deleted file mode 100644
index 56e2b5451..000000000
--- a/old-examples/tutorial/semantics/AnswerBase.hs
+++ /dev/null
@@ -1,90 +0,0 @@
-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
deleted file mode 100644
index 4586c3106..000000000
--- a/old-examples/tutorial/semantics/Base.gf
+++ /dev/null
@@ -1,60 +0,0 @@
--- 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
deleted file mode 100644
index bd79bc98c..000000000
--- a/old-examples/tutorial/semantics/BaseEng.gf
+++ /dev/null
@@ -1,56 +0,0 @@
---# -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
deleted file mode 100644
index ec967e443..000000000
--- a/old-examples/tutorial/semantics/BaseI.gf
+++ /dev/null
@@ -1,70 +0,0 @@
-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
deleted file mode 100644
index a73bd44c6..000000000
--- a/old-examples/tutorial/semantics/BaseIEng.gf
+++ /dev/null
@@ -1,8 +0,0 @@
---# -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
deleted file mode 100644
index 6329c1c9c..000000000
--- a/old-examples/tutorial/semantics/BaseSwe.gf
+++ /dev/null
@@ -1,8 +0,0 @@
---# -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
deleted file mode 100644
index 975cf827f..000000000
--- a/old-examples/tutorial/semantics/Core.gf
+++ /dev/null
@@ -1,6 +0,0 @@
-abstract Core = {
-
- cat
-
-
-}
diff --git a/old-examples/tutorial/semantics/GSyntax.hs b/old-examples/tutorial/semantics/GSyntax.hs
deleted file mode 100644
index 6c67e40aa..000000000
--- a/old-examples/tutorial/semantics/GSyntax.hs
+++ /dev/null
@@ -1,242 +0,0 @@
-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
deleted file mode 100644
index 83713a35f..000000000
--- a/old-examples/tutorial/semantics/LexBase.gf
+++ /dev/null
@@ -1,19 +0,0 @@
-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
deleted file mode 100644
index aea3a838b..000000000
--- a/old-examples/tutorial/semantics/LexBaseEng.gf
+++ /dev/null
@@ -1,20 +0,0 @@
-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
deleted file mode 100644
index 6ac1904aa..000000000
--- a/old-examples/tutorial/semantics/LexBaseSwe.gf
+++ /dev/null
@@ -1,22 +0,0 @@
-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
deleted file mode 100644
index b5c615da5..000000000
--- a/old-examples/tutorial/semantics/Logic.hs
+++ /dev/null
@@ -1,101 +0,0 @@
-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
deleted file mode 100644
index 24073894b..000000000
--- a/old-examples/tutorial/semantics/SemBase.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-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
deleted file mode 100644
index 6027b238c..000000000
--- a/old-examples/tutorial/semantics/Top.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-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
-