mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-08 18:52:50 -06:00
Putting def definitions in place.
This commit is contained in:
@@ -61,6 +61,7 @@ data Exp =
|
||||
| EProd Ident Exp Exp
|
||||
| EAbs Ident Exp
|
||||
| EAtom Atom
|
||||
| EData
|
||||
| EEq [Equation]
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
|
||||
@@ -47,7 +47,7 @@ redInfo (c,info) = errIn ("decompiling abstract" +++ show c) $ do
|
||||
c' <- redIdent c
|
||||
info' <- case info of
|
||||
AbsCat cont fs -> do
|
||||
return $ G.AbsCat (Yes cont) (Yes fs)
|
||||
return $ G.AbsCat (Yes cont) (Yes (map (uncurry G.Q) fs))
|
||||
AbsFun typ df -> do
|
||||
return $ G.AbsFun (Yes typ) (Yes df)
|
||||
|
||||
|
||||
@@ -67,7 +67,8 @@ trExp t = case t of
|
||||
EProd x a b -> A.Prod x (trExp a) (trExp b)
|
||||
EAbs x b -> A.Abs x (trExp b)
|
||||
EApp f a -> A.App (trExp f) (trExp a)
|
||||
EEq _ -> A.Eqs [] ---- eqs
|
||||
EEq eqs -> A.Eqs [(map trPt ps, trExp e) | Equ ps e <- eqs]
|
||||
EData -> A.EData
|
||||
_ -> trAt t
|
||||
where
|
||||
trAt (EAtom t) = case t of
|
||||
@@ -78,6 +79,12 @@ trExp t = case t of
|
||||
AT s -> A.Sort $ prt s
|
||||
AS s -> A.K s
|
||||
AI i -> A.EInt $ fromInteger i
|
||||
trPt p = case p of
|
||||
APC mc ps -> let (m,c) = trQIdent mc in A.PP m c (map trPt ps)
|
||||
APV x -> A.PV x
|
||||
APS s -> A.PString s
|
||||
API i -> A.PInt $ fromInteger i
|
||||
APW -> A.PW
|
||||
|
||||
trQIdent (CIQ m c) = (m,c)
|
||||
|
||||
@@ -102,7 +109,8 @@ rtExp t = case t of
|
||||
A.Prod x a b -> EProd (rtIdent x) (rtExp a) (rtExp b)
|
||||
A.Abs x b -> EAbs (rtIdent x) (rtExp b)
|
||||
A.App f a -> EApp (rtExp f) (rtExp a)
|
||||
A.Eqs _ -> EEq [] ---- eqs
|
||||
A.Eqs eqs -> EEq [Equ (map rtPt ps) (rtExp e) | (ps,e) <- eqs]
|
||||
A.EData -> EData
|
||||
_ -> EAtom $ rtAt t
|
||||
where
|
||||
rtAt t = case t of
|
||||
@@ -114,6 +122,14 @@ rtExp t = case t of
|
||||
A.K s -> AS s
|
||||
A.EInt i -> AI $ toInteger i
|
||||
_ -> error $ "MkGFC.rt not defined for" +++ show t
|
||||
rtPt p = case p of
|
||||
A.PP m c ps -> APC (rtQIdent (m,c)) (map rtPt ps)
|
||||
A.PV x -> APV x
|
||||
A.PString s -> APS s
|
||||
A.PInt i -> API $ toInteger i
|
||||
A.PW -> APW
|
||||
_ -> error $ "MkGFC.rt not defined for" +++ show p
|
||||
|
||||
|
||||
rtQIdent (m,c) = CIQ (rtIdent m) (rtIdent c)
|
||||
rtIdent x
|
||||
|
||||
@@ -163,6 +163,7 @@ instance Print Exp where
|
||||
EAtom atom -> prPrec i 2 (concat [prt 0 atom])
|
||||
EAbs id exp -> prPrec i 0 (concat [["\\"] , prt 0 id , ["->"] , prt 0 exp])
|
||||
EEq equations -> prPrec i 0 (concat [["{"] , prt 0 equations , ["}"]])
|
||||
EData -> prPrec i 2 (concat [["data"]])
|
||||
|
||||
instance Print Sort where
|
||||
prt i e = case e of
|
||||
@@ -185,7 +186,7 @@ instance Print APatt where
|
||||
APW -> prPrec i 0 (concat [["_"]])
|
||||
|
||||
prtList es = case es of
|
||||
[x] -> (concat [prt 0 x])
|
||||
[] -> (concat [])
|
||||
x:xs -> (concat [prt 0 x , prt 0 xs])
|
||||
|
||||
instance Print Atom where
|
||||
|
||||
@@ -1,7 +1,5 @@
|
||||
module SkelGFC where
|
||||
|
||||
import Ident
|
||||
|
||||
-- Haskell module generated by the BNF converter
|
||||
|
||||
import AbsGFC
|
||||
@@ -13,7 +11,7 @@ failure x = Bad $ "Undefined case: " ++ show x
|
||||
|
||||
transIdent :: Ident -> Result
|
||||
transIdent x = case x of
|
||||
_ -> failure x
|
||||
Ident str -> failure x
|
||||
|
||||
|
||||
transCanon :: Canon -> Result
|
||||
@@ -83,6 +81,7 @@ transExp x = case x of
|
||||
EProd id exp0 exp -> failure x
|
||||
EAbs id exp -> failure x
|
||||
EAtom atom -> failure x
|
||||
EData -> failure x
|
||||
EEq equations -> failure x
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user