Common Lisp compared to Perl6: converts seconds into years months days hours minutes seconds

gistfile1.txt

===========================PERL 6======================

seconds;

sub seconds
  {
    say "Please enter number of seconds: ";
    my $raw = get.Int;
    
    my $sec = $raw;
    my $min = $sec div 60;
    $sec    = $raw - ( $min * 60 );
    my $hr  = $min div 60;
    $min    = $min - ( $hr * 60 );
    my $day = $hr div 24;
    $hr     = $hr - ( $day * 24);
    my $yr  = $day div 365;
    $day    = $day - ( $yr * 365 );
    

    say "Years:$yr   Days:$day   Hours:$hr   Minutes:$min   Seconds:$sec";
  }

==================================COMMON LISP=============================
==================================four versions=========================

============== FIRST ============

(defun whatever (seconds)
  (multiple-value-bind (years remainder)
     (floor seconds 31536000)
  (multiple-value-bind (days remainder)
      (floor remainder 86400)
  (multiple-value-bind (hours remainder)
       (floor remainder 3600)
   (multiple-value-bind (minutes seconds)
       (floor remainder 60)
   (values years days hours minutes seconds))))))


=============  Second ==================

 
(defparameter *time-bases*       '(60       60        24    30     12))
(defparameter *time-bases-names* '("second" "minute" "hour" "day" "month" "year"))

(defmacro define-base-decomposer (name bases)
  "Note: BASES is evaluated."
  `(defun ,name (value)
     (labels ((decompose (value bases result)
                (if (null bases)
                    (reverse (cons (unless (zerop value) value) result))
                    (multiple-value-bind (q r) (truncate value (car bases))
                      (decompose q (cdr bases)
                                 (cons (unless (zerop r) r) result))))))
       (decompose value ,bases '()))))

(define-base-decomposer time-interval-to-components *time-bases*)


(time-interval-to-components 19308902312) ; --> (32 58 15 12 9 620)


;; Actually, a better solution:

================================= Third ===================================

(defmacro define-base-decomposer (name bases)
  "
Generates a decomposer function for the given list of bases.
BASES: either a symbol naming a dynamic variable bound to a list of bases in the compilation environment,
       or a literal list of bases.
"
  (labels ((generate-decompose-expression (bases val-var remainders)
             (if (endp bases)
                 `(list ,@(reverse remainders) ,val-var)
                 (let ((quotient  (gensym))
                       (remainder (gensym)))
                   `(multiple-value-bind (,quotient ,remainder) (truncate ,val-var ,(first bases))
                      ,(if (endp (rest bases))
                           `(list ,@(reverse remainders)  ,remainder ,quotient)
                           (generate-decompose-expression (rest bases) quotient (cons remainder remainders))))))))
    (let ((bases (if (symbolp bases)
                     (symbol-value bases)
                     bases)))
      `(defun ,name (value)
         ,(generate-decompose-expression bases 'value '())))))


(define-base-decomposer time-interval-to-components (60 60 24 30 12))
(time-interval-to-components 19308902312)
;; --> (32 58 15 12 9 620)


(pprint (macroexpand-1 '(define-base-decomposer time-interval-to-components *time-bases*)))

(defun time-interval-to-components (value)
  (multiple-value-bind (#1=#:g19270 #5=#:g19271)
      (truncate value 60)
    (multiple-value-bind (#2=#:g19272 #6=#:g19273)
        (truncate #1# 60)
      (multiple-value-bind (#3=#:g19274 #7=#:g19275)
          (truncate #2# 24)
        (multiple-value-bind (#4=#:g19276 #8=#:g19277)
            (truncate #3# 30)
          (multiple-value-bind (#10=#:g19278 #9=#:g19279) (truncate #4# 12) (list #5# #6# #7# #8# #9# #10#)))))))


=========== Fourth ======================

(defvar *program*
  '(my $min-t = $raw div 60             ;
    my $sec   = $raw - ( $min-t * 60 )  ;
    my $hr-t  = $min-t div 60           ;
    my $min   = $min-t - ( $hr-t * 60 ) ;
    my $day-t = $hr-t div 24            ;
    my $hr    = $hr-t - ( $day-t * 24 ) ;
    my $yr    = $day-t div 365          ;
    my $day   = $day-t - ( $yr * 365 )  ;
  
    say |Year:| $yr |Day:| $day |Hour:| $hr |Min:| $min |Sec:| $sec ;
    }))

(defun result (program)
  (cond ((null program) nil)
        ((numberp program) program)
        ((and (symbolp program) (boundp program))
         (symbol-value program))
        ((eq program '}) '|:)|)
        ((symbolp program)
         program)
        ((eq (car program) 'my)
         (let* ((lhs (cadr program))
                (rest (member-if (lambda (x) (member x '(my say })))
                                 (cdddr program)))
                (rhs (ldiff (cdddr program) rest)))
           (progv (list lhs) (list (result rhs))
             (result rest))))
        ((eq (cadr program) '*)
         (* (result (car program))
            (result (caddr program))))
        ((eq (cadr program) 'div)
         (truncate (result (car program))
                   (result (caddr program))))
        ((eq (cadr program) '-)
         (- (result (car program))
            (result (caddr program))))
        ((eq (car program) 'say)
         (dolist (arg (cdr program))
           (princ (result arg))
           (princ " ")))))

(defun test ()
  (progv '($raw) '(123456789)
    (result *program*)))

I think this is a better Perl 6 example:

#| asks for a number of seconds
multi sub MAIN () {
  my $seconds = prompt("Please enter number of seconds: ").Int;
  nextwith $seconds;
}

multi sub MAIN ( Int:D $seconds ) { # allows it to be given on the command line
    put join '   ', (
            < Years: Days: Hours: Minutes: Seconds: >
        Z~
            $seconds.polymod(60,60,24,365).reverse
    )
}

Or if you really want to create lexical variables

…
multi sub MAIN ( Int:D $seconds ) { # the name is used for the -h / --help message
    my ($sec,$min,$hr,$day,$yr) = $seconds.polymod(60,60,24,365);
    say "Years:$yr   Days:$day   Hours:$hr   Minutes:$min   Seconds:$sec";
}

Note that it will print this if you give it the argument -h or --help

Usage:
  ./test.p6 -- asks for a number of seconds
  ./test.p6 <seconds> 

Although I would also think about writing it like this if it was a one off program

put <Years: Days: Hours: Minutes: Seconds:> Z~ prompt("Please enter number of seconds: ").Int.polymod(60,60,24,365).reverse

I just now saw your comment. That looks pretty concise and foreign -- very perly. Thanks for the comment, though!

I've been studying Common Lisp for a few months now. Here is what my version would be. I'm really not sure why the others didn't submit something similar to mine:

(defun seconds_to_years (raw)
           (let*
               ((min_t (car (list (floor raw 60))))
                (seconds (- raw (* 60 min_t)))
                (hr_t (car (list (floor min_t 60))))
                (minutes (- min_t (* 60 hr_t)))
                (day_t (car (list (floor hr_t 24))))
                (hours (- hr_t (* 24 day_t)))
                (years (car (list (floor day_t 365))))
                (days (- day_t (* 365 years))))
             (list seconds minutes hours days years)))