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
|
module Values where
import Operations
import Zipper
import Grammar
import 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 Int
deriving (Eq,Show)
type Binds = [(Ident,Val)]
type Constraints = [(Val,Val)]
type MetaSubst = [(MetaSymb,Val)]
-- for TC
valAbsInt, valAbsString :: Val
valAbsInt = VCn (cPredefAbs, cInt)
valAbsString = VCn (cPredefAbs, cString)
vType :: Val
vType = VType
cType,cPredefAbs,cInt,cString :: Ident
cType = identC "Type" --- #0
cPredefAbs = identC "PredefAbs"
cInt = identC "Int"
cString = identC "String"
isPredefCat c = elem c [cInt,cString]
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
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))
|
