@@ -99,7 +99,9 @@ deriveGeneric mn ds tyConNm dargs = do
9999 ]
100100 where
101101 mkSpineFunction :: Declaration -> m Expr
102− mkSpineFunction (DataDeclaration _ _ _ args) = lamCase "$x" <$> mapM mkCtorClause args
102+ mkSpineFunction (DataDeclaration _ _ _ args) = do
103+ x <- freshIdent'
104+ lamCase x <$> mapM mkCtorClause args
103105 where
104106 prodConstructor :: Expr -> Expr
105107 prodConstructor = App (Constructor (Qualified (Just dataGeneric) (ProperName "SProd")))
@@ -122,7 +124,7 @@ deriveGeneric mn ds tyConNm dargs = do
122124 lamNull . recordConstructor . ArrayLiteral .
123125 map (\(str,typ) -> ObjectLiteral [("recLabel", StringLiteral str), ("recValue", toSpineFun (Accessor str i) typ)])
124126 $ decomposeRec rec
125− toSpineFun i _ = lamNull $ App (mkGenVar C.toSpine) i
127+ toSpineFun i _ = lamNull $ App (mkGenVar (Ident C.toSpine)) i
126128 mkSpineFunction (PositionedDeclaration _ _ d) = mkSpineFunction d
127129 mkSpineFunction _ = internalError "mkSpineFunction: expected DataDeclaration"
128130
@@ -154,14 +156,16 @@ deriveGeneric mn ds tyConNm dargs = do
154156 ]
155157 | (str, typ) <- decomposeRec rec
156158 ]
157− mkProductSignature typ = lamNull $ App (mkGenVar C.toSignature)
158− (TypedValue False (mkGenVar "anyProxy") (proxy typ))
159+ mkProductSignature typ = lamNull $ App (mkGenVar (Ident C.toSignature))
160+ (TypedValue False (mkGenVar (Ident "anyProxy")) (proxy typ))
159161 instantiate = replaceAllTypeVars (zipWith (\(arg, _) ty -> (arg, ty)) tyArgs classArgs)
160162 mkSignatureFunction (PositionedDeclaration _ _ d) classArgs = mkSignatureFunction d classArgs
161163 mkSignatureFunction _ _ = internalError "mkSignatureFunction: expected DataDeclaration"
162164
163165 mkFromSpineFunction :: Declaration -> m Expr
164− mkFromSpineFunction (DataDeclaration _ _ _ args) = lamCase "$x" <$> (addCatch <$> mapM mkAlternative args)
166+ mkFromSpineFunction (DataDeclaration _ _ _ args) = do
167+ x <- freshIdent'
168+ lamCase x <$> (addCatch <$> mapM mkAlternative args)
165169 where
166170 mkJust :: Expr -> Expr
167171 mkJust = App (Constructor (Qualified (Just dataMaybe) (ProperName "Just")))
@@ -188,36 +192,37 @@ deriveGeneric mn ds tyConNm dargs = do
188192 where
189193 catchAll = CaseAlternative [NullBinder] (Right mkNothing)
190194
195+ fromSpineFun :: Expr -> Type -> Expr
191196 fromSpineFun e r
192197 | Just rec <- objectType r
193− = App (lamCase "r" [ mkRecCase (decomposeRec rec)
194− , CaseAlternative [NullBinder] (Right mkNothing)
195− ])
196− (App e (mkPrelVar "unit"))
197−
198− fromSpineFun e _ = App (mkGenVar C.fromSpine) (App e (mkPrelVar "unit"))
198+ = App (lamCase (Ident "r") [ mkRecCase (decomposeRec rec)
199+ , CaseAlternative [NullBinder] (Right mkNothing)
200+ ])
201+ (App e (mkPrelVar (Ident "unit")))
202+ fromSpineFun e _ = App (mkGenVar (Ident C.fromSpine)) (App e (mkPrelVar (Ident "unit")))
199203
204+ mkRecCase :: [(String, Type)] -> CaseAlternative
200205 mkRecCase rs = CaseAlternative [ recordBinder [ ArrayBinder (map (VarBinder . Ident . fst) rs)
201206 ]
202207 ]
203208 . Right
204− $ liftApplicative (mkRecFun rs) (map (\(x, y) -> fromSpineFun (Accessor "recValue" (mkVar x)) y) rs)
209+ $ liftApplicative (mkRecFun rs) (map (\(x, y) -> fromSpineFun (Accessor "recValue" (mkVar (Ident x))) y) rs)
205210
206211 mkRecFun :: [(String, Type)] -> Expr
207− mkRecFun xs = mkJust $ foldr lam recLiteral (map fst xs)
208− where recLiteral = ObjectLiteral $ map (\(s,_) -> (s,mkVar s)) xs
212+ mkRecFun xs = mkJust $ foldr lam recLiteral (map (Ident . fst) xs)
213+ where recLiteral = ObjectLiteral $ map (\(s,_) -> (s, mkVar (Ident s))) xs
209214 mkFromSpineFunction (PositionedDeclaration _ _ d) = mkFromSpineFunction d
210215 mkFromSpineFunction _ = internalError "mkFromSpineFunction: expected DataDeclaration"
211216
212217 -- Helpers
213218
214219 liftApplicative :: Expr -> [Expr] -> Expr
215− liftApplicative = foldl' (\x e -> App (App (mkPrelVar "apply") x) e)
220+ liftApplicative = foldl' (\x e -> App (App (mkPrelVar (Ident "apply")) x) e)
216221
217− mkPrelVar :: String -> Expr
222+ mkPrelVar :: Ident -> Expr
218223 mkPrelVar = mkVarMn (Just (ModuleName [ProperName C.prelude]))
219224
220− mkGenVar :: String -> Expr
225+ mkGenVar :: Ident -> Expr
221226 mkGenVar = mkVarMn (Just (ModuleName [ProperName "Data", ProperName C.generic]))
222227
223228deriveEq ::
@@ -232,7 +237,10 @@ deriveEq mn ds tyConNm = do
232237 return [ ValueDeclaration (Ident C.eq) Public [] (Right eqFun) ]
233238 where
234239 mkEqFunction :: Declaration -> m Expr
235− mkEqFunction (DataDeclaration _ _ _ args) = lamCase2 "$x" "$y" <$> (addCatch <$> mapM mkCtorClause args)
240+ mkEqFunction (DataDeclaration _ _ _ args) = do
241+ x <- freshIdent "x"
242+ y <- freshIdent "y"
243+ lamCase2 x y <$> (addCatch <$> mapM mkCtorClause args)
236244 mkEqFunction (PositionedDeclaration _ _ d) = mkEqFunction d
237245 mkEqFunction _ = internalError "mkEqFunction: expected DataDeclaration"
238246
@@ -249,7 +257,8 @@ deriveEq mn ds tyConNm = do
249257
250258 mkCtorClause :: (ProperName 'ConstructorName, [Type]) -> m CaseAlternative
251259 mkCtorClause (ctorName, tys) = do
252− [identsL, identsR] <- replicateM 2 (replicateM (length tys) freshIdent')
260+ identsL <- replicateM (length tys) (freshIdent "l")
261+ identsR <- replicateM (length tys) (freshIdent "r")
253262 let tests = zipWith3 toEqTest (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys
254263 return $ CaseAlternative [caseBinder identsL, caseBinder identsR] (Right (conjAll tests))
255264 where
@@ -278,22 +287,23 @@ deriveOrd mn ds tyConNm = do
278287 return [ ValueDeclaration (Ident C.compare) Public [] (Right compareFun) ]
279288 where
280289 mkCompareFunction :: Declaration -> m Expr
281− mkCompareFunction (DataDeclaration _ _ _ args) = lamCase2 "$x" "$y" <$> (concat <$> mapM mkCtorClauses args)
290+ mkCompareFunction (DataDeclaration _ _ _ args) = do
291+ x <- freshIdent "x"
292+ y <- freshIdent "y"
293+ lamCase2 x y <$> (concat <$> mapM mkCtorClauses args)
282294 mkCompareFunction (PositionedDeclaration _ _ d) = mkCompareFunction d
283295 mkCompareFunction _ = internalError "mkCompareFunction: expected DataDeclaration"
284296
285297 preludeCtor :: String -> Expr
286298 preludeCtor = Constructor . Qualified (Just (ModuleName [ProperName C.prelude])) . ProperName
287299
288− preludeAppend :: Expr -> Expr -> Expr
289− preludeAppend = App . App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident C.append)))
290−
291300 preludeCompare :: Expr -> Expr -> Expr
292301 preludeCompare = App . App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident C.compare)))
293302
294303 mkCtorClauses :: (ProperName 'ConstructorName, [Type]) -> m [CaseAlternative]
295304 mkCtorClauses (ctorName, tys) = do
296− [identsL, identsR] <- replicateM 2 (replicateM (length tys) freshIdent')
305+ identsL <- replicateM (length tys) (freshIdent "l")
306+ identsR <- replicateM (length tys) (freshIdent "r")
297307 let tests = zipWith3 toOrdering (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys
298308 return [ CaseAlternative [ caseBinder identsL
299309 , caseBinder identsR
@@ -313,7 +323,14 @@ deriveOrd mn ds tyConNm = do
313323
314324 appendAll :: [Expr] -> Expr
315325 appendAll [] = preludeCtor "EQ"
316− appendAll xs = foldl1 preludeAppend xs
326+ appendAll [x] = x
327+ appendAll (x : xs) = Case [x] [ CaseAlternative [ ConstructorBinder (Qualified (Just (ModuleName [ProperName C.prelude])) (ProperName "LT")) [] ]
328+ (Right (preludeCtor "LT"))
329+ , CaseAlternative [ ConstructorBinder (Qualified (Just (ModuleName [ProperName C.prelude])) (ProperName "GT")) [] ]
330+ (Right (preludeCtor "GT"))
331+ , CaseAlternative [ NullBinder ]
332+ (Right (appendAll xs))
333+ ]
317334
318335 toOrdering :: Expr -> Expr -> Type -> Expr
319336 toOrdering l r ty | Just rec <- objectType ty =
@@ -334,22 +351,22 @@ findTypeDecl tyConNm = maybe (throwError . errorMessage $ CannotFindDerivingType
334351 isTypeDecl (PositionedDeclaration _ _ d) = isTypeDecl d
335352 isTypeDecl _ = False
336353
337−lam :: String -> Expr -> Expr
338−lam s = Abs (Left (Ident s))
354+lam :: Ident -> Expr -> Expr
355+lam = Abs . Left
339356
340357lamNull :: Expr -> Expr
341−lamNull = lam "$q"
358+lamNull = lam (Ident "$q") -- TODO: use GenIdent
342359
343−lamCase :: String -> [CaseAlternative] -> Expr
360+lamCase :: Ident -> [CaseAlternative] -> Expr
344361lamCase s = lam s . Case [mkVar s]
345362
346−lamCase2 :: String -> String -> [CaseAlternative] -> Expr
363+lamCase2 :: Ident -> Ident -> [CaseAlternative] -> Expr
347364lamCase2 s t = lam s . lam t . Case [mkVar s, mkVar t]
348365
349−mkVarMn :: Maybe ModuleName -> String -> Expr
350−mkVarMn mn s = Var (Qualified mn (Ident s))
366+mkVarMn :: Maybe ModuleName -> Ident -> Expr
367+mkVarMn mn = Var . Qualified mn
351368
352−mkVar :: String -> Expr
369+mkVar :: Ident -> Expr
353370mkVar = mkVarMn Nothing
354371
355372objectType :: Type -> Maybe Type