Input and output codes now looks similar to Haskell (or Curry?)
authorKazutaka Matsuda <kztk@kb.ecei.tohoku.ac.jp>
Mon, 13 Sep 2010 12:56:03 +0000 (12:56 +0000)
committerKazutaka Matsuda <kztk@kb.ecei.tohoku.ac.jp>
Mon, 13 Sep 2010 12:56:03 +0000 (12:56 +0000)
AST.hs
Parser.hs
SemSyn.hs
b18n-combined-cgi.hs
example/init.txt
example/initHalf.txt
example/rev.txt
example/sieve.txt

diff --git a/AST.hs b/AST.hs
index 0d05ce3..792b65e 100644 (file)
--- a/AST.hs
+++ b/AST.hs
@@ -4,14 +4,15 @@ import Util
 import Text.PrettyPrint
 import Data.List (groupBy)
 
+import Debug.Trace 
 import Control.Monad.State
 
 data AST = AST [ Decl ]
 
 instance Ppr AST where
     ppr (AST ds) = 
-        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 
         where 
           pprDecls (d:ds) =
               ppr d $$ pprDeclsSimp ds 
@@ -56,8 +57,9 @@ data Decl = Decl Name FType [Pat] Exp
 
 instance Ppr Decl where
     ppr (Decl fname ftype ps e) = 
-        addSig (ppr fname <> 
-                     parens (hsep $ punctuate comma (map ppr ps)) $$
+        addSig (ppr fname <+> 
+                    (hsep $ map pprChildP ps) $$
+--                     parens (hsep $ punctuate comma (map ppr ps)) $$
                      nest 4 (text "=") $$
                      nest 6 (ppr e))
         where 
@@ -78,21 +80,53 @@ type ID = Maybe Int
 addPprType t d = 
     case t of 
       TUndet -> d
-      _      -> 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 
 
 instance Ppr Exp where
     ppr (EVar _ t vname)     
         = addPprType t (ppr vname)
     ppr (EFun _ t fname es) 
         = addPprType t $
-            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 
     ppr (ECon _ t cname []) 
         = addPprType t $ ppr cname 
     ppr (ECon _ t cname es)
         = addPprType t $ 
-             ppr cname <>
-             parens (sep $ punctuate comma (map ppr es))
+             ppr cname <+>
+                 (hsep $ map pprChildE es)
+--             parens (sep $ punctuate comma (map ppr es))
+
 
 instance Show Exp where
     show = show . ppr 
@@ -101,14 +135,44 @@ data Pat  = PVar ID Type Name
           | PCon ID Type Name [Pat] 
        deriving (Ord,Eq)
 
+
+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 
+
+
 instance Ppr Pat where
     ppr (PVar _ t vname)     
         = addPprType t (ppr vname)
+    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 
     ppr (PCon _ t cname [])
         = addPprType t (ppr cname)
     ppr (PCon _ t cname ps)
         = addPprType t $ ppr cname 
-          <> parens (sep $ punctuate comma (map ppr ps))
+           <+> (hsep $ map pprChildP ps)
+--           <> parens (sep $ punctuate comma (map ppr ps))
           
 instance Show Pat where
     show = show . ppr 
@@ -151,6 +215,10 @@ data Type = TUndet           -- PlaceHolder
 instance Ppr Type where
     ppr (TUndet)        = text "?"
     ppr (TVar i)        = text ("t" ++ show i) 
+    ppr (TCon (Name "Unit") []) =
+        parens empty 
+    ppr (TCon (Name "List") [t]) = 
+        brackets $ ppr t
     ppr (TCon tname ts) =
         ppr tname <+> 
              hsep (map (\t -> f t (ppr t)) ts)
@@ -226,18 +294,26 @@ data TAST  = TAST [TDecl]
 data TDecl = TDecl Name [Pat] [Exp] [VDecl] -- f(ps) = es where ... 
 data VDecl = VDecl [Name] Name [Name]          -- vs = f(us)
 
+parensIfMultiple []  = parens empty 
+parensIfMultiple [p] = p
+parensIfMultiple ps  = parens (hsep $ punctuate comma ps)
+
 instance Ppr TAST where 
-    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
+
+
 instance Ppr TDecl where
     ppr (TDecl f ps es vdecls) =
-        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)) $$
             if null vdecls then 
                 empty 
             else 
                 (nest 6 (text "where") $$
                  nest 8 (vcat $ map ppr vdecls))
 instance Ppr VDecl where
-    ppr (VDecl vs f us) = parens (hsep $ punctuate comma (map ppr vs))
+    ppr (VDecl vs f us) = parensIfMultiple (map ppr vs)
                           <+> text "=" <+> ppr f <>
-                          parens (hsep $ punctuate comma (map ppr us))
+                          parensIfMultiple (map ppr us)
index 4de88ba..e3c4293 100644 (file)
--- a/Parser.hs
+++ b/Parser.hs
@@ -4,8 +4,43 @@ import Text.ParserCombinators.Parsec
 import qualified Text.ParserCombinators.Parsec.Token as Tk
 import Text.ParserCombinators.Parsec.Language
 
+import Debug.Trace 
+import Data.Char (isSpace)
+import Data.List (partition)
+
 import AST
 
+
+-- 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
+
+
+                      
 varId :: Parser String
 varId = do { c <- lower
            ; cs <- many (alphaNum <|> char '_')
@@ -20,118 +55,239 @@ number :: Parser Int
 number = do { cs <- many1 digit
             ; return $ read cs }
 
-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", "_" ]
+--                  }
+
+
 
 parens = Tk.parens myLexer
 symbol = Tk.symbol myLexer
 comma  = Tk.comma myLexer
 lexeme = Tk.lexeme myLexer
 reserved = Tk.reserved myLexer
+brackets = Tk.brackets myLexer 
 whiteSpace = Tk.whiteSpace myLexer
+semi = Tk.semi myLexer
 
 
-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) }
 
-parseProgram = 
-    (parse pProg "")
 
-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 }
 
 
-parseString s = 
-    parseProgram s 
+-- pPats = sepBy pPat comma 
 
+{-
+ pPat  ::= pAPat : pPat 
+        |  pCPat 
+ pCPat ::= C pAPat ... pAPat 
+        |  pAPat 
+ pAPat ::= C | x | BList | (pPat)
+ BList ::= [ pPat, ..., pPat ]
+-}
 
-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 }
 
+-- 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 } }
 
-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}
 
+-- 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  }
 
-pDecl = do { pos <- getPosition 
-            ; fName <- lexeme varId 
-            ; ps    <- parens (pPats)
-            ; symbol "=" 
-            ; e     <- pExp
-            ; return $ Decl (Name fName) FTUndet ps e }
 
+-- 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 }
+--            }
 
-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 }
 
 
-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 } }
 
+-- 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 }}
 
-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 }}
 
+{-
+ 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 
 pExp = do { whiteSpace
-          ; pos <- getPosition
-          ; do { c  <- lexeme conId
-               ; es <- option [] $ parens (sepBy (pExp) comma)
-               ; return $ ECon Nothing TUndet (Name c) es }
-            <|>
-            do { c <- lexeme $ number
-               ; return $ ECon Nothing TUndet (Name $ show c) [] }
+          ; pos <- getPosition 
+          ; try (do { e1 <- pAExp 
+                    ; symbol ":" 
+                    ; e2 <- pExp 
+                    ; return $ econs e1 e2 })
             <|>
-            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 }
+--           }
+
 
 
-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)} 
 
 
index 3e5d6a8..47c48ff 100644 (file)
--- a/SemSyn.hs
+++ b/SemSyn.hs
@@ -94,7 +94,14 @@ outputCode conf_ isShapify orig ast =
                       , ppr $ generateCodeBwd (orig, p1, p2, p3) ]
              else 
                  vcat [ ppr (constructTypeDecl p2)
-                      , 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) ]
          SemanticB18n -> vcat $ 
              [ text "import Data.Bff" ] ++
              [ text "import BUtil" ] ++ 
index 7de0b25..927a5c7 100644 (file)
@@ -183,30 +183,30 @@ maindiv = thediv ! [theclass "main"]
         
 examples =
        [ ("init", unlines
-               [ "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"
                ])
        , ("initHalf", unlines
-               [ "initHalf(Nil)       = Nil"
-               , "initHalf(Cons(a,x)) = Cons(a,initHalfWork(x,x))"
+               [ "initHalf []    = []"
+               , "initHalf (a:x) = a:initHalfWork x x"
                , ""
-               , "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"
                ])
        , ("sieve", unlines
-               [ "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"
                ])
        , ("rev", unlines
-               [ "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)"
                ])
        ]
 
index 5869f43..30d45a5 100644 (file)
@@ -1,5 +1,5 @@
-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
index 69d4482..9e8cca0 100644 (file)
@@ -1,7 +1,17 @@
-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
 
-initHalfWork(xs, Nil)         = Nil
-initHalfWork(xs, Cons(x,Nil)) = Nil
-initHalfWork(Cons(a,x), Cons(b,Cons(c,y)))
-    = Cons(a,initHalfWork(x,y))
index 015da67..e9da91f 100644 (file)
@@ -1,3 +1,3 @@
-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) 
index 3414bc2..413fbc8 100644 (file)
@@ -1,3 +1,3 @@
-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)