1 {-# LANGUAGE PatternGuards #-}
10 | Conc [Expr] -- Conc [] is Id
17 | AllZipWith String String BoolExpr Expr Expr
18 | Condition String String Typ BoolExpr BoolExpr
19 | UnCond String Bool Typ BoolExpr
20 | TypeVarInst Int BoolExpr
27 allZipWith v1 v2 rel e1 e2 | Just v1' <- defFor v1 rel =
28 e1 `equal` app (app Map (lambda v2 v1')) e2
29 | Just v2' <- defFor v2 rel =
30 app (app Map (lambda v1 v2')) e1 `equal` e2
32 AllZipWith v1 v2 rel e1 e2
34 defFor v (e1 `Equal` e2) | (Var v) == e1 = Just e2
35 | (Var v) == e2 = Just e1
38 app Map (Conc []) = Conc []
42 unCond v b t (Equal l r) | (Just l') <- isApplOn v l
43 , (Just r') <- isApplOn v r =
44 if hasVar v l' || hasVar v r'
45 then UnCond v b t (Equal l' r')
47 unCond v b t e = UnCond v b t e
49 lambda v e | (Just e') <- isApplOn v e, not (hasVar v e') = e'
50 | Var v == e = Conc []
51 | otherwise = Lambda v e
54 conc f (Conc fs) = Conc (f:fs)
58 isApplOn v (Var _) = Nothing
59 isApplOn v (App f (Var v')) | v == v' = Just (Conc [f])
60 isApplOn v (App f e) | (Just inner) <- isApplOn v e = Just (conc f inner)
61 isApplOn _ _ = Nothing
63 hasVar v (Var v') = v == v'
64 hasVar v (App e1 e2) = hasVar v e1 && hasVar v e2
65 hasVar v (Conc es) = any (hasVar v) es
66 hasVar v (Lambda _ e) = hasVar v e
79 instance Show Expr where
80 showsPrec d (Var s) = showString s
81 showsPrec d (App e1 e2) = showParen (d>10) $
82 showsPrec 10 e1 . showChar ' ' . showsPrec 11 e2
83 showsPrec d (Conc []) = showString "id"
84 showsPrec d (Conc [e]) = showsPrec d e
85 showsPrec d (Conc es) = showParen (d>9) $
86 showIntercalate (showString " . ") (map (showsPrec 10) es)
87 showsPrec d (Lambda v e) = showParen True $
92 showsPrec _ Map = showString "map"
94 showIntercalate i [] = id
95 showIntercalate i [x] = x
96 showIntercalate i (x:xs) = x . i . showIntercalate i xs
98 instance Show BoolExpr where
99 show (Equal e1 e2) = showsPrec 9 e1 $
102 show (AllZipWith v1 v2 be e1 e2) =
113 showsPrec 11 e1 "" ++
116 show (Condition v1 v2 t be1 be2) =
120 arrowInstType False t ++
124 arrowInstType True t ++
126 indent 2 (show be1) ++
129 show (UnCond v1 b t be1) =
136 show (TypeVarInst i be) =
150 indent n = unlines . map (replicate n ' ' ++) . lines
152 arrowInstType :: Bool -> Typ -> String
153 arrowInstType b = ait 0
156 ait _ (TVar (TypVar i)) | not b = "t" ++ show (2*i-1)
157 | b = "t" ++ show (2*i)
158 ait d (Arrow t1 t2) = paren (d>9) $
159 ait 10 t1 ++ " -> " ++ ait 9 t2
160 ait d (List t) = "[" ++ ait 0 t ++ "]"
161 ait d (TEither t1 t2) = "Either " ++ ait 11 t1 ++
163 ait d (TPair t1 t2) = "(" ++ ait 0 t1 ++ ", " ++ ait 0 t2 ++ ")"
165 paren b p = if b then "(" ++ p ++ ")" else p