Mercurial > repo
view interps/rhotor/Evaluator.hs @ 11562:6b0304dcec5c draft
<oerjan> ` cd bin; cp welcome \xd0\xb4\xd0\xbe\xd0\xb1\xd1\x80\xd0\xbe-\xd0\xbf\xd0\xbe\xd0\xb6\xd0\xb0\xd0\xbb\xd0\xbe\xd0\xb2\xd0\xb0\xd1\x82\xd1\x8c; sled \xd0\xb4\xd0\xbe\xd0\xb1\xd1\x80\xd0\xbe-\xd0\xbf\xd0\xbe\xd0\xb6\xd0\xb0\xd0\xbb\xd0\xbe\xd0\xb2\xd0\xb0\xd1\x82\xd1\x8c//s,welcome,welcome.ru,
author | HackEso <hackeso@esolangs.org> |
---|---|
date | Wed, 16 May 2018 04:46:17 +0100 |
parents | 859f9b4339e6 |
children |
line wrap: on
line source
module Evaluator (evaluate) where import Node import Uniqs evaluate :: Node -> Node evaluate x = eval x--stripBreaks (eval x) eval :: Node -> Node eval (Cons a b) = Cons (eval a) (eval b) eval (Function a b c) = Function (eval a) (eval b) (eval c) eval (Application (Function a b c) d) = if patternMatch a d then eval (application a b d) else eval (Application c d) eval (Application Nil _) = Nil eval (Application (Cons a b) d) = eval (Cons (Application a d) (Application b d)) eval (Application y@(Application _ _) d) = eval (Application (eval y) d) eval (Application y@(Break _) d) = eval (Application (eval y) d) eval (Break x) = eval x eval x = x stripBreaks :: Node -> Node stripBreaks (Break a) = stripBreaks a stripBreaks (Function a b c) = Function (stripBreaks a) (stripBreaks b) (stripBreaks c) stripBreaks (Application a b) = Application (stripBreaks a) (stripBreaks b) stripBreaks (Cons a b) = Cons (stripBreaks a) (stripBreaks b) stripBreaks x = x patternMatch :: Node -> Node -> Bool patternMatch (Symbol _) _ = True patternMatch Nil Nil = True patternMatch (Cons a1 d1) (Cons a2 d2) = (patternMatch a1 a2) && (patternMatch d1 d2) -- patternMatch (Function a1 d1 c1) (Function a2 d2 c2) = (patternMatch a1 a2) && (patternMatch d1 d2) && (patternMatch e1 e2) patternMatch a@(Application _ _ ) b = patternMatch (eval a) b patternMatch a b@(Application _ _ ) = patternMatch a (eval a) patternMatch (Break a) b = patternMatch a b patternMatch a (Break b) = patternMatch a b patternMatch _ _ = False application :: Node -> Node -> Node -> Node application patrn func arg = applyList func (applicationList patrn arg) applyList :: Node -> [(Uniqs, Node)] -> Node applyList (Symbol y) list = getNodeForSymbol y list applyList (Cons a d) list = Cons (applyList a list) (applyList d list) applyList (Function a b c) list = Function (applyList a list) (applyList b list) (applyList c list) applyList (Application a b) list = Application (applyList a list) (applyList b list) applyList (Break a) _ = Break a applyList Nil _ = Nil getNodeForSymbol :: Uniqs -> [(Uniqs, Node)] -> Node getNodeForSymbol s tab = case (lookup s tab) of Just (Break a) -> Break a Just a -> Break a Nothing -> Symbol s applicationList :: Node -> Node -> [(Uniqs, Node)] applicationList (Symbol y) x = [(y,x)] applicationList Nil Nil = [] applicationList (Cons a1 d1) (Cons a2 d2) = (applicationList a1 a2) ++ (applicationList d1 d2) applicationList a@(Application _ _ ) b = applicationList (eval a) b applicationList a b@(Application _ _ ) = applicationList a (eval a) applicationList (Break a) b = applicationList a b applicationList a (Break b) = applicationList a b