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

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/PervEnv/Boot/pre-basis.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/PervEnv/Boot/pre-basis.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 224 - (view) (download)

1 : monnier 89 (* pre-basis.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * This contains definitions of various Basis types that are
6 :     * abstract but need to be concrete to the basis implementation.
7 :     * It also has some ultility functions.
8 :     *
9 :     *)
10 :    
11 :     structure PreBasis =
12 :     struct
13 :    
14 :     local
15 :     val op - = InlineT.DfltInt.-
16 :     val op + = InlineT.DfltInt.+
17 :     val op < = InlineT.DfltInt.<
18 :     in
19 :    
20 :    
21 :     (* the time type is abstract in the time structure, but other modules need
22 :     * access to it. Here we open the type-only Time structure to expose the
23 :     * representation.
24 :     *)
25 :     open Time
26 :    
27 :    
28 :     (***************************************************************************
29 :     * These definitions are part of the StringCvt structure, but are defined here
30 :     * so that they can be used in other basis modules.
31 :     *)
32 :    
33 :     fun scanString scanFn s = let
34 :     val n = InlineT.CharVector.length s
35 :     fun getc i =
36 :     if (i < n) then SOME(InlineT.CharVector.sub(s, i), i+1) else NONE
37 :     in
38 :     case (scanFn getc 0)
39 :     of NONE => NONE
40 :     | SOME(x, _) => SOME x
41 :     (* end case *)
42 :     end
43 :    
44 :     fun skipWS (getc : 'a -> (char * 'a) option) = let
45 :     fun isWS (#" ") = true
46 :     | isWS (#"\t") = true
47 :     | isWS (#"\n") = true
48 :     | isWS _ = false
49 :     fun lp cs = (case (getc cs)
50 :     of (SOME(c, cs')) => if (isWS c) then lp cs' else cs
51 :     | NONE => cs
52 :     (* end case *))
53 :     in
54 :     lp
55 :     end
56 :    
57 :     (* get n characters from a character source (this is not a visible part of
58 :     * StringCvt.
59 :     *)
60 :     fun getNChars (getc : 'a -> (char * 'a) option) (cs, n) = let
61 :     fun rev ([], l2) = l2
62 :     | rev (x::l1, l2) = rev(l1, x::l2)
63 :     fun get (cs, 0, l) = SOME(rev(l, []), cs)
64 :     | get (cs, i, l) = (case getc cs
65 :     of NONE => NONE
66 :     | (SOME(c, cs')) => get (cs', i-1, c::l)
67 :     (* end case *))
68 :     in
69 :     get (cs, n, [])
70 :     end
71 :    
72 :     end (* local *)
73 :     end;
74 :    
75 :    
76 :     (*
77 : monnier 223 * $Log: pre-basis.sml,v $
78 :     * Revision 1.1.1.1 1998/04/08 18:40:05 george
79 :     * Version 110.5
80 :     *
81 : monnier 89 *)

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