mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 13:09:33 -06:00
243 lines
6.2 KiB
Haskell
243 lines
6.2 KiB
Haskell
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)
|
|
|
|
|