Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

[cl-backend] move stash handling into a seperate package

  • Loading branch information...
commit a552664b99eb5b8ca17da5b499ef851ffae53794 1 parent e735b87
@pmurias pmurias authored
Showing with 46 additions and 29 deletions.
  1. +12 −29 cl-backend/backend.lisp
  2. +34 −0 cl-backend/niecza-stash.lisp
View
41 cl-backend/backend.lisp
@@ -1,16 +1,24 @@
(load (merge-pathnames "quicklisp/setup.lisp"
(user-homedir-pathname)))
+
(ql:quickload "cl-json")
(ql:quickload "fare-matcher")
+(defpackage niecza (:use common-lisp))
+(in-package :niecza)
+
; Macros
-(defun to-stash-name (name) (intern (format nil "~{~A~^-~}" name)))
-(defmacro get-stash (name) (to-stash-name name))
(defun xref-to-symbol (xref) (intern (concatenate 'string "XREF-" (first xref) "-" (write-to-string (second xref)))))
+(load "cl-backend/niecza-stash.lisp")
+
+
+
(defun main-xref (i) (xref-to-symbol (list "MAIN" i "...")))
+
+(defmacro get-stash (name) (niecza-stash:to-stash-name name))
(defmacro nam-op (name params &body body) `(defmacro ,(concat-symbol 'nam- name) ,params ,@body))
@@ -229,32 +237,7 @@
)))
-(defun fstash (prefix node)
- (fare-matcher:match node
- ((and (list name var Xref ChildNode) (when (equal var "var")))
- (cons (list (append prefix (list name)) Xref) (fstash-list (cons name prefix) ChildNode)))))
-
-
-(defun fstash-list (prefix nodes) (apply 'append (mapcar #'(lambda (x) (fstash prefix x)) nodes)))
-
-
-(defun fstash-to-let (stash body)
- `(let
- ,(mapcar (lambda (x) (list (to-stash-name (first x)) nil)) (hide-foreign stash))
- ,@body
- ,@(fstash-to-setf stash)
- ))
-
-(defun only-with-xrefs (stash) (remove-if (lambda (x) (not (second x))) stash))
-
-(defun fstash-to-setf (stash)
- (mapcar (lambda (x) `(setf ,(to-stash-name (first x)) ,(xref-to-symbol (second x)))) (only-with-xrefs (hide-foreign stash))))
-(defun hide-foreign (stash)
- (remove-if
- (lambda (x)
- (and (second x) (not (equal (first (second x)) "MAIN"))))
- stash))
(defun compile-unit (nam)
(fare-matcher:match nam
@@ -271,7 +254,7 @@
stash_root ; Trie holding classes and global variables
)
- (list (fstash-to-let (fstash-list '() 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)))))))
(defun print-thing (thing) (format t "~A" (FETCH thing)))
@@ -299,7 +282,7 @@
)
,@compiled-unit (,(main-xref 0))))
-(let ((compiled-unit (compile-unit (json:decode-json (open (first *args*))))))
+(let ((compiled-unit (compile-unit (json:decode-json (open (first common-lisp-user::*args*))))))
;(format t "~w~%~%~%" (json:decode-json (open (first *args*))))
;(format t "~w~%~%~%" compiled-unit)
(format t "--------~%~%~w~%~%~%" (strip-ann compiled-unit))
View
34 cl-backend/niecza-stash.lisp
@@ -0,0 +1,34 @@
+(defpackage niecza-stash (:export wrap-in-let to-stash-name) (:use :common-lisp))
+(in-package :niecza-stash)
+
+(ql:quickload "fare-matcher")
+
+(defun to-stash-name (name) (intern (format nil "~{~A~^-~}" name)))
+
+(defun entry (prefix node)
+ (fare-matcher:match node
+ ((and (list name var Xref ChildNode) (when (equal var "var")))
+ (cons (list (append prefix (list name)) Xref) (process (cons name prefix) ChildNode)))))
+
+
+(defun process (prefix nodes) (apply 'append (mapcar #'(lambda (x) (entry prefix x)) nodes)))
+
+
+(defun wrap-in-let (stash body)
+ (let ((processed (process '() stash)))
+ `(let
+ ,(mapcar (lambda (x) (list (to-stash-name (first x)) nil)) (hide-foreign processed))
+ ,@body
+ ,@(set-stash processed))))
+
+(defun only-with-xrefs (stash) (remove-if (lambda (x) (not (second x))) 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))))
+
+(defun hide-foreign (stash)
+ (remove-if
+ (lambda (x)
+ (and (second x) (not (equal (first (second x)) "MAIN"))))
+ stash))
+
Please sign in to comment.
Something went wrong with that request. Please try again.