[Input and output codes now looks similar to Haskell (or Curry?)
Kazutaka Matsuda <kztk@kb.ecei.tohoku.ac.jp>**20100913125603
 Ignore-this: 329ff88d6380d9ba2a7d78fa8d8601d8
] hunk ./AST.hs 7
+import Debug.Trace 
hunk ./AST.hs 14
-        let dss = groupBy (\(Decl f _ _ _) (Decl g _ _ _) -> f == g) ds
-        in vcat $ map pprDecls dss 
+        let dss = groupBy isSameFunc ds
+        in vcat $ punctuate (text "\n") $ map pprDecls dss 
hunk ./AST.hs 60
-        addSig (ppr fname <> 
-                     parens (hsep $ punctuate comma (map ppr ps)) $$
+        addSig (ppr fname <+> 
+                    (hsep $ map pprChildP ps) $$
+--                     parens (hsep $ punctuate comma (map ppr ps)) $$
hunk ./AST.hs 83
-      _      -> d <> text "::" <> ppr t 
+      _      -> parens ( d <> text "::" <> ppr t )
+
+
+pprChildE e | isAtomicE e = ppr e 
+            | otherwise   = parens (ppr e)
+isAtomicE (EVar _ _ _)     = True
+isAtomicE (EFun _ _ _ [])  = True
+isAtomicE (ECon _ _ _ [])  = True
+isAtomicE e | isAllListE e = True 
+isAtomicE _                = False
+
+pprListE (ECon _ _ (Name "Cons") [e1,ECon _ _ (Name "Nil") []]) 
+    = ppr e1 
+pprListE (ECon _ _ (Name "Cons") [e1,e2]) 
+    = ppr e1 <> comma <+> pprListE e2 
+pprListE (ECon _ _ (Name "Nil") []) 
+    = empty
+
+isAllListE (ECon _ _ (Name "Cons") [e1,e2])
+    = isAllListE e2 
+isAllListE (ECon _ _ (Name "Nil") []) 
+    = True
+isAllListE _ 
+    = False 
hunk ./AST.hs 113
-            ppr fname <>
-            parens (sep $ punctuate comma (map ppr es))          
+            ppr fname <+>
+                (hsep $ map pprChildE es)
+--            parens (sep $ punctuate comma (map ppr es))          
+    ppr e | isAllListE e
+        = brackets (pprListE e )
+    ppr (ECon _ _ (Name "Cons") [e1,e2]) 
+        = pprChildE e1 <> text ":" <> ppr e2 
+    ppr (ECon _ _ (Name "Unit") []) 
+        = parens empty 
hunk ./AST.hs 126
-             ppr cname <>
-             parens (sep $ punctuate comma (map ppr es))
+             ppr cname <+>
+                 (hsep $ map pprChildE es)
+--             parens (sep $ punctuate comma (map ppr es))
+
hunk ./AST.hs 138
+
+pprChildP p | isAtomicP p = ppr p
+            | otherwise   = parens (ppr p)
+isAtomicP (PVar _ _ _)     = True
+isAtomicP (PCon _ _ _ [])  = True
+isAtomicP p | isAllListP p = True
+isAtomicP _                = False
+
+pprListP (PCon _ _ (Name "Cons") [p1, PCon _ _ (Name "Nil") []])
+    = ppr p1
+pprListP (PCon _ _ (Name "Cons") [p1,p2]) 
+    = ppr p1 <> comma <+> pprListP p2 
+pprListP (PCon _ _ (Name "Nil") []) 
+    = empty
+
+isAllListP (PCon _ _ (Name "Cons") [p1,p2])
+    = isAllListP p2 
+isAllListP (PCon _ _ (Name "Nil") []) 
+    = True
+isAllListP _ 
+    = False 
+
+
hunk ./AST.hs 164
+    ppr e | isAllListP e
+        = brackets (pprListP e )
+    ppr (PCon _ _ (Name "Cons") [p1,p2]) 
+        = pprChildP p1 <> text ":" <> ppr p2 
+    ppr (PCon _ _ (Name "Unit") []) -- never happens 
+        = parens empty 
hunk ./AST.hs 174
-          <> parens (sep $ punctuate comma (map ppr ps))
+           <+> (hsep $ map pprChildP ps)
+--           <> parens (sep $ punctuate comma (map ppr ps))
hunk ./AST.hs 218
+    ppr (TCon (Name "Unit") []) =
+        parens empty 
+    ppr (TCon (Name "List") [t]) = 
+        brackets $ ppr t
hunk ./AST.hs 297
+parensIfMultiple []  = parens empty 
+parensIfMultiple [p] = p
+parensIfMultiple ps  = parens (hsep $ punctuate comma ps)
+
hunk ./AST.hs 302
-    ppr (TAST tdecls) = vcat $ map ppr tdecls 
+    ppr (TAST tdecls) = 
+        let tdeclss = groupBy (\(TDecl f _ _ _) (TDecl g _ _ _) -> f == g) tdecls 
+        in vcat $ punctuate (text "\n") $ map (\tdecls -> vcat $ map ppr tdecls) tdeclss
+
+
hunk ./AST.hs 309
-        ppr f <> parens (hsep $ punctuate comma (map ppr ps)) $$
-            nest 4 (text "=" <+> parens (hsep $ punctuate comma (map ppr es))) $$
+        ppr f <+> parensIfMultiple (map ppr ps) $$
+            nest 4 (text "=" <+> parensIfMultiple (map ppr es)) $$
hunk ./AST.hs 317
-    ppr (VDecl vs f us) = parens (hsep $ punctuate comma (map ppr vs))
+    ppr (VDecl vs f us) = parensIfMultiple (map ppr vs)
hunk ./AST.hs 319
-                          parens (hsep $ punctuate comma (map ppr us))
+                          parensIfMultiple (map ppr us)
hunk ./Parser.hs 7
+import Debug.Trace 
+import Data.Char (isSpace)
+import Data.List (partition)
+
hunk ./Parser.hs 13
+
+-- cnv f s = case f s of
+--            Left  err -> Left $ show err
+--            Right r   -> Right $ r 
+
+parseProgram s = 
+    (parse pProg "") $ insertSemi s
+
+parseExpression = 
+    (parse pExp "") 
+
+
+parseString s = 
+    parseProgram s 
+
+
+parseFile filename =
+    return . parseProgram =<< readFile filename
+
+
+-- | |insertSemi| inserts ";" after every "\n".
+insertSemi :: String -> String 
+insertSemi []  = []
+insertSemi [x] = [x]
+insertSemi ('\r':'\n':x) | not (isSpace $ head x) = ';':'\r':'\n':insertSemi x 
+insertSemi ('\n':x)      | not (isSpace $ head x) = ';':'\n':insertSemi x 
+insertSemi ('\r':x)      | not (isSpace $ head x) = ';':'\r':insertSemi x 
+insertSemi (a:x)    = a:insertSemi x
+
+
+                      
hunk ./Parser.hs 58
-myLexer = Tk.makeTokenParser 
-            $ emptyDef {
-                    commentStart = "{-"
-                  , commentEnd   = "-}"
-                  , commentLine  = "--"           
-                  , reservedNames = ["let", "in","case","data","type"]
-                 }
+myLexer = Tk.makeTokenParser haskellDef 
+--             $ emptyDef {
+--                     commentStart = "{-"
+--                   , commentEnd   = "-}"
+--                   , commentLine  = "--"           
+--                   , reservedNames = ["case", "class", "data", "default", "deriving", "do", "else", "if", "import", "in", "infix", "infixl", "infixr", "instance", "let", "module", "newtype", "of", "then", "type", "where", "_" ]
+--                  }
+
+
hunk ./Parser.hs 73
+brackets = Tk.brackets myLexer 
hunk ./Parser.hs 75
+semi = Tk.semi myLexer
hunk ./Parser.hs 78
-cnv f s = case f s of
-            Left  err -> Left $ show err
-            Right r   -> Right $ r 
+pProg = do { skipMany (whiteSpace >> semi)
+           ; ds <- sepEndBy (pDecl) (many1 (whiteSpace >> semi)) -- many (lexeme pDecl)
+           ; return $ assignIDsAST (AST $ ds) }
hunk ./Parser.hs 82
-parseProgram = 
-    (parse pProg "")
hunk ./Parser.hs 83
-parseExpression = 
-    (parse pExp "")
+pDecl = do { whiteSpace
+           ; pos <- getPosition 
+           ; fName <- lexeme varId 
+           ; ps    <- many1 pAPat -- parens (pPats)
+           ; whiteSpace 
+           ; symbol "=" 
+           ; e     <- pExp
+           ; return $ Decl (Name fName) FTUndet ps e }
hunk ./Parser.hs 93
-parseString s = 
-    parseProgram s 
+-- pPats = sepBy pPat comma 
hunk ./Parser.hs 95
+{-
+ pPat  ::= pAPat : pPat 
+        |  pCPat 
+ pCPat ::= C pAPat ... pAPat 
+        |  pAPat 
+ pAPat ::= C | x | BList | (pPat)
+ BList ::= [ pPat, ..., pPat ]
+-}
hunk ./Parser.hs 104
-parseFile filename =
-    return . parseProgram =<< readFile filename
+pcons x y = PCon Nothing TUndet (Name "Cons") [x,y]
+pnil      = PCon Nothing TUndet (Name "Nil")  []
+
+-- list pattern 
+pPat = do { whiteSpace 
+          ; pos <- getPosition 
+          ; try ( do { p1 <- pAPat 
+                     ; symbol ":" 
+                     ; p2 <- pPat 
+                     ; return $ pcons p1 p2 } )
+            <|> 
+            pCPat }
+
+-- constructor pattern
+pCPat = do { whiteSpace
+           ; pos <- getPosition 
+           ; do { c <- lexeme conId
+                ; ps <- many pAPat 
+                ; return $ PCon Nothing TUndet (Name c) ps }
+             <|> 
+             pAPat }
hunk ./Parser.hs 126
+-- pattern need not to be enclosed with parens
+pAPat = do { whiteSpace 
+           ; pos <- getPosition 
+           ; do { c <- lexeme conId 
+                ; ps <- many pAPat 
+                ; return $ PCon Nothing TUndet (Name c) [] }
+             <|>
+             do { c <- lexeme number 
+                ; return $ PCon Nothing TUndet (Name $ show c) [] }
+             <|>
+             do { c <- lexeme varId 
+                ; return $ PVar Nothing TUndet (Name c) }
+             <|>
+             do { pBListPat }
+             <|>
+             do { parens pPat } }
hunk ./Parser.hs 143
-pProg = do { whiteSpace
-           ; ds <- many (lexeme pDecl)
-           ; return $ assignIDsAST (AST ds) }
+-- [p1, ..., pn]                    
+pBListPat = do { ps <- brackets (sepBy pPat comma)
+               ; return $ foldr pcons pnil ps}
hunk ./Parser.hs 147
+-- pPat = do { whiteSpace  
+--           ; pos <- getPosition 
+--           ; try pList 
+--             <|> 
+--             do { c <- lexeme conId                
+--                ; ps <- many pAPat -- option [] $ parens pPats 
+--                ; return $ PCon Nothing TUndet (Name c) ps }
+--             <|>             
+--             pAPat  }
hunk ./Parser.hs 157
-pDecl = do { pos <- getPosition 
-            ; fName <- lexeme varId 
-            ; ps    <- parens (pPats)
-            ; symbol "=" 
-            ; e     <- pExp
-            ; return $ Decl (Name fName) FTUndet ps e }
hunk ./Parser.hs 158
+-- pAPat = do { whiteSpace
+--            ; pos <- getPosition 
+--            ; do { c <- lexeme conId
+--                 ; return $ PCon Nothing TUndet (Name c) [] }
+--              <|>
+--              do { c <- lexeme number 
+--                 ; return $ PCon Nothing TUndet (Name $ show c) [] }
+--              <|>
+--              do { c <- lexeme varId 
+--                 ; return $ PVar Nothing TUndet (Name c) }
+--              <|>
+--            --  do { pBList }
+--            --  <|>
+--              do { parens pPat }
+--            }
hunk ./Parser.hs 174
-pPats = sepBy pPat comma 
+-- pList = do { whiteSpace 
+--            ; pos <- getPosition 
+--            ; try (do { p1 <- pAPat 
+--                      ; symbol ":"
+--                      ; p2 <- pPat 
+--                      ; return $ PCon Nothing TUndet (Name $ "Cons") [p1,p2] })
+--              <|>
+--              pAPat }
hunk ./Parser.hs 184
-pPat = do { pos <- getPosition 
-          ; do { c <- lexeme conId                
-               ; ps <- option [] $ parens pPats 
-               ; return $ PCon Nothing TUndet (Name c) ps }
-            <|> 
-            do { c <- lexeme $ number
-               ; return $ PCon Nothing TUndet (Name $show c) [] }
-            <|>
-            do { c <- lexeme varId
-               ; return $ PVar Nothing TUndet (Name c) }
-            <|>
-            do { _ <- string "("
-               ; p <- pPat 
-               ; _ <- string ")" 
-               ; return p } }
hunk ./Parser.hs 185
+-- pTExp = do { whiteSpace
+--            ; pos <- getPosition
+--            ; do { c  <- lexeme conId
+--                 ; es <- option [] $ parens (sepBy (pTExp) comma)
+--                 ; return $ ECon Nothing TUndet (Name c) es }
+--              <|>
+--              do { c <- lexeme $ number
+--                 ; return $ ECon Nothing TUndet (Name $ show c) [] }
+--              <|>
+--              do { c <- lexeme varId 
+--                 ; do { es <- parens (sepBy (pArg) comma) 
+--                      ; return $ EFun Nothing TUndet (Name c) es }
+--                   <|>
+--                   do { return $ EVar Nothing TUndet (Name c) } } 
+--              <|> 
+--              do { _ <- string "("
+--                 ; c <- pTExp 
+--                 ; _ <- string ")" 
+--                 ; return c }}
hunk ./Parser.hs 205
-pTExp = do { whiteSpace
-           ; pos <- getPosition
-           ; do { c  <- lexeme conId
-                ; es <- option [] $ parens (sepBy (pTExp) comma)
-                ; return $ ECon Nothing TUndet (Name c) es }
-             <|>
-             do { c <- lexeme $ number
-                ; return $ ECon Nothing TUndet (Name $ show c) [] }
-             <|>
-             do { c <- lexeme varId 
-                ; do { es <- parens (sepBy (pArg) comma) 
-                     ; return $ EFun Nothing TUndet (Name c) es }
-                  <|>
-                  do { return $ EVar Nothing TUndet (Name c) } } 
-             <|> 
-             do { _ <- string "("
-                ; c <- pTExp 
-                ; _ <- string ")" 
-                ; return c }}
hunk ./Parser.hs 206
+{-
+ pExp  ::= pAExp : pExp
+        |  pAppExp 
+
+ pAppExp ::= C pAExp ... pAExp
+          |  f pAExp ... pAExp 
+          | pAExp 
+
+ pAPat ::= C | n | x | pBListExp | (pExp)
+ pBListExp ::= [ pExp, ..., pExp ]
+-}
+
+
+econs x y = ECon Nothing TUndet (Name $ "Cons") [x,y]
+enil      = ECon Nothing TUndet (Name $ "Nil")  [] 
+
+-- Cons 
hunk ./Parser.hs 224
-          ; pos <- getPosition
-          ; do { c  <- lexeme conId
-               ; es <- option [] $ parens (sepBy (pExp) comma)
-               ; return $ ECon Nothing TUndet (Name c) es }
+          ; pos <- getPosition 
+          ; try (do { e1 <- pAExp 
+                    ; symbol ":" 
+                    ; e2 <- pExp 
+                    ; return $ econs e1 e2 })
hunk ./Parser.hs 230
-            do { c <- lexeme $ number
-               ; return $ ECon Nothing TUndet (Name $ show c) [] }
-            <|>
-            do { c <- lexeme varId 
-               ; do { es <- parens (sepBy (pExp) comma) 
-                    ; return $ EFun Nothing TUndet (Name c) es }
-                 <|>
-                 do { return $ EVar Nothing TUndet (Name c) } } 
-            <|> 
-            do { _ <- string "("
-               ; e <- pExp
-               ; _ <- string ")"
-               ; return e }
-          }
+            pAppExp }
+
+-- Application
+pAppExp = do { whiteSpace
+             ; pos <- getPosition 
+             ; do { c  <- lexeme conId
+                  ; es <- many pAExp -- option [] $ parens (sepBy (pExp) comma)
+                  ; return $ ECon Nothing TUndet (Name c) es }
+               <|>
+               do { c <- lexeme varId 
+                  ; do { es <- many1 pAExp --  parens (sepBy (pExp) comma) 
+                       ; return $ EFun Nothing TUndet (Name c) es }
+                    <|>
+                    do { return $ EVar Nothing TUndet (Name c) } }                
+               <|>
+               pAExp }
+                    
+-- Atomic
+pAExp = do { whiteSpace
+           ; pos <- getPosition 
+           ; do { c <- lexeme conId
+                ; return $ ECon Nothing TUndet (Name c) [] }
+             <|>
+             do { c <- lexeme number 
+                ; return $ ECon Nothing TUndet (Name $show c) [] }
+             <|>
+             do { c <- lexeme varId
+                ; return $ EVar Nothing TUndet (Name c) }
+             <|>
+             do { pBListExp }
+             <|>
+             do { parens pExp }
+           }
+
+-- [e1, ..., en]                    
+pBListExp = do { es <- brackets (sepBy pExp comma)
+               ; return $ foldr econs enil es}
+
+
+-- pExp = do { whiteSpace
+--           ; pos <- getPosition
+--           ; do { c  <- lexeme conId
+--                ; es <- many pAExp -- option [] $ parens (sepBy (pExp) comma)
+--                ; return $ ECon Nothing TUndet (Name c) es }
+--             <|>
+--             do { c <- lexeme $ number
+--                ; return $ ECon Nothing TUndet (Name $ show c) [] }
+--             <|>
+--             do { c <- lexeme varId 
+--                ; do { es <- many1 pAExp --  parens (sepBy (pExp) comma) 
+--                     ; return $ EFun Nothing TUndet (Name c) es }
+--                  <|>
+--                  do { return $ EVar Nothing TUndet (Name c) } } 
+--             <|> 
+--             do { parens pExp }
+--           }
+
hunk ./Parser.hs 289
-pArg = do { pos <- getPosition
-          ; c <- lexeme varId
-          ; return $ EVar Nothing TUndet (Name c)} 
+-- pArg = do { pos <- getPosition
+--           ; c <- lexeme varId
+--           ; return $ EVar Nothing TUndet (Name c)} 
hunk ./SemSyn.hs 97
-                      , ppr orig $$ ppr (typeFilter p1) $$ ppr (typeFilter p2) $$ ppr (typeFilterT p3) ]
+                      , space
+                      , ppr orig
+                      , space
+                      , ppr (typeFilter p1) 
+                      , space 
+                      , ppr (typeFilter p2)
+                      , space 
+                      , ppr (typeFilterT p3) ]
hunk ./b18n-combined-cgi.hs 186
-		[ "init (Nil)         = Nil"
-		, "init (Cons(a,Nil)) = Nil"
-		, "init (Cons(a,Cons(b,x))) = Cons(a,initWork(b,x))"
-		, "initWork(a,Nil)       = Nil"
-		, "initWork(a,Cons(b,x)) = Cons(a,initWork(b,x))"
+		[ "init []      = []"
+		, "init [a]     = []"
+		, "init (a:b:x) = a:initWork b x"
+		, "initWork a []    = []"
+		, "initWork a (b:x) = a:initWork b x"
hunk ./b18n-combined-cgi.hs 193
-		[ "initHalf(Nil)       = Nil"
-		, "initHalf(Cons(a,x)) = Cons(a,initHalfWork(x,x))"
+		[ "initHalf []    = []"
+		, "initHalf (a:x) = a:initHalfWork x x"
hunk ./b18n-combined-cgi.hs 196
-		, "initHalfWork(xs, Nil)         = Nil"
-		, "initHalfWork(xs, Cons(x,Nil)) = Nil"
-		, "initHalfWork(Cons(a,x), Cons(b,Cons(c,y)))"
-		, "                    = Cons(a,initHalfWork(x,y))"
+		, "initHalfWork xs  []  = []"
+		, "initHalfWork xs  [x] = []"
+		, "initHalfWork (a:x) (b:c:y)"
+		, "                    = a:initHalfWork x y"
hunk ./b18n-combined-cgi.hs 202
-		[ "sieve (Nil)               = Nil"
-		, "sieve (Cons(a,Nil))       = Nil"
-		, "sieve (Cons(a,Cons(b,x))) = Cons(b,sieve(x))"
+		[ "sieve []      = []"
+		, "sieve [a]     = []"
+		, "sieve (a:b:x) = b:sieve x"
hunk ./b18n-combined-cgi.hs 207
-		[ "reverse(xs) = rev(xs,Nil)"
-		, "rev(Nil,y)       = y"
-		, "rev(Cons(a,x),y) = rev(x,Cons(a,y))"
+		[ "reverse xs = rev xs []"
+		, "rev []    y = y"
+		, "rev (a:x) y = rev x (a:y)"
hunk ./example/init.txt 1
-init (Nil)         = Nil
-init (Cons(a,Nil)) = Nil
-init (Cons(a,Cons(b,x))) = Cons(a,initWork(b,x))
-initWork(a,Nil)       = Nil
-initWork(a,Cons(b,x)) = Cons(a,initWork(b,x))
+init []          = []
+init [a]         = []
+init (a:b:x)     = a:initWork b x
+initWork a []    = []
+initWork a (b:x) = a:initWork b x
hunk ./example/initHalf.txt 1
-initHalf(Nil)       = Nil
-initHalf(Cons(a,x)) = Cons(a,initHalfWork(x,x))
+--  This program requires further preprocessing 
+--  to get effective "put" function.
+--
+--  However, "shap"ication makes the preprocess easier.
+--
+--  After the shapificatoin, 
+--  we can easily observe that the first parameter 
+--  of initHalfWork is useless.	  
+
+initHalf []     = []
+initHalf (a:x)  = a:initHalfWork x x
+
+initHalfWork xs []  = []
+initHalfWork xs [x] = []
+initHalfWork (a:x) (b:c:y)
+    = a:initHalfWork x y
hunk ./example/initHalf.txt 18
-initHalfWork(xs, Nil)         = Nil
-initHalfWork(xs, Cons(x,Nil)) = Nil
-initHalfWork(Cons(a,x), Cons(b,Cons(c,y)))
-    = Cons(a,initHalfWork(x,y))
hunk ./example/rev.txt 1
-reverse(xs) = rev(xs,Nil)
-rev(Nil,y)       = y
-rev(Cons(a,x),y) = rev(x,Cons(a,y))
+reverse xs = rev xs []
+rev [] y    = y 
+rev (a:x) y = rev x (a:y) 
hunk ./example/sieve.txt 1
-sieve (Nil)               = Nil
-sieve (Cons(a,Nil))       = Nil
-sieve (Cons(a,Cons(b,x))) = Cons(b,sieve(x))
+sieve []      = []
+sieve [a]     = []
+sieve (a:b:x) = b:sieve (x)