@@ -64,71 +64,3 @@ expr :: IParser Pattern
6464expr = do
6565 patterns <- consSep1 (patternConstructor <|> term)
6666 asPattern (foldr1 Pattern.cons patterns) <?> "pattern"
67−
68−{--
69−extract :: Pattern -> LExpr t v -> Unique (String, LExpr t v)
70−extract pattern body@(L t s _) =
71− let loc = L t s in
72− let fn x e = (x,e) in
73− case pattern of
74− PAnything -> return $ fn "_" body
75− PVar x -> return $ fn x body
76− PAlias x PAnything -> return $ fn x body
77− PAlias x p -> do
78− (x', body') <- extract p body
79− return $ fn x (loc $ Let [FnDef x' [] (loc $ Var x)] body')
80− PData name ps -> do
81− x <- guid
82− let a = '_' : show x
83− return . fn a . loc $ Case (loc (Var a)) [(pattern, body)]
84− PRecord fs -> do
85− x <- guid
86− let a = '_' : show x
87− toDef f = FnDef f [] (loc $ Access (loc $ Var a) f)
88− return . fn a . loc $ Let (map toDef fs) body
89−
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
94− go (x:args) ps e
95−
96−flatten :: [Pattern] -> LExpr t v -> Unique (IParser [Def t v])
97−flatten patterns exp@(L t s _) =
98− let loc = L t s in
99− case patterns of
100− PVar f : args -> do
101− (as,e) <- extracts args exp
102− return . return $
103− if isOp (head f) then let [a,b] = as in [ OpDef f a b e ]
104− else [ FnDef f as e ]
105−
106− [p] -> return `liftM` matchSingle p exp p
107−
108− _ -> return . fail $ "Pattern (" ++ unwords (map show patterns) ++
109− ") cannot be used on the left-hand side of an assign statement."
110−
111−matchSingle :: Pattern -> LExpr t v -> Pattern -> Unique [Def t v]
112−matchSingle pat exp@(L t s _) p =
113− let loc = L t s in
114− case p of
115− PData _ ps -> do
116− x <- guid
117− let v = '_' : show x
118− dss <- mapM (matchSingle pat . loc $ Var v) ps
119− return (FnDef v [] exp : concat dss)
120−
121− PVar x ->
122− return [ FnDef x [] (loc $ Case exp [(pat, loc $ Var x)]) ]
123−
124− PAlias x p' -> do
125− subPat <- matchSingle p' (loc $ Var x) p'
126− return $ (FnDef x [] (loc $ Case exp [(pat, loc $ Var x)])):subPat
127−
128− PRecord fs -> do
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)
132−
133− PAnything -> return []
134−--}