Concurrent Clean : [id:lethevert:20060801:p3]を作った
今度はCleanで。
同じような感じに書いたので、あまり変わり映えがしない気がする。
後で、Parserライブラリを使って書いてみよう。
module Main import StdEnv, OptEnv Start :: *World -> *World Start w = w --> f input where f s = s --> parse --> snd --> eval input = "(begin\n" +++ " (print (concat Hell \"o W\" \"orld!\"))\n" +++ " (print \"1+2*3*4 = \" (+ 1 (* 2 3 4)))\n" +++ " ((concat pri nt) ok))\n" ::Tree = Branch Tree Tree | Leaf String | NIL str :: [Char] -> {#Char} str s = {x \\ x <- reverse s} parse :: {#Char} -> (Int, Tree) parse input = parse [] 0 where len = size input parse s i | i >= len = case s of [] = (i, NIL) _ = (i, Branch (Leaf (str s)) NIL) parse s i = p input.[i] where p '(' = case s of [] = (i1, Branch t0 t1) _ = (i1, Branch (Leaf (str s)) (Branch t0 t1)) where (i0, t0) = parse [] (inc i) (i1, t1) = parse [] i0 p ')' = case s of [] = (inc i, NIL) _ = (inc i, Branch (Leaf (str s)) NIL) p '\"' = case s of [] = (i1, Branch t0 t1) _ = (i1, Branch (Leaf (str s)) (Branch t0 t1)) where (i0, t0) = parseStr [] (inc i) (i1, t1) = parse [] i0 p c | isSpace c = case s of [] = parse [] (inc i) _ = (i0, Branch (Leaf (str s)) t0) where (i0, t0) = parse [] (inc i) p c = parse [c:s] (inc i) parseStr s i = p input.[i] where p '\"' = (inc i, Leaf (str s)) p '\\' = parseStr [input.[inc i]:s] (i+2) p c = parseStr [c:s] (inc i) eval :: Tree *World -> *World eval t w # (f,w) = stdio w (_,f) = f --> evalArgs t (_,w) = fclose f w = w; where evalArgs (Branch t0 t1) f # (s0,f) = eval t0 f (s1,f) = evalArgs t1 f = (Branch s0 s1, f) evalArgs t f = (t, f) eval (t=:(Branch _ _)) f # (Branch (Leaf s) t, f) = evalArgs t f = apply s t f where apply "begin" t f = (last t, f) where last (Branch _ tr) = last tr last t = t apply "print" t f = print t f where print (Branch (Leaf s) tr) f = f --> fwrites s --> print tr print _ f = (Leaf "ok", f --> fwrites "\n") apply "concat" t f = (Leaf s, f) where s = {x \\ x <- concat t} concat (Branch (Leaf s) tr) = [x \\ x <-:s] ++ concat tr concat _ = [] apply "+" t f = (Leaf (toString (add t)), f) where add (Branch (Leaf s) tr) = toInt s + add tr add _ = 0 apply "*" t f = (Leaf (toString (mul t)), f) where mul (Branch (Leaf s) tr) = toInt s * mul tr mul _ = 1 eval t f = (t,f)