mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
conversion of Int to Tree in haskell
This commit is contained in:
aarne
299
lib/haskell/Numeral.hs
Normal file
299
lib/haskell/Numeral.hs
Normal file
@@ -0,0 +1,299 @@
|
||||
module Numeral (int2tree) where
|
||||
|
||||
import PGF
|
||||
|
||||
int2tree :: Int -> Tree
|
||||
int2tree i =
|
||||
if i < 1000000
|
||||
then gf (int2numeral i)
|
||||
else gf (int2digits i)
|
||||
|
||||
int2numeral :: Int -> GNumeral
|
||||
int2numeral i = case tens i of
|
||||
0:0:0:m@(_:_) -> Gnum (Gpot3 (s2s1000 m))
|
||||
n:0:0:m@(_:_) -> Gnum (Gpot3plus (s2s1000 m) (s2s1000 [n]))
|
||||
n1:n2:0:m@(_:_) -> Gnum (Gpot3plus (s2s1000 m) (s2s1000 [n1,n2]))
|
||||
n1:n2:n3:m@(_:_) -> Gnum (Gpot3plus (s2s1000 m) (s2s1000 [n1,n2,n3]))
|
||||
n -> Gnum (Gpot2as3 (s2s1000 n))
|
||||
where
|
||||
s2s1000 :: [Int] -> GSub1000
|
||||
s2s1000 k = case k of
|
||||
0:0:d:[] -> Gpot2 (s2s10 d)
|
||||
n:0:d:[] -> Gpot2plus (s2s10 d) (s2s100 [n])
|
||||
n1:n2:d:[] -> Gpot2plus (s2s10 d) (s2s100 [n1,n2])
|
||||
n -> Gpot1as2 (s2s100 n)
|
||||
s2s100 :: [Int] -> GSub100
|
||||
s2s100 k = case k of
|
||||
0:1:[] -> Gpot110 ;
|
||||
1:1:[] -> Gpot111 ;
|
||||
d:1:[] | digit d -> Gpot1to19 (s2d d)
|
||||
0:d:[] | idigit d -> Gpot1 (s2d d)
|
||||
n:d:[] | idigit d -> Gpot1plus (s2d d) (s2s10 n)
|
||||
[n] -> Gpot0as1 (s2s10 n)
|
||||
_ -> error $ "too many digits in " ++ show i
|
||||
s2s10 :: Int -> GSub10
|
||||
s2s10 k = case k of
|
||||
1 -> Gpot01
|
||||
_ | idigit k -> Gpot0 (s2d k)
|
||||
_ -> error ("not a valid digit" ++ show k)
|
||||
s2d :: Int -> GDigit
|
||||
s2d d = case d of
|
||||
2 -> Gn2
|
||||
3 -> Gn3
|
||||
4 -> Gn4
|
||||
5 -> Gn5
|
||||
6 -> Gn6
|
||||
7 -> Gn7
|
||||
8 -> Gn8
|
||||
9 -> Gn9
|
||||
_ -> error ("not a valid digit" ++ show d)
|
||||
|
||||
digit = flip elem [1 .. 9]
|
||||
idigit = flip elem [0 .. 9]
|
||||
|
||||
int2digits :: Int -> GDigits
|
||||
int2digits i =
|
||||
let ([d],ds) = splitAt 1 (map dig (tens i)) in
|
||||
foldr GIIDig (GIDig d) (reverse ds)
|
||||
where
|
||||
dig d = [GD_0,GD_1,GD_2,GD_3,GD_4,GD_5,GD_6,GD_7,GD_8,GD_9] !! d
|
||||
|
||||
tens n = let n' = div n 10 in mod n 10 : if n'==0 then [] else tens n'
|
||||
|
||||
----------------------------------------------------
|
||||
-- below this line machine-generated by 'gf -output-format=haskell Numeral.gf'
|
||||
----------------------------------------------------
|
||||
|
||||
----------------------------------------------------
|
||||
-- automatic translation from GF to Haskell
|
||||
----------------------------------------------------
|
||||
|
||||
class Gf a where
|
||||
gf :: a -> Tree
|
||||
fg :: Tree -> a
|
||||
|
||||
newtype GString = GString String deriving Show
|
||||
|
||||
instance Gf GString where
|
||||
gf (GString x) = mkStr x
|
||||
fg t =
|
||||
case unStr t of
|
||||
Just x -> GString x
|
||||
Nothing -> error ("no GString " ++ show t)
|
||||
|
||||
newtype GInt = GInt Integer deriving Show
|
||||
|
||||
instance Gf GInt where
|
||||
gf (GInt x) = mkInt x
|
||||
fg t =
|
||||
case unInt t of
|
||||
Just x -> GInt x
|
||||
Nothing -> error ("no GInt " ++ show t)
|
||||
|
||||
newtype GFloat = GFloat Double deriving Show
|
||||
|
||||
instance Gf GFloat where
|
||||
gf (GFloat x) = mkDouble x
|
||||
fg t =
|
||||
case unDouble t of
|
||||
Just x -> GFloat x
|
||||
Nothing -> error ("no GFloat " ++ show t)
|
||||
|
||||
----------------------------------------------------
|
||||
-- below this line machine-generated
|
||||
----------------------------------------------------
|
||||
|
||||
data GDig =
|
||||
GD_0
|
||||
| GD_1
|
||||
| GD_2
|
||||
| GD_3
|
||||
| GD_4
|
||||
| GD_5
|
||||
| GD_6
|
||||
| GD_7
|
||||
| GD_8
|
||||
| GD_9
|
||||
deriving Show
|
||||
|
||||
data GDigit =
|
||||
Gn2
|
||||
| Gn3
|
||||
| Gn4
|
||||
| Gn5
|
||||
| Gn6
|
||||
| Gn7
|
||||
| Gn8
|
||||
| Gn9
|
||||
deriving Show
|
||||
|
||||
data GDigits =
|
||||
GIDig GDig
|
||||
| GIIDig GDig GDigits
|
||||
deriving Show
|
||||
|
||||
data GNumeral = Gnum GSub1000000
|
||||
deriving Show
|
||||
|
||||
data GSub10 =
|
||||
Gpot0 GDigit
|
||||
| Gpot01
|
||||
deriving Show
|
||||
|
||||
data GSub100 =
|
||||
Gpot0as1 GSub10
|
||||
| Gpot1 GDigit
|
||||
| Gpot110
|
||||
| Gpot111
|
||||
| Gpot1plus GDigit GSub10
|
||||
| Gpot1to19 GDigit
|
||||
deriving Show
|
||||
|
||||
data GSub1000 =
|
||||
Gpot1as2 GSub100
|
||||
| Gpot2 GSub10
|
||||
| Gpot2plus GSub10 GSub100
|
||||
deriving Show
|
||||
|
||||
data GSub1000000 =
|
||||
Gpot2as3 GSub1000
|
||||
| Gpot3 GSub1000
|
||||
| Gpot3plus GSub1000 GSub1000
|
||||
deriving Show
|
||||
|
||||
|
||||
instance Gf GDig where
|
||||
gf GD_0 = mkApp (mkCId "D_0") []
|
||||
gf GD_1 = mkApp (mkCId "D_1") []
|
||||
gf GD_2 = mkApp (mkCId "D_2") []
|
||||
gf GD_3 = mkApp (mkCId "D_3") []
|
||||
gf GD_4 = mkApp (mkCId "D_4") []
|
||||
gf GD_5 = mkApp (mkCId "D_5") []
|
||||
gf GD_6 = mkApp (mkCId "D_6") []
|
||||
gf GD_7 = mkApp (mkCId "D_7") []
|
||||
gf GD_8 = mkApp (mkCId "D_8") []
|
||||
gf GD_9 = mkApp (mkCId "D_9") []
|
||||
|
||||
fg t =
|
||||
case unApp t of
|
||||
Just (i,[]) | i == mkCId "D_0" -> GD_0
|
||||
Just (i,[]) | i == mkCId "D_1" -> GD_1
|
||||
Just (i,[]) | i == mkCId "D_2" -> GD_2
|
||||
Just (i,[]) | i == mkCId "D_3" -> GD_3
|
||||
Just (i,[]) | i == mkCId "D_4" -> GD_4
|
||||
Just (i,[]) | i == mkCId "D_5" -> GD_5
|
||||
Just (i,[]) | i == mkCId "D_6" -> GD_6
|
||||
Just (i,[]) | i == mkCId "D_7" -> GD_7
|
||||
Just (i,[]) | i == mkCId "D_8" -> GD_8
|
||||
Just (i,[]) | i == mkCId "D_9" -> GD_9
|
||||
|
||||
|
||||
_ -> error ("no Dig " ++ show t)
|
||||
|
||||
instance Gf GDigit where
|
||||
gf Gn2 = mkApp (mkCId "n2") []
|
||||
gf Gn3 = mkApp (mkCId "n3") []
|
||||
gf Gn4 = mkApp (mkCId "n4") []
|
||||
gf Gn5 = mkApp (mkCId "n5") []
|
||||
gf Gn6 = mkApp (mkCId "n6") []
|
||||
gf Gn7 = mkApp (mkCId "n7") []
|
||||
gf Gn8 = mkApp (mkCId "n8") []
|
||||
gf Gn9 = mkApp (mkCId "n9") []
|
||||
|
||||
fg t =
|
||||
case unApp t of
|
||||
Just (i,[]) | i == mkCId "n2" -> Gn2
|
||||
Just (i,[]) | i == mkCId "n3" -> Gn3
|
||||
Just (i,[]) | i == mkCId "n4" -> Gn4
|
||||
Just (i,[]) | i == mkCId "n5" -> Gn5
|
||||
Just (i,[]) | i == mkCId "n6" -> Gn6
|
||||
Just (i,[]) | i == mkCId "n7" -> Gn7
|
||||
Just (i,[]) | i == mkCId "n8" -> Gn8
|
||||
Just (i,[]) | i == mkCId "n9" -> Gn9
|
||||
|
||||
|
||||
_ -> error ("no Digit " ++ show t)
|
||||
|
||||
instance Gf GDigits where
|
||||
gf (GIDig x1) = mkApp (mkCId "IDig") [gf x1]
|
||||
gf (GIIDig x1 x2) = mkApp (mkCId "IIDig") [gf x1, gf x2]
|
||||
|
||||
fg t =
|
||||
case unApp t of
|
||||
Just (i,[x1]) | i == mkCId "IDig" -> GIDig (fg x1)
|
||||
Just (i,[x1,x2]) | i == mkCId "IIDig" -> GIIDig (fg x1) (fg x2)
|
||||
|
||||
|
||||
_ -> error ("no Digits " ++ show t)
|
||||
|
||||
instance Gf GNumeral where
|
||||
gf (Gnum x1) = mkApp (mkCId "num") [gf x1]
|
||||
|
||||
fg t =
|
||||
case unApp t of
|
||||
Just (i,[x1]) | i == mkCId "num" -> Gnum (fg x1)
|
||||
|
||||
|
||||
_ -> error ("no Numeral " ++ show t)
|
||||
|
||||
instance Gf GSub10 where
|
||||
gf (Gpot0 x1) = mkApp (mkCId "pot0") [gf x1]
|
||||
gf Gpot01 = mkApp (mkCId "pot01") []
|
||||
|
||||
fg t =
|
||||
case unApp t of
|
||||
Just (i,[x1]) | i == mkCId "pot0" -> Gpot0 (fg x1)
|
||||
Just (i,[]) | i == mkCId "pot01" -> Gpot01
|
||||
|
||||
|
||||
_ -> error ("no Sub10 " ++ show t)
|
||||
|
||||
instance Gf GSub100 where
|
||||
gf (Gpot0as1 x1) = mkApp (mkCId "pot0as1") [gf x1]
|
||||
gf (Gpot1 x1) = mkApp (mkCId "pot1") [gf x1]
|
||||
gf Gpot110 = mkApp (mkCId "pot110") []
|
||||
gf Gpot111 = mkApp (mkCId "pot111") []
|
||||
gf (Gpot1plus x1 x2) = mkApp (mkCId "pot1plus") [gf x1, gf x2]
|
||||
gf (Gpot1to19 x1) = mkApp (mkCId "pot1to19") [gf x1]
|
||||
|
||||
fg t =
|
||||
case unApp t of
|
||||
Just (i,[x1]) | i == mkCId "pot0as1" -> Gpot0as1 (fg x1)
|
||||
Just (i,[x1]) | i == mkCId "pot1" -> Gpot1 (fg x1)
|
||||
Just (i,[]) | i == mkCId "pot110" -> Gpot110
|
||||
Just (i,[]) | i == mkCId "pot111" -> Gpot111
|
||||
Just (i,[x1,x2]) | i == mkCId "pot1plus" -> Gpot1plus (fg x1) (fg x2)
|
||||
Just (i,[x1]) | i == mkCId "pot1to19" -> Gpot1to19 (fg x1)
|
||||
|
||||
|
||||
_ -> error ("no Sub100 " ++ show t)
|
||||
|
||||
instance Gf GSub1000 where
|
||||
gf (Gpot1as2 x1) = mkApp (mkCId "pot1as2") [gf x1]
|
||||
gf (Gpot2 x1) = mkApp (mkCId "pot2") [gf x1]
|
||||
gf (Gpot2plus x1 x2) = mkApp (mkCId "pot2plus") [gf x1, gf x2]
|
||||
|
||||
fg t =
|
||||
case unApp t of
|
||||
Just (i,[x1]) | i == mkCId "pot1as2" -> Gpot1as2 (fg x1)
|
||||
Just (i,[x1]) | i == mkCId "pot2" -> Gpot2 (fg x1)
|
||||
Just (i,[x1,x2]) | i == mkCId "pot2plus" -> Gpot2plus (fg x1) (fg x2)
|
||||
|
||||
|
||||
_ -> error ("no Sub1000 " ++ show t)
|
||||
|
||||
instance Gf GSub1000000 where
|
||||
gf (Gpot2as3 x1) = mkApp (mkCId "pot2as3") [gf x1]
|
||||
gf (Gpot3 x1) = mkApp (mkCId "pot3") [gf x1]
|
||||
gf (Gpot3plus x1 x2) = mkApp (mkCId "pot3plus") [gf x1, gf x2]
|
||||
|
||||
fg t =
|
||||
case unApp t of
|
||||
Just (i,[x1]) | i == mkCId "pot2as3" -> Gpot2as3 (fg x1)
|
||||
Just (i,[x1]) | i == mkCId "pot3" -> Gpot3 (fg x1)
|
||||
Just (i,[x1,x2]) | i == mkCId "pot3plus" -> Gpot3plus (fg x1) (fg x2)
|
||||
|
||||
|
||||
_ -> error ("no Sub1000000 " ++ show t)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user