From 502979bef170d101e2ce8cdfed7fbbc6313edaec Mon Sep 17 00:00:00 2001 From: krasimir Date: Sat, 19 Sep 2009 10:16:37 +0000 Subject: [PATCH] use the syntax in PGF.Expr for typed expressions. This is consistent with the GF language --- src/PGF/Expr.hs | 25 +++++++------ testsuite/runtime/eval/eval.gfs | 24 ++++++------- testsuite/runtime/typecheck/typecheck.gfs | 18 +++++----- .../runtime/typecheck/typecheck.gfs.gold | 36 +++---------------- 4 files changed, 37 insertions(+), 66 deletions(-) diff --git a/src/PGF/Expr.hs b/src/PGF/Expr.hs index c17d410ee..d3a5992bb 100644 --- a/src/PGF/Expr.hs +++ b/src/PGF/Expr.hs @@ -127,28 +127,27 @@ unDouble (ELit (LFlt f)) = Just f ----------------------------------------------------- pExpr :: RP.ReadP Expr -pExpr = pExpr0 >>= optTyped +pExpr = RP.skipSpaces >> (pAbs RP.<++ pTerm) where - pExpr0 = RP.skipSpaces >> (pAbs RP.<++ pTerm) - pTerm = fmap (foldl1 EApp) (RP.sepBy1 pFactor RP.skipSpaces) pAbs = do xs <- RP.between (RP.char '\\') (RP.skipSpaces >> RP.string "->") (RP.sepBy1 (RP.skipSpaces >> pCId) (RP.skipSpaces >> RP.char ',')) - e <- pExpr0 + e <- pExpr return (foldr EAbs e xs) - - optTyped e = do RP.skipSpaces - RP.char ':' - RP.skipSpaces - ty <- pType - return (ETyped e ty) - RP.<++ - return e pFactor = fmap EFun pCId RP.<++ fmap ELit pLit RP.<++ fmap EMeta pMeta RP.<++ RP.between (RP.char '(') (RP.char ')') pExpr + RP.<++ RP.between (RP.char '<') (RP.char '>') pTyped + +pTyped = do RP.skipSpaces + e <- pExpr + RP.skipSpaces + RP.char ':' + RP.skipSpaces + ty <- pType + return (ETyped e ty) pMeta = do RP.char '?' return 0 @@ -184,7 +183,7 @@ ppExpr d scope (ELit l) = ppLit l ppExpr d scope (EMeta n) = ppMeta n ppExpr d scope (EFun f) = ppCId f ppExpr d scope (EVar i) = ppCId (scope !! i) -ppExpr d scope (ETyped e ty)= ppParens (d > 0) (ppExpr 0 scope e PP.<+> PP.colon PP.<+> ppType 0 scope ty) +ppExpr d scope (ETyped e ty)= PP.char '<' PP.<> ppExpr 0 scope e PP.<+> PP.colon PP.<+> ppType 0 scope ty PP.<> PP.char '>' ppPatt :: Int -> [CId] -> Patt -> ([CId],PP.Doc) ppPatt d scope (PApp f ps) = let (scope',ds) = mapAccumL (ppPatt 2) scope ps diff --git a/testsuite/runtime/eval/eval.gfs b/testsuite/runtime/eval/eval.gfs index c232161f4..9317ce92a 100644 --- a/testsuite/runtime/eval/eval.gfs +++ b/testsuite/runtime/eval/eval.gfs @@ -1,28 +1,28 @@ i -src testsuite/runtime/eval/Test.gf -pt -compute \x -> x 1 : (Int->Int)->Int -pt -compute (? : Int -> Int) 1 -pt -compute (\x -> x 1 : (Int->Int)->Int) ? +pt -compute <\x -> x 1 : (Int->Int)->Int> +pt -compute Int> 1 +pt -compute <\x -> x 1 : (Int->Int)->Int> ? pt -compute f 1 2 -pt -compute \x -> x : Nat -> Nat -pt -compute ? : String +pt -compute <\x -> x : Nat -> Nat> +pt -compute pt -compute f -pt -compute (\x -> x 2 : (Int->Int)->Int) (f 1) +pt -compute <\x -> x 2 : (Int->Int)->Int> (f 1) pt -compute g 1 pt -compute g 0 -pt -compute \x -> g x : Int -> Int +pt -compute <\x -> g x : Int -> Int> pt -compute g ? -pt -compute (\x -> x 5 : (Int->Int)->Int) (g2 1) -pt -compute (\x -> x 3 : (Int->Int)->Int) (\x -> x) +pt -compute <\x -> x 5 : (Int->Int)->Int> (g2 1) +pt -compute <\x -> x 3 : (Int->Int)->Int> (\x -> x) pt -compute g0 -pt -compute (\x -> x 32 : (Int -> Int -> Int) -> Int -> Int) (\x -> f x : Int -> Int -> Int) +pt -compute <\x -> x 32 : (Int -> Int -> Int) -> Int -> Int> <\x -> f x : Int -> Int -> Int> pt -compute g0 23 pt -compute const 3.14 "pi" pt -compute dec (succ (succ zero)) pt -compute dec (succ ?) -pt -compute \x -> dec x : Nat -> Nat +pt -compute <\x -> dec x : Nat -> Nat> pt -compute dec ? -pt -compute (\f -> f 0 : (Int -> Int) -> Int) (g3 ?) +pt -compute <\f -> f 0 : (Int -> Int) -> Int> (g3 ?) pt -compute g (g2 ? 0) pt -compute plus (succ zero) (succ zero) pt -compute dec2 0 (succ zero) diff --git a/testsuite/runtime/typecheck/typecheck.gfs b/testsuite/runtime/typecheck/typecheck.gfs index ef2f31698..5a663aef3 100644 --- a/testsuite/runtime/typecheck/typecheck.gfs +++ b/testsuite/runtime/typecheck/typecheck.gfs @@ -1,22 +1,22 @@ i -src testsuite/runtime/typecheck/Test.gf ai succ "0" -ai succ : Int 0 +ai ai 1 2 -ai (\x -> x 2 : (Int->Int)->Int) 1 +ai <\x -> x 2 : (Int->Int)->Int> 1 ai unknown_fun -ai 0 : unknown_cat +ai <0 : unknown_cat> ai \x -> x -ai \x -> x : Int +ai <\x -> x : Int> ai append (succ (succ zero)) (succ zero) (vector (succ (succ zero))) (vector (succ zero)) -ai \m,n -> vector (plus m n) : (m,n : Nat) -> Vector (plus m n) +ai <\m,n -> vector (plus m n) : (m,n : Nat) -> Vector (plus m n)> ai mkMorph (\x -> succ zero) ai idMorph (mkMorph (\x -> x)) ai idMorph (mkMorph (\x -> succ zero)) -ai append zero (succ zero) : Vector zero -> Vector (succ zero) -> Vector (succ zero) -ai \n,v1,n,v2 -> append ? ? v1 v2 : (n : Nat) -> Vector n -> (m : Nat) -> Vector m -> Vector (plus n m) -ai \n -> (\v1,v2 -> eqVector n v1 v2 : Vector ? -> Vector ? -> EQ) (vector ?) : (n : Nat) -> Vector n -> EQ -ai (\v1,v2 -> cmpVector ? v1 v2 : Vector ? -> Vector ? -> Int) (vector ?) +ai Vector (succ zero) -> Vector (succ zero)> +ai <\n,v1,n,v2 -> append ? ? v1 v2 : (n : Nat) -> Vector n -> (m : Nat) -> Vector m -> Vector (plus n m)> +ai <\n -> <\v1,v2 -> eqVector n v1 v2 : Vector ? -> Vector ? -> EQ> (vector ?) : (n : Nat) -> Vector n -> EQ> +ai <\v1,v2 -> cmpVector ? v1 v2 : Vector ? -> Vector ? -> Int> (vector ?) ai f0 ? vector ai f1 ? vector ai f1 ? (\x -> vector (succ x)) diff --git a/testsuite/runtime/typecheck/typecheck.gfs.gold b/testsuite/runtime/typecheck/typecheck.gfs.gold index ca0412fb8..f4c48d250 100644 --- a/testsuite/runtime/typecheck/typecheck.gfs.gold +++ b/testsuite/runtime/typecheck/typecheck.gfs.gold @@ -1,16 +1,9 @@ - Couldn't match expected type Nat against inferred type String In the expression: "0" - - Category Int should have 0 argument(s), but has been given 1 In the type: Int 0 - - A function type is expected for the expression 1 instead of type Int - - Couldn't match expected type Int -> Int against inferred type Int In the expression: 1 @@ -20,17 +13,12 @@ Function unknown_fun is not in scope Category unknown_cat is not in scope - - Cannot infer the type of expression \x -> x - - A function type is expected for the expression \x -> x instead of type Int - Expression: append (succ (succ zero)) (succ zero) (vector (succ (succ zero))) (vector (succ zero)) Type: Vector (plus (succ (succ zero)) (succ zero)) -Expression: \m, n -> vector (plus m n) : (m : Nat) -> (n : Nat) -> Vector (plus m n) +Expression: <\m, n -> vector (plus m n) : (m : Nat) -> (n : Nat) -> Vector (plus m n)> Type: (m : Nat) -> (n : Nat) -> Vector (plus m n) Expression: mkMorph (\x -> succ zero) @@ -39,64 +27,48 @@ Type: Morph (\x -> succ zero) Expression: idMorph (mkMorph (\x -> x)) Type: Nat - Couldn't match expected type Morph (\x -> x) against inferred type Morph (\x -> succ zero) In the expression: mkMorph (\x -> succ zero) - -Expression: append zero (succ zero) : Vector zero -> Vector (succ zero) -> Vector (succ zero) +Expression: Vector (succ zero) -> Vector (succ zero)> Type: Vector zero -> Vector (succ zero) -> Vector (succ zero) -Expression: \n, v1, n'1, v2 -> append n n'1 v1 v2 : (n : Nat) -> Vector n -> (m : Nat) -> Vector m -> Vector (plus n m) +Expression: <\n, v1, n'1, v2 -> append n n'1 v1 v2 : (n : Nat) -> Vector n -> (m : Nat) -> Vector m -> Vector (plus n m)> Type: (n : Nat) -> Vector n -> (m : Nat) -> Vector m -> Vector (plus n m) - Category EQ is not in scope - -Expression: (\v1, v2 -> cmpVector ?7 v1 v2 : Vector ?7 -> Vector ?7 -> Int) (vector ?7) +Expression: <\v1, v2 -> cmpVector ?7 v1 v2 : Vector ?7 -> Vector ?7 -> Int> (vector ?7) Type: Vector ?7 -> Int - Couldn't match expected type (m : Nat) -> Vector ?1 against inferred type (n : Nat) -> Vector n In the expression: vector - Expression: f1 (\v -> v) vector Type: Int Expression: f1 (\v -> succ v) (\x -> vector (succ x)) Type: Int - Couldn't match expected type Vector x against inferred type Vector (succ x) In the expression: vector (succ x) - - Couldn't match expected type Vector n against inferred type Vector (succ n) In the expression: vector (succ n) - Expression: h ?2 (u0 ?2) Type: Int - Couldn't match expected type U ?2 ?2 against inferred type U ?2 (succ ?2) In the expression: u1 ?2 - - Meta variable(s) ?11 should be resolved in the expression: cmpVector (succ (succ zero)) (vector (succ (succ zero))) (append ?11 (succ zero) (vector ?11) (vector (succ zero))) - Expression: diff (succ (succ (succ zero))) (succ (succ zero)) (vector (succ (succ (succ (succ (succ zero)))))) (vector (succ (succ (succ zero)))) Type: Vector (succ (succ zero)) Couldn't match expected type Vector (plus (succ (succ (succ zero))) (succ (succ zero))) against inferred type Vector (succ (succ (succ (succ zero)))) In the expression: vector (succ (succ (succ (succ zero)))) - Couldn't match expected type Vector ?1 against inferred type Vector zero In the expression: vector zero -