Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/system/Basis/Implementation/Target32Bit/int.sml
ViewVC logotype

Diff of /sml/trunk/system/Basis/Implementation/Target32Bit/int.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 5447, Sun Jun 16 17:51:39 2019 UTC revision 5448, Sun Jun 16 17:52:28 2019 UTC
# Line 1  Line 1 
1  (* int31.sml  (* int.sml
2   *   *
3   * COPYRIGHT (c) 2018 The Fellowship of SML/NJ (http://www.smlnj.org)   * COPYRIGHT (c) 2018 The Fellowship of SML/NJ (http://www.smlnj.org)
4   * All rights reserved.   * All rights reserved.
5   *   *
6   * Default int structure for 32-bit targets.   * Default int structure (31 bits) for 32-bit targets.
  *  
  * The following structures must be without signatures so that inlining  
  * can take place: Bits, Vector, Array, RealArray, Int, Real  
7   *)   *)
8    
9  structure IntImp : INTEGER =  structure IntImp : INTEGER =
10    struct    struct
11      structure Int = InlineT.Int      structure Int = InlineT.Int
     structure I32 = InlineT.Int32  
12    
13      exception Div = Assembly.Div      exception Div = Assembly.Div
14      exception Overflow = Assembly.Overflow      exception Overflow = Assembly.Overflow
# Line 55  Line 51 
51      val op <    : int * int -> bool = Int.<      val op <    : int * int -> bool = Int.<
52      val op <=   : int * int -> bool = Int.<=      val op <=   : int * int -> bool = Int.<=
53    
54      fun fmt radix = (NumFormat32.fmtInt radix) o Int32Imp.fromInt      fun fmt radix = (NumFormat32.fmtInt radix) o InlineT.Int32.fromInt
55    
56      fun scan radix = let      fun scan radix = let
57        val scanLarge = NumScan32.scanInt radix            val scanInt32 = NumScan32.scanInt radix
58        fun f getc cs =            fun f getc cs = (case scanInt32 getc cs
         (case scanLarge getc cs  
59            of NONE => NONE            of NONE => NONE
60             | SOME(i, cs') =>                      | SOME(i, cs') => SOME(Int32Imp.toInt i, cs')
61  (* this is redundant because Int32.toInt does the check already:                    (* end case *))
62               if I32.>(i, 0x3fffffff) orelse I32.<(i, ~0x40000000) then            in
63                 raise Overflow              f
              else  
 *)  
                SOME(Int32Imp.toInt i, cs')  
         (*esac*))  
     in f  
64      end      end
65    
66      val toString = fmt StringCvt.DEC      val toString = fmt StringCvt.DEC
67    
68  (*  (*
69      val fromString = PreBasis.scanString (scan StringCvt.DEC)      val fromString = PreBasis.scanString (scan StringCvt.DEC)
70  *)  *)
# Line 84  Line 75 
75    (* optimized version of fromString; it is about 2x as fast as    (* optimized version of fromString; it is about 2x as fast as
76     * using scanString:     * using scanString:
77     *)     *)
78      fun fromString s =      fun fromString s = let
79          let val n = size s            val n = size s
80              val z = ord #"0"              val z = ord #"0"
81              val sub = CV.sub              val sub = CV.sub
82              infix ++              infix ++
83              fun x ++ y = Word.toIntX (Word.+ (Word.fromInt x, Word.fromInt y))            fun x ++ y = InlineT.Int.fast_add(x, y)
84              fun num (i, a) =            fun num (i, a) = if i >= n
85                  if i >= n then a                  then a
86                  else let val c = ord (sub (s, i)) - z                  else let
87                      val c = ord (sub (s, i)) - z
88                       in                       in
89                           if c < 0 orelse c > 9 then a                      if c < 0 orelse c > 9
90                          then a
91                           else num (i ++ 1, 10 * a - c)                           else num (i ++ 1, 10 * a - c)
92                       end                       end
93              (* Do the arithmetic using the negated absolute to avoid              (* Do the arithmetic using the negated absolute to avoid
94               * premature overflow on minInt. *)           * premature overflow on minInt.
95              fun negabs i =           *)
96                  if i >= n then NONE            fun negabs i = if i >= n
97                  else let val c = z - ord (sub (s, i))                  then NONE
98                    else let
99                      val c = z - ord (sub (s, i))
100                       in                       in
101                           if c > 0 orelse c < ~9 then NONE                      if c > 0 orelse c < ~9
102                          then NONE
103                           else SOME (num (i ++ 1, c))                           else SOME (num (i ++ 1, c))
104                       end                       end
105              fun skipwhite i =            fun skipwhite i = if i >= n
106                  if i >= n then NONE                  then NONE
107                  else let val c = sub (s, i)                  else let
108                       in                    val c = sub (s, i)
109                           if Char.isSpace c then skipwhite (i ++ 1)                    in
110                           else if c = #"-" orelse c = #"~" then                      if Char.isSpace c
111                               negabs (i ++ 1)                        then skipwhite (i ++ 1)
112                           else if c = #"+" then                      else if c = #"-" orelse c = #"~"
113                               Option.map ~ (negabs (i ++ 1))                        then negabs (i ++ 1)
114                        else if c = #"+"
115                          then Option.map ~ (negabs (i ++ 1))
116                           else Option.map ~ (negabs i)                           else Option.map ~ (negabs i)
117                       end                       end
118          in          in

Legend:
Removed from v.5447  
changed lines
  Added in v.5448

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0