Skip to content

Commit

Permalink
[cl-backend] foreign stash entries are for now filled in with dummy
Browse files Browse the repository at this point in the history
symbols
  • Loading branch information
pmurias committed Feb 16, 2011
1 parent a5f68a0 commit 1d616cd
Show file tree
Hide file tree
Showing 2 changed files with 10 additions and 4 deletions.
8 changes: 6 additions & 2 deletions cl-backend/backend.lisp
Expand Up @@ -10,7 +10,8 @@
; Macros ; Macros




(defun xref-to-symbol (xref) (intern (concatenate 'string "XREF-" (first xref) "-" (write-to-string (second xref))))) (defun xref-to-symbol (xref) (if (equal (first xref) "MAIN") (xref-to-symbol-real xref) (list 'quote (xref-to-symbol-real xref))))
(defun xref-to-symbol-real (xref) (intern (concatenate 'string "XREF-" (first xref) "-" (write-to-string (second xref)))))


(load "cl-backend/niecza-stash.lisp") (load "cl-backend/niecza-stash.lisp")


Expand Down Expand Up @@ -158,7 +159,9 @@
nil nil
(list (var-name var) (make-scalar "")))) (list (var-name var) (make-scalar ""))))
((and (list* var stash path) (when (equal stash "stash"))) ((and (list* var stash path) (when (equal stash "stash")))
(list (var-name var) `(get-stash ,path))))) (list (var-name var) `(get-stash ,path)))
((and (list* var common path) (when (equal common "common")))
(list (var-name var) (niecza-stash:to-stash-name path)))))




; converts a list of lexicals ; converts a list of lexicals
Expand Down Expand Up @@ -257,6 +260,7 @@
(list (niecza-stash:wrap-in-let stash_root (list (niecza-stash:wrap-in-let stash_root
(loop for thing in xref for i upfrom 0 when thing collect (compile-sub-or-packagoid i thing))))))) (loop for thing in xref for i upfrom 0 when thing collect (compile-sub-or-packagoid i thing)))))))



(defun print-thing (thing) (format t "~A" (FETCH thing))) (defun print-thing (thing) (format t "~A" (FETCH thing)))
(defun p6-say (&rest things) (mapcar #'print-thing things) (format t "~%")) (defun p6-say (&rest things) (mapcar #'print-thing things) (format t "~%"))
(defun p6-concat (&rest things) (apply 'concatenate 'string (mapcar #'FETCH things))) (defun p6-concat (&rest things) (apply 'concatenate 'string (mapcar #'FETCH things)))
Expand Down
6 changes: 4 additions & 2 deletions cl-backend/niecza-stash.lisp
Expand Up @@ -10,21 +10,23 @@
((and (list name var Xref ChildNode) (when (equal var "var"))) ((and (list name var Xref ChildNode) (when (equal var "var")))
(cons (list (append prefix (list name)) Xref) (process (cons name prefix) ChildNode))))) (cons (list (append prefix (list name)) Xref) (process (cons name prefix) ChildNode)))))


;;(trace entry)


(defun process (prefix nodes) (apply 'append (mapcar #'(lambda (x) (entry prefix x)) nodes))) (defun process (prefix nodes) (apply 'append (mapcar #'(lambda (x) (entry prefix x)) nodes)))





(defun wrap-in-let (stash body) (defun wrap-in-let (stash body)
(let ((processed (process '() stash))) (let ((processed (process '() stash)))
`(let `(let
,(mapcar (lambda (x) (list (to-stash-name (first x)) nil)) (hide-foreign processed)) ,(mapcar (lambda (x) (list (to-stash-name (first x)) nil)) processed)
,@body ,@body
,@(set-stash processed)))) ,@(set-stash processed))))


(defun only-with-xrefs (stash) (remove-if (lambda (x) (not (second x))) stash)) (defun only-with-xrefs (stash) (remove-if (lambda (x) (not (second x))) stash))


(defun set-stash (stash) (defun set-stash (stash)
(mapcar (lambda (x) `(setf ,(to-stash-name (first x)) ,(niecza::xref-to-symbol (second x)))) (only-with-xrefs (hide-foreign stash)))) (mapcar (lambda (x) `(setf ,(to-stash-name (first x)) ,(niecza::xref-to-symbol (second x)))) (only-with-xrefs stash)))


(defun hide-foreign (stash) (defun hide-foreign (stash)
(remove-if (remove-if
Expand Down

0 comments on commit 1d616cd

Please sign in to comment.