@@ -49,13 +49,9 @@ elaborateInstance e = return e
4949mkSpineFunction :: (Functor m, MonadState CheckState m) => Qualified ProperName -> m Expr
5050mkSpineFunction t = do
5151 ctors <- M.toList . dataConstructors <$> getEnv
52− tcs <- M.toList . typeClasses <$> getEnv
5352 let prodConstructor = App (Constructor $ findName "SProd" ctors)
5453 recordConstructor = App (Constructor $ findName "SRecord" ctors)
5554
56− --TODO always set this
57− genericModule = case findName C.generic tcs of (Qualified mn _) -> mn
58−
5955 mkCtorClause (ctorName, (_,_,typ,idents)) = CaseAlternative [ConstructorBinder ctorName (map VarBinder idents)] (Right caseResult)
6056 where caseResult = App (prodConstructor (StringLiteral . runProperName . unQualify $ ctorName)) . ArrayLiteral $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) (argTypes typ)
6157
@@ -64,7 +60,7 @@ mkSpineFunction t = do
6460 lamNull . recordConstructor . ArrayLiteral .
6561 map (\(str,typ) -> ObjectLiteral [("recLabel", StringLiteral str), ("recValue", toSpineFun (Accessor str i) typ)])
6662 $ decomposeRec rec
67− toSpineFun i _ = lamNull $ App (mkVarMn genericModule C.toSpine) i
63+ toSpineFun i _ = lamNull $ App (mkGenVar C.toSpine) i
6864
6965 return . lamCase "$x" . map mkCtorClause . constructorsForType t $ ctors
7066
@@ -72,33 +68,26 @@ mkSignatureFunction :: (Functor m, MonadState CheckState m) => Qualified ProperN
7268mkSignatureFunction t = do
7369 ctors <- M.toList . dataConstructors <$> getEnv
7470 envtyps <- M.toList . types <$> getEnv
75− tcs <- M.toList . typeClasses <$> getEnv
7671 let mkSigProd = App (Constructor $ findName "SigProd" ctors) . ArrayLiteral
7772 mkSigRec = App (Constructor $ findName "SigRecord" ctors) . ArrayLiteral
7873
79− -- TODO always fix this
80− genericModule = case findName "Generic" tcs of (Qualified mn _) -> mn
81−
8274 mkProdClause (ctorName, (_,_,typ,_)) = ObjectLiteral [("sigConstructor",StringLiteral (runProperName . unQualify $ ctorName)),("sigValues", ArrayLiteral . map mkProductSignature . argTypes $ typ)]
8375
8476 mkProductSignature (ObjectType rec) =
8577 lamNull . mkSigRec .
8678 map (\(str,typ) -> ObjectLiteral [("recLabel", StringLiteral str), ("recValue", mkProductSignature typ)])
8779 $ decomposeRec rec
88− mkProductSignature typ = lamNull $ App (mkVarMn genericModule "toSignature")
89− (TypedValue False (mkVarMn genericModule "anyProxy") (TypeApp (TypeConstructor $ findName "Proxy" envtyps) typ))
80+ mkProductSignature typ = lamNull $ App (mkGenVar C.toSignature)
81+ (TypedValue False (mkGenVar "anyProxy") (TypeApp (TypeConstructor $ findName "Proxy" envtyps) typ))
9082
9183 return . lamNull . mkSigProd . map mkProdClause . constructorsForType t $ ctors
9284
9385mkFromSpineFunction :: (Functor m, MonadState CheckState m) => Qualified ProperName -> m Expr
9486mkFromSpineFunction t = do
9587 ctors <- M.toList . dataConstructors <$> getEnv
96− tcs <- M.toList . typeClasses <$> getEnv
9788 let
9889 mkJust = App (Constructor $ findName "Just" ctors)
9990 mkNothing = Constructor $ findName "Nothing" ctors
100− --TODO hardwire this
101− genericModule = case findName "Generic" tcs of (Qualified mn _) -> mn
10291
10392 mkAlternative (ctor@(Qualified _ (ProperName ctorName)), (_,_,typ,idents)) =
10493 CaseAlternative [ConstructorBinder (findName "SProd" ctors) [StringBinder ctorName, ArrayBinder (map VarBinder idents)]]
@@ -106,7 +95,7 @@ mkFromSpineFunction t = do
10695
10796 fromSpineFun e (ObjectType rec) = App (lamCase "r" [mkRecCase (decomposeRec rec), CaseAlternative [NullBinder] (Right mkNothing)]) (App e (mkPrelVar "unit"))
10897
109− fromSpineFun e _ = App (mkVarMn genericModule C.fromSpine) (App e (mkPrelVar "unit"))
98+ fromSpineFun e _ = App (mkGenVar C.fromSpine) (App e (mkPrelVar "unit"))
11099
111100 mkRecCase rs = CaseAlternative [ConstructorBinder (findName "SRecord" ctors) [ArrayBinder (map (VarBinder . Ident . fst) rs)]] . Right $ liftApplicative (mkRecFun rs) (map (\(x,y) -> fromSpineFun (Accessor "recValue" (mkVar x)) y) rs)
112101
@@ -124,7 +113,7 @@ lam :: String -> Expr -> Expr
124113lam s = Abs (Left (Ident s))
125114
126115lamNull :: Expr -> Expr
127−lamNull = Abs (Right NullBinder)
116+lamNull = lam "$q"
128117
129118lamCase :: String -> [CaseAlternative] -> Expr
130119lamCase s = lam s . Case [mkVar s]
@@ -141,6 +130,9 @@ mkVar s = mkVarMn Nothing s
141130mkPrelVar :: String -> Expr
142131mkPrelVar s = mkVarMn (Just (ModuleName [ProperName C.prelude])) s
143132
133+mkGenVar :: String -> Expr
134+mkGenVar s = mkVarMn (Just (ModuleName [ProperName "Data", ProperName C.generic])) s
135+
144136decomposeRec :: Type -> [(String, Type)]
145137decomposeRec = sortBy (comparing fst) . go
146138 where go (RCons str typ typs) = (str, typ) : decomposeRec typs