diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/compiler/GF/Compile/Concrete/TypeCheck.hs | 8 | ||||
| -rw-r--r-- | src/compiler/GF/Grammar/Printer.hs | 1 |
2 files changed, 6 insertions, 3 deletions
diff --git a/src/compiler/GF/Compile/Concrete/TypeCheck.hs b/src/compiler/GF/Compile/Concrete/TypeCheck.hs index 670f36625..eafa0dbd7 100644 --- a/src/compiler/GF/Compile/Concrete/TypeCheck.hs +++ b/src/compiler/GF/Compile/Concrete/TypeCheck.hs @@ -256,7 +256,7 @@ inferLType gr g trm = case trm of -- for record fields, which may be typed inferM (mty, t) = do (t', ty') <- case mty of - Just ty -> checkLType gr g ty t + Just ty -> checkLType gr g t ty _ -> inferLType gr g t return (Just ty',t') @@ -431,6 +431,7 @@ checkLType gr g trm typ0 = do ExtR (Vr _) (RecType _) -> termWith trm $ return typeType -- ext t = t ** ... _ -> checkError (text "invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm)) + RecType rr -> do (r',ty,s') <- checks [ do (r',ty) <- inferLType gr g r @@ -438,7 +439,8 @@ checkLType gr g trm typ0 = do , do (s',ty) <- inferLType gr g s return (s',ty,r) - ] + ] + case ty of RecType rr1 -> do let (rr0,rr2) = recParts rr rr1 @@ -451,7 +453,7 @@ checkLType gr g trm typ0 = do ExtR ty ex -> do r' <- justCheck g r ty s' <- justCheck g s ex - return $ (ExtR r' s', typ) --- is this all? + return $ (ExtR r' s', typ) --- is this all? it assumes the same division in trm and typ _ -> checkError (text "record extension not meaningful for" <+> ppTerm Unqualified 0 typ) diff --git a/src/compiler/GF/Grammar/Printer.hs b/src/compiler/GF/Grammar/Printer.hs index 1db1eb4f3..8c5b06d9b 100644 --- a/src/compiler/GF/Grammar/Printer.hs +++ b/src/compiler/GF/Grammar/Printer.hs @@ -176,6 +176,7 @@ ppTerm q d (EInt n) = integer n ppTerm q d (EFloat f) = double f
ppTerm q d (Meta _) = char '?'
ppTerm q d (Empty) = text "[]"
+ppTerm q d (R []) = text "<>" -- to distinguish from {} empty RecType
ppTerm q d (R xs) = braces (fsep (punctuate semi [ppLabel l <+>
fsep [case mb_t of {Just t -> colon <+> ppTerm q 0 t; Nothing -> empty},
equals <+> ppTerm q 0 e] | (l,(mb_t,e)) <- xs]))
|