diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/PGF.hs | 2 | ||||
| -rw-r--r-- | src/PGF/Data.hs | 52 | ||||
| -rw-r--r-- | src/PGF/Expr.hs | 45 | ||||
| -rw-r--r-- | src/PGF/Type.hs | 26 | ||||
| -rw-r--r-- | src/server/MainFastCGI.hs | 1 |
5 files changed, 69 insertions, 57 deletions
diff --git a/src/PGF.hs b/src/PGF.hs index 19b3d2f8a..113cc08b8 100644 --- a/src/PGF.hs +++ b/src/PGF.hs @@ -69,8 +69,6 @@ import PGF.TypeCheck import PGF.Paraphrase import PGF.Macros import PGF.Data -import PGF.Expr -import PGF.Type import PGF.Raw.Convert import PGF.Raw.Parse import PGF.Raw.Print (printTree) diff --git a/src/PGF/Data.hs b/src/PGF/Data.hs index 644e33750..8ee95c579 100644 --- a/src/PGF/Data.hs +++ b/src/PGF/Data.hs @@ -1,6 +1,8 @@ -module PGF.Data where +module PGF.Data (module PGF.Data, module PGF.Expr, module PGF.Type) where import PGF.CId +import PGF.Expr hiding (Value, Env) +import PGF.Type import GF.Text.UTF8 import qualified Data.Map as Map @@ -40,42 +42,6 @@ data Concr = Concr { parser :: Maybe ParserInfo -- parser } -data Type = - DTyp [Hypo] CId [Expr] - deriving (Eq,Ord,Show) - -data Literal = - LStr String -- ^ string constant - | LInt Integer -- ^ integer constant - | LFlt Double -- ^ floating point constant - deriving (Eq,Ord,Show) - --- | The tree is an evaluated expression in the abstract syntax --- of the grammar. The type is especially restricted to not --- allow unapplied lambda abstractions. The tree is used directly --- from the linearizer and is produced directly from the parser. -data Tree = - Abs [CId] Tree -- ^ lambda abstraction. The list of variables is non-empty - | Var CId -- ^ variable - | Fun CId [Tree] -- ^ function application - | Lit Literal -- ^ literal - | Meta Int -- ^ meta variable - deriving (Show, Eq, Ord) - --- | An expression represents a potentially unevaluated expression --- in the abstract syntax of the grammar. It can be evaluated with --- the 'expr2tree' function and then linearized or it can be used --- directly in the dependent types. -data Expr = - EAbs CId Expr -- ^ lambda abstraction - | EApp Expr Expr -- ^ application - | ELit Literal -- ^ literal - | EMeta Int -- ^ meta variable - | EVar CId -- ^ variable or function reference - | EEq [Equation] -- ^ lambda function defined as a set of equations with pattern matching - | EPi CId Expr Expr -- ^ dependent function type - deriving (Eq,Ord,Show) - data Term = R [Term] | P Term Term @@ -98,18 +64,6 @@ data Alternative = Alt [String] [String] deriving (Eq,Ord,Show) -data Hypo = - Hyp CId Type - deriving (Eq,Ord,Show) - --- | The equation is used to define lambda function as a sequence --- of equations with pattern matching. The list of 'Expr' represents --- the patterns and the second 'Expr' is the function body for this --- equation. -data Equation = - Equ [Expr] Expr - deriving (Eq,Ord,Show) - type FCat = Int type FIndex = Int diff --git a/src/PGF/Expr.hs b/src/PGF/Expr.hs index 454989728..0dde19310 100644 --- a/src/PGF/Expr.hs +++ b/src/PGF/Expr.hs @@ -1,4 +1,7 @@ -module PGF.Expr(readTree, showTree, pTree, ppTree,
+module PGF.Expr(Tree(..), Literal(..),
+ readTree, showTree, pTree, ppTree,
+
+ Expr(..), Equation(..),
readExpr, showExpr, pExpr, ppExpr,
tree2expr, expr2tree,
@@ -11,7 +14,6 @@ module PGF.Expr(readTree, showTree, pTree, ppTree, ) where
import PGF.CId
-import PGF.Data
import Data.Char
import Data.Maybe
@@ -20,6 +22,45 @@ import qualified Text.PrettyPrint as PP import qualified Text.ParserCombinators.ReadP as RP
import qualified Data.Map as Map
+data Literal =
+ LStr String -- ^ string constant
+ | LInt Integer -- ^ integer constant
+ | LFlt Double -- ^ floating point constant
+ deriving (Eq,Ord,Show)
+
+-- | The tree is an evaluated expression in the abstract syntax
+-- of the grammar. The type is especially restricted to not
+-- allow unapplied lambda abstractions. The tree is used directly
+-- from the linearizer and is produced directly from the parser.
+data Tree =
+ Abs [CId] Tree -- ^ lambda abstraction. The list of variables is non-empty
+ | Var CId -- ^ variable
+ | Fun CId [Tree] -- ^ function application
+ | Lit Literal -- ^ literal
+ | Meta Int -- ^ meta variable
+ deriving (Show, Eq, Ord)
+
+-- | An expression represents a potentially unevaluated expression
+-- in the abstract syntax of the grammar. It can be evaluated with
+-- the 'expr2tree' function and then linearized or it can be used
+-- directly in the dependent types.
+data Expr =
+ EAbs CId Expr -- ^ lambda abstraction
+ | EApp Expr Expr -- ^ application
+ | ELit Literal -- ^ literal
+ | EMeta Int -- ^ meta variable
+ | EVar CId -- ^ variable or function reference
+ | EEq [Equation] -- ^ lambda function defined as a set of equations with pattern matching
+ | EPi CId Expr Expr -- ^ dependent function type
+ deriving (Eq,Ord,Show)
+
+-- | The equation is used to define lambda function as a sequence
+-- of equations with pattern matching. The list of 'Expr' represents
+-- the patterns and the second 'Expr' is the function body for this
+-- equation.
+data Equation =
+ Equ [Expr] Expr
+ deriving (Eq,Ord,Show)
-- | parses 'String' as an expression
readTree :: String -> Maybe Tree
diff --git a/src/PGF/Type.hs b/src/PGF/Type.hs index cfe0bbe72..9ec5b3022 100644 --- a/src/PGF/Type.hs +++ b/src/PGF/Type.hs @@ -1,7 +1,8 @@ -module PGF.Type ( readType, showType, pType, ppType ) where
+module PGF.Type ( Type(..), Hypo(..),
+ readType, showType,
+ pType, ppType ) where
import PGF.CId
-import PGF.Data
import PGF.Expr
import Data.Char
import qualified Text.PrettyPrint as PP
@@ -9,16 +10,32 @@ import qualified Text.ParserCombinators.ReadP as RP import Control.Monad
import Debug.Trace
--- | parses 'String' as an expression
+-- | To read a type from a 'String', use 'read' or 'readType'.
+data Type =
+ DTyp [Hypo] CId [Expr]
+ deriving (Eq,Ord)
+
+data Hypo =
+ Hyp CId Type
+ deriving (Eq,Ord,Show)
+
+-- | Reads a 'Type' from a 'String'.
readType :: String -> Maybe Type
readType s = case [x | (x,cs) <- RP.readP_to_S pType s, all isSpace cs] of
[x] -> Just x
_ -> Nothing
+instance Show Type where
+ showsPrec i x = showString (PP.render (ppType i x))
+
+instance Read Type where
+ readsPrec _ = RP.readP_to_S pType
+
-- | renders type as 'String'
showType :: Type -> String
showType = PP.render . ppType 0
+pType :: RP.ReadP Type
pType = do
RP.skipSpaces
hyps <- RP.sepBy (pHypo >>= \h -> RP.string "->" >> return h) RP.skipSpaces
@@ -45,7 +62,7 @@ pType = do args <- RP.sepBy pFactor RP.skipSpaces
return (mkCId cat, args)
-
+ppType :: Int -> Type -> PP.Doc
ppType d (DTyp ctxt cat args)
| null ctxt = ppRes cat args
| otherwise = ppParens (d > 0) (foldr ppCtxt (ppRes cat args) ctxt)
@@ -56,5 +73,6 @@ ppType d (DTyp ctxt cat args) ppRes cat es = PP.text (prCId cat) PP.<+> PP.hsep (map (ppExpr 2) es)
+ppParens :: Bool -> PP.Doc -> PP.Doc
ppParens True = PP.parens
ppParens False = id
diff --git a/src/server/MainFastCGI.hs b/src/server/MainFastCGI.hs index 38748fcc4..69f5fb419 100644 --- a/src/server/MainFastCGI.hs +++ b/src/server/MainFastCGI.hs @@ -54,6 +54,7 @@ pgfMain pgf command = getCat = do mcat <- getInput "cat" case mcat of + Nothing -> return Nothing Just "" -> return Nothing Just cat | cat `notElem` PGF.categories pgf -> throwCGIError 400 "Unknown category" ["Unknown category: " ++ cat] |