@@ -5,9 +5,7 @@ import Idris.AbsSyntax
5import Idris.Docstrings
5import Idris.Docstrings
6import Idris.Error
6import Idris.Error
7import Idris.Delaborate
7import Idris.Delaborate
9−import Idris.ParseExpr -- Remove me
8+import Idris.ParseExpr
11import Idris.Core.TT
9import Idris.Core.TT
12import Idris.Core.Evaluate
10import Idris.Core.Evaluate
@@ -17,10 +15,6 @@ import Data.Maybe
17import Data.List
15import Data.List
18import Control.Monad
16import Control.Monad
21−-- Consider what to do about type parameters in projection that do not occur as a parameter.
22−-- I.e. set_bar : Foo n -> Vect n a
24elabRecord :: ElabInfo ->
18elabRecord :: ElabInfo ->
25 (Docstring (Either Err PTerm)) ->
19 (Docstring (Either Err PTerm)) ->
26 SyntaxInfo ->
20 SyntaxInfo ->
@@ -42,7 +36,7 @@ elabRecord info doc rsyn fc opts tyn params paramDocs fields fieldDocs cname cdo
42 logLvl 4 $ "Type constructor " ++ showTmImpls tycon
36 logLvl 4 $ "Type constructor " ++ showTmImpls tycon
44 -- Data constructor
38 -- Data constructor
45− dconName <- liftM (expandNS csyn) $ generateDConName cname
39+ dconName <- generateDConName cname
46 let dcon = generateDCon params fields
40 let dcon = generateDCon params fields
47 logLvl 4 $ "Data constructor: " ++ showTmImpls dcon
41 logLvl 4 $ "Data constructor: " ++ showTmImpls dcon
@@ -60,19 +54,22 @@ elabRecord info doc rsyn fc opts tyn params paramDocs fields fieldDocs cname cdo
61 -- The arguments to the constructor
55 -- The arguments to the constructor
62 let constructorArgs = getArgTys ttCons
56 let constructorArgs = getArgTys ttCons
57+ -- If elaborating the constructor has resulted in some new implicit fields we make projection functions for them.
58+ let freeFieldsForElab = map (freeField i) (filter (not . isFieldOrParam') constructorArgs)
63 -- The parameters for elaboration with their documentation
60 -- The parameters for elaboration with their documentation
64− paramsForElab = [((nsroot n), (param_name n), impl, t, d) | (n, t, d) <- zip' i params paramDocs]
61+ let paramsForElab = [((nsroot n), (param_name n), impl, t, d) | (n, t, d) <- zip' i params paramDocs]
65− -- If elaborating the constructor has resulted in some new implicit fields we make a projeciton functions for them.
62+
66− freeFieldsForElab = map (freeField i) (filter (not . isFieldOrParam') constructorArgs)
67 -- The fields (written by the user) with their documentation.
63 -- The fields (written by the user) with their documentation.
68− userFieldsForElab = [((nsroot n), n, p, t, d) | ((n, p, t), (_, d)) <- zip fields fieldDocs]
64+ let userFieldsForElab = [((nsroot n), n, p, t, d) | ((n, p, t), (_, d)) <- zip fields fieldDocs]
69− -- All things we need to elaborate projection functions for, together with a number denoting their position in the constructor.
66+ -- All things we need to elaborate projection functions for, together with a number denoting their position in the constructor.
70− fieldsForElab = [(n, n', p, t, d, i) | ((n, n', p, t, d), i) <- zip (freeFieldsForElab ++ paramsForElab ++ userFieldsForElab) [0..]]
67+ let fieldsForElab = [(n, n', p, t, d, i) | ((n, n', p, t, d), i) <- zip (freeFieldsForElab ++ paramsForElab ++ userFieldsForElab) [0..]]
72 -- Build projection functions
69 -- Build projection functions
73 elabProj dconName fieldsForElab
70 elabProj dconName fieldsForElab
74 -- Build update functions
71 -- Build update functions
75− elabUp dconName fieldsForElab -- [(n, n', p, t, d, i) | ((n, n', p, t, d), i) <- zip (paramsForElab ++ userFieldsForElab) [0..]]
72+ elabUp dconName [(n, n', p, t, d, i) | ((n, n', p, t, d), i) <- zip (paramsForElab ++ userFieldsForElab) [0..]]
77 -- | Generates a type constructor.
74 -- | Generates a type constructor.
78 generateTyCon :: [(Name, Plicity, PTerm)] -> PTerm
75 generateTyCon :: [(Name, Plicity, PTerm)] -> PTerm
@@ -116,7 +113,7 @@ elabRecord info doc rsyn fc opts tyn params paramDocs fields fieldDocs cname cdo
116 paramNames = [nsroot n | (n, _, _) <- params]
113 paramNames = [nsroot n | (n, _, _) <- params]
118 isFieldOrParam :: Name -> Bool
115 isFieldOrParam :: Name -> Bool
119− isFieldOrParam = flip elem (fieldNames ++ paramNames)
116+ isFieldOrParam n = n `elem` (fieldNames ++ paramNames)
121 isFieldOrParam' :: (Name, a) -> Bool
118 isFieldOrParam' :: (Name, a) -> Bool
122 isFieldOrParam' = isFieldOrParam . fst
119 isFieldOrParam' = isFieldOrParam . fst
@@ -245,7 +242,7 @@ elabProjection info cname pname plicity pty pdoc psyn fc tty cn phArgs fnames in
245 -- | The left hand side of the projection function.
242 -- | The left hand side of the projection function.
246 generateLhs :: PTerm
243 generateLhs :: PTerm
247 generateLhs = let args = lhsArgs index phArgs
244 generateLhs = let args = lhsArgs index phArgs
248− in PApp fc (PRef fc pname) [pexp (PApp fc (PRef fc cn) args)]
245+ in PApp fc (PRef fc pname) [pexp (PApp fc (PRef fc cn) args)]
250 lhsArgs :: Int -> [PArg] -> [PArg]
247 lhsArgs :: Int -> [PArg] -> [PArg]
251 lhsArgs 0 (_ : rest) = (asArg plicity (nsroot cname) (PRef fc pname_in)) : rest
248 lhsArgs 0 (_ : rest) = (asArg plicity (nsroot cname) (PRef fc pname_in)) : rest