From c3263ea25d8b83590aa1dd76ced9e5729174d5aa Mon Sep 17 00:00:00 2001 From: aarne Date: Mon, 7 Dec 2009 10:29:53 +0000 Subject: [PATCH] Constructors.str2numeral for making numerals from strings --- lib/src/api/Constructors.gf | 124 ++++++++++++++++++++++- src/GF/Compile/Concrete/AppPredefined.hs | 4 +- 2 files changed, 124 insertions(+), 4 deletions(-) diff --git a/lib/src/api/Constructors.gf b/lib/src/api/Constructors.gf index 46c7d3657..923f0e28f 100644 --- a/lib/src/api/Constructors.gf +++ b/lib/src/api/Constructors.gf @@ -23,7 +23,7 @@ incomplete resource Constructors = open Grammar in { -- The recommended usage of this module is via the wrapper module $Syntax$, -- which also contains the $Structural$ (structural words). -- Together with $Paradigms$, $Syntax$ gives everything that is needed --- to implement the concrete syntax for a langauge. +-- to implement the concrete syntax for a language. --2 Principles of organization --# notminimal @@ -449,11 +449,22 @@ incomplete resource Constructors = open Grammar in { -- and from symbolic integers. mkNum : overload { --# notminimal + mkNum : Str -> Num ; -- 0. thirty-five (given by "35") --# notminimal mkNum : Numeral -> Num ; -- 1. twenty --# notminimal mkNum : Digits -> Num ; -- 2. 51 --# notminimal mkNum : Card -> Num ; -- 3. almost ten --# notminimal --- A numeral can be modified by an adnumeral. +-- Cardinals are the non-dummy numerals. + + mkCard : overload { + mkCard : Str -> Card ; -- 0. thirty-five (given by "35") + mkCard : Numeral -> Card ; -- 0. thirty-five (given in any way) + mkCard : Digits -> Card ; -- 51 --# notminimal + mkCard : AdN -> Card -> Card --# notminimal + } ; + + +-- Such a numeral can be modified by an adnumeral. mkNum : AdN -> Card -> Num -- 4. almost ten --# notminimal } ; --# notminimal @@ -501,6 +512,10 @@ incomplete resource Constructors = open Grammar in { n100_Numeral : Numeral ; -- 12. hundred --# notminimal n1000_Numeral : Numeral ; -- 13. thousand --# notminimal + mkNumeral : overload { --# notminimal + mkNumeral : Str -> Numeral -- 0. thirty-five (given by "35") --# notminimal + } ; --# notminimal + -- See $Numeral$ for the full set of constructors, and use the category -- $Digits$ for other numbers from one million. @@ -1129,6 +1144,8 @@ incomplete resource Constructors = open Grammar in { mkCard = overload { + mkCard : Str -> Card + = str2card ; mkCard : Numeral -> Card = NumNumeral ; mkCard : Digits -> Card -- 51 --# notminimal @@ -1138,6 +1155,8 @@ incomplete resource Constructors = open Grammar in { } ; mkNum = overload { + mkNum : Str -> Num + = \s -> NumCard (str2card s) ; mkNum : Numeral -> Num = \d -> NumCard (NumNumeral d) ; mkNum : Digits -> Num -- 51 --# notminimal @@ -1155,6 +1174,7 @@ incomplete resource Constructors = open Grammar in { = NumPl ; --# notminimal mkOrd = overload { --# notminimal + -- mkOrd : Str -> Ord = str2ord ; -- ambiguous in Try mkOrd : Numeral -> Ord = OrdNumeral ; --# notminimal mkOrd : Digits -> Ord -- 51st --# notminimal = OrdDigits ; --# notminimal @@ -1165,6 +1185,11 @@ incomplete resource Constructors = open Grammar in { = OrdSuperl --# notminimal } ; --# notminimal + mkNumeral = overload { --# notminimal + mkNumeral : Str -> Numeral --# notminimal + = str2numeral ; --# notminimal + } ; --# notminimal + n1_Numeral = num (pot2as3 (pot1as2 (pot0as1 pot01))) ; n2_Numeral = num (pot2as3 (pot1as2 (pot0as1 (pot0 n2)))) ; n3_Numeral = num (pot2as3 (pot1as2 (pot0as1 (pot0 n3)))) ; @@ -1197,6 +1222,7 @@ incomplete resource Constructors = open Grammar in { mkAdN : CAdv -> AdN = AdnCAdv ; -- more (than five) --# notminimal mkDigits = overload { --# notminimal + mkDigits : Str -> Digits = str2digits ; --# notminimal mkDigits : Dig -> Digits = IDig ; --# notminimal mkDigits : Dig -> Digits -> Digits = IIDig ; --# notminimal } ; --# notminimal @@ -1761,4 +1787,98 @@ incomplete resource Constructors = open Grammar in { TUseQCl : Tense -> Ant -> Pol -> QCl -> QS = \t,a -> UseQCl (TTAnt t a) ; TUseRCl : Tense -> Ant -> Pol -> RCl -> RS = \t,a -> UseRCl (TTAnt t a) ; --# notminimal +-- numerals from strings + +oper + str2ord : Str -> Ord = \s -> case Predef.lessInt (Predef.length s) 7 of { + Predef.PTrue => OrdNumeral (str2numeral s) ; + Predef.PFalse => OrdDigits (str2digits s) + } ; + + str2card : Str -> Card = \s -> case Predef.lessInt (Predef.length s) 7 of { + Predef.PTrue => NumNumeral (str2numeral s) ; + Predef.PFalse => NumDigits (str2digits s) + } ; + + str2numeral : Str -> Numeral = (\s -> case s of { + m@(? + _) + "000" => num (pot3 (s2s1000 m)) ; + m@(? + _) + "00" + n@? => num (pot3plus (s2s1000 m) (s2s1000 n)) ; + m@(? + _) + "0" + n@(? + ?) => num (pot3plus (s2s1000 m) (s2s1000 n)) ; + m@(? + _) + n@(? + ? + ?) => num (pot3plus (s2s1000 m) (s2s1000 n)) ; + _ => num (pot2as3 (s2s1000 s)) + }) + where { + + s2d : Str -> Digit = \s -> case s of { + "2" => n2 ; + "3" => n3 ; + "4" => n4 ; + "5" => n5 ; + "6" => n6 ; + "7" => n7 ; + "8" => n8 ; + "9" => n9 ; + _ => Predef.error ("not a valid digit" ++ s) + } ; + + s2s10 : Str -> Sub10 = \s -> case s of { + "1" => pot01 ; + #idigit => pot0 (s2d s) ; + _ => Predef.error ("not a valid digit" ++ s) + } ; + + s2s100 : Str -> Sub100 = \s -> case s of { + "10" => pot110 ; + "11" => pot111 ; + "1" + d@#digit => pot1to19 (s2d d) ; + d@#idigit + "0" => pot1 (s2d d) ; + d@#idigit + n@? => pot1plus (s2d d) (s2s10 n) ; + _ => pot0as1 (s2s10 s) + } ; + + s2s1000 : Str -> Sub1000 = \s -> case s of { + d@? + "00" => pot2 (s2s10 d) ; + d@? + "0" + n@? => pot2plus (s2s10 d) (s2s100 n) ; + d@? + n@(? + ?) => pot2plus (s2s10 d) (s2s100 n) ; + _ => pot1as2 (s2s100 s) + } ; + } ; + idigit : pattern Str = #("1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9") ; + digit : pattern Str = #("0" | #idigit) ; + + --- it would be nice to have foldr on strings... + str2digits : Str -> Digits = (\s -> case s of { + d0@? => IDig (s2d d0) ; + d1@? + d0@? => IIDig (s2d d1) (IDig (s2d d0)) ; + d2@? + d1@? + d0@? => IIDig (s2d d2) (IIDig (s2d d1) (IDig (s2d d0))) ; + d3@? + d2@? + d1@? + d0@? => + IIDig (s2d d3) (IIDig (s2d d2) (IIDig (s2d d1) (IDig (s2d d0)))) ; + d4@? + d3@? + d2@? + d1@? + d0@? => + IIDig (s2d d4) (IIDig (s2d d3) (IIDig (s2d d2) (IIDig (s2d d1) (IDig (s2d d0))))) ; + d5@? + d4@? + d3@? + d2@? + d1@? + d0@? => + IIDig (s2d d5) (IIDig (s2d d4) (IIDig (s2d d3) (IIDig (s2d d2) + (IIDig (s2d d1) (IDig (s2d d0)))))) ; + d6@? + d5@? + d4@? + d3@? + d2@? + d1@? + d0@? => + IIDig (s2d d6) (IIDig (s2d d5) (IIDig (s2d d4) (IIDig (s2d d3) + (IIDig (s2d d2) (IIDig (s2d d1) (IDig (s2d d0))))))) ; + d7@? + d6@? + d5@? + d4@? + d3@? + d2@? + d1@? + d0@? => + IIDig (s2d d7) (IIDig (s2d d6) (IIDig (s2d d5) (IIDig (s2d d4) (IIDig (s2d d3) + (IIDig (s2d d2) (IIDig (s2d d1) (IDig (s2d d0)))))))) ; + _ => Predef.error ("cannot deal with so many digits:" ++ s) + }) where { + s2d : Str -> Dig = \s -> case s of { + "0" => D_0 ; + "1" => D_1 ; + "2" => D_2 ; + "3" => D_3 ; + "4" => D_4 ; + "5" => D_5 ; + "6" => D_6 ; + "7" => D_7 ; + "8" => D_8 ; + "9" => D_9 ; + _ => Predef.error ("not a valid digit" ++ s) + } ; + } ; + } diff --git a/src/GF/Compile/Concrete/AppPredefined.hs b/src/GF/Compile/Concrete/AppPredefined.hs index 95316a4ea..c05127191 100644 --- a/src/GF/Compile/Concrete/AppPredefined.hs +++ b/src/GF/Compile/Concrete/AppPredefined.hs @@ -100,8 +100,8 @@ appPredefined t = case t of (y,_) <- appPredefined y0 (z,_) <- appPredefined z0 case (z, y, x) of - (ty,op,t) | f == cMapStr -> retf $ mapStr ty op t - _ -> retb t ---- prtBad "cannot compute predefined" t + (ty,op,t) | f == cMapStr -> retf $ mapStr ty op t + _ -> retb t ---- prtBad "cannot compute predefined" t _ -> retb t ---- prtBad "cannot compute predefined" t _ -> retb t