@@ -64,71 +64,3 @@ expr :: IParser Pattern
65 patterns <- consSep1 (patternConstructor <|> term)
65 patterns <- consSep1 (patternConstructor <|> term)
66 asPattern (foldr1 Pattern.cons patterns) <?> "pattern"
66 asPattern (foldr1 Pattern.cons patterns) <?> "pattern"
69−extract :: Pattern -> LExpr t v -> Unique (String, LExpr t v)
70−extract pattern body@(L t s _) =
72− let fn x e = (x,e) in
74− PAnything -> return $ fn "_" body
75− PVar x -> return $ fn x body
76− PAlias x PAnything -> return $ fn x body
78− (x', body') <- extract p body
79− return $ fn x (loc $ Let [FnDef x' [] (loc $ Var x)] body')
83− return . fn a . loc $ Case (loc (Var a)) [(pattern, body)]
87− toDef f = FnDef f [] (loc $ Access (loc $ Var a) f)
88− return . fn a . loc $ Let (map toDef fs) body
90−extracts :: [Pattern] -> LExpr t v -> Unique ([String], LExpr t v)
91−extracts ps body = go [] (reverse ps) body
92− where go args [] body = return (args, body)
93− go args (p:ps) body = do (x,e) <- extract p body
96−flatten :: [Pattern] -> LExpr t v -> Unique (IParser [Def t v])
97−flatten patterns exp@(L t s _) =
101− (as,e) <- extracts args exp
103− if isOp (head f) then let [a,b] = as in [ OpDef f a b e ]
104− else [ FnDef f as e ]
106− [p] -> return `liftM` matchSingle p exp p
108− _ -> return . fail $ "Pattern (" ++ unwords (map show patterns) ++
109− ") cannot be used on the left-hand side of an assign statement."
111−matchSingle :: Pattern -> LExpr t v -> Pattern -> Unique [Def t v]
112−matchSingle pat exp@(L t s _) p =
117− let v = '_' : show x
118− dss <- mapM (matchSingle pat . loc $ Var v) ps
119− return (FnDef v [] exp : concat dss)
122− return [ FnDef x [] (loc $ Case exp [(pat, loc $ Var x)]) ]
125− subPat <- matchSingle p' (loc $ Var x) p'
126− return $ (FnDef x [] (loc $ Case exp [(pat, loc $ Var x)])):subPat
129− a <- (\x -> '_' : show x) `liftM` guid
130− let toDef f = FnDef f [] (loc $ Access (loc $ Var a) f)
131− return (FnDef a [] exp : map toDef fs)
133− PAnything -> return []