Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 37 lines (24 sloc) 1.115 kb
a552664 @pmurias [cl-backend] move stash handling into a seperate package
pmurias authored
1 (defpackage niecza-stash (:export wrap-in-let to-stash-name) (:use :common-lisp))
2 (in-package :niecza-stash)
3
4 (ql:quickload "fare-matcher")
5
6 (defun to-stash-name (name) (intern (format nil "~{~A~^-~}" name)))
7
8 (defun entry (prefix node)
9 (fare-matcher:match node
10 ((and (list name var Xref ChildNode) (when (equal var "var")))
11 (cons (list (append prefix (list name)) Xref) (process (cons name prefix) ChildNode)))))
12
1d616cd @pmurias [cl-backend] foreign stash entries are for now filled in with dummy
pmurias authored
13 ;;(trace entry)
a552664 @pmurias [cl-backend] move stash handling into a seperate package
pmurias authored
14
15 (defun process (prefix nodes) (apply 'append (mapcar #'(lambda (x) (entry prefix x)) nodes)))
16
17
1d616cd @pmurias [cl-backend] foreign stash entries are for now filled in with dummy
pmurias authored
18
a552664 @pmurias [cl-backend] move stash handling into a seperate package
pmurias authored
19 (defun wrap-in-let (stash body)
20 (let ((processed (process '() stash)))
21 `(let
1d616cd @pmurias [cl-backend] foreign stash entries are for now filled in with dummy
pmurias authored
22 ,(mapcar (lambda (x) (list (to-stash-name (first x)) nil)) processed)
a552664 @pmurias [cl-backend] move stash handling into a seperate package
pmurias authored
23 ,@body
24 ,@(set-stash processed))))
25
26 (defun only-with-xrefs (stash) (remove-if (lambda (x) (not (second x))) stash))
27
28 (defun set-stash (stash)
1d616cd @pmurias [cl-backend] foreign stash entries are for now filled in with dummy
pmurias authored
29 (mapcar (lambda (x) `(setf ,(to-stash-name (first x)) ,(niecza::xref-to-symbol (second x)))) (only-with-xrefs stash)))
a552664 @pmurias [cl-backend] move stash handling into a seperate package
pmurias authored
30
31 (defun hide-foreign (stash)
32 (remove-if
33 (lambda (x)
34 (and (second x) (not (equal (first (second x)) "MAIN"))))
35 stash))
36
Something went wrong with that request. Please try again.