From fd518ed2a3fe50238e0e9e7947e33cc9d5de9bce Mon Sep 17 00:00:00 2001 From: aarne Date: Tue, 27 Mar 2007 20:54:49 +0000 Subject: primitive pattern matching --- devel/compiler/Match.hs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 devel/compiler/Match.hs (limited to 'devel/compiler/Match.hs') diff --git a/devel/compiler/Match.hs b/devel/compiler/Match.hs new file mode 100644 index 000000000..a9ac839ef --- /dev/null +++ b/devel/compiler/Match.hs @@ -0,0 +1,21 @@ +module Match where + +import AbsSrc +import AbsTgt + +import Env +import STM + +match :: [Case] -> Exp -> STM Env Exp +match cs v = checks $ map (tryMatch v) cs + +---- return substitution +tryMatch :: Exp -> Case -> STM Env Exp +tryMatch e (Cas p v) = if fit (e, p) then return v else raise "no fit" where + fit (exp,patt) = case (exp,patt) of + (ECst c es, PCon d ps) -> + c == d && + length es == length ps && + all fit (zip es ps) + (_,PVar _) -> True ---- not is exp contains variables + -- cgit v1.2.3