Changeset 17042

Timestamp:

07/14/07 03:52:25 (1 year ago)

Author:

audreyt

Message:

* Switch from System.Time to the newer Data.Time modules

for localtime(), time(), the :M filetest, etc.
(No user-visible changes.)

Files:

• src/Pugs/Compat.hs (modified) (2 diffs)
• src/Pugs/Internals.hs (modified) (2 diffs)
• src/Pugs/Prim.hs (modified) (6 diffs)
• src/Pugs/Prim/FileTest.hs (modified) (1 diff)
• src/Pugs/Run.hs (modified) (1 diff)
• src/perl6/Prelude.pm (modified) (1 diff)

src/Pugs/Compat.hs

@@ -58 +58 @@
-import System.Cmd
-import System.Posix.Types
-System
+Data
-
-#ifdef PUGS_HAVE_POSIX
@@ -336 +336 @@
-        peekCString =<< peekElemOff argv 0
-
+epochY2K :: UTCTime
+epochY2K = UTCTime
+    { utctDay     = fromGregorian 2000 01 01
+    , utctDayTime = 0
+    }
+
-{-|
-Convert an internal @ClockTime@ to a Pugs-style fractional time.
-Used by op0 "time", @Pugs.Run.prepareEnv@, and the file time tests.
--}
-
-
-
-
-
-
-
-
-
+
+

src/Pugs/Internals.hs

@@ -51 +51 @@
-import Data.Sequence          as X (Seq, singleton)
-import Data.Set               as X (Set)
+import Data.Time              as X 
+import Data.Time.Clock.POSIX  as X 
-import Data.Tree              as X 
-import Data.Unique            as X 
@@ -73 +75 @@
-import System.Process         as X 
-import System.Random          as X hiding (split)
-import System.Time            as X 
-
--- Instances.

src/Pugs/Prim.hs

@@ -56 +56 @@
-import GHC.Unicode
-import qualified Data.HashTable as H
+import Data.Time.LocalTime
+import Data.Time.Calendar.OrdinalDate
+import Data.Time.Calendar.MonthDay
-
-constMacro :: Exp -> [Val] -> Eval Val
@@ -72 +75 @@
-op0 "False" = constMacro . Val $ VBool False
-op0 "time"  = const $ do
-lock
+urrent
-    return $ VRat $ pugsTimeSpec clkt
-op0 "times"  = const $ do
@@ -420 +423 @@
-    x <- fromVal v :: Eval VNum
-    guardIO $ do
-TOD t0s t0ps <- getClock
+start   <- getCurrent
-        threadDelay (round $ x * clocksPerSecond)
-
-
-
-
+
+
-op1 "mkdir" = guardedIO createDirectory
-op1 "rmdir" = guardedIO removeDirectory
@@ -699 +700 @@
-op1 "stat" = \x -> opPerl5 "require File::stat; File::stat::stat" [x]
-op1 "lstat" = \x -> opPerl5 "require File::stat; File::stat::lstat" [x]
+op1 "Pugs::Internals::localtime"  = \x -> do
+    tz  <- io getCurrentTimeZone
+    tm  <- fromVal x    -- seconds since Perl's epoch
+    let utc   = posixSecondsToUTCTime (fromInteger tm + offset)
+        local = utcToLocalTime tz utc
+        day   = localDay local
+        tod   = localTimeOfDay local
+        (year, month, dayOfMonth)   = toGregorian day 
+        (sec, pico)                 = properFraction $ todSec tod
+        (_, dayOfWeek)              = sundayStartWeek day
+    -- if wantString then return . VStr $ formatTime "%c" (ZonedTime local tz) else
+    retSeq [ vI    $ year
+           , vI    $ month
+           , vI    $ dayOfMonth
+           , vI    $ todHour tod
+           , vI    $ todMin tod
+           , VInt  $ sec
+           , vI    $ fromEnum (pico * 1000000000000)
+           , vI    $ dayOfWeek + 1
+           , vI    $ (monthAndDayToDayOfYear (isLeapYear year) month dayOfMonth) - 1
+           , VStr  $ timeZoneName tz
+           , vI    $ timeZoneMinutes tz * 60
+           , VBool $ timeZoneSummerOnly tz
+           ]
+    where
+    offset :: NominalDiffTime
+    offset = 946684800 -- diff between Haskell and Perl epochs (seconds)
+    vI :: Integral a => a -> Val
+    vI = VInt . toInteger
-
-op1 other   = \_ -> fail ("Unimplemented unaryOp: " ++ other)
@@ -1324 +1354 @@
-    return $ VObject o{ objAttrs = attrs', objId = uniq }
-
-op3 "Pugs::Internals::localtime"  = \x y z -> do
-    wantString <- fromVal x
-    sec <- fromVal y
-    pico <- fromVal z
-    c <- guardIO $ toCalendarTime $ TOD (offset + sec) pico
-    if wantString then return $ VStr $ calendarTimeToString c else
-        retSeq $ [ vI $ ctYear c
-                 , vI $ (1+) $ fromEnum $ ctMonth c
-                 , vI $ ctDay c
-                 , vI $ ctHour c
-                 , vI $ ctMin c
-                 , vI $ ctSec c
-                 , VInt $ ctPicosec c
-                 , vI $ (1+) $ fromEnum $ ctWDay c
-                 , vI $ ctYDay c
-                 , VStr $ ctTZName c
-                 , vI $ ctTZ c
-                 , VBool $ ctIsDST c
-                 ]
-    where
-       offset = 946684800 :: Integer -- diff between Haskell and Perl epochs (seconds)
-       vI = VInt . toInteger
-op3 "Pugs::Internals::hSeek" = \x y z -> do
-    handle <- fromVal x
@@ -1971 +1979 @@
-\\n   Num       pre     time    safe   ()\
-\\n   List      pre     times   safe   ()\
-Bool, Int, Int
+Num
-\\n   Str       pre     want    safe   ()\
-\\n   Str       pre     File::Spec::cwd     unsafe ()\

src/Pugs/Prim/FileTest.hs

@@ -61 +61 @@
-fileTime :: (FilePath -> IO Integer) -> Val -> Eval Val
-fileTime test f = do
-
+  
-    if (t == undef) then return VUndef else do
-<- fromVal t
-<- (readVar $ cast "$*BASETIME") >>= fromVal
-$ TOD t' 0
+ <- fromVal t :: Eval Integer
+  <- fromVal =<< readVar (cast "$*BASETIME")
+. posixSecondsToUTCTime $ fromIntegral t'
-
-fileTestIO :: (Value n) => (n -> IO Val) -> Val -> Eval Val

src/Pugs/Run.hs

@@ -114 +114 @@
-    autoSV  <- newScalar undef
-    classes <- initClassObjects (MkObjectId $ -1) [] initTree
- 
-<- getClock
+
+  <- getCurrent
-#if defined(PUGS_HAVE_HSPLUGINS)
-    hspluginsSV <- newScalar (VInt 1)

src/perl6/Prelude.pm

@@ -564 +564 @@
-        is primitive is builtin is safe {
-    my $res;
-
-
+#
+#
-    # XXX: waiting on a better want
-    #if want ~~ rx:P5/^Item/ {
-    #    $res = Pugs::Internals::localtime(Bool::True, $sec, $pico);
-    #} else {
-
+$when); # 
-
-        # FIXME: this is how it oughta look, with @ids being class level.