GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-21 02:39:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

Added meta variables to transfer front-end and core.

Browse Source
This commit is contained in:
bringert
2005-11-29 15:48:13 +00:00
parent 2be80a7e3b
commit eef20fa404
21 changed files with 517 additions and 407 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
src/Transfer/Core/Abs.hs
View File

@@ -28,6 +28,8 @@ data FieldType_
type FieldType = Tree FieldType_
data FieldValue_
type FieldValue = Tree FieldValue_
data TMeta_
type TMeta = Tree TMeta_
data CIdent_
type CIdent = Tree CIdent_
@@ -59,10 +61,12 @@ data Tree :: * -> * where
EType :: Tree Exp_
EStr :: String -> Tree Exp_
EInt :: Integer -> Tree Exp_
EMeta :: TMeta -> Tree Exp_
LetDef :: CIdent -> Exp -> Exp -> Tree LetDef_
Case :: Pattern -> Exp -> Tree Case_
FieldType :: CIdent -> Exp -> Tree FieldType_
FieldValue :: CIdent -> Exp -> Tree FieldValue_
TMeta :: String -> Tree TMeta_
CIdent :: String -> Tree CIdent_
composOp :: (forall a. Tree a -> Tree a) -> Tree c -> Tree c
@@ -98,6 +102,7 @@ composOpM f t = case t of
ERecType fieldtypes -> return ERecType `ap` mapM f fieldtypes
ERec fieldvalues -> return ERec `ap` mapM f fieldvalues
EVar cident -> return EVar `ap` f cident
EMeta tmeta -> return EMeta `ap` f tmeta
LetDef cident exp0 exp1 -> return LetDef `ap` f cident `ap` f exp0 `ap` f exp1
Case pattern exp -> return Case `ap` f pattern `ap` f exp
FieldType cident exp -> return FieldType `ap` f cident `ap` f exp
@@ -125,6 +130,7 @@ composOpFold zero combine f t = case t of
ERecType fieldtypes -> foldr combine zero (map f fieldtypes)
ERec fieldvalues -> foldr combine zero (map f fieldvalues)
EVar cident -> f cident
EMeta tmeta -> f tmeta
LetDef cident exp0 exp1 -> f cident `combine` f exp0 `combine` f exp1
Case pattern exp -> f pattern `combine` f exp
FieldType cident exp -> f cident `combine` f exp
@@ -160,10 +166,12 @@ instance Show (Tree c) where
EType -> showString "EType"
EStr str -> opar n . showString "EStr" . showChar ' ' . showsPrec 1 str . cpar n
EInt n -> opar n . showString "EInt" . showChar ' ' . showsPrec 1 n . cpar n
EMeta tmeta -> opar n . showString "EMeta" . showChar ' ' . showsPrec 1 tmeta . cpar n
LetDef cident exp0 exp1 -> opar n . showString "LetDef" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp0 . showChar ' ' . showsPrec 1 exp1 . cpar n
Case pattern exp -> opar n . showString "Case" . showChar ' ' . showsPrec 1 pattern . showChar ' ' . showsPrec 1 exp . cpar n
FieldType cident exp -> opar n . showString "FieldType" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n
FieldValue cident exp -> opar n . showString "FieldValue" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n
TMeta str -> opar n . showString "TMeta" . showChar ' ' . showsPrec 1 str . cpar n
CIdent str -> opar n . showString "CIdent" . showChar ' ' . showsPrec 1 str . cpar n
where opar n = if n > 0 then showChar '(' else id
cpar n = if n > 0 then showChar ')' else id
@@ -198,10 +206,12 @@ johnMajorEq (EVar cident) (EVar cident_) = cident == cident_
johnMajorEq EType EType = True
johnMajorEq (EStr str) (EStr str_) = str == str_
johnMajorEq (EInt n) (EInt n_) = n == n_
johnMajorEq (EMeta tmeta) (EMeta tmeta_) = tmeta == tmeta_
johnMajorEq (LetDef cident exp0 exp1) (LetDef cident_ exp0_ exp1_) = cident == cident_ && exp0 == exp0_ && exp1 == exp1_
johnMajorEq (Case pattern exp) (Case pattern_ exp_) = pattern == pattern_ && exp == exp_
johnMajorEq (FieldType cident exp) (FieldType cident_ exp_) = cident == cident_ && exp == exp_
johnMajorEq (FieldValue cident exp) (FieldValue cident_ exp_) = cident == cident_ && exp == exp_
johnMajorEq (TMeta str) (TMeta str_) = str == str_
johnMajorEq (CIdent str) (CIdent str_) = str == str_
johnMajorEq _ _ = False
@@ -235,11 +245,13 @@ instance Ord (Tree c) where
index (EType ) = 24
index (EStr _) = 25
index (EInt _) = 26
index (LetDef _ _ _) = 27
index (Case _ _) = 28
index (FieldType _ _) = 29
index (FieldValue _ _) = 30
index (CIdent _) = 31
index (EMeta _) = 27
index (LetDef _ _ _) = 28
index (Case _ _) = 29
index (FieldType _ _) = 30
index (FieldValue _ _) = 31
index (TMeta _) = 32
index (CIdent _) = 33
compareSame (Module decls) (Module decls_) = compare decls decls_
compareSame (DataDecl cident exp consdecls) (DataDecl cident_ exp_ consdecls_) = mappend (compare cident cident_) (mappend (compare exp exp_) (compare consdecls consdecls_))
compareSame (TypeDecl cident exp) (TypeDecl cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
@@ -267,9 +279,11 @@ instance Ord (Tree c) where
compareSame EType EType = EQ
compareSame (EStr str) (EStr str_) = compare str str_
compareSame (EInt n) (EInt n_) = compare n n_
compareSame (EMeta tmeta) (EMeta tmeta_) = compare tmeta tmeta_
compareSame (LetDef cident exp0 exp1) (LetDef cident_ exp0_ exp1_) = mappend (compare cident cident_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
compareSame (Case pattern exp) (Case pattern_ exp_) = mappend (compare pattern pattern_) (compare exp exp_)
compareSame (FieldType cident exp) (FieldType cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
compareSame (FieldValue cident exp) (FieldValue cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
compareSame (TMeta str) (TMeta str_) = compare str str_
compareSame (CIdent str) (CIdent str_) = compare str str_
compareSame x y = error "BNFC error:" compareSame

4
src/Transfer/Core/Core.cf
View File

@@ -72,6 +72,10 @@ EType. Exp5 ::= "Type" ;
EStr. Exp5 ::= String ;
-- Integer literal expressions.
EInt. Exp5 ::= Integer ;
-- Meta variables
EMeta. Exp5 ::= TMeta ;
token TMeta ('?' digit+) ;
coercions Exp 5 ;

5
src/Transfer/Core/Doc.tex
View File

@@ -34,6 +34,10 @@ Integer literals \nonterminal{Int}\ are nonempty sequences of digits.
TMeta literals are recognized by the regular expression
\(\mbox{`?'} {\nonterminal{digit}}+\)
CIdent literals are recognized by the regular expression
\(({\nonterminal{letter}} \mid \mbox{`\_'}) ({\nonterminal{letter}} \mid {\nonterminal{digit}} \mid \mbox{`\_'} \mid \mbox{`''})*\)
@@ -162,6 +166,7 @@ All other symbols are terminals.\\
& {\delimit} &{\terminal{Type}} \\
& {\delimit} &{\nonterminal{String}} \\
& {\delimit} &{\nonterminal{Integer}} \\
& {\delimit} &{\nonterminal{TMeta}} \\
& {\delimit} &{\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} \\
\end{tabular}\\

23
src/Transfer/Core/Lex.hs
View File

File diff suppressed because one or more lines are too long

3
src/Transfer/Core/Lex.x
View File

@@ -24,6 +24,7 @@ $u = [\0-\255] -- universal: any character
$white+ ;
@rsyms { tok (\p s -> PT p (TS $ share s)) }
\? $d + { tok (\p s -> PT p (eitherResIdent (T_TMeta . share) s)) }
($l | \_)($l | $d | \_ | \')* { tok (\p s -> PT p (eitherResIdent (T_CIdent . share) s)) }
$l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
@@ -46,6 +47,7 @@ data Tok =
| TV !String -- identifiers
| TD !String -- double precision float literals
| TC !String -- character literals
| T_TMeta !String
| T_CIdent !String
deriving (Eq,Show,Ord)
@@ -68,6 +70,7 @@ prToken t = case t of
PT _ (TV s) -> s
PT _ (TD s) -> s
PT _ (TC s) -> s
PT _ (T_TMeta s) -> s
PT _ (T_CIdent s) -> s
_ -> show t

693
src/Transfer/Core/Par.hs
View File

File diff suppressed because it is too large Load Diff

3
src/Transfer/Core/Par.y
View File

@@ -35,6 +35,7 @@ import Transfer.ErrM
L_quoted { PT _ (TL $$) }
L_integ { PT _ (TI $$) }
L_TMeta { PT _ (T_TMeta $$) }
L_CIdent { PT _ (T_CIdent $$) }
L_err { _ }
@@ -43,6 +44,7 @@ L_err { _ }
String :: { String } : L_quoted { $1 }
Integer :: { Integer } : L_integ { (read $1) :: Integer }
TMeta :: { TMeta} : L_TMeta { TMeta ($1)}
CIdent :: { CIdent} : L_CIdent { CIdent ($1)}
Module :: { Module }
@@ -140,6 +142,7 @@ Exp5 : '{' '}' { EEmptyRec }
| 'Type' { EType }
| String { EStr $1 }
| Integer { EInt $1 }
| TMeta { EMeta $1 }
| '(' Exp ')' { $2 }

2
src/Transfer/Core/Print.hs
View File

@@ -107,10 +107,12 @@ instance Print (Tree c) where
EType -> prPrec _i 5 (concatD [doc (showString "Type")])
EStr str -> prPrec _i 5 (concatD [prt 0 str])
EInt n -> prPrec _i 5 (concatD [prt 0 n])
EMeta tmeta -> prPrec _i 5 (concatD [prt 0 tmeta])
LetDef cident exp0 exp1 -> prPrec _i 0 (concatD [prt 0 cident , doc (showString ":") , prt 0 exp0 , doc (showString "=") , prt 0 exp1])
Case pattern exp -> prPrec _i 0 (concatD [prt 0 pattern , doc (showString "->") , prt 0 exp])
FieldType cident exp -> prPrec _i 0 (concatD [prt 0 cident , doc (showString ":") , prt 0 exp])
FieldValue cident exp -> prPrec _i 0 (concatD [prt 0 cident , doc (showString "=") , prt 0 exp])
TMeta str -> prPrec _i 0 (doc (showString str))
CIdent str -> prPrec _i 0 (doc (showString str))
instance Print [Decl] where

7
src/Transfer/Core/Skel.hs
View File

@@ -38,10 +38,12 @@ transTree t = case t of
EType -> failure t
EStr str -> failure t
EInt n -> failure t
EMeta tmeta -> failure t
LetDef cident exp0 exp1 -> failure t
Case pattern exp -> failure t
FieldType cident exp -> failure t
FieldValue cident exp -> failure t
TMeta str -> failure t
CIdent str -> failure t
transModule :: Module -> Result
@@ -91,6 +93,7 @@ transExp t = case t of
EType -> failure t
EStr str -> failure t
EInt n -> failure t
EMeta tmeta -> failure t
transLetDef :: LetDef -> Result
transLetDef t = case t of
@@ -108,6 +111,10 @@ transFieldValue :: FieldValue -> Result
transFieldValue t = case t of
FieldValue cident exp -> failure t
transTMeta :: TMeta -> Result
transTMeta t = case t of
TMeta str -> failure t
transCIdent :: CIdent -> Result
transCIdent t = case t of
CIdent str -> failure t