; Similix job for generating cogen -*- Scheme -*-
; Copyright (C) 1993 Anders Bondorf
; Please see the file README for copyright notice, license and disclaimer.


;-----------------------------------------------------------------------------
; This job should NOT usually be run. It is included to show how the
; compiler generator was generated automatically by double
; self-application.
;
; ******* This job destroys (but regenerates) "system/cogen.sim"!!  *******
; ******* ONLY RUN THIS JOB IF YOU HAVE A BACKUP COPY OF	    *******
; ******* THE FILE "system/cogen.sim".				    *******
; ******* In particular, notice that if a new version of	    *******
; ******* "system/cogen.sim" is generated by this job under an	    *******
; ******* R3RS Scheme system (or older), this new		    *******
; ******* "system/cogen.sim" will NOT work under R4RS Scheme	    *******

;-----------------------------------------------------------------------------

(load "../system/sim-scm.scm") ; (load "../system/sim-chez.so")

; Generate spec-ann:
(preprocess!
 '_sim-specialize '(s d s d) (string-append **Similix-path** "spec.sim"))
(define spec-ann (preprocessed-program))

; Generate cogen = mix(spec-ann, spec-ann):
(similix (list '_sim-specialize '*** **Similix-preprocessed-program** '***)
	 spec-ann
	 '_sim-cogen
	 (string-append **Similix-path** "cogen.sim"))
(define my-cogen (residual-program))
(compile-sim-file (string-append **Similix-path** "cogen.sim"))

; Regenerate cogen = cogen(spec-ann):
(cogen spec-ann '_sim-cogen)
(define my-new-cogen (current-compiler))
(equal? my-cogen my-new-cogen) ; should give #t

; The new-cogen just generated is itself a "compiler", so let's apply it
; (in effect again running cogen = cogen(spec-ann)):
(begin
  (comp '_sim-cogen ; goal procedure of current compiler (to be run now)
	(list '_sim-specialize '*** **Similix-preprocessed-program** '***)
	'_sim-cogen ; goal procedure of generated residual program
	)
  'done)
(define my-new-new-cogen (residual-program))
(equal? my-cogen my-new-new-cogen) ; should give #t

(exit)

;-----------------------------------------------------------------------------
