primitive pattern matching

1 files changed, 21 insertions, 0 deletions

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
+