msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

judgements lindef are now respected by both the parser and the linearizer

Browse Source
This commit is contained in:
krasimir
2009-12-11 17:39:18 +00:00
parent 3353059277
commit 5804db9816
4 changed files with 50 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
src/PGF/Linearize.hs
View File

@@ -1,3 +1,4 @@
{-# LANGUAGE ParallelListComp #-}
module PGF.Linearize
(linearizes,realize,realizes,linTree, linTreeMark,linearizesMark) where
@@ -56,20 +57,26 @@ liftVariants = f
f t = return t
linTree :: PGF -> CId -> Expr -> Term
linTree pgf lang = lin . expr2tree
linTree pgf lang e = lin (expr2tree e) Nothing
where
lin (Abs xs e ) = case lin e of
R ts -> R $ ts ++ (Data.List.map (kks . showCId . snd) xs)
TM s -> R $ (TM s) : (Data.List.map (kks . showCId . snd) xs)
lin (Fun fun es) = let argVariants = mapM (liftVariants . lin) es
in variants [compute pgf lang args $ look fun | args <- argVariants]
lin (Lit (LStr s)) = R [kks (show s)] -- quoted
lin (Lit (LInt i)) = R [kks (show i)]
lin (Lit (LFlt d)) = R [kks (show d)]
lin (Var x) = TM (showCId x)
lin (Meta i) = TM (show i)
look = lookLin pgf lang
cnc = lookMap (error "no lang") lang (concretes pgf)
lin (Abs xs e ) mty = case lin e Nothing of
R ts -> R $ ts ++ (Data.List.map (kks . showCId . snd) xs)
TM s -> R $ (TM s) : (Data.List.map (kks . showCId . snd) xs)
lin (Fun fun es) mty = case Map.lookup fun (funs (abstract pgf)) of
Just (DTyp hyps _ _,_,_) -> let argVariants = sequence [liftVariants (lin e (Just ty)) | e <- es | (_,_,ty) <- hyps]
in variants [compute pgf lang args $ lookMap tm0 fun (lins cnc) | args <- argVariants]
Nothing -> tm0
lin (Lit (LStr s)) mty = R [kks (show s)] -- quoted
lin (Lit (LInt i)) mty = R [kks (show i)]
lin (Lit (LFlt d)) mty = R [kks (show d)]
lin (Var x) mty = case mty of
Just (DTyp _ cat _) -> compute pgf lang [K (KS (showCId x))] (lookMap tm0 cat (lindefs cnc))
Nothing -> TM (showCId x)
lin (Meta i) mty = case mty of
Just (DTyp _ cat _) -> compute pgf lang [K (KS (show i))] (lookMap tm0 cat (lindefs cnc))
Nothing -> TM (show i)
variants :: [Term] -> Term
variants ts = case ts of

3
src/PGF/Macros.hs
View File

@@ -146,8 +146,9 @@ combinations t = case t of
aa:uu -> [a:u | a <- aa, u <- combinations uu]
isLiteralCat :: CId -> Bool
isLiteralCat = (`elem` [cidString, cidFloat, cidInt])
isLiteralCat = (`elem` [cidString, cidFloat, cidInt, cidVar])
cidString = mkCId "String"
cidInt = mkCId "Int"
cidFloat = mkCId "Float"
cidVar = mkCId "#Var"