diff --git a/scheme/ikarus.time-and-date.ss b/scheme/ikarus.time-and-date.ss new file mode 100644 index 0000000..b6d233b --- /dev/null +++ b/scheme/ikarus.time-and-date.ss @@ -0,0 +1,33 @@ +;;; Ikarus Scheme -- A compiler for R6RS Scheme. +;;; Copyright (C) 2006,2007 Abdulaziz Ghuloum +;;; +;;; This program is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License version 3 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 +;;; along with this program. If not, see . + + +(library (ikarus system time-and-date) + (export current-time time? time-seconds) + (import + (except (ikarus) time current-time time? time-seconds)) + + (define-struct time (msecs secs usecs)) + ;;; mega/seconds/micros + + (define (current-time) + (foreign-call "ikrt_current_time" (make-time 0 0 0))) + + (define (time-seconds x) + (if (time? x) + (+ (* (time-msecs x) #e10e6) + (time-secs x)) + (error 'time-seconds "not a time" x)))) +