On 10/14/2017 3:00 AM, Jack Firth wrote:
So is there a way ... from normal code ... to get at the locals of
functions higher in the call chain? Or at least the immediate
caller?
Some reflective capability that I haven't yet discovered?
I'm not sure if there's a way to do that, but I'm wondering if what
you want to do can be achieved more simply with plain functions and a
very small macro wrapper. In particular, I suspect putting too much
logic in the macro is what led you to eval which is the root of all
evil. From what I can tell there shouldn't be any need at all for eval
or any sort of dynamic runtime compilation to do things like what
you're describing. Could you give a few more details about your use
case? Ideally with some example code illustrating the problem?
Basically, this is a sort of Unix at-like function for flexible
scheduling. It takes an expression containing dates, times, certain
keywords and arbitrary numeric expressions, and it produces seconds
since the epoch. Code is attached - hope it survives posting to the
list. It should be runnable as is.
What led me to eval originally was wanting to reference arbitrary
functions/variables from the runtime environment. I'd like to be able
to say
things like:
(let [(y 42)] (schedule (at now + y mins) ...))
and similar involving top-level defined functions [which already works
with eval].
I know that eval is not needed if I generate inline code rather than
having the macro invoke a normal function. But that is complicated by
having to deal with free form expressions: they can have internal
references between things which are not necessarily adjacent. It is
doable, but at some expense and not very cleanly.
I started out going the "compile" route - just generating inline code.
But as more functionality was added, that became unwieldy. So I switched
to a runtime function. Right now the assoc list code is overly complex
[so please ignore it] - it is there as a debugging tool until I get
everything working exactly right.
George
--
You received this message because you are subscribed to the Google Groups "Racket
Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to racket-users+unsubscr...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.
#lang racket/base
(require
(for-syntax racket/base
racket/format
racket/pretty
)
racket/base
racket/match
racket/list
racket/format
racket/dict
racket/date
racket/port
)
(provide
at
at-time
month/year
)
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#|
allows free form date/time descriptions in
the style of the Unix "at" command. converts
the description into seconds since the Unix
epoch: 1970-01-01 at 00:00hrs.
the resulting seconds value may be converted
into a usable date structure, or passed to
an alarm event for scheduling.
freestanding + operators will be ignored.
for signed values use [+-]?[:digits:]+.
key words:
"now" = current date/time
"today" - at 00hrs
"tomorrow" - at 00hrs
"this-month" - at 00hrs on the 1st
"next-month" - at 00hrs on the 1st
dates must be entered in yyyy-mm-dd format.
times are 24hr format: hours and minutes
are required - seconds are optional. a
separate AM/PM qualifier can be used to adjust
ambiguous times.
anything not a date, time or keyword will be
evaluated as a racket expression. expressions
may reference variables or functions from the
surrounding code environment.
an expression may be followed immediately by
a unit multiplier. units may be seconds,
minutes, hours, days, or weeks (or some of
the typical abbreviations for these units).
|#
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
;======================================
;
; macro interface - generates call to
; parsing function at runtime
;
;======================================
(define-syntax (at stx)
(let* [
(input (cdr (syntax->datum stx)))
(input (map ~a input))
(fnspec (list 'apply '+ (list* 'at-time input)))
]
(datum->syntax stx fnspec)
))
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
;======================================
;
; parse a time/date description
;
;======================================
(define (at-time #:namespace [ns (current-namespace)] . input)
(let* [
(now (current-seconds))
(today (current-date))
(hour12 (* 12 60 60))
(hour13 (* 13 60 60))
]
(let loop [
(input input)
(output '())
]
(match input
; done
([? empty?]
(eprintf "=> ~s~n" (reverse output))
(map cdr output)
)
; current time
([list "now" _ ___ ]
(loop (cdr input) (cons (cons 'now now) output)))
; date (at 00:00:00)
([list (pregexp px-date [list _ yy mm dd]) _ ___]
(let* [
(yy (string->number yy))
(mm (string->number mm))
(dd (string->number dd))
(result (find-seconds 0 0 0 dd mm yy))
]
(loop (cdr input) (cons (cons 'date result) output))
))
; time 24hr format
([list (pregexp px-time [list _ hh mm _ ss]) _ ___]
(let* [
(hh (string->number hh))
(mm (string->number mm))
(ss (if ss (string->number ss) 0))
; translate as absolute offset from epoch
(result (find-seconds ss mm hh 1 1 1970 #f))
]
(loop (cdr input) (cons (cons 'time result) output))
))
; PM - offset (time < 12:00)
([list (or "pm" "PM") _ ___]
(let* [
(time (assq 'time output))
(ok (and time (< (cdr time) hour12)))
]
(if ok
(loop (cdr input) (cons (cons 'am/pm hour12) output))
(loop (cdr input) output))
))
; AM - offset (12:00 <= time < 13:00)
([list (or "am" "AM") _ ___]
(let* [
(time (assq 'time output))
(ok (and time
(or (= (cdr time) hour12)
(< hour12 (cdr time) hour13)
)))
]
(if ok
(loop (cdr input) (cons (cons 'am/pm (- hour12)) output))
(loop (cdr input) output))
))
; today (at 00:00:00)
([list "today" _ ___]
(let [
(result (find-seconds 0 0 0 [date-day today][date-month
today][date-year today]))
]
(loop (cdr input) (cons (cons 'today result) output))
))
; tomorrow (at 00:00:00)
([list "tomorrow" _ ___]
(let* [
(result (find-seconds 0 0 0 [date-day today][date-month
today][date-year today]))
(result (+ result (dict-ref units "day")))
]
(loop (cdr input) (cons (cons 'tomorrow result) output))
))
; this-month (1st day at 00:00:00)
([list "this-month" _ ___]
(let [
(result (find-seconds 0 0 0 1 [date-month today][date-year
today]))
]
(loop (cdr input) (cons (cons 'this-month result) output))
))
; next-month (1st day at 00:00:00)
([list "next-month" _ ___]
(let*-values
[
((month year) (month/year [date-month today] [date-year today]
+1))
((result) (find-seconds 0 0 0 1 month year))
]
(loop (cdr input) (cons (cons 'next-month result) output))
))
; punctuation/whitespace
([list "+" _ ___ ]
(loop (cdr input) output))
; unit multiplier
([list (app (λ(e) (dict-ref units e #f)) unit)
_ ___]
(if unit
(let* [
(expr (if [pair? output] (car output) #f))
(expr (if [and expr (eq? (car expr) 'expr)]
(* (cdr expr) unit)
#f))
]
(if expr
(loop (cdr input) (cons (cons 'unit-expr expr) (cdr output)))
(error 'at "unit must follow expression")))
(failure-cont)
))
; number
([list (app string->number num) _ ___]
(if num
(loop (cdr input) (cons (cons 'expr num) output))
(failure-cont) ))
; expression
([list expr _ ___]
(let [
(val (with-handlers [(exn:fail? (λ(e)#f))]
(with-input-from-string expr
(λ() (eval (read) ns)))))
]
(eprintf "expr: ~s -> ~s~n" expr val)
(if [number? val]
(loop (cdr input) (cons (cons 'expr val) output))
(failure-cont))
))
(else
(error 'at "I don't understand: ~a" input))
) ; end match
)))
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(define units
(let* [
(second 1)
(minute (* 60 second))
(hour (* 60 minute))
(day (* 24 hour ))
(week (* 7 day ))
(myhash (make-custom-hash member))
]
(dict-set*! myhash
'("sec" "secs" "second" "seconds") second
'("min" "mins" "minute" "minutes") minute
'("hr" "hrs" "hour" "hours" ) hour
'( "day" "days" ) day
'( "week" "weeks" ) week
)
myhash))
(define px-time #px"(2[0-3]|[01]?[0-9]):([0-5][0-9])(:([0-5][0-9]))?" )
(define px-date #px"([0-9]{4})-(0[1-9]|1[0-2])-(0[1-9]|[12][0-9]|3[01])")
(define px-integer #px"[+-]?[[:digit:]]+")
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
;======================================
;
; compute ending month & year
;
;======================================
(define (month/year month year offset)
(let* [
; offset month for modular arithmetic
(month (- month 1))
; compute ending year
(year (let [
(op (if (>= offset 0) + -))
(offset (abs offset))
]
(if [eq? op +]
(let [(left (- 11 month))]
(if (<= offset left)
year
(+ year (ceiling (/ (- offset left) 12)))
))
;[eq? op -]
(if (<= offset month)
year
(- year (ceiling (/ (- offset month) 12)))
)
)
))
; compute ending month
(month (modulo (+ month offset) 12))
(month (+ month 1))
]
; return month and year
(values month year)
))
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
