From 4e987026148fe65c323afbc93cd560c07bf06b3f Mon Sep 17 00:00:00 2001 From: Yale AI Dept Date: Wed, 14 Jul 1993 13:08:00 -0500 Subject: Import to github. --- top/prelude-core-syms.scm | 57 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 top/prelude-core-syms.scm (limited to 'top/prelude-core-syms.scm') diff --git a/top/prelude-core-syms.scm b/top/prelude-core-syms.scm new file mode 100644 index 0000000..ddae21f --- /dev/null +++ b/top/prelude-core-syms.scm @@ -0,0 +1,57 @@ +;;; This should be used to create core symbols for every name exported +;;; by PreludeCore. This only needs to run when the Prelude definition +;;; changes. + +(define (def->name-string x) + (symbol->string (def-name x))) + + +(define (generate-prelude-core-symbols) + (initialize-compilation) + (load-compilation-unit *prelude-unit-filename* '#t '#f '#f '#f) + (let* ((core (table-entry *modules* '|PreludeCore|)) + (export-table (module-export-table core)) + (vars '()) + (classes '()) + (types '()) + (constrs '()) + (syns '()) + (methods '())) + (table-for-each + (lambda (k v) + (declare (ignore k)) + (let ((def (tuple-2-2 (car v)))) + (cond ((var? def) + (push (def->name-string def) vars)) + ((synonym? def) + (push (def->name-string def) syns)) + ((algdata? def) + (push (def->name-string def) types) + (dolist (x (cdr v)) + (push (remove-con-prefix (def->name-string (tuple-2-2 x))) + constrs))) + ((class? def) + (push (def->name-string def) classes) + (dolist (x (cdr v)) + (push (def->name-string (tuple-2-2 x)) + methods))) + (else (error "? strange def"))))) + export-table) + (call-with-output-file "/tmp/prelude-syms" + (lambda (port) + (pprint `(define *haskell-prelude-vars* + '((classes ,@classes) + (methods ,@methods) + (types ,@types) + (constructors ,@constrs) + (synonyms ,@syns) + (values ,@vars))) + port))))) + + + +(define (create-prelude-init-code defs) + (let* ((name (def-name def)) + (sym-name (make-core-symbol-name name))) + `(define sym-name '()))) + -- cgit v1.2.3