#lang scheme

(require scheme
         scheme/sandbox)

(define (infinity? n)
  (= (abs n) +inf.0))

;for a langauge level that guarantees halting
(define-syntax (limited-lambda stx)
  (syntax-case stx ()
    ((limited-lambda secs mb arg . body)
     #'(lambda arg
         (let ((secs-limit
                (if (procedure? secs)
                    (secs . body)
                    secs))
               (mb-limit
                (if (procedure? secs)
                    (mb . body)
                    mb)))
           (when (and (infinity? secs-limit)
                        (infinity? mb-limit))
             (error "Both limits cann't be infinity"))
           (with-limits secs-limit mb-limit
                        . body))))))

(define-syntax (limited-define stx)
  (syntax-case stx ()
    ((limited-define (f secs mb . arg) . body)
     #'(limited-define f
                       (limited-lambda secs mb arg
                                       . body)))
    ((limited-define v exp)
     #'(define v exp))))

(define-syntax (limited-let stx)
  (syntax-case stx ()
    ((limited-let (bindings ...) . body)
     #'(let (bindings ...) . body))
    ((limited-let proc-id secs mb ((id val-exp) ...) . body)
     #'(letrec ((proc-id
                 (limited-lambda secs mb (id ...)
                                 . body)))
         (proc-id val-exp ...)))))

(define-syntax (limited-do stx)
  (syntax-case stx ()
    ((limited-do secs mb
                 ([id init-expr . step-expr-maybe] ...)
                 (stop?-expr . finish-expr)
                 . expr)
     #`(let lp secs mb
         ((id init-expr) ...)
         (if stop?-expr
             (begin . finish-expr)
             (begin #,@#'expr
                    (lp #,@(map (lambda (id step)
                                  (let ((maybe (syntax->list step)))
                                    (if (null? maybe)
                                        id
                                        (car maybe))))
                                (syntax->list #'(id ...))
                                (syntax->list #'(step-expr-maybe ...))))))))))

(provide (except-out (all-from-out scheme)
                     lambda
                     define
                     let
                     do)
         (rename-out (limited-lambda lambda)
                     (limited-define define)
                     (limited-let let)
                     (limited-do do)))