forked from GitHub/gf-core
Transfer: Added Double type.
This commit is contained in:
@@ -59,7 +59,8 @@ data Tree :: * -> * where
|
||||
EVar :: CIdent -> Tree Exp_
|
||||
EType :: Tree Exp_
|
||||
EStr :: String -> Tree Exp_
|
||||
EInt :: Integer -> Tree Exp_
|
||||
EInteger :: Integer -> Tree Exp_
|
||||
EDouble :: Double -> Tree Exp_
|
||||
EMeta :: TMeta -> Tree Exp_
|
||||
LetDef :: CIdent -> Exp -> Exp -> Tree LetDef_
|
||||
FieldType :: CIdent -> Exp -> Tree FieldType_
|
||||
@@ -163,7 +164,8 @@ instance Show (Tree c) where
|
||||
EVar cident -> opar n . showString "EVar" . showChar ' ' . showsPrec 1 cident . cpar n
|
||||
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
|
||||
EInteger n -> opar n . showString "EInteger" . showChar ' ' . showsPrec 1 n . cpar n
|
||||
EDouble d -> opar n . showString "EDouble" . showChar ' ' . showsPrec 1 d . 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
|
||||
FieldType cident exp -> opar n . showString "FieldType" . showChar ' ' . showsPrec 1 cident . showChar ' ' . showsPrec 1 exp . cpar n
|
||||
@@ -202,7 +204,8 @@ johnMajorEq (ERec fieldvalues) (ERec fieldvalues_) = fieldvalues == fieldvalues_
|
||||
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 (EInteger n) (EInteger n_) = n == n_
|
||||
johnMajorEq (EDouble d) (EDouble d_) = d == d_
|
||||
johnMajorEq (EMeta tmeta) (EMeta tmeta_) = tmeta == tmeta_
|
||||
johnMajorEq (LetDef cident exp0 exp1) (LetDef cident_ exp0_ exp1_) = cident == cident_ && exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (FieldType cident exp) (FieldType cident_ exp_) = cident == cident_ && exp == exp_
|
||||
@@ -240,14 +243,15 @@ instance Ord (Tree c) where
|
||||
index (EVar _) = 22
|
||||
index (EType ) = 23
|
||||
index (EStr _) = 24
|
||||
index (EInt _) = 25
|
||||
index (EMeta _) = 26
|
||||
index (LetDef _ _ _) = 27
|
||||
index (FieldType _ _) = 28
|
||||
index (FieldValue _ _) = 29
|
||||
index (Case _ _) = 30
|
||||
index (TMeta _) = 31
|
||||
index (CIdent _) = 32
|
||||
index (EInteger _) = 25
|
||||
index (EDouble _) = 26
|
||||
index (EMeta _) = 27
|
||||
index (LetDef _ _ _) = 28
|
||||
index (FieldType _ _) = 29
|
||||
index (FieldValue _ _) = 30
|
||||
index (Case _ _) = 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_)
|
||||
@@ -273,7 +277,8 @@ instance Ord (Tree c) where
|
||||
compareSame (EVar cident) (EVar cident_) = compare cident cident_
|
||||
compareSame EType EType = EQ
|
||||
compareSame (EStr str) (EStr str_) = compare str str_
|
||||
compareSame (EInt n) (EInt n_) = compare n n_
|
||||
compareSame (EInteger n) (EInteger n_) = compare n n_
|
||||
compareSame (EDouble d) (EDouble d_) = compare d d_
|
||||
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 (FieldType cident exp) (FieldType cident_ exp_) = mappend (compare cident cident_) (compare exp exp_)
|
||||
|
||||
@@ -77,7 +77,9 @@ EType. Exp5 ::= "Type" ;
|
||||
-- String literal expressions.
|
||||
EStr. Exp5 ::= String ;
|
||||
-- Integer literal expressions.
|
||||
EInt. Exp5 ::= Integer ;
|
||||
EInteger. Exp5 ::= Integer ;
|
||||
-- Double literal expressions.
|
||||
EDouble. Exp5 ::= Double ;
|
||||
-- Meta variables
|
||||
EMeta. Exp5 ::= TMeta ;
|
||||
|
||||
|
||||
@@ -32,6 +32,12 @@ except \terminal{"}\ unless preceded by \verb6\6.
|
||||
Integer literals \nonterminal{Int}\ are nonempty sequences of digits.
|
||||
|
||||
|
||||
Double-precision float literals \nonterminal{Double}\ have the structure
|
||||
indicated by the regular expression $\nonterminal{digit}+ \mbox{{\it `.'}} \nonterminal{digit}+ (\mbox{{\it `e'}} \mbox{{\it `-'}}? \nonterminal{digit}+)?$ i.e.\
|
||||
two sequences of digits separated by a decimal point, optionally
|
||||
followed by an unsigned or negative exponent.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -165,6 +171,7 @@ All other symbols are terminals.\\
|
||||
& {\delimit} &{\terminal{Type}} \\
|
||||
& {\delimit} &{\nonterminal{String}} \\
|
||||
& {\delimit} &{\nonterminal{Integer}} \\
|
||||
& {\delimit} &{\nonterminal{Double}} \\
|
||||
& {\delimit} &{\nonterminal{TMeta}} \\
|
||||
& {\delimit} &{\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -31,7 +31,7 @@ $l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
|
||||
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
|
||||
|
||||
$d+ { tok (\p s -> PT p (TI $ share s)) }
|
||||
|
||||
$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
|
||||
|
||||
{
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -37,6 +37,7 @@ import Transfer.ErrM
|
||||
|
||||
L_quoted { PT _ (TL $$) }
|
||||
L_integ { PT _ (TI $$) }
|
||||
L_doubl { PT _ (TD $$) }
|
||||
L_TMeta { PT _ (T_TMeta $$) }
|
||||
L_CIdent { PT _ (T_CIdent $$) }
|
||||
L_err { _ }
|
||||
@@ -46,6 +47,7 @@ L_err { _ }
|
||||
|
||||
String :: { String } : L_quoted { $1 }
|
||||
Integer :: { Integer } : L_integ { (read $1) :: Integer }
|
||||
Double :: { Double } : L_doubl { (read $1) :: Double }
|
||||
TMeta :: { TMeta} : L_TMeta { TMeta ($1)}
|
||||
CIdent :: { CIdent} : L_CIdent { CIdent ($1)}
|
||||
|
||||
@@ -142,7 +144,8 @@ Exp5 : 'sig' '{' ListFieldType '}' { ERecType $3 }
|
||||
| CIdent { EVar $1 }
|
||||
| 'Type' { EType }
|
||||
| String { EStr $1 }
|
||||
| Integer { EInt $1 }
|
||||
| Integer { EInteger $1 }
|
||||
| Double { EDouble $1 }
|
||||
| TMeta { EMeta $1 }
|
||||
| '(' Exp ')' { $2 }
|
||||
|
||||
|
||||
@@ -105,7 +105,8 @@ instance Print (Tree c) where
|
||||
EVar cident -> prPrec _i 5 (concatD [prt 0 cident])
|
||||
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])
|
||||
EInteger n -> prPrec _i 5 (concatD [prt 0 n])
|
||||
EDouble d -> prPrec _i 5 (concatD [prt 0 d])
|
||||
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])
|
||||
FieldType cident exp -> prPrec _i 0 (concatD [prt 0 cident , doc (showString ":") , prt 0 exp])
|
||||
|
||||
@@ -36,7 +36,8 @@ transTree t = case t of
|
||||
EVar cident -> failure t
|
||||
EType -> failure t
|
||||
EStr str -> failure t
|
||||
EInt n -> failure t
|
||||
EInteger n -> failure t
|
||||
EDouble d -> failure t
|
||||
EMeta tmeta -> failure t
|
||||
LetDef cident exp0 exp1 -> failure t
|
||||
FieldType cident exp -> failure t
|
||||
@@ -90,7 +91,8 @@ transExp t = case t of
|
||||
EVar cident -> failure t
|
||||
EType -> failure t
|
||||
EStr str -> failure t
|
||||
EInt n -> failure t
|
||||
EInteger n -> failure t
|
||||
EDouble d -> failure t
|
||||
EMeta tmeta -> failure t
|
||||
|
||||
transLetDef :: LetDef -> Result
|
||||
|
||||
@@ -11,6 +11,7 @@ import Debug.Trace
|
||||
|
||||
data Value = VStr String
|
||||
| VInt Integer
|
||||
| VDbl Double
|
||||
| VType
|
||||
| VRec [(CIdent,Value)]
|
||||
| VClos Env Exp
|
||||
@@ -51,7 +52,8 @@ seqEnv (Env e) = Env $! deepSeqList [ fst p `seq` p | p <- e ]
|
||||
-- | The built-in types and functions.
|
||||
builtin :: Env
|
||||
builtin =
|
||||
mkEnv [(CIdent "Int",VType),
|
||||
mkEnv [(CIdent "Integer",VType),
|
||||
(CIdent "Double",VType),
|
||||
(CIdent "String",VType),
|
||||
mkIntUn "neg" negate toInt,
|
||||
mkIntBin "add" (+) toInt,
|
||||
@@ -62,6 +64,15 @@ builtin =
|
||||
mkIntBin "eq" (==) toBool,
|
||||
mkIntBin "cmp" compare toOrd,
|
||||
mkIntUn "show" show toStr,
|
||||
mkDblUn "neg" negate toDbl,
|
||||
mkDblBin "add" (+) toDbl,
|
||||
mkDblBin "sub" (-) toDbl,
|
||||
mkDblBin "mul" (*) toDbl,
|
||||
mkDblBin "div" (/) toDbl,
|
||||
mkDblBin "mod" (\_ _ -> 0.0) toDbl,
|
||||
mkDblBin "eq" (==) toBool,
|
||||
mkDblBin "cmp" compare toOrd,
|
||||
mkDblUn "show" show toStr,
|
||||
mkStrBin "add" (++) toStr,
|
||||
mkStrBin "eq" (==) toBool,
|
||||
mkStrBin "cmp" compare toOrd,
|
||||
@@ -69,28 +80,38 @@ builtin =
|
||||
]
|
||||
where
|
||||
toInt i = VInt i
|
||||
toDbl i = VDbl i
|
||||
toBool b = VCons (CIdent (show b)) []
|
||||
toOrd o = VCons (CIdent (show o)) []
|
||||
toStr s = VStr s
|
||||
mkIntUn x f g = let c = CIdent ("prim_"++x++"_Int")
|
||||
in (c, VPrim (\n -> appInt1 f g n))
|
||||
mkIntBin x f g = let c = CIdent ("prim_"++x++"_Int")
|
||||
in (c, VPrim (\n -> VPrim (\m -> appInt2 f g n m )))
|
||||
appInt1 f g x = case x of
|
||||
mkUn t a x f g = let c = CIdent ("prim_" ++ x ++ "_" ++ t)
|
||||
in (c, VPrim (\n -> a f g n))
|
||||
mkBin t a x f g = let c = CIdent ("prim_" ++ x ++ "_" ++ t)
|
||||
in (c, VPrim (\n -> VPrim (\m -> a f g n m )))
|
||||
mkIntUn = mkUn "Integer" $ \ f g x ->
|
||||
case x of
|
||||
VInt n -> g (f n)
|
||||
_ -> error $ printValue x ++ " is not an integer"
|
||||
appInt2 f g x y = case (x,y) of
|
||||
mkIntBin = mkBin "Integer" $ \ f g x y ->
|
||||
case (x,y) of
|
||||
(VInt n,VInt m) -> g (f n m)
|
||||
_ -> error $ printValue x ++ " and " ++ printValue y
|
||||
++ " are not both integers"
|
||||
mkStrUn x f g = let c = CIdent ("prim_"++x++"_Str")
|
||||
in (c, VPrim (\n -> appStr1 f g n))
|
||||
mkStrBin x f g = let c = CIdent ("prim_"++x++"_Str")
|
||||
in (c, VPrim (\n -> VPrim (\m -> appStr2 f g n m )))
|
||||
appStr1 f g x = case x of
|
||||
mkDblUn = mkUn "Double" $ \ f g x ->
|
||||
case x of
|
||||
VDbl n -> g (f n)
|
||||
_ -> error $ printValue x ++ " is not a double"
|
||||
mkDblBin = mkBin "Double" $ \ f g x y ->
|
||||
case (x,y) of
|
||||
(VDbl n,VDbl m) -> g (f n m)
|
||||
_ -> error $ printValue x ++ " and " ++ printValue y
|
||||
++ " are not both doubles"
|
||||
mkStrUn = mkUn "String" $ \ f g x ->
|
||||
case x of
|
||||
VStr n -> g (f n)
|
||||
_ -> error $ printValue x ++ " is not an integer"
|
||||
appStr2 f g x y = case (x,y) of
|
||||
_ -> error $ printValue x ++ " is not a string"
|
||||
mkStrBin = mkBin "String" $ \ f g x y ->
|
||||
case (x,y) of
|
||||
(VStr n,VStr m) -> g (f n m)
|
||||
_ -> error $ printValue x ++ " and " ++ printValue y
|
||||
++ " are not both strings"
|
||||
@@ -144,7 +165,8 @@ eval env x = case x of
|
||||
EVar id -> lookupEnv env id
|
||||
EType -> VType
|
||||
EStr str -> VStr str
|
||||
EInt n -> VInt n
|
||||
EInteger n -> VInt n
|
||||
EDouble n -> VDbl n
|
||||
EMeta (TMeta t) -> VMeta (read $ drop 1 t)
|
||||
|
||||
firstMatch :: Value -> [Case] -> Maybe (Exp,[(CIdent,Value)])
|
||||
@@ -196,7 +218,8 @@ valueToExp :: Value -> Exp
|
||||
valueToExp v =
|
||||
case v of
|
||||
VStr s -> EStr s
|
||||
VInt i -> EInt i
|
||||
VInt i -> EInteger i
|
||||
VDbl i -> EDouble i
|
||||
VType -> EType
|
||||
VRec fs -> ERec [ FieldValue f (valueToExp v) | (f,v) <- fs]
|
||||
VClos env e -> e
|
||||
|
||||
@@ -85,7 +85,8 @@ data Tree :: * -> * where
|
||||
EVar :: Ident -> Tree Exp_
|
||||
EType :: Tree Exp_
|
||||
EStr :: String -> Tree Exp_
|
||||
EInt :: Integer -> Tree Exp_
|
||||
EInteger :: Integer -> Tree Exp_
|
||||
EDouble :: Double -> Tree Exp_
|
||||
EMeta :: Tree Exp_
|
||||
LetDef :: Ident -> Exp -> Exp -> Tree LetDef_
|
||||
Case :: Pattern -> Exp -> Tree Case_
|
||||
@@ -268,7 +269,8 @@ instance Show (Tree c) where
|
||||
EVar i -> opar n . showString "EVar" . showChar ' ' . showsPrec 1 i . cpar n
|
||||
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
|
||||
EInteger n -> opar n . showString "EInteger" . showChar ' ' . showsPrec 1 n . cpar n
|
||||
EDouble d -> opar n . showString "EDouble" . showChar ' ' . showsPrec 1 d . cpar n
|
||||
EMeta -> showString "EMeta"
|
||||
LetDef i exp0 exp1 -> opar n . showString "LetDef" . showChar ' ' . showsPrec 1 i . 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
|
||||
@@ -334,7 +336,8 @@ johnMajorEq (EList exps) (EList exps_) = exps == exps_
|
||||
johnMajorEq (EVar i) (EVar i_) = i == i_
|
||||
johnMajorEq EType EType = True
|
||||
johnMajorEq (EStr str) (EStr str_) = str == str_
|
||||
johnMajorEq (EInt n) (EInt n_) = n == n_
|
||||
johnMajorEq (EInteger n) (EInteger n_) = n == n_
|
||||
johnMajorEq (EDouble d) (EDouble d_) = d == d_
|
||||
johnMajorEq EMeta EMeta = True
|
||||
johnMajorEq (LetDef i exp0 exp1) (LetDef i_ exp0_ exp1_) = i == i_ && exp0 == exp0_ && exp1 == exp1_
|
||||
johnMajorEq (Case pattern exp) (Case pattern_ exp_) = pattern == pattern_ && exp == exp_
|
||||
@@ -399,17 +402,18 @@ instance Ord (Tree c) where
|
||||
index (EVar _) = 46
|
||||
index (EType ) = 47
|
||||
index (EStr _) = 48
|
||||
index (EInt _) = 49
|
||||
index (EMeta ) = 50
|
||||
index (LetDef _ _ _) = 51
|
||||
index (Case _ _) = 52
|
||||
index (BindVar _ _) = 53
|
||||
index (BindNoVar _) = 54
|
||||
index (VVar _) = 55
|
||||
index (VWild ) = 56
|
||||
index (FieldType _ _) = 57
|
||||
index (FieldValue _ _) = 58
|
||||
index (Ident _) = 59
|
||||
index (EInteger _) = 49
|
||||
index (EDouble _) = 50
|
||||
index (EMeta ) = 51
|
||||
index (LetDef _ _ _) = 52
|
||||
index (Case _ _) = 53
|
||||
index (BindVar _ _) = 54
|
||||
index (BindNoVar _) = 55
|
||||
index (VVar _) = 56
|
||||
index (VWild ) = 57
|
||||
index (FieldType _ _) = 58
|
||||
index (FieldValue _ _) = 59
|
||||
index (Ident _) = 60
|
||||
compareSame (Module imports decls) (Module imports_ decls_) = mappend (compare imports imports_) (compare decls decls_)
|
||||
compareSame (Import i) (Import i_) = compare i i_
|
||||
compareSame (DataDecl i exp consdecls) (DataDecl i_ exp_ consdecls_) = mappend (compare i i_) (mappend (compare exp exp_) (compare consdecls consdecls_))
|
||||
@@ -459,7 +463,8 @@ instance Ord (Tree c) where
|
||||
compareSame (EVar i) (EVar i_) = compare i i_
|
||||
compareSame EType EType = EQ
|
||||
compareSame (EStr str) (EStr str_) = compare str str_
|
||||
compareSame (EInt n) (EInt n_) = compare n n_
|
||||
compareSame (EInteger n) (EInteger n_) = compare n n_
|
||||
compareSame (EDouble d) (EDouble d_) = compare d d_
|
||||
compareSame EMeta EMeta = EQ
|
||||
compareSame (LetDef i exp0 exp1) (LetDef i_ exp0_ exp1_) = mappend (compare i i_) (mappend (compare exp0 exp0_) (compare exp1 exp1_))
|
||||
compareSame (Case pattern exp) (Case pattern_ exp_) = mappend (compare pattern pattern_) (compare exp exp_)
|
||||
|
||||
@@ -37,6 +37,12 @@ except \terminal{"}\ unless preceded by \verb6\6.
|
||||
Integer literals \nonterminal{Int}\ are nonempty sequences of digits.
|
||||
|
||||
|
||||
Double-precision float literals \nonterminal{Double}\ have the structure
|
||||
indicated by the regular expression $\nonterminal{digit}+ \mbox{{\it `.'}} \nonterminal{digit}+ (\mbox{{\it `e'}} \mbox{{\it `-'}}? \nonterminal{digit}+)?$ i.e.\
|
||||
two sequences of digits separated by a decimal point, optionally
|
||||
followed by an unsigned or negative exponent.
|
||||
|
||||
|
||||
|
||||
|
||||
\subsection*{Reserved words and symbols}
|
||||
@@ -266,6 +272,7 @@ All other symbols are terminals.\\
|
||||
& {\delimit} &{\terminal{Type}} \\
|
||||
& {\delimit} &{\nonterminal{String}} \\
|
||||
& {\delimit} &{\nonterminal{Integer}} \\
|
||||
& {\delimit} &{\nonterminal{Double}} \\
|
||||
& {\delimit} &{\terminal{?}} \\
|
||||
& {\delimit} &{\terminal{(}} {\nonterminal{Exp}} {\terminal{)}} \\
|
||||
\end{tabular}\\
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -29,7 +29,7 @@ $l $i* { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
|
||||
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
|
||||
|
||||
$d+ { tok (\p s -> PT p (TI $ share s)) }
|
||||
|
||||
$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
|
||||
|
||||
{
|
||||
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -65,6 +65,7 @@ import Transfer.ErrM
|
||||
L_ident { PT _ (TV $$) }
|
||||
L_quoted { PT _ (TL $$) }
|
||||
L_integ { PT _ (TI $$) }
|
||||
L_doubl { PT _ (TD $$) }
|
||||
L_err { _ }
|
||||
|
||||
|
||||
@@ -73,6 +74,7 @@ L_err { _ }
|
||||
Ident :: { Ident } : L_ident { Ident $1 }
|
||||
String :: { String } : L_quoted { $1 }
|
||||
Integer :: { Integer } : L_integ { (read $1) :: Integer }
|
||||
Double :: { Double } : L_doubl { (read $1) :: Double }
|
||||
|
||||
Module :: { Module }
|
||||
Module : ListImport ListDecl { Module $1 $2 }
|
||||
@@ -262,7 +264,8 @@ Exp13 : 'sig' '{' ListFieldType '}' { ERecType $3 }
|
||||
| Ident { EVar $1 }
|
||||
| 'Type' { EType }
|
||||
| String { EStr $1 }
|
||||
| Integer { EInt $1 }
|
||||
| Integer { EInteger $1 }
|
||||
| Double { EDouble $1 }
|
||||
| '?' { EMeta }
|
||||
| '(' Exp ')' { $2 }
|
||||
|
||||
|
||||
@@ -129,7 +129,8 @@ instance Print (Tree c) where
|
||||
EVar i -> prPrec _i 13 (concatD [prt 0 i])
|
||||
EType -> prPrec _i 13 (concatD [doc (showString "Type")])
|
||||
EStr str -> prPrec _i 13 (concatD [prt 0 str])
|
||||
EInt n -> prPrec _i 13 (concatD [prt 0 n])
|
||||
EInteger n -> prPrec _i 13 (concatD [prt 0 n])
|
||||
EDouble d -> prPrec _i 13 (concatD [prt 0 d])
|
||||
EMeta -> prPrec _i 13 (concatD [doc (showString "?")])
|
||||
LetDef i exp0 exp1 -> prPrec _i 0 (concatD [prt 0 i , 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])
|
||||
|
||||
@@ -60,7 +60,8 @@ transTree t = case t of
|
||||
EVar i -> failure t
|
||||
EType -> failure t
|
||||
EStr str -> failure t
|
||||
EInt n -> failure t
|
||||
EInteger n -> failure t
|
||||
EDouble d -> failure t
|
||||
EMeta -> failure t
|
||||
LetDef i exp0 exp1 -> failure t
|
||||
Case pattern exp -> failure t
|
||||
@@ -141,7 +142,8 @@ transExp t = case t of
|
||||
EVar i -> failure t
|
||||
EType -> failure t
|
||||
EStr str -> failure t
|
||||
EInt n -> failure t
|
||||
EInteger n -> failure t
|
||||
EDouble d -> failure t
|
||||
EMeta -> failure t
|
||||
|
||||
transLetDef :: LetDef -> Result
|
||||
|
||||
@@ -115,7 +115,8 @@ EList. Exp13 ::= "[" [Exp] "]" ;
|
||||
EVar. Exp13 ::= Ident ;
|
||||
EType. Exp13 ::= "Type" ;
|
||||
EStr. Exp13 ::= String ;
|
||||
EInt. Exp13 ::= Integer ;
|
||||
EInteger. Exp13 ::= Integer ;
|
||||
EDouble. Exp13 ::= Double ;
|
||||
EMeta. Exp13 ::= "?" ;
|
||||
|
||||
coercions Exp 13 ;
|
||||
|
||||
@@ -22,18 +22,40 @@ id _ x = x
|
||||
|
||||
num_Integer : Num Integer
|
||||
num_Integer = rec zero = 0
|
||||
plus = prim_add_Int
|
||||
minus = prim_sub_Int
|
||||
plus = prim_add_Integer
|
||||
minus = prim_sub_Integer
|
||||
one = 1
|
||||
times = prim_mul_Int
|
||||
div = prim_div_Int
|
||||
mod = prim_mod_Int
|
||||
negate = prim_neg_Int
|
||||
eq = prim_eq_Int
|
||||
compare = prim_cmp_Int
|
||||
times = prim_mul_Integer
|
||||
div = prim_div_Integer
|
||||
mod = prim_mod_Integer
|
||||
negate = prim_neg_Integer
|
||||
eq = prim_eq_Integer
|
||||
compare = prim_cmp_Integer
|
||||
|
||||
show_Integer : Show Integer
|
||||
show_Integer = rec show = prim_show_Int
|
||||
show_Integer = rec show = prim_show_Integer
|
||||
|
||||
|
||||
--
|
||||
-- The Double type
|
||||
--
|
||||
|
||||
-- Instances:
|
||||
|
||||
num_Double : Num Double
|
||||
num_Double = rec zero = 0.0
|
||||
plus = prim_add_Double
|
||||
minus = prim_sub_Double
|
||||
one = 1.0
|
||||
times = prim_mul_Double
|
||||
div = prim_div_Double
|
||||
mod = prim_mod_Double
|
||||
negate = prim_neg_Double
|
||||
eq = prim_eq_Double
|
||||
compare = prim_cmp_Double
|
||||
|
||||
show_Double : Show Double
|
||||
show_Double = rec show = prim_show_Double
|
||||
|
||||
|
||||
|
||||
@@ -45,15 +67,15 @@ show_Integer = rec show = prim_show_Int
|
||||
|
||||
add_String : Add String
|
||||
add_String = rec zero = ""
|
||||
plus = prim_add_Str
|
||||
plus = prim_add_String
|
||||
|
||||
|
||||
ord_String : Ord String
|
||||
ord_String = rec eq = prim_eq_Str
|
||||
compare = prim_cmp_Str
|
||||
compare = prim_cmp_String
|
||||
|
||||
show_String : Show String
|
||||
show_String = rec show = prim_show_Str
|
||||
show_String = rec show = prim_show_String
|
||||
|
||||
|
||||
--
|
||||
@@ -283,7 +305,7 @@ Neg : Type -> Type
|
||||
Neg = sig negate : A -> A
|
||||
|
||||
negate : (A : Type) -> Neg A -> A -> A
|
||||
negate _ d = d.neg
|
||||
negate _ d = d.negate
|
||||
|
||||
-- Operators:
|
||||
|
||||
|
||||
Reference in New Issue
Block a user