|
|
| Строка 133: |
Строка 133: |
| Пишет Великий Факториал как: | | Пишет Великий Факториал как: |
|
| |
|
| <pre>
| | fac2 n = product [1..n] |
| | |
| data Term = Occ Var
| |
| | Use Prim
| |
| | Lit Integer
| |
| | App Term Term
| |
| | Abs Var Term
| |
| | Rec Var Term
| |
| | |
| type Var = String
| |
| type Prim = String
| |
| | |
| data Value = Num Integer
| |
| | Bool Bool
| |
| | Fun (Value -> Value)
| |
| | |
| instance Show Value where
| |
| show (Num n) = show n
| |
| show (Bool b) = show b
| |
| show (Fun _) = ""
| |
| | |
| prjFun (Fun f) = f
| |
| prjFun _ = error «bad function value»
| |
| | |
| prjNum (Num n) = n
| |
| prjNum _ = error «bad numeric value»
| |
| | |
| prjBool (Bool b) = b
| |
| prjBool _ = error «bad boolean value»
| |
| | |
| binOp inj f = Fun (\i -> (Fun (\j -> inj (f (prjNum i) (prjNum j)))))
| |
| | |
| type Env = [(Var, Value)]
| |
| | |
| getval x env = case lookup x env of
| |
| Just v -> v
| |
| Nothing -> error ("no value for " ++ x)
| |
| | |
| eval env (Occ x) = getval x env
| |
| eval env (Use c) = getval c prims
| |
| eval env (Lit k) = Num k
| |
| eval env (App m n) = prjFun (eval env m) (eval env n)
| |
| eval env (Abs x m) = Fun (\v -> eval ((x, v) : env) m)
| |
| eval env (Rec x m) = f where f = eval ((x, f) : env) m
| |
| | |
| times = binOp Num (*)
| |
| minus = binOp Num (-)
| |
| equal = binOp Bool (==)
| |
| cond = Fun (\b -> Fun (\x -> Fun (\y -> if (prjBool b) then x else y)))
| |
| | |
| prims = [ («*», times), («-», minus), («==", equal), ("if», cond) ]
| |
| | |
| facTerm = Rec «f» (Abs «n»
| |
| (App (App (App (Use "if")
| |
| (App (App (Use "==") (Occ "n")) (Lit 0))) (Lit 1))
| |
| (App (App (Use "*") (Occ "n"))
| |
| (App (Occ "f")
| |
| (App (App (Use "-") (Occ "n")) (Lit 1))))))
| |
| | |
| fac n = prjNum (eval [] (App facTerm (Lit n)))
| |
| | |
| </pre>
| |
|
| |
|
| === [[Григорий Перельман]] - 4 уровень === | | === [[Григорий Перельман]] - 4 уровень === |