■

Parsecの使い方が分かったよ！超簡単じゃん！(今更)前はHaskellの基本もよく理解できてなかったから、その詳細に呑まれてたんだなぁ。Haskell使って2日目とか3日目だったし。てことで、S式っぽいもののパーサ。(2 . 3)みたいなのはパースできないけど、今回の目的には必要ないので、わざと。

import Text.ParserCombinators.Parsec

data SExpr = 
   SymS String -- symbol
 | IntS Integer -- integer
 | BoolS Bool -- #t,#f(boolean)
 | StringS String --string
 | ListS [SExpr] deriving (Eq,Show)

parseS :: String -> SExpr
parseS input = case (parse sexprParser "what's this?" input) of
 Left err -> undefined
 Right x -> x

symParser :: Parser SExpr --parse symbol,and boolean
symParser =
 do {s1 <- letter <|> (oneOf "%_!$&+-*/~") ;
     s2 <- many (letter <|> digit <|> (oneOf "%_!$+-*/&~")) ;
     return (SymS ([s1]++s2))}

boolParser :: Parser SExpr
boolParser =
 do {c1 <- char '#' ;
     c2 <- (char 't' <|> char 'f') ;
     return (BoolS (case c2 of {'t'->True;'f'->False}))}

strParser :: Parser SExpr
strParser =
  do {char '"' ;
      s <- many (noneOf "\"") ;
      char '"' ;
      return (StringS s)}
 
numParser :: Parser SExpr
numParser =
 do {n <- many1 digit ;
     return (IntS (read n))}

listParser :: Parser SExpr
listParser =
 do {char '(' ;
     ls <- sepBy sexprParser spaces ;
     char ')' ;
     return (ListS ls)}

sexprParser :: Parser SExpr
sexprParser = 
     symParser 
 <|> boolParser
 <|> strParser 
 <|> numParser 
 <|> listParser

仕組みはよく分からんけど。これって効率とかどうなんだ？あと、parse関数の第二引数が何のために存在するのか謎。いやー、けどこんな簡単なんだったら、GHC External Coreのパーサを直接書いてもいいかな〜とか思い始めた。ていうか、自分で書かなくても、GHCのどっかにあるはずなんだけど、GHCのソースは入り組んでて、ちょろっとコピペしてくるってわけにもいかんだろうなーとか、そういうのが。まあ、知らんけど。そのへんは冬休みの宿題ってことで。

あとは機械的に

data Term = 
   Var String  -- variable
 | Lit Literal -- literal
 | Tuples [Term] 
 | Lam Args Term
 | Let String Term Term 
 | Case Term [(Pat,Term)] 
 | FApp String [Term]
 | CApp String [Term] -- constructor application
 | App Term Term -- application(general) 
 | Juncs [Term]  -- junc
 | Plus [Term]
 | Hylo Term Term Term
 | Tags (Int , Term) 
    deriving (Eq,Show)

data Literal =    --適宜修正
    HfUnit
  | HfBool Bool 
  | HfString String
  | HfInteger Integer 
  | HfChar Char
  | HfDouble Double 
     deriving (Eq,Show)

data Args = Argv String | Vars [String] deriving (Eq,Show)
data Pat = PVar String | PTuples [Pat] | CPat String [Pat] deriving (Eq,Show)

--S式をpattern式に
s2pat :: SExpr -> Pat
s2pat (SymS s) 
 = case (isUpper (head s)) of
    True -> CPat s []
    False -> PVar s
s2pat (ListS ((SymS a):cdr))
 = case (isUpper (head a)) of
    True -> CPat a (map s2pat cdr)
    False -> PTuples ((PVar a):(map s2pat cdr))

--S式をTermに
s2term :: SExpr -> Term
s2term (SymS v) = Var v
s2term (BoolS v) = Lit (HfBool v)
s2term (StringS v) = Lit (HfString v)
s2term (IntS v) = Lit (HfInteger v)
s2term (ListS [SymS "lambda" , ListS args , body]) -- lambda式
 = Lam (Vars (map (\x -> case x of (SymS s)->s) args)) (s2term body)
s2term (ListS [SymS "let" , ListS [SymS a,v] , body]) -- let式
 = Let a (s2term v) (s2term body)
s2term (ListS [SymS "case" , t0 , ListS body])
 = Case (s2term t0) (map (\x->case x of (ListS [p,t])-> (s2pat p,s2term t)) body)
s2term (ListS ((SymS f):args)) -- function application
 = case (isUpper (head f)) of
    True -> (CApp f (map s2term args))
    False -> (FApp f (map s2term args))

これでもう(Lam (Vars ["x" ,"y"]) ...)とか書かなくていい。

>s2term $ parseS "(lambda (n) (case n ((Nil 0) ((Cons a as) (+ a (sum as))))))"
Lam (Vars ["n"]) (Case (Var "n") [(CPat "Nil" [],Lit (HfInteger 0)),(CPat "Cons" [PVar "a",PVar "as"],FApp "+" [Var "a",FApp "sum" [Var "as"]])])

ルール
・大文字から始まるシンボルは、型構成子とみなす。小文字から始まるシンボルは変数
・let式の構文は、(let (var val) body)。(let ( (x 3) (y 4) ) body)みたいなことはできない

あー、あとはFusion書くだけだなぁ。ってか、そこがメインだけど

気になる点。
その１。「Case式の平坦化」の意味を私が誤解してるような気がしてきた。具体的に、どういう処理を指してるんだろうか。ていうか、どういう処理にしろ、あまり真面目に悩む必要もないかもしれない。多分、関数の微妙な表現形式の違い(let式がネストしてるかどうかとか)によって、得られるhylo-formが変わるというようなことはあるんだろうけど、んでもって、そういうのもあるから、HyloFusionは、最適化プロセスの最後の方に持ってくるほうがいいとか、そういう話なのかもしれないけど、でも、そういうのやりだすと、私はHaskell(のサブセットの)コンパイラ書くのかい？とか、そういう話になっちゃうしなぁ。適当にお茶濁しとけばいいかぁ的な。

その２。いまんとこ、(私が定義している)hylo-formは関手に関する情報([|phi,tau,psi|]_F,GのF,Gの部分)を持ってないけど、これは問題ないんだろうか。いい大人なんだから、それくらい推測してよね、とか。まあ、ダメだったらそのうち考える。

その３。hylo-formに変換するには、(\x1 ... xn -> case t0 of {p1->t1;...;pm->tm})という形の式を変換するわけだけど、変換後の式の形は(\x1 ... x(n-1) -> hylo ....)みたいなのになってる。てことは、仮引数の順番を考えてやらんといかんのではないかとか。Warm Fusionのときは、t0式に現れる仮引数とそうでない仮引数をまず区別してた記憶が。あとでよく考える