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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
----------------------------------------------------------------------
-- |
-- Module : Values
-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/21 16:22:32 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.7 $
--
-- (Description of the module)
-----------------------------------------------------------------------------
module GF.Grammar.Values (-- * values used in TC type checking
Exp, Val(..), Env,
-- * annotated tree used in editing
Tree, TrNode(..), Atom(..), Binds, Constraints, MetaSubst,
-- * for TC
valAbsInt, valAbsFloat, valAbsString, vType,
isPredefCat,
cType, cPredefAbs, cInt, cFloat, cString,
eType, tree2exp, loc2treeFocus
) where
import GF.Data.Operations
import GF.Data.Zipper
import GF.Grammar.Grammar
import GF.Infra.Ident
-- values used in TC type checking
type Exp = Term
data Val = VGen Int Ident | VApp Val Val | VCn QIdent | VType | VClos Env Exp
deriving (Eq,Show)
type Env = [(Ident,Val)]
-- annotated tree used in editing
type Tree = Tr TrNode
newtype TrNode = N (Binds,Atom,Val,(Constraints,MetaSubst),Bool)
deriving (Eq,Show)
data Atom =
AtC Fun | AtM MetaSymb | AtV Ident | AtL String | AtI Integer | AtF Double
deriving (Eq,Show)
type Binds = [(Ident,Val)]
type Constraints = [(Val,Val)]
type MetaSubst = [(MetaSymb,Val)]
-- for TC
valAbsInt :: Val
valAbsInt = VCn (cPredefAbs, cInt)
valAbsFloat :: Val
valAbsFloat = VCn (cPredefAbs, cFloat)
valAbsString :: Val
valAbsString = VCn (cPredefAbs, cString)
vType :: Val
vType = VType
cType :: Ident
cType = identC "Type" --- #0
cPredefAbs :: Ident
cPredefAbs = identC "PredefAbs"
cInt :: Ident
cInt = identC "Int"
cFloat :: Ident
cFloat = identC "Float"
cString :: Ident
cString = identC "String"
isPredefCat :: Ident -> Bool
isPredefCat c = elem c [cInt,cString,cFloat]
eType :: Exp
eType = Sort "Type"
tree2exp :: Tree -> Exp
tree2exp (Tr (N (bi,at,_,_,_),ts)) = foldr Abs (foldl App at' ts') bi' where
at' = case at of
AtC (m,c) -> Q m c
AtV i -> Vr i
AtM m -> Meta m
AtL s -> K s
AtI s -> EInt s
AtF s -> EFloat s
bi' = map fst bi
ts' = map tree2exp ts
loc2treeFocus :: Loc TrNode -> Tree
loc2treeFocus (Loc (Tr (a,ts),p)) =
loc2tree (Loc (Tr (mark a, map (mapTr nomark) ts), mapPath nomark p))
where
(mark, nomark) = (\(N (a,b,c,d,_)) -> N(a,b,c,d,True),
\(N (a,b,c,d,_)) -> N(a,b,c,d,False))
|
