summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile/PGFtoAbstract.hs
blob: 032a53f81579c4c0abace4a15efec0f7c1b674d4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
-- | Extract the abstract syntax from a PGF and convert to it
-- the AST for canonical GF grammars
module GF.Compile.PGFtoAbstract(abstract2canonical) where
import qualified Data.Map as M
import PGF(CId,mkCId,showCId,wildCId,unType,abstractName)
import PGF.Internal(abstract,cats,funs)
import GF.Grammar.Canonical


abstract2canonical pgf = Abstract (gId (abstractName pgf)) cs fs
  where
    abstr = abstract pgf
    cs = [CatDef (gId c) (convHs' hs) |
            (c,(hs,_,_)) <- M.toList (cats abstr),
            c `notElem` predefCat]
    fs = [FunDef (gId f) (convT ty) | (f,(ty,ar,_,_)) <- M.toList (funs abstr)]

predefCat = map mkCId ["Float","Int","String"]

convHs' = map convH'
convH' (bt,name,ty) =
  case unType ty of
    ([],name,[]) -> gId name -- !!

convT t =
  case unType t of
    (hypos,name,[]) -> Type (convHs hypos) (TypeApp (gId name) []) -- !!

convHs = map convH

convH (bt,name,ty) = TypeBinding (gId name) (convT ty)

--------------------------------------------------------------------------------

class FromCId i where gId :: CId -> i

instance FromCId FunId where gId = FunId . showCId
instance FromCId CatId where gId = CatId . showCId
instance FromCId ModId where gId = ModId . showCId

instance FromCId VarId where
  gId i = if i==wildCId then Anonymous else VarId (showCId i)