[e90b2f]: src / new-cmp / cmpform.lsp Maximize Restore History

Download this file

cmpform.lsp    98 lines (85 with data), 2.9 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
;;;;
;;;; Copyright (c) 2009, Juan Jose Garcia-Ripoll
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Library General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2 of the License, or (at your option) any later version.
;;;;
;;;; See file '../Copyright' for full details.
;;;;
;;;; CMPFORM -- Internal representation of Lisp forms
;;;;
(in-package "C-DATA")
(defmacro make-c1form* (&rest args)
`(list (make-c1form-alone ,@args)))
#+(or)
(defmacro make-c1form-alone (name &rest args)
(let ((info-args '())
(form-args '()))
(do ((l args (cdr l)))
((endp l))
(let ((key (first l)))
(cond ((not (keywordp key))
(baboon))
((eq key ':args)
(setf form-args (rest l))
(return))
(t
(setf info-args (list* key (second l) info-args)
l (cdr l))))))
`(do-make-c1form :name ,name :args (list ,@form-args)
:form *current-form*
:file *compile-file-truename*
:file-position *compile-file-position*
,@info-args)))
(defun make-c1form-alone (name &rest args)
(let ((info-args '())
(form-args '()))
(do ((l args (cdr l)))
((endp l))
(let ((key (first l)))
(cond ((not (keywordp key))
(baboon))
((eq key ':args)
(setf form-args (rest l))
(return))
(t
(setf info-args (list* key (second l) info-args)
l (cdr l))))))
(apply #'do-make-c1form :name name :args form-args
:form *current-form*
:file *compile-file-truename*
:file-position *compile-file-position*
info-args)))
(defun copy-c1form (form)
(copy-structure form))
(defmacro c1form-arg (nth form)
(case nth
(0 `(first (c1form-args ,form)))
(1 `(second (c1form-args ,form)))
(otherwise `(nth ,nth (c1form-args ,form)))))
(defun c1form-volatile* (form)
(if (c1form-volatile form) "volatile " ""))
(defun c1form-set-volatile (flag forms)
(loop for i in forms
do (setf (c1form-volatile i) flag))
forms)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; OUTPUT C1FORMS
;;;
(defun pprint-c1form (f &optional (stream t))
(cond ((c1form-p f)
(format stream "~&~4T~16A~4T~{~A ~}" (c1form-name f) (c1form-args f)))
((tag-p f)
(format stream "~&~A / ~A:" (tag-name f) (tag-label f)))
(t
(format stream "~&;;; Unknown form ~A" f)))
(force-output stream)
f)
(defun pprint-c1forms (forms &optional (stream t))
(loop for f in forms do (pprint-c1form f stream)))
(defun print-c1form (form stream)
(format stream "#<form ~A ~X>" (c1form-name form) (ext::pointer form)))