quasiquoting for patterns

[clean-tests.git] / datatype / Printer.hs

diff --git a/datatype/Printer.hs b/datatype/Printer.hs
index 8668b91..873d381 100644 (file)
--- a/datatype/Printer.hs
+++ b/datatype/Printer.hs
@@ -88,22 +88,23 @@ instance Expression Printer where
     (>.) = printBinOp (nonectx 4) ">"
     (<=.) = printBinOp (nonectx 4) "<"
     (>=.) = printBinOp (nonectx 4) ">"
-    if' p t e = printLit "if" >> p >> printLit "then" >> t >> printLit "else" >> e
+    if' p t e = paren' CtxNonfix $ printLit "if " >> p >> printLit " then " >> local (\_->CtxNonfix) t >> printLit " else " >> local (\_->CtxNonfix) e
+    bottom msg = printLit $ "error " ++ show msg
 
 freshLabel :: MonadState PS m => String -> m String
 freshLabel prefix = gets fresh >>= \(f:fs)->modify (\s->s {fresh=fs}) >> pure (prefix ++ show f)
 
 instance Function () Printer where
     fun def = Main $ freshLabel "f" >>= \f->
-        let g :- m = def (\()->printLit (f ++ " ()"))
+        let g :- m = def (\()->paren' CtxNonfix $ printLit (f ++ " ()"))
         in  printLit ("let " ++ f ++ " () = ") >> g () >> printLit "\n in " >> unmain m
 instance Function (Printer a) Printer where
     fun def = Main $ freshLabel "f" >>= \f->freshLabel "a" >>= \a->
-        let g :- m = def (\arg->printLit (f ++ " ") >>> arg)
+        let g :- m = def (\arg->paren' CtxNonfix $ printLit (f ++ " ") >>> arg)
         in  printLit (concat ["let ", f, " ", a, " = "]) >> g (printLit a) >> printLit " in\n" >> unmain m
 instance Function (Printer a, Printer b) Printer where
     fun def = Main $ freshLabel "f" >>= \f->freshLabel "a" >>= \a1->freshLabel "a" >>= \a2->
-        let g :- m = def (\(arg1, arg2)->printLit (f ++ " ") >> arg1 >> printLit " " >>> arg2)
+        let g :- m = def (\(arg1, arg2)->paren' CtxNonfix $ printLit (f ++ " ") >> arg1 >> printLit " " >>> arg2)
         in  printLit (concat ["let ", f, " ", a1, " ", a2, " = "]) >> g (printLit a1, printLit a2) >> printLit " in\n" >> unmain m
 instance Function (Printer a, Printer b, Printer c) Printer where
     fun def = Main $
@@ -111,7 +112,7 @@ instance Function (Printer a, Printer b, Printer c) Printer where
         freshLabel "a" >>= \a1->
         freshLabel "a" >>= \a2->
         freshLabel "a" >>= \a3->
-        let g :- m = def (\(arg1, arg2, arg3)->printLit (f ++ " ") >> arg1 >> printLit " " >> arg2 >> printLit " " >>> arg3)
+        let g :- m = def (\(arg1, arg2, arg3)->paren' CtxNonfix $ printLit (f ++ " ") >> arg1 >> printLit " " >> arg2 >> printLit " " >>> arg3)
         in  printLit (concat ["let ", f, " ", a1, " ", a2, " ", a3, " = "]) >> g (printLit a1, printLit a2, printLit a3) >> printLit " in\n" >> unmain m
 
 (>>>) :: Printer a1 -> Printer a2 -> Printer a3
@@ -120,13 +121,12 @@ l >>> r = l >> r >> pure undefined
 printBinOp :: Ctx -> String -> Printer a1 -> Printer a2 -> Printer a3
 printBinOp thisctx op l r = paren' thisctx $
        local (\_->setBranch thisctx CtxLeft) l
-    >> printLit op
-    >> local (\_->setBranch thisctx CtxRight) r
-    >> pure undefined
+    >> printLit (' ':op ++ " ")
+    >>> local (\_->setBranch thisctx CtxRight) r
 
 printUnOp :: Ctx -> String -> Printer a -> Printer a
 printUnOp thisctx op l = paren' thisctx $
-       printLit op
+       printLit (' ':op ++ " ")
     >> local (\_->setBranch thisctx CtxRight) l
 
 printCons :: String -> Printer a -> Printer a