diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/LambdaCube/Compiler/Pretty.hs | 24 |
1 files changed, 13 insertions, 11 deletions
diff --git a/src/LambdaCube/Compiler/Pretty.hs b/src/LambdaCube/Compiler/Pretty.hs index 1d0e07dd..fb6cfb22 100644 --- a/src/LambdaCube/Compiler/Pretty.hs +++ b/src/LambdaCube/Compiler/Pretty.hs | |||
@@ -108,7 +108,7 @@ plainShow = show . P.plain . renderDoc . pShow | |||
108 | renderDoc :: Doc -> P.Doc | 108 | renderDoc :: Doc -> P.Doc |
109 | renderDoc | 109 | renderDoc |
110 | = render | 110 | = render |
111 | . addPar (-10) | 111 | . addPar (Infix (-10)) |
112 | . flip runReader ((\s n -> '_': n: s) <$> iterate ('\'':) "" <*> ['a'..'z']) | 112 | . flip runReader ((\s n -> '_': n: s) <$> iterate ('\'':) "" <*> ['a'..'z']) |
113 | . flip evalStateT (flip (:) <$> iterate ('\'':) "" <*> ['a'..'z']) | 113 | . flip evalStateT (flip (:) <$> iterate ('\'':) "" <*> ['a'..'z']) |
114 | . showVars | 114 | . showVars |
@@ -140,24 +140,26 @@ renderDoc | |||
140 | showVarA (SimpleAtom s) = pure $ SimpleAtom s | 140 | showVarA (SimpleAtom s) = pure $ SimpleAtom s |
141 | showVarA (ComplexAtom s i d a) = ComplexAtom s i <$> showVars d <*> showVarA a | 141 | showVarA (ComplexAtom s i d a) = ComplexAtom s i <$> showVars d <*> showVarA a |
142 | 142 | ||
143 | addPar :: Int -> Doc -> Doc | 143 | addPar :: Fixity -> Doc -> Doc |
144 | addPar pr x = case x of | 144 | addPar pr x = case x of |
145 | DAtom x -> DAtom $ addParA x | 145 | DAtom x -> DAtom $ addParA x |
146 | DOp0 s f -> DParen $ DOp0 s f | 146 | DOp0 s f -> DParen $ DOp0 s f |
147 | DOpL s f x -> DParen $ DOpL s f $ addPar (leftPrecedence f) x | 147 | DOpL s f x -> DParen $ DOpL s f $ addPar (InfixL $ leftPrecedence f) x |
148 | DOpR s f x -> DParen $ DOpR s f $ addPar (rightPrecedence f) x | 148 | DOpR s f x -> DParen $ DOpR s f $ addPar (InfixR $ rightPrecedence f) x |
149 | DInfix pr' x op y -> (if protect then DParen else id) | 149 | DInfix pr' x op y -> (if protect then DParen else id) |
150 | $ DInfix pr' (addPar (leftPrecedence pr') x) (addParA op) (addPar (rightPrecedence pr') y) | 150 | $ DInfix pr' (addPar (InfixL $ leftPrecedence pr') x) (addParA op) (addPar (InfixR $ rightPrecedence pr') y) |
151 | DPreOp pr' op y -> (if protect then DParen else id) | 151 | DPreOp pr' op y -> (if protect then DParen else id) |
152 | $ DPreOp pr' (addParA op) (addPar pr' y) | 152 | $ DPreOp pr' (addParA op) (addPar (Infix pr') y) |
153 | DFormat c x -> DFormat c $ addPar pr x | 153 | DFormat c x -> DFormat c $ addPar pr x |
154 | DDocOp x d -> DDocOp x $ addPar (-10) <$> d | 154 | DDocOp x d -> DDocOp x $ addPar (Infix (-10)) <$> d |
155 | where | 155 | where |
156 | addParA = mapDocAtom (\_ -> addPar) | 156 | addParA = mapDocAtom (\_ -> addPar . Infix) |
157 | 157 | ||
158 | protect = case x of | 158 | protect = case x of |
159 | DInfix f _ _ _ -> precedence f < pr | 159 | DInfix f _ _ _ -> precedence f < precedence pr |
160 | DPreOp f _ _ -> f < pr | 160 | DPreOp f _ _ -> case pr of |
161 | InfixL pr -> f < pr | ||
162 | _ -> False | ||
161 | _ -> False | 163 | _ -> False |
162 | 164 | ||
163 | render :: Doc -> P.Doc | 165 | render :: Doc -> P.Doc |
@@ -270,7 +272,7 @@ shAnn _ x y = DAnn x y | |||
270 | shArr = DArr | 272 | shArr = DArr |
271 | 273 | ||
272 | 274 | ||
273 | pattern DForall s vs e = DArr_ s (DSep (Infix 10) (DText "forall") vs) e | 275 | pattern DForall s vs e = DArr_ s (DPreOp 10 (SimpleAtom "forall") vs) e |
274 | pattern DContext vs e = DArr_ "=>" vs e | 276 | pattern DContext vs e = DArr_ "=>" vs e |
275 | pattern DParContext vs e = DContext (DParen vs) e | 277 | pattern DParContext vs e = DContext (DParen vs) e |
276 | pattern DLam vs e = DPreOp (-10) (ComplexAtom "\\" 11 vs (SimpleAtom "->")) e | 278 | pattern DLam vs e = DPreOp (-10) (ComplexAtom "\\" 11 vs (SimpleAtom "->")) e |