;;;----- Licensing notice ---------------------------------------------------
;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
;;;
;;; SOD is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
((in-use-p :initarg :in-use-p :initform nil
:type boolean :accessor var-in-use-p)))
+(define-module-var *temporary-index* 0
+ "Index for temporary name generation.
+
+ This is automatically reset to zero before the output functions are
+ invoked to write a file. This way, we can ensure that the same output
+ file is always produced from the same input.")
+
+(define-clear-the-decks reset-codegen-index
+ (setf *temporary-index* 0))
+
(defmethod commentify-argument-name ((name temporary-name))
nil)
-(export 'temporary-function)
(defun temporary-function ()
"Return a temporary function name."
(make-instance 'temporary-function
(format-temporary-name var stream)))
;;;--------------------------------------------------------------------------
-;;; Instruction types.
-
-;; Compound statements.
-
-(export '(if-inst make-if-inst
- while-inst make-while-inst
- do-inst make-do-inst
- inst-condition inst-consequent inst-alternative inst-body))
-
-(definst if (stream) (condition consequent alternative)
- (format-compound-statement (stream consequent alternative)
- (format stream "if (~A)" condition))
- (when alternative
- (format-compound-statement (stream alternative)
- (write-string "else" stream))))
-
-(definst while (stream) (condition body)
- (format-compound-statement (stream body)
- (format stream "while (~A)" condition)))
-
-(definst do-while (stream) (body condition)
- (format-compound-statement (stream body :space)
- (write-string "do" stream))
- (format stream "while (~A);" condition))
-
-;; Special varargs hacks.
-
-(export '(va-start-inst make-va-start-inst
- va-copy-inst make-va-copy-inst
- va-end-inst make-va-end-inst
- inst-ap inst-arg inst-to inst-from))
-
-(definst va-start (stream) (ap arg)
- (format stream "va_start(~@<~A, ~_~A~:>);" ap arg))
-
-(definst va-copy (stream) (to from)
- (format stream "va_copy(~@<~A, ~_~A~:>);" to from))
-
-(definst va-end (stream) (ap)
- (format stream "va_end(~A);" ap))
-
-;; Expressions.
-
-(export '(call-inst make-call-inst inst-func inst-args))
-
-(definst call (stream) (func args)
- (format stream "~A(~@<~{~A~^, ~_~}~:>)" func args))
-
-;;;--------------------------------------------------------------------------
;;; Code generator objects.
(defclass basic-codegen ()
(:documentation
"Base class for code generator state.
- This contains the bare essentials for supporting the EMIT-INST and
- ENSURE-VAR protocols; see the documentation for those generic functions
+ This contains the bare essentials for supporting the `emit-inst' and
+ `ensure-var' protocols; see the documentation for those generic functions
for more details.
- This class isn't abstract. A full CODEGEN object uses instances of this
+ This class isn't abstract. A full `codegen' object uses instances of this
to keep track of pending functions which haven't been completed yet.
Just in case that wasn't clear enough: this is nothing to do with the
(defmethod emit-insts ((codegen basic-codegen) insts)
(asetf (codegen-insts codegen) (revappend insts it)))
+(defmethod emit-decl ((codegen basic-codegen) inst)
+ (push inst (codegen-vars codegen)))
+
+(defmethod emit-decls ((codegen basic-codegen) insts)
+ (asetf (codegen-vars codegen) (revappend insts it)))
+
(defmethod ensure-var ((codegen basic-codegen) name type &optional init)
(let* ((vars (codegen-vars codegen))
- (var (find name vars :key #'inst-name :test #'equal)))
+ (var (find name
+ (remove-if-not (lambda (var) (typep var 'var-inst)) vars)
+ :key #'inst-name :test #'equal)))
(cond ((not var)
(setf (codegen-vars codegen)
(cons (make-var-inst name type init) vars)))
((not (c-type-equal-p type (inst-type var)))
- (error "(Internal) Redefining type for variable ~A." name)))
+ (error "(Internal) Redefining type for variable ~A" name)))
name))
(export 'codegen)
(defclass codegen (basic-codegen)
- ((functions :initform nil :type list :accessor codegen-functions)
+ ((functions :initform nil :type list :reader codegen-functions)
(stack :initform nil :type list :accessor codegen-stack))
(:documentation
"A full-fat code generator which can generate and track functions.
This is the real deal. Subclasses may which to attach additional state
for convenience's sake, but this class is self-contained. It supports the
- CODEGEN-PUSH, CODEGEN-POP and CODEGEN-POP-FUNCTION protocols."))
+ `codegen-push', `codegen-pop' and `codegen-pop-function' protocols."))
(defmethod codegen-push ((codegen codegen))
(with-slots (vars insts temp-index stack) codegen
(c-type-equal-p type (inst-type var)))
name
nil)))
- vars)
+ (remove-if-not (lambda (var) (typep var 'var-inst)) vars))
(let* ((name (make-instance 'temporary-variable
:in-use-p t
:tag (prog1 temp-index
(incf temp-index)))))
- (push (make-var-inst name type nil) vars)
+ (push (make-var-inst name type) vars)
name))))
;;;----- That's all, folks --------------------------------------------------
~mdw / sod / blobdiff