Transfer: Added Double type.

src/Transfer/Syntax/Abs.hs

@@ -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_)

src/Transfer/Syntax/Doc.tex

@@ -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}\\

src/Transfer/Syntax/Lex.x

@@ -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)) }
 
 {
 

src/Transfer/Syntax/Par.y

@@ -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 }
 

src/Transfer/Syntax/Print.hs

@@ -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])

src/Transfer/Syntax/Skel.hs

@@ -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

src/Transfer/Syntax/Syntax.cf

@@ -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 ;