Lists in the PGF API

Conjunctions.gf

abstract Conjunctions = {
  cat
    S ; NP ; AP ; Conj ;
    [NP]{2} ;
    [AP]{2} ;

  fun
    Pred : NP -> AP -> S ; -- the pizza is Italian

    ConjNP : Conj -> [NP] -> NP ; -- pizza, beer and sandwich
    ConjAP : Conj -> [AP] -> AP ; -- Italian, cold and crispy

    pizza_NP, beer_NP, sandwich_NP : NP ;
    Italian_AP, cold_AP, crispy_AP : AP ;

    and_Conj : Conj ;
}

Conjunctions.hs

module Conjunctions where

import PGF hiding (Tree)

----------------------------------------------------
-- automatic translation from GF to Haskell
----------------------------------------------------

class Gf a where
  gf :: a -> Expr
  fg :: Expr -> a

newtype GString = GString String deriving Show

instance Gf GString where
  gf (GString x) = mkStr x
  fg t =
    case unStr t of
      Just x  ->  GString x
      Nothing -> error ("no GString " ++ show t)

newtype GInt = GInt Int deriving Show

instance Gf GInt where
  gf (GInt x) = mkInt x
  fg t =
    case unInt t of
      Just x  ->  GInt x
      Nothing -> error ("no GInt " ++ show t)

newtype GFloat = GFloat Double deriving Show

instance Gf GFloat where
  gf (GFloat x) = mkFloat x
  fg t =
    case unFloat t of
      Just x  ->  GFloat x
      Nothing -> error ("no GFloat " ++ show t)

----------------------------------------------------
-- below this line machine-generated
----------------------------------------------------

data GAP =
   GConjAP GConj GListAP 
 | GItalian_AP 
 | Gcold_AP 
 | Gcrispy_AP 
  deriving Show

data GConj = Gand_Conj 
  deriving Show

-- The list categories are represented as real Haskell lists
newtype GListAP = GListAP [GAP] deriving Show

newtype GListNP = GListNP [GNP] deriving Show

data GNP =
   GConjNP GConj GListNP 
 | Gbeer_NP 
 | Gpizza_NP 
 | Gsandwich_NP 
  deriving Show

data GS = GPred GNP GAP 
  deriving Show


instance Gf GAP where
  gf (GConjAP x1 x2) = mkApp (mkCId "ConjAP") [gf x1, gf x2]
  gf GItalian_AP = mkApp (mkCId "Italian_AP") []
  gf Gcold_AP = mkApp (mkCId "cold_AP") []
  gf Gcrispy_AP = mkApp (mkCId "crispy_AP") []

  fg t =
    case unApp t of
      Just (i,[x1,x2]) | i == mkCId "ConjAP" -> GConjAP (fg x1) (fg x2)
      Just (i,[]) | i == mkCId "Italian_AP" -> GItalian_AP 
      Just (i,[]) | i == mkCId "cold_AP" -> Gcold_AP 
      Just (i,[]) | i == mkCId "crispy_AP" -> Gcrispy_AP 


      _ -> error ("no AP " ++ show t)

instance Gf GConj where
  gf Gand_Conj = mkApp (mkCId "and_Conj") []

  fg t =
    case unApp t of
      Just (i,[]) | i == mkCId "and_Conj" -> Gand_Conj 


      _ -> error ("no Conj " ++ show t)

instance Gf GListAP where
  gf (GListAP [x1,x2]) = mkApp (mkCId "BaseAP") [gf x1, gf x2]
  gf (GListAP (x:xs)) = mkApp (mkCId "ConsAP") [gf x, gf (GListAP xs)]
  fg t =
    GListAP (fgs t) where
     fgs t = case unApp t of
      Just (i,[x1,x2]) | i == mkCId "BaseAP" -> [fg x1, fg x2]
      Just (i,[x1,x2]) | i == mkCId "ConsAP" -> fg x1 : fgs x2


      _ -> error ("no ListAP " ++ show t)

instance Gf GListNP where
  gf (GListNP [x1,x2]) = mkApp (mkCId "BaseNP") [gf x1, gf x2]
  gf (GListNP (x:xs)) = mkApp (mkCId "ConsNP") [gf x, gf (GListNP xs)]
  fg t =
    GListNP (fgs t) where
     fgs t = case unApp t of
      Just (i,[x1,x2]) | i == mkCId "BaseNP" -> [fg x1, fg x2]
      Just (i,[x1,x2]) | i == mkCId "ConsNP" -> fg x1 : fgs x2


      _ -> error ("no ListNP " ++ show t)

instance Gf GNP where
  gf (GConjNP x1 x2) = mkApp (mkCId "ConjNP") [gf x1, gf x2]
  gf Gbeer_NP = mkApp (mkCId "beer_NP") []
  gf Gpizza_NP = mkApp (mkCId "pizza_NP") []
  gf Gsandwich_NP = mkApp (mkCId "sandwich_NP") []

  fg t =
    case unApp t of
      Just (i,[x1,x2]) | i == mkCId "ConjNP" -> GConjNP (fg x1) (fg x2)
      Just (i,[]) | i == mkCId "beer_NP" -> Gbeer_NP 
      Just (i,[]) | i == mkCId "pizza_NP" -> Gpizza_NP 
      Just (i,[]) | i == mkCId "sandwich_NP" -> Gsandwich_NP 


      _ -> error ("no NP " ++ show t)

instance Gf GS where
  gf (GPred x1 x2) = mkApp (mkCId "Pred") [gf x1, gf x2]

  fg t =
    case unApp t of
      Just (i,[x1,x2]) | i == mkCId "Pred" -> GPred (fg x1) (fg x2)


      _ -> error ("no S " ++ show t)

ConjunctionsEng.gf

concrete ConjunctionsEng of Conjunctions = open SyntaxEng, ParadigmsEng in {
  lincat
    S = SyntaxEng.S ;
    NP = SyntaxEng.NP ;
    AP = SyntaxEng.AP ;
    Conj = SyntaxEng.Conj ;
    [NP] = SyntaxEng.ListNP ;
    [AP] = SyntaxEng.ListAP ;

  lin

    -- NP -> AP -> S ; -- the pizza is Italian
    Pred np ap = mkS (mkCl np ap) ;

    -- : Conj -> [NP] -> NP ; -- pizza, beer and sandwich
    ConjNP and nps = mkNP and nps ;
    -- : Conj -> [AP] -> AP ; -- Italian, cold and crispy
    ConjAP and aps = mkAP and aps ;

    pizza_NP = mkNP (mkN "pizza") ;
    beer_NP = mkNP (mkN "beer") ;
    sandwich_NP = mkNP (mkN "sandwich") ;

    Italian_AP = mkAP (mkA "Italian") ;
    cold_AP = mkAP (mkA "cold") ;
    crispy_AP = mkAP (mkA "crispy") ;

    and_Conj = SyntaxEng.and_Conj;

    BaseAP = SyntaxEng.mkListAP ;
    ConsAP = SyntaxEng.mkListAP ;
    BaseNP = SyntaxEng.mkListNP ;
    ConsNP = SyntaxEng.mkListNP ;

}