You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
313 lines
10 KiB
Scheme
313 lines
10 KiB
Scheme
;; config.ss
|
|
;; Lots of parameters for analysis
|
|
; ----------------------------------------------------------------------
|
|
; Copyright (C) 1995-97 Cormac Flanagan
|
|
;
|
|
; This program is free software; you can redistribute it and/or
|
|
; modify it under the terms of the GNU General Public License
|
|
; version 2 as published by the Free Software Foundation.
|
|
;
|
|
; This program is distributed in the hope that it will be useful,
|
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
; GNU General Public License for more details.
|
|
;
|
|
; You should have received a copy of the GNU General Public License
|
|
; along with this program; if not, write to the Free Software
|
|
; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
; ----------------------------------------------------------------------
|
|
|
|
(define st:restricted
|
|
(not (string? (current-load-relative-directory))))
|
|
(define st:name "MrSpidey")
|
|
(define st:version (lambda () "49s1"))
|
|
|
|
;; ----------------------------------------------------------------------
|
|
;; Front end parameters
|
|
|
|
(define st:fake-reader (make-parameter-boolean #f))
|
|
(define st:system-expand (make-parameter-boolean #f))
|
|
|
|
;; ----------------------------------------------------------------------
|
|
;; Analysis parameters
|
|
|
|
(define st:constants (make-parameter-boolean #f))
|
|
(define st:const-merge-size (make-parameter-integer 7))
|
|
|
|
(define st:if-split (make-parameter-boolean #t))
|
|
; If #t, then knowledgeable about if's
|
|
|
|
(define st:flow-sensitive (make-parameter-boolean #t))
|
|
; If #t, then in (begin (car x) (cdr x)), cdr is never checked
|
|
|
|
(define st:fo-units (make-parameter-boolean #t))
|
|
;; If #t, then first-order units treated specially
|
|
|
|
(define st:lazy-fo-units (make-parameter-boolean #t))
|
|
;; If #t, then first-order units treated specially
|
|
|
|
(define st:cache-units (make-parameter-boolean #t))
|
|
;; If #t, then first-order units treated specially
|
|
|
|
(define st:whole-program (make-parameter-boolean #t))
|
|
|
|
(define st:special-fo-prims (make-parameter-boolean #t))
|
|
(define st:see-void (make-parameter-boolean #t))
|
|
(define st:cons-mutable (make-parameter-boolean #t))
|
|
(define st:use-fo-ftype (make-parameter-boolean #t))
|
|
|
|
(define need-label-types #t)
|
|
(define need-explanation #t)
|
|
|
|
(define st:zero-old-constraint-sets (make-parameter-boolean #t))
|
|
(define st:zero-old-asts (make-parameter-boolean #t))
|
|
|
|
;; ----------------------------------------------------------------------
|
|
;; Simplification parameters
|
|
|
|
(define constraint-simplification-list
|
|
(if st:restricted
|
|
'(
|
|
(none "No simplification")
|
|
(nonempty "Remove empty constraints")
|
|
(live "Remove empty and unreachable constraints")
|
|
(live-few-e "As above, and also remove epsilon constraints")
|
|
((live-few-e dfa-min-glb dfa-min-lub)
|
|
"Live, few epsilon, DFA min")
|
|
)
|
|
'(
|
|
(none "No simplification")
|
|
(nonempty "Remove empty constraints")
|
|
(nonempty-copy "Copy nonempty")
|
|
(live "Remove empty and unreachable constraints")
|
|
(live-few-e-L "Live, few lower epsilon")
|
|
(live-few-e-U "Live, few upper epsilon")
|
|
(live-few-e "Live, few epsilon")
|
|
((live-few-e dfa-min-lub)
|
|
"Live, few epsilon, DFA min LUB")
|
|
((live-few-e dfa-min-glb)
|
|
"Live, few epsilon, DFA min GLB")
|
|
((live-few-e dfa-min-lub dfa-min-glb)
|
|
"Live, few epsilon, DFA min")
|
|
)))
|
|
|
|
(define make-constraint-simplification-para
|
|
(case-lambda
|
|
[() (make-constraint-simplification-para 'live-few-e)]
|
|
[(default)
|
|
(make-parameter-list
|
|
default
|
|
constraint-simplification-list
|
|
(lambda (_) (void))
|
|
;; also-ok?
|
|
(lambda (x)
|
|
(and (list? x)
|
|
(andmap
|
|
(lambda (y) (member y (map car constraint-simplification-list)))
|
|
x))))]))
|
|
|
|
(define st:minimize-respect-assignable-part-of-fields
|
|
(make-parameter-boolean #t))
|
|
|
|
;; ----------------------------------------------------------------------
|
|
;; Polymorphism parameters
|
|
|
|
(define st:constraint-simplification-poly (make-constraint-simplification-para))
|
|
|
|
(define st:polymorphism
|
|
(make-parameter-list 'compress
|
|
`((none "No polymorphism")
|
|
(compress "Simplify constraints")
|
|
;;(copy-con "")
|
|
(reanalyze "Reanalyze")
|
|
)))
|
|
|
|
;; ----------------------------------------------------------------------
|
|
;; Unit parameters
|
|
|
|
(define st:unit-read-za (make-parameter-boolean #t))
|
|
(define st:unit-write-za (make-parameter-boolean #t))
|
|
(define st:unit-simplify
|
|
(make-constraint-simplification-para 'live-few-e))
|
|
(define st:unit-separate-S (make-parameter-boolean #t))
|
|
(define st:save-za-in
|
|
(make-parameter-list
|
|
'source-directory
|
|
`( (source-directory "Source file directory" "")
|
|
(tmp-directory
|
|
,(string-append
|
|
(if (defined? 'wx:find-path)
|
|
(wx:find-path 'temp-dir) " directory"))
|
|
""))))
|
|
|
|
;; ----------------------------------------------------------------------
|
|
;; Type Viewing parameters
|
|
|
|
;; --- copying
|
|
|
|
(define st:sdl-fo
|
|
(make-parameter-list
|
|
'basic-types
|
|
'( (basic-types "Basic Types" "ie (1 -> 1)")
|
|
(type-schemas "Type Schemas" "ie (X1 -> X1)"))))
|
|
|
|
(define st:sdl-fo-ivars (make-parameter-boolean #t))
|
|
(define st:sdl-fo-struct-fields (make-parameter-boolean #t))
|
|
(define st:sdl-fo-depth-limit? (make-parameter-boolean #t))
|
|
(define st:sdl-fo-depth-limit (make-parameter-integer 50))
|
|
(define st:sdl-fo-size-limit? (make-parameter-boolean #t))
|
|
(define st:sdl-fo-size-limit (make-parameter-integer 50))
|
|
|
|
;; --- simplification
|
|
|
|
(define st:sdl-constraint-simplification
|
|
(make-constraint-simplification-para 'live-few-e))
|
|
|
|
(define st:show-assignable-part-of-fields
|
|
(make-parameter-boolean #f))
|
|
|
|
;; --- to SDL
|
|
|
|
(define st:listify-etc (make-parameter-boolean #t))
|
|
|
|
(define st:sdl-constructor/selector
|
|
(make-parameter-list
|
|
'constructor
|
|
'((constructor "Show types as constructors" "")
|
|
(selector "Show types as selectors" ""))))
|
|
|
|
(define st:naming-strategy
|
|
(make-parameter-list
|
|
'multiple
|
|
(if st:restricted
|
|
'((recursive "Recursive" "Name types on cycles")
|
|
(multiple "Multiple" "Name types referenced more than once")
|
|
(nontrivial "Non-Trivial" "Name non-trivial types")
|
|
(all "All" "Name all types"))
|
|
'((recursive "Recursive" "Name types on cycles")
|
|
(multiple "Multiple" "Name types referenced more than once")
|
|
(nontrivial "Non-Trivial" "Name non-trivial types")
|
|
(all "All" "Name all types")))))
|
|
|
|
(define st:primitive-types
|
|
(make-parameter-list
|
|
'inferred
|
|
'((prim "(prim ...)" "ie (prim car)")
|
|
(given "Given types" "ie ((cons a b) -> a)")
|
|
(inferred "Inferred types" "ie ((cons 'a-symbol 4) -> 'a-symbol)"))))
|
|
|
|
;; --- simplifying SDL
|
|
|
|
(define st:expand-output-type (make-parameter-boolean #t))
|
|
(define st:sdl-tidy (make-parameter-boolean #t))
|
|
|
|
;; ---
|
|
|
|
(define st:pretty-type-width (make-parameter-integer 60))
|
|
|
|
;; ----------------------------------------------------------------------
|
|
|
|
(define st:check-kernel (make-parameter-boolean #f))
|
|
(define st:compare-min-algs (make-parameter-boolean #f))
|
|
|
|
;; ----------------------------------------------------------------------
|
|
;; Checking parameters
|
|
|
|
(define st:all-checks (make-parameter-boolean #f))
|
|
|
|
;; ----------------------------------------------------------------------
|
|
;; control - interface to all parameters
|
|
|
|
(define mrspidey:control-fn
|
|
(let ([paras
|
|
(begin-elaboration-time
|
|
(cons 'list
|
|
(map
|
|
(lambda (x) (list 'cons (list 'quote x) x))
|
|
'(;; --- Analysis time
|
|
st:constants
|
|
st:const-merge-size
|
|
st:fo-units
|
|
st:if-split
|
|
st:flow-sensitive
|
|
st:special-fo-prims
|
|
st:system-expand
|
|
st:see-void
|
|
st:unit-read-za
|
|
st:unit-write-za
|
|
st:save-za-in
|
|
;; --- Polymorphism
|
|
st:polymorphism
|
|
st:constraint-simplification-poly
|
|
;;st:library-prims
|
|
;;st:topo-sort
|
|
;; --- Seperate analysis
|
|
st:unit-simplify
|
|
;; --- Type viewing
|
|
st:sdl-fo
|
|
st:sdl-fo-ivars
|
|
st:sdl-fo-struct-fields
|
|
st:sdl-fo-depth-limit?
|
|
st:sdl-fo-depth-limit
|
|
st:sdl-fo-size-limit?
|
|
st:sdl-fo-size-limit
|
|
st:sdl-constraint-simplification
|
|
st:show-assignable-part-of-fields
|
|
st:listify-etc
|
|
st:sdl-constructor/selector
|
|
st:naming-strategy
|
|
st:primitive-types
|
|
st:expand-output-type
|
|
st:sdl-tidy
|
|
st:pretty-type-width
|
|
|
|
;; --- checking parameters
|
|
st:all-checks
|
|
))))])
|
|
(match-lambda*
|
|
[()
|
|
;; Return list of all settings
|
|
(map
|
|
(match-lambda [(sym . para) (list sym (para))])
|
|
paras)
|
|
]
|
|
[(para-name)
|
|
;; Return one setting
|
|
(match (assq para-name paras)
|
|
[(_ . para) (para)]
|
|
[#f (error 'mrspidey:control "Unknown parameter ~s" para-name)])]
|
|
[(para-name nu-val)
|
|
;; Return one setting
|
|
(match (assq para-name paras)
|
|
[(_ . para)
|
|
(if (memq nu-val (map car (para '?)))
|
|
(para nu-val)
|
|
(error 'mrspidey:control "Value ~s invalid for parameter ~s"
|
|
nu-val para-name))]
|
|
[#f
|
|
(error 'mrspidey:control "Unknown parameter ~s" para-name)])]
|
|
[_ (error 'mrspidey:control "Bad # arguments")])))
|
|
|
|
;======================================================================
|
|
|
|
(when st:restricted
|
|
;; . special configuration, if necy
|
|
(void)
|
|
)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|