summaryrefslogtreecommitdiff
path: root/src/GF/Grammar/Values.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-25 16:54:35 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-25 16:54:35 +0000
commite9e80fc389365e24d4300d7d5390c7d833a96c50 (patch)
treef0b58473adaa670bd8fc52ada419d8cad470ee03 /src/GF/Grammar/Values.hs
parentb96b36f43de3e2f8b58d5f539daa6f6d47f25870 (diff)
changed names of resource-1.3; added a note on homepage on release
Diffstat (limited to 'src/GF/Grammar/Values.hs')
-rw-r--r--src/GF/Grammar/Values.hs91
1 files changed, 91 insertions, 0 deletions
diff --git a/src/GF/Grammar/Values.hs b/src/GF/Grammar/Values.hs
new file mode 100644
index 000000000..ab7d874da
--- /dev/null
+++ b/src/GF/Grammar/Values.hs
@@ -0,0 +1,91 @@
+----------------------------------------------------------------------
+-- |
+-- 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,
+ eType, tree2exp, loc2treeFocus
+ ) where
+
+import GF.Data.Operations
+import GF.Data.Zipper
+
+import GF.Infra.Ident
+import GF.Grammar.Grammar
+import GF.Grammar.Predef
+
+-- 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
+
+eType :: Exp
+eType = Sort cType
+
+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))
+