Patch title: Release 90 bulk changes
Abstract:
File: /language/type/misc/datetime.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

scope "/pliant/language/" "/pliant/install/"
module "/pliant/install/ring3.pli"


type Time
  field Float seconds

type Date
  field Int days

type DateTime
  field Float seconds


function build  t
  arg_w Time t
  t seconds := undefined

function build  d
  arg_w Date d
  d days := undefined

function build  dt
  arg_w DateTime dt
  dt seconds := undefined


# ancient C codage under OS/2 : DateTime 0 <=> 31/12/0 0:0:0
# new Pliant codage: DateTime 0 <=> 1/1/1 0:0:0


(gvar Array:Int month_max) size := 13
for (gvar Int i) 1 12
  month_max i := shunt i%2=(shunt i<=7 1 0) 31 30
month_max 0 := 0
month_max 2 := 29

(gvar Array:Int month_base) size := 13
for i 0 12
  month_base i := shunt i>1 month_base:(i-1)+month_max:(i-1) 0

function year_base year -> base
  arg Int year base
  return year*365+year\4-year\100+year\400

function year_is_normal year -> normal
  arg Int year ; arg CBool normal
  normal := year%4<>0 or (year%100=0 and year%400<>0)


#----------------------------------------------------------------------
#  building


function date year month day -> d
  arg Int year month day ; arg Date d
  if month<1 or month>12 or day<1 or day>month_max:month
    d days := undefined
    return
  var CBool norm := year_is_normal year
  if month=2 and day=29 and norm
    d days := undefined
    return
  d days := year_base:(year-1) + month_base:month+(shunt norm and month>2 (-1) 0) + day-1


function time hour minute second fraction -> t
  arg Int hour minute second ; arg Float fraction ; arg Time t
  if hour<0 or hour>=24 or minute<0 or minute>=60 or second<0 or second>=60
    t seconds := undefined
    return
  t seconds := hour*3600 + minute*60 + second + fraction


function datetime year month day hour minute second fraction -> dt
  arg Int year month day hour minute second ; arg Float fraction ; arg DateTime dt
  var Date d := date year month day
  if d:days=undefined
    dt seconds := undefined
    return
  var Time t := time hour minute second fraction
  if t:seconds=undefined
    dt seconds := undefined
    return
  dt seconds := d:days*86400.0 + t:seconds


#----------------------------------------------------------------------
#  splitting


function try_month month norm remain day -> ok
  arg Int month ; arg CBool norm ; arg Int remain ; arg_rw Int day ; arg CBool ok
  var Int r := remain - month_base:month + (shunt norm and month>2 1 0)
  if r<0 or r>=month_max:month+(shunt norm and month=2 (-1) 0)
    return false
  day := r+1
  return true

function try_year year remain month day -> ok
  arg Int year remain ; arg_w Int month day ; arg CBool ok
  var CBool norm := year_is_normal year
  var Int r := remain-year_base:(year-1)
  if r<0 or r>(shunt norm 364 365)
    return false
  month := r*2\61+1
  if (try_month month norm r day)
    return true
  if (try_month month+1 norm r day)
    month := month+1
    return true
  if (try_month month-1 norm r day)
    month := month-1
    return true
  error error_id_check "Failed to extract Date month"

method d split year month day
  arg Date d ; arg_w Int year month day
  if d:days=defined
    var Int days := d days
    year := cast (days+14.75)/365.25+1-0.5 Int
    if (try_year year days month day)
      void
    eif (try_year year+1 days month day)
      year := year+1
    eif (try_year year-1 days month day)
      year := year-1
    else
      error error_id_check "Failed to extract Date year"
      year := undefined ; month := undefined ; day := undefined
      # error error_id_check "Failed to extract Date year"
  else
    year := undefined ; month := undefined ; day := undefined


method t split seconds fraction
  arg Time t ; arg_w Int seconds ; arg_w Float fraction
  if t:seconds=defined
    seconds := cast t:seconds-0.5 Int
    fraction := t:seconds-seconds
    if fraction<0
      fraction := fraction+1 ; seconds := seconds-1
    eif fraction>=1
      fraction := fraction-1 ; seconds := seconds+1
    check fraction>=0 and fraction<1
  else
    seconds := undefined ; fraction := undefined

method t split hour minute second fraction
  arg Time t ; arg_w Int hour minute second ; arg_w Float fraction
  var Int seconds
  t split seconds fraction
  if seconds=defined
    hour := seconds\3600
    minute := seconds\60%60
    second := seconds%60
  else
    hour := undefined ; minute := undefined ; second := undefined


method dt split d t
  arg DateTime dt ; arg_w Date d ; arg_w Time t
  if dt:seconds=defined
    d days := cast dt:seconds/86400-0.5 Int
    t seconds := dt:seconds-86400.0*d:days
    if t:seconds<0
      t seconds := t:seconds+86400 ; d days := d:days-1
    eif t:seconds>=86400
      t seconds := t:seconds-86400 ; d days := d:days+1
    check t:seconds>=0 and t:seconds<86400
  else
    d:days := undefined ; t:seconds := undefined

method dt split year month day hour minute second fraction
  arg DateTime dt ; arg_w Int year month day hour minute second ; arg_w Float fraction
  var Date d ; var Time t
  dt split d t
  d split year month day
  t split hour minute second fraction



#----------------------------------------------------------------------
#  fields


method d year -> y
  arg Date d ; arg Int y
  d split y (var Int mo) (var Int da)

method d month -> m
  arg Date d ; arg Int m
  d split (var Int ye) m (var Int da)

method d day -> da
  arg Date d ; arg Int da
  d split (var Int ye) (var Int mo) da

method d day_of_week -> dow
  arg Date d ; arg Int dow
  if d:days=defined
    dow := (d:days+1)%7
  else
    dow := undefined

gvar Array:Str day_name
day_name size := 7
day_name 0 := "sunday"
day_name 1 := "monday"
day_name 2 := "tuesday"
day_name 3 := "wednesday"
day_name 4 := "thursday"
day_name 5 := "friday"
day_name 6 := "saturday"


method t hour -> h
  arg Time t ; arg Int h
  t split (var Int seconds) (var Float fraction)
  if seconds=defined
    h := seconds\3600
  else
    h := undefined

method t minute -> m
  arg Time t ; arg Int m
  t split (var Int seconds) (var Float fraction)
  if seconds=defined
    m := seconds\60%60
  else
    m := undefined

method t second -> s
  arg Time t ; arg Int s
  t split (var Int seconds) (var Float fraction)
  if seconds=defined
    s := seconds%60
  else
    s := undefined

method t fraction -> f
  arg Time t ; arg Float f
  t split (var Int seconds) f


method dt date -> d
  arg DateTime dt ; arg Date d
  dt split d (var Time t)

method dt time -> t
  arg DateTime dt ; arg Time t
  dt split (var Date d) t

method dt year -> y
  arg DateTime dt ; arg Int y
  y := dt:date year

method dt month -> m
  arg DateTime dt ; arg Int m
  m := dt:date month

method dt day -> d
  arg DateTime dt ; arg Int d
  d := dt:date day

method dt day_of_week -> dow
  arg DateTime dt ; arg Int dow
  dow := dt:date day_of_week

method dt hour -> h
  arg DateTime dt ; arg Int h
  h := dt:time hour

method dt minute -> m
  arg DateTime dt ; arg Int m
  m := dt:time minute

method dt second -> s
  arg DateTime dt ; arg Int s
  s := dt:time second

method dt fraction -> f
  arg DateTime dt ; arg Float f
  f := dt:time fraction


#----------------------------------------------------------------------
#  comparing


function compare a b -> c
  arg Date a b ; arg Int c
  c := compare a:days b:days

function compare a b -> c
  arg Time a b ; arg Int c
  c := compare a:seconds b:seconds

function compare a b -> c
  arg DateTime a b ; arg Int c
  c := compare a:seconds b:seconds


#----------------------------------------------------------------------
#  computing


function '+' d1 days -> d2
  arg Date d1 d2 ; arg Int days
  d2:days := d1:days + days

function '-' d1 days -> d2
  arg Date d1 d2 ; arg Int days
  d2:days := d1:days - days

function '-' d1 d2 -> days
  arg Date d1 d2 ; arg Int days
  days := d1:days - d2:days


function '+' t1 seconds -> t2
  arg Time t1 t2 ; arg Float seconds
  t2:seconds := t1:seconds + seconds

function '-' t1 seconds -> t2
  arg Time t1 t2 ; arg Float seconds
  t2:seconds := t1:seconds - seconds

function '+' t1 t2 -> t3
  arg Time t1 t2 t3
  t3 seconds := t1:seconds + t2:seconds

function '-' t1 t2 -> seconds
  arg Time t1 t2 ; arg Float seconds
  seconds := t1:seconds - t2:seconds


function '+' dt1 t -> dt2
  arg DateTime dt1 dt2 ; arg Time t
  dt2:seconds := dt1:seconds + t:seconds

function '-' dt1 t -> dt2
  arg DateTime dt1 dt2 ; arg Time t
  dt2:seconds := dt1:seconds - t:seconds

function '-' dt1 dt2 -> t
  arg DateTime dt1 dt2 ; arg Time t
  t:seconds := dt1:seconds - dt2:seconds


export Date date '. days'
export Time time '. seconds'
export DateTime datetime
export '. split' '. date' '. time' '. year' '. month' '. day' '. day_of_week'
export '. hour' '. minute' '. second' '. fraction'
export '+' '-'
export day_name


#----------------------------------------------------------------------
#  status


function 'cast Status' d -> s
  arg Date d ; arg Status s
  explicit
  s := cast d:days Status

function 'cast Date' s -> d
  arg Status s ; arg Date d
  extension
  if s<>undefined
    error error_id_unexpected "Unexpected Status value"
  d days := undefined


function 'cast Status' t -> s
  arg Time t ; arg Status s
  explicit
  s := cast t:seconds Status

function 'cast Time' s -> t
  arg Status s ; arg Time t
  reduction
  if s<>undefined
    error error_id_unexpected "Unexpected Status value"
  t seconds := undefined


function 'cast Status' dt -> s
  arg DateTime dt ; arg Status s
  s := cast dt:seconds Status

function 'cast DateTime' s -> dt
  arg Status s ; arg DateTime dt
  extension
  if s<>undefined
    error error_id_unexpected "Unexpected Status value"
  dt seconds := undefined


export compare 'cast Status' 'cast Date' 'cast Time' 'cast DateTime'


#----------------------------------------------------------------------
#  current date/time


if os_api="linux" or os_api="posix"

  constant os_datetime_origin (datetime 1970 1 1 0 0 0 0)

  function datetime -> dt
    arg DateTime dt
    os_gettimeofday (var os_timeval tv) (var os_timezone tz)
    dt seconds := os_datetime_origin:seconds + tv:tv_sec + tv:tv_usec/1000000

  function sleep s
    arg Float s
    var os_timespec spec
    spec tv_sec := cast s-0.5 Int
    spec tv_nsec := cast (s-spec:tv_sec)*1000^3 Int
    if spec:tv_nsec>=1000^3
      spec tv_sec := spec:tv_sec + 1 ; spec tv_nsec := spec:tv_nsec - 1000^3
    eif spec:tv_nsec<0
      spec tv_sec := spec:tv_sec - 1 ; spec tv_nsec := spec:tv_nsec + 1000^3
    os_nanosleep spec (null map os_timespec)

  export datetime sleep os_datetime_origin

eif os_api="win32"

  function datetime -> dt
    arg DateTime dt
    os_GetSystemTime (var os_SYSTEMTIME t)
    dt := datetime t:wYear t:wMonth t:wDay t:wHour t:wMinute t:wSecond t:wMilliseconds/1000

  function sleep s
    arg Float s
    os_Sleep (cast s*1000 Int)

  export datetime sleep

eif os_api="os2"

  function datetime -> dt
    arg DateTime dt
    os_DosGetDateTime (var os_DATETIME t)
    dt := datetime t:year t:month t:day t:hours t:minutes t:seconds t:hundredths/100

  function sleep s
    arg Float s
    os_DosSleep (cast s*1000 Int)

  export datetime sleep


#----------------------------------------------------------------------
#  parsing


method data 'to string' options -> s
  arg Time data ; arg Str options ; arg Str s
  if data=undefined
    return (shunt options="db" "" "?")
  data split (var Int hour) (var Int minute) (var Int second) (var Float fraction)
  s := (right (string hour) 2 "0")+":"+(right (string minute) 2 "0")+":"+(right (string second) 2 "0")


method data 'from string' string options may_skip skiped offset -> status
  arg_w Time data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status
  if (string eparse any:(var Str drop1) (var Int hour) ":" (var Int minute) ":" (var Int second) offset:offset any:(var Str drop2))
    skiped := drop1 len
    data := time hour minute second 0
    status := success
  else
    data := undefined
    status := shunt string="" and options="db" success failure


method data 'to string' options -> s
  arg Date data ; arg Str options ; arg Str s
  if data=undefined
    return (shunt options="db" "" "?")
  data split (var Int year) (var Int month) (var Int day)
  s := (right (string year) 4 "0")+"/"+(right (string month) 2 "0")+"/"+(right (string day) 2 "0")


method data 'from string' string options may_skip skiped offset -> status
  arg_w Date data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status
  if (string eparse any:(var Str drop1) (var Int year) "/" (var Int month) "/" (var Int day) offset:offset any:(var Str drop2))
    skiped := drop1 len
    data := date year month day
    status := success
  else
    data := undefined
    status := shunt string="" and options="db" success failure


method data 'to string' options -> s
  arg DateTime data ; arg Str options ; arg Str s
  if data=undefined
    return (shunt options="db" "" "?")
  data split (var Int year) (var Int month) (var Int day) (var Int hour) (var Int minute) (var Int second) (var Float fraction)
  s := (right (string year) 4 "0")+"/"+(right (string month) 2 "0")+"/"+(right (string day) 2 "0")+" "+(right (string hour) 2 "0")+":"+(right (string minute) 2 "0")+":"+(right (string second) 2 "0")


method data 'from string' string options may_skip skiped offset -> status
  arg_w DateTime data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status
  if (string eparse any:(var Str drop1) (var Int year) "/" (var Int month) "/" (var Int day) _ (var Int hour) ":" (var Int minute) ":" (var Int second) offset:offset any:(var Str drop2))
    skiped := drop1 len
    data := datetime year month day hour minute second 0
    status := success
  else
    data := undefined
    status := shunt string="" and options="db" success failure