;;Defining lexically scoped, unified variables and
;;functions with keyword access.
(defpackage :clclojure.lexical
  (:use  :common-lisp  :clclojure.keywordfunc
   :common-utils)
  (:export :unified-let*))
(in-package :clclojure.lexical)

;;if the arg can be construed as a function,
;;the lexical symbol should be unified..

  (    binding ( var )
    ` ( cond ( ( functionp   , var )          
            ( setf ( symbol - function ( quote , var ) )
;;                 ,var))
           ( ( keywordp    , var )
;;           (if  (not (keyfn? ,var))
                 ( progn ( pprint ( format nil " adding keyword access for : ~a " k ) )
;;                       (eval (key-accessor ,var)))))))

;;we need to use let and flet instead of this...

  (    binding ( var )
    ` ( cond ( ( functionp   , var )          
            ( setf ( symbol - function ( quote , var ) )
;;                 ,var))
           ( ( keywordp    , var )
;;           (if  (not (keyfn? ,var))
                 ( progn ( pprint ( format nil " adding keyword access for : ~a " , var ) )
;;                       ;;(eval (key-accessor ,var))
                        ( setf ( symbol - function ( quote , var ) )
;;                             (->keyaccess ,var)) 
;;                       )))))

;;a couple of notes on evaluation and symbol/function namespaces,
;;including lexical scope....
;;we have a few cases to cover...
if we want to cover every possible case and get a lisp1 ,
;;in the lexical case, we are relegated to using a combination
;;of let and flet on all the symbols
;; (let* ((g       (->keyaccess :a))
;;        (lookup  (->keyaccess :b)))
;;   (labels ((g      (arg)      (funcall (keyaccess-func g)  arg))
;;            (lookup (arg)      (funcall (keyaccess-func lookup)  arg)))
      ; ; ( mapcar f ( list     ) )
      ( pprint ( list : obj lookup : fn (   ) ) ) ) )

;;this is an example of how we can play with lexical binds...
;;In the extreme case, we may not know what any types are,
;;which means they're functions or objects....
;; (defun some-fn (z)
    ( let * ( ( g        ( lambda ( x ) ( + x 5 ) ) ) ; ; an actual function object ...
;;          (lookup  (->keyaccess :b))
           ( z        ( if (   )
;;                       (->keyaccess z)
;;                       z))) ;;keyword access function object...
;;     (labels (;;general implementation of fn
;;              (g      (&rest args)      (apply  g  args))
;;              ;;specific implementation for kw lookup..
;;              (lookup (arg)      (funcall (keyaccess-func lookup)  arg))
;;              (z      (&rest args)     (apply z args))
;;              )
        ( pprint ( list :   : fn ( g 2 ) : keyaccess lookup
                      : z z : z - lookup (   )
;;                     (mapcar  (lambda (x) (list :type x (type-of x)))
                               ( list   g   lookup z ) ) ) ) ) ) )

;;the only things that we know...  are keywords, or fn forms bindings
;;are already in pairs...

;;Scrape the bindings to let*, and if we find keywords,
;;create an alist that associates the keyword to an
;;expression that defines a labels lexical function
;;for the keyword accessor.  We compute/construct
a  at compile time , and though it 's
;;funcallable, we lookup its associated function
;;for use (and efficiency).  We then provide
;;a simple function wrapper that invokes the keyword
;;fn (bear in mind, this is setfable).
(EVAL-WHEN (:compile-toplevel :load-toplevel :execute)
  (defun keyword-accessors (bindings)
    (let ((arg (gensym "lookup")))
      (mapcar (lambda (lr)
                (destructuring-bind (l r) lr
                  (let ((f (keyaccess-func  (->keyaccess r))))
                    (list r `(,l (,arg) (funcall (->keyaccess ,r) ,arg))))))
              (filter (lambda (lr) (keywordp (second lr))) bindings))))

  ;;we use a generic apply here...  collect all the args into a list and
  ;;apply.  In clojure, there's some cost to that.  Dunno what the
overhead is in CL .   Also , if we " know " anything about the function ,
  ;;we may be able to do some analysis and compile a more efficient
  ;;binding form (i.e. known number of args in the lambda. or simple
  ;;funcall...

  ;;There's some question about how much we know about the parameters at
  ;;runtime (specifically for let bindings).  For certain classes of
  ;;lexical environments, we may be a-okay doing significant analysis of
  ;;what's involved in the let (case in point: if it's a lambda or a
  ;;known function we have meta on, we can derive types / args).  Thats
  ;;a future optimization...

Note : if we do n't refer to the lexical vars ( NOT fns ) for the
  ;;keywords, we end up with a slew of style warnings, since they don't
  ;;appear to be used (they are used for the lexical keyaccessors
  ;;though).  To prevent this, we define a dummy function (never
  ;;invoked) that builds a list composed from the symbol-values.  For
  ;;now, it's convenient.  I may revisit this to see if we can detect if
  ;;the symbols aren't validly used...

  ;;we get compiler complaints with this if we don't...

  (defun functionize-bindings (bindings)
    (let* ((kwalist (keyword-accessors bindings))
           (vars    (mapcar (lambda (lr) (first (second lr))) kwalist))
           (dummy   (gensym "dummyfn")))
      (cons `(,dummy () (list :this-prevents-warnings-nothing-else
                              ,@vars))
            (mapcar (lambda (lr)
                      (destructuring-bind (l r) lr
                        (if (keywordp r)
                            (second  (assoc r kwalist))
                            `(,l (,'&rest ,'args) (apply ,l ,'args)))))
                    bindings)))))

;;so at the lexical level, we need to analyze the bindings.
;;determine if an item is a function (or an applicable object like
;;a keyword), and create matching labels for them...

;;this acts like let*, except it allows bindings that may be functions
;;or things that can act like functions -> keywords.  Everything else
;;should be covered by a funcallable object...  We unify the
;;symbol-value and symbol-function namespaces in the lexical context,
;;detecting the need to generate keyword accessors.
(defmacro unified-let* (bindings &rest body)
  `(let* (,@bindings)
     (labels (,@ (functionize-bindings bindings)
                 )
       ,@body)))

;;a simple test function to tie everything together.
(defun test-my-scope ()
  (unified-let* ((hello :hello)  ;;we create (or lookup cached) keyaccess funcallable objects
                 (world :world)  ;;when we have literal keywords bound to symbols.
                 (k 2) 
                 (inc (lambda (x) (+ x 1)))
                 (add (lambda (x y) (+ x y)))
                 (tbl (unified-let* ((tbl (make-hash-table)))
                                    (setf  (gethash :hello tbl) "World")
                                    (setf  (gethash :world tbl) "Hello")
                                    (setf  (gethash :k  tbl)    k)
                                    tbl)))
                (list (hello tbl)
                      (world tbl)
                      (add (inc 39) k)
(: k  ) ; ; does n't work without some extra macro magic ...
                      (funcall (->keyaccess :k) tbl) ;;it will look like this behind the scenes.
                      )))

;;LEXICAL> (test-my-scope)
( " World " " Hello " 42 2 )   ; ; works !

Defining lexically scoped, unified variables and
functions with keyword access.
if the arg can be construed as a function,
the lexical symbol should be unified..
                 ,var))
           (if  (not (keyfn? ,var))
                       (eval (key-accessor ,var)))))))
we need to use let and flet instead of this...
                 ,var))
           (if  (not (keyfn? ,var))
                       ;;(eval (key-accessor ,var))
                             (->keyaccess ,var)) 
                       )))))
a couple of notes on evaluation and symbol/function namespaces,
including lexical scope....
we have a few cases to cover...
in the lexical case, we are relegated to using a combination
of let and flet on all the symbols
 (let* ((g       (->keyaccess :a))
        (lookup  (->keyaccess :b)))
   (labels ((g      (arg)      (funcall (keyaccess-func g)  arg))
            (lookup (arg)      (funcall (keyaccess-func lookup)  arg)))
 ; ( mapcar f ( list     ) )
this is an example of how we can play with lexical binds...
In the extreme case, we may not know what any types are,
which means they're functions or objects....
 (defun some-fn (z)
 ; an actual function object ...
          (lookup  (->keyaccess :b))
                       (->keyaccess z)
                       z))) ;;keyword access function object...
     (labels (;;general implementation of fn
              (g      (&rest args)      (apply  g  args))
              ;;specific implementation for kw lookup..
              (lookup (arg)      (funcall (keyaccess-func lookup)  arg))
              (z      (&rest args)     (apply z args))
              )
                     (mapcar  (lambda (x) (list :type x (type-of x)))
the only things that we know...  are keywords, or fn forms bindings
are already in pairs...
Scrape the bindings to let*, and if we find keywords,
create an alist that associates the keyword to an
expression that defines a labels lexical function
for the keyword accessor.  We compute/construct
funcallable, we lookup its associated function
for use (and efficiency).  We then provide
a simple function wrapper that invokes the keyword
fn (bear in mind, this is setfable).
we use a generic apply here...  collect all the args into a list and
apply.  In clojure, there's some cost to that.  Dunno what the
we may be able to do some analysis and compile a more efficient
binding form (i.e. known number of args in the lambda. or simple
funcall...
There's some question about how much we know about the parameters at
runtime (specifically for let bindings).  For certain classes of
lexical environments, we may be a-okay doing significant analysis of
what's involved in the let (case in point: if it's a lambda or a
known function we have meta on, we can derive types / args).  Thats
a future optimization...
keywords, we end up with a slew of style warnings, since they don't
appear to be used (they are used for the lexical keyaccessors
though).  To prevent this, we define a dummy function (never
invoked) that builds a list composed from the symbol-values.  For
now, it's convenient.  I may revisit this to see if we can detect if
the symbols aren't validly used...
we get compiler complaints with this if we don't...
so at the lexical level, we need to analyze the bindings.
determine if an item is a function (or an applicable object like
a keyword), and create matching labels for them...
this acts like let*, except it allows bindings that may be functions
or things that can act like functions -> keywords.  Everything else
should be covered by a funcallable object...  We unify the
symbol-value and symbol-function namespaces in the lexical context,
detecting the need to generate keyword accessors.
a simple test function to tie everything together.
we create (or lookup cached) keyaccess funcallable objects
when we have literal keywords bound to symbols.
 ; does n't work without some extra macro magic ...
it will look like this behind the scenes.
LEXICAL> (test-my-scope)
 ; works !
(defpackage :clclojure.lexical
  (:use  :common-lisp  :clclojure.keywordfunc
   :common-utils)
  (:export :unified-let*))
(in-package :clclojure.lexical)


  (    binding ( var )
    ` ( cond ( ( functionp   , var )          
            ( setf ( symbol - function ( quote , var ) )
           ( ( keywordp    , var )
                 ( progn ( pprint ( format nil " adding keyword access for : ~a " k ) )


  (    binding ( var )
    ` ( cond ( ( functionp   , var )          
            ( setf ( symbol - function ( quote , var ) )
           ( ( keywordp    , var )
                 ( progn ( pprint ( format nil " adding keyword access for : ~a " , var ) )
                        ( setf ( symbol - function ( quote , var ) )

if we want to cover every possible case and get a lisp1 ,
      ( pprint ( list : obj lookup : fn (   ) ) ) ) )

           ( z        ( if (   )
        ( pprint ( list :   : fn ( g 2 ) : keyaccess lookup
                      : z z : z - lookup (   )
                               ( list   g   lookup z ) ) ) ) ) ) )


a  at compile time , and though it 's
(EVAL-WHEN (:compile-toplevel :load-toplevel :execute)
  (defun keyword-accessors (bindings)
    (let ((arg (gensym "lookup")))
      (mapcar (lambda (lr)
                (destructuring-bind (l r) lr
                  (let ((f (keyaccess-func  (->keyaccess r))))
                    (list r `(,l (,arg) (funcall (->keyaccess ,r) ,arg))))))
              (filter (lambda (lr) (keywordp (second lr))) bindings))))

overhead is in CL .   Also , if we " know " anything about the function ,


Note : if we do n't refer to the lexical vars ( NOT fns ) for the


  (defun functionize-bindings (bindings)
    (let* ((kwalist (keyword-accessors bindings))
           (vars    (mapcar (lambda (lr) (first (second lr))) kwalist))
           (dummy   (gensym "dummyfn")))
      (cons `(,dummy () (list :this-prevents-warnings-nothing-else
                              ,@vars))
            (mapcar (lambda (lr)
                      (destructuring-bind (l r) lr
                        (if (keywordp r)
                            (second  (assoc r kwalist))
                            `(,l (,'&rest ,'args) (apply ,l ,'args)))))
                    bindings)))))


(defmacro unified-let* (bindings &rest body)
  `(let* (,@bindings)
     (labels (,@ (functionize-bindings bindings)
                 )
       ,@body)))

(defun test-my-scope ()
                 (k 2) 
                 (inc (lambda (x) (+ x 1)))
                 (add (lambda (x y) (+ x y)))
                 (tbl (unified-let* ((tbl (make-hash-table)))
                                    (setf  (gethash :hello tbl) "World")
                                    (setf  (gethash :world tbl) "Hello")
                                    (setf  (gethash :k  tbl)    k)
                                    tbl)))
                (list (hello tbl)
                      (world tbl)
                      (add (inc 39) k)
                      )))

