alex-eg
1f445f0f9b
Two things out of one mechanism. `_' as a type means "work it out from
the initializer", so (var n _ (strlen s)) stops needing size-t spelled
out; `type-of' hands a macro the type of an expression, so a macro can
dispatch on what it was handed rather than on what was declared. Both
read the same answers from two sides.
Algorithm W's core, intra-procedural, with the extensions C forces:
- an unknown type, since (include stdio.h) brings in names we never
parsed. Unification is consistency rather than equality, so
anything touching an unparsed declaration stops constraining
instead of rejecting a program that compiled yesterday;
- the usual arithmetic conversions, since `+' is not a function of
one type;
- checking mode for initializers, since #(0 0) has no type of its own
and takes one from its context. #(T : ...) is the way out of that.
What it wanted on the way:
- what type a *name* has, which neither the typedef nor the tag
database recorded. One table serves functions and variables, since
a function type already has a surface spelling;
- a scope chain, so a (var c int 9) inside a do ends with the block;
- form-type, keyed by cons cell, so one form has one type;
- macros expanded during the walk rather than before it, so type-of
is answered in the scope the macro was written in.
Closures take the same machinery: a receiver whose type comes from a
call, captures written (name expr) and typed from the expression, and
conversion from a bare function wherever a closure is expected.
type-match grew `_' on the pattern side, since (closure ((int)) int)
and (closure ((float)) int) were separate clauses for one case.
175 lines
5.6 KiB
Scheme
175 lines
5.6 KiB
Scheme
(import
|
|
scheme
|
|
(scheme base) ; make-parameter
|
|
(chicken base)
|
|
(chicken pathname)
|
|
(chicken process-context)
|
|
srfi-1
|
|
srfi-69)
|
|
|
|
(define-syntax prog1
|
|
(syntax-rules ()
|
|
((prog1 form . forms)
|
|
(let ((res form))
|
|
(begin . forms)
|
|
res))))
|
|
|
|
(define-syntax with-directory
|
|
(syntax-rules ()
|
|
((with-directory path form . forms)
|
|
(let ((current-dir (current-directory)))
|
|
(set-working-directory path)
|
|
(prog1
|
|
(begin form . forms)
|
|
(change-directory current-dir))))))
|
|
|
|
(define (get-env-var name)
|
|
(get-environment-variable name))
|
|
|
|
(define (set-working-directory file)
|
|
(change-directory
|
|
(normalize-pathname
|
|
(if (absolute-pathname? file)
|
|
(pathname-directory file)
|
|
(make-absolute-pathname
|
|
(current-directory)
|
|
(pathname-directory file))))))
|
|
|
|
(define (to-absolute-pathname pathname)
|
|
(if (absolute-pathname? pathname)
|
|
pathname
|
|
(make-absolute-pathname
|
|
(current-directory)
|
|
pathname)))
|
|
|
|
(define (comment-form? form)
|
|
(and (pair? form) (eq? (car form) 'comment)))
|
|
|
|
;;; Remove the comment forms from the first COUNT elements of FORM --
|
|
;;; its header -- so that the positional accessors reading it are not
|
|
;;; shifted by one
|
|
(define (strip-header-comments form count)
|
|
;; This always rebuilds the list, so the location has to be carried
|
|
;; over explicitly -- otherwise every form loses it
|
|
(copy-form-source!
|
|
form
|
|
(let loop ((rest form) (kept 0) (acc (list)))
|
|
(cond
|
|
((null? rest) (reverse acc))
|
|
((= kept count) (append (reverse acc) rest))
|
|
((comment-form? (car rest)) (loop (cdr rest) kept acc))
|
|
(else (loop (cdr rest) (+ kept 1) (cons (car rest) acc)))))))
|
|
|
|
(define (list-split src-list split-elt)
|
|
;; split '(1 2 / 3 4 / 5 6) by '/ -> '((1 2) (3 4) (5 6))
|
|
(fold (lambda (elt acc)
|
|
(if (eq? elt split-elt)
|
|
(append acc (list (list)))
|
|
(append (drop-right acc 1)
|
|
(list (append (last acc) (list elt))))))
|
|
(list (list))
|
|
src-list))
|
|
|
|
(define (list-join lists join-by)
|
|
(drop-right
|
|
(fold (lambda (elt acc)
|
|
(append acc (list elt) (list join-by)))
|
|
(list)
|
|
lists)
|
|
1))
|
|
|
|
;;; Reconstruct form
|
|
(define (recons old-cons new-car new-cdr)
|
|
(if (and (eq? new-car (car old-cons))
|
|
(eq? new-cdr (cdr old-cons)))
|
|
old-cons
|
|
;; A rebuilt cell is still the same source form, so it keeps the
|
|
;; same location
|
|
(copy-form-source! old-cons (cons new-car new-cdr))))
|
|
|
|
;;; Source-location map.
|
|
;;; Our hand-written reader records the source location of each form
|
|
;;; here, keyed by the form's cons cell (eq?). This replaces CHICKEN's
|
|
;;; read-with-source-info / get-line-number, which only works when forms
|
|
;;; are produced by the built-in `read'.
|
|
;;;
|
|
;;; A location is (file . line). The file matters because imported
|
|
;;; modules paste their public forms into the current unit: those forms
|
|
;;; originate in another file and must be reported as such
|
|
(define +form-sources+ (make-hash-table eq?))
|
|
|
|
;;; The file `parse-all' is currently reading. Bound by the reader
|
|
(define current-source-file (make-parameter "<unknown>"))
|
|
|
|
;;; What type a form has, once something has worked it out. Keyed by
|
|
;;; cons cell like the sources above, so one form has one type: a body
|
|
;;; typed at two instantiations has to be copied before the second.
|
|
(define +form-types+ (make-hash-table eq?))
|
|
|
|
(define (set-form-type! form type)
|
|
(when (pair? form)
|
|
(hash-table-set! +form-types+ form type))
|
|
type)
|
|
|
|
(define (form-type form)
|
|
(hash-table-ref/default +form-types+ form #f))
|
|
|
|
(define (set-form-source! form file line)
|
|
(hash-table-set! +form-sources+ form (cons file line)))
|
|
|
|
(define (form-source form)
|
|
(hash-table-ref/default +form-sources+ form #f))
|
|
|
|
(define (form-file form)
|
|
(let ((src (form-source form)))
|
|
(and src (car src))))
|
|
|
|
(define (form-line form)
|
|
(let ((src (form-source form)))
|
|
(and src (cdr src))))
|
|
|
|
(define (copy-form-source! from to)
|
|
"Give TO the location of FROM, if FROM has one. Returns TO, so it can
|
|
wrap a form-building expression."
|
|
(let ((src (form-source from)))
|
|
(when (and src (pair? to))
|
|
(hash-table-set! +form-sources+ to src)))
|
|
to)
|
|
|
|
;;; Diagnostics
|
|
;;;
|
|
;;; Every form carries a location now, so an error can say where the
|
|
;;; wrong code was written
|
|
(define (form-location form)
|
|
"\"file:line: \" for FORM, or \"\" when it has none"
|
|
(let ((src (form-source form)))
|
|
(if src
|
|
(string-append (car src) ":" (number->string (cdr src)) ": ")
|
|
"")))
|
|
|
|
(define (sex-error form message . args)
|
|
"Signal an error about FORM, prefixed with where it was written."
|
|
(apply error (string-append (form-location form) message) args))
|
|
|
|
(define (sex-warning form message . args)
|
|
"Report something about FORM that does not stop the compilation.
|
|
Goes to stderr, prefixed with where the form was written, so a warning
|
|
reads like an error and sorts alongside one in a build log."
|
|
(let ((port (current-error-port)))
|
|
(display (form-location form) port)
|
|
(display "warning: " port)
|
|
(display message port)
|
|
(for-each (lambda (arg) (display " " port) (display arg port)) args)
|
|
(newline port)))
|
|
|
|
(define (stamp-form-source! form src)
|
|
"Give FORM and every subform that has none the location SRC. Used for
|
|
macro expansions, which inherit the location of the call site the way a
|
|
cpp macro does. Forms that already have a location keep it."
|
|
(when (and src (pair? form))
|
|
(unless (form-source form)
|
|
(hash-table-set! +form-sources+ form src))
|
|
(stamp-form-source! (car form) src)
|
|
(stamp-form-source! (cdr form) src))
|
|
form)
|