ruler-0.4.0.0: src/Expr/ToAEqn.chs
-------------------------------------------------------------------------
-- (A)Eqn as Expr
-------------------------------------------------------------------------
%%[1 hs module (Expr.ToAEqn)
%%]
%%[1 hs export (exprMbAEqnRest, mkExprEqn, exprCheckAEqnForm)
%%]
%%[1 hs import (qualified Data.Set as Set, qualified Data.Map as Map, Common, Expr.Expr)
%%]
%%[1 hs import (Expr.NmS, ARule.ARule, Gam, FmGam)
%%]
-------------------------------------------------------------------------
-- Construct Expr of the form later to be dissected into AEqn
-------------------------------------------------------------------------
%%[1 hs
mkExprEqn :: Expr -> Expr -> Expr
mkExprEqn l r = Expr_AppTop (Expr_Op (nmEql) (Expr_Var (nmEql)) l r)
%%]
-------------------------------------------------------------------------
-- Expr dissected as AEqn (as constructed by mkExprEqn)
-------------------------------------------------------------------------
%%[1 hs
exprCheckAEqnForm :: Expr -> Maybe (Map.Map Expr Expr)
exprCheckAEqnForm e
= eqn (exprStrip StripBasic e)
where eqn (Expr_Op n _ l r) | n == nmEql = Just (lr l r `Map.union` tup l r)
eqn e = Nothing
tup (Expr_Op ln _ l1 l2)
(Expr_Op rn _ r1 r2) | ln == nmComma && rn == nmComma
= lr l1 r1 `Map.union` tup l1 r1 `Map.union` tup l2 r2
tup l r = Map.empty
lr l r = Map.fromList $ concat $ [ [(l,r),(r,l)] | l <- ls, r <- rs ]
where (_,_,ls) = exprStrip' StripBasic l
(_,_,rs) = exprStrip' StripBasic r
%%]
-------------------------------------------------------------------------
-- Expr as AEqn
-------------------------------------------------------------------------
%%[1 hs
exprMbAEqnRest :: Expr -> Maybe (AEqn,[Expr],FmGam Expr)
exprMbAEqnRest expr
= eE (exprStrip StripBasic expr)
where eE (Expr_Op n _ d s) | n == nmEql
= do (d',ed,gd) <- dE (exprStrip StripBasic d) False
(s' ) <- sE s
return (AEqn_Eqn d' s', ed, gd)
eE e = Nothing
dE (Expr_AVar n) _ = return (AEqnDest_One n,[],emptyGam)
dE (Expr_Retain (Expr_AVar (ANm_Loc n p))) _= return (AEqnDest_One (ANm_Loc n (AtRetain:p)),[],emptyGam)
dE (Expr_Var n) _ = vE [] n
dE (Expr_Retain (Expr_Var n)) _ = vE [AtRetain] n
dE (Expr_StrAsIs s) _ = nE [] s
dE (Expr_Retain (Expr_StrAsIs s)) _ = nE [AtRetain] s
dE (Expr_Retain e) p = dE e p
dE (Expr_SelTop e) p = dE e p
dE e@(Expr_Op n _ _ _) p | n == nmComma = tE e
dE (Expr_Sel e (Just s)) _
= do ne <- dsE e
ns <- dsE s
return (AEqnDest_One (ANm_Node ne ns),[],emptyGam)
dE _ False = Nothing
dE e True = tE e
dsE (Expr_AppTop e) = dsE e
dsE (Expr_Paren e) = dsE e
dsE (Expr_AVar (ANm_Fld n)) = return n
dsE (Expr_Var n) = return n
dsE _ = Nothing
tE e@(Expr_Op n _ _ _) | n == nmComma
= do (dL,eo,go) <- oE e
return (AEqnDest_Many dL,eo,go)
tE e
= return (AEqnDest_One n,[mkExprEqn (Expr_AppTop e) (Expr_AVar n)],emptyGam)
where n = flip ANm_Loc [] . Nm . nmShowAG . foldr nmApd nmWild . take 2 . Set.toList $ exprNmS e
oE (Expr_Op n _ e1 e2) | n == nmComma
= do (e1',ed,gd) <- dE (exprStrip StripBasic e1) True
(e2',eo,go) <- oE e2
return (e1' : e2', ed ++ eo, gd `gu` go)
oE e
= do (e',ee,ge) <- dE (exprStrip StripBasic e) True
return ([e'],ee,ge)
sE e = return (AExpr_Expr e)
vE props n
= if n == nmWild
then return (AEqnDest_One ANm_Wild,[],emptyGam)
else let a = ANm_Loc (Nm (nmShowAG n)) props
in return (AEqnDest_One a,[],n `gs` Expr_AVar a)
nE props n
= fmap (\n -> (AEqnDest_One n,[],emptyGam)) m
where m = case n of
('@':'l':'o':'c':'.':nm) -> Just (ANm_Loc (Nm nm) props)
( 'l':'o':'c':'.':nm) -> Just (ANm_Loc (Nm nm) props)
('@':'l':'h':'s':'.':nm) -> Just (ANm_Lhs (Nm nm) [])
( 'l':'h':'s':'.':nm) -> Just (ANm_Lhs (Nm nm) [])
s | s == strUnd -> Just (ANm_Wild)
| otherwise -> Nothing
gu = fmGamUnion
gs n e = fmGamFromList' FmAG [(n,e)]
%%]