wizard
svn: r2881
This commit is contained in:
Matthias Felleisen
parent
4748ea4490
commit
87fb388130
|
|
@ -1,593 +1,386 @@
|
|||
#cs(module class mzscheme
|
||||
(require (lib "etc.ss")
|
||||
(lib "list.ss")
|
||||
(lib "contract.ss")
|
||||
(file "data-defs.scm"))
|
||||
|
||||
;; ------------------------------------------------------------------------
|
||||
(provide/contract
|
||||
[make-class ((Class) (boolean? boolean?) . opt-> . string?)]
|
||||
)
|
||||
|
||||
#| Usage:
|
||||
(make-class a-class toString? template?)
|
||||
create a Java class from the class specification (a-class).
|
||||
#cs
|
||||
(module class mzscheme
|
||||
(require "data-defs.scm"
|
||||
(lib "contract.ss")
|
||||
(lib "etc.ss")
|
||||
(lib "list.ss")
|
||||
(lib "string.ss" "srfi" "13")
|
||||
(only (lib "1.ss" "srfi") zip))
|
||||
|
||||
;; ------------------------------------------------------------------------
|
||||
(provide/contract
|
||||
[make-class ((Class) (boolean? boolean? string? Fields (listof Method)) . opt-> . string?)]
|
||||
[method (Method . -> . string?)]
|
||||
)
|
||||
|
||||
#| Usage:
|
||||
(make-class a-class toString? template? language? Fields Methods)
|
||||
create a Java class from the class specification (a-class) and add
|
||||
Fields from super and Methods from the implementing interface.
|
||||
|
||||
The first optional boolean parameter specifies whether we want toString
|
||||
in the class hiearchy. Default: true
|
||||
|
||||
The second optional boolean parameter specifies whether we want
|
||||
a draft method template in comments. Default: true
|
||||
|
||||
The third optinal determines the language level.
|
||||
|#
|
||||
|
||||
(provide/contract
|
||||
[make-union ((Union) (boolean? boolean?) . opt-> . string?)]
|
||||
)
|
||||
|
||||
#| Usage:
|
||||
(make-union a-union toString? template?)
|
||||
create a Java implementation of a datatype specification using an
|
||||
abstract class and N variants.
|
||||
|
||||
The first optional boolean parameter specifies whether we want toString
|
||||
in the class hiearchy. Default: true
|
||||
|
||||
The second optional boolean parameter specifies whether we want
|
||||
a draft method template in comments. Default: true
|
||||
|#
|
||||
|
||||
;; ------------------------------------------------------------------------
|
||||
;; Construct a union as a collection of Java classes
|
||||
|
||||
;; String (Listof VariantClass) -> String
|
||||
(define make-union
|
||||
(opt-lambda (the-union [toString? #t][template? #t])
|
||||
(let ([type (dt-type the-union)][type-fields (dt-fields the-union)])
|
||||
(string-append
|
||||
(car (purpose-statement (dt-purpose the-union)))
|
||||
(abstractClass type type-fields template?)
|
||||
"\n"
|
||||
(commas
|
||||
(map (lambda (sc)
|
||||
(make-class
|
||||
`(,(car sc) ,type ,(cadr sc) ,(variant-purpose sc))
|
||||
toString?
|
||||
template?
|
||||
type-fields))
|
||||
(dt-variants the-union))
|
||||
"\n")))))
|
||||
|
||||
;; String -> String
|
||||
(define (abstractClass type type-fields template?)
|
||||
(apply string-append
|
||||
`(,(format abstractF type)
|
||||
;; fields
|
||||
,@(map (lambda (f) (format declaf (car f) (cadr f))) type-fields)
|
||||
;; optional abstract template
|
||||
,@(if (not template?)
|
||||
(list "")
|
||||
`( ,cmnt/*
|
||||
,warnin
|
||||
,purpos
|
||||
,absteg
|
||||
,cmnt*/))
|
||||
,endclf)))
|
||||
|
||||
;; ------------------------------------------------------------------------
|
||||
;; Construct individual Java classes
|
||||
|
||||
;; create class definition (as string) from name, super and list of fields
|
||||
(define make-class
|
||||
(opt-lambda (the-class [toString? #t][template? #t][super-fields '()])
|
||||
(let ([type (car the-class)]
|
||||
[super (cadr the-class)]
|
||||
[fields (caddr the-class)]
|
||||
[prps (class-purpose the-class)])
|
||||
(apply string-append
|
||||
`( ,@(purpose-statement prps)
|
||||
,(format classf type (extends super))
|
||||
;; fields
|
||||
,@(map (lambda (f) (format declaf (car f) (cadr f))) fields)
|
||||
"\n"
|
||||
;; constructor
|
||||
,(class-constructor type fields super-fields)
|
||||
;; optional template draft:
|
||||
,@(make-template super fields template?)
|
||||
;; optional toString method:
|
||||
,@(toString type fields toString?)
|
||||
,endclf)))))
|
||||
|
||||
;; String -> String
|
||||
(define (extends super) (if (string=? "" super) "" (format extendsf super)))
|
||||
|
||||
;; String Fields Fields -> String
|
||||
(define (class-constructor type fields super-fields)
|
||||
(apply string-append
|
||||
`( ,(format constf type (parameters (append super-fields fields)))
|
||||
#| When we switch to super in beginner, this will need to change.
|
||||
|
||||
;; ------------------------------------------------------------------------
|
||||
;; Construct individual Java classes
|
||||
|
||||
;; create class definition (as string) from name, super and list of fields
|
||||
(define make-class
|
||||
(opt-lambda (the-class [toString? #t][template? #t][language BEGINNER][super-fields '()][method-sigs '()])
|
||||
(define no-public (or (eq? language BEGINNER) (or (eq? language INTERMEDIATE))))
|
||||
(let ([type (car the-class)]
|
||||
[super (cadr the-class)]
|
||||
[fields (caddr the-class)]
|
||||
[prps (class-purpose the-class)])
|
||||
(define templates
|
||||
(if (or (not template?) (eq? language BEGINNER))
|
||||
""
|
||||
(enumerate-with-separator
|
||||
(map (lambda (ms)
|
||||
(apply string-append (make-template ms super fields template? (not no-public))))
|
||||
method-sigs)
|
||||
"\n")))
|
||||
(apply string-append
|
||||
`( ,@(purpose-statement prps)
|
||||
,(format classf type (implements super))
|
||||
;; fields
|
||||
,@(map (lambda (f) (format declaf (car f) (cadr f))) fields)
|
||||
"\n"
|
||||
;; constructor
|
||||
,(class-constructor type fields super-fields)
|
||||
;; optional template draft:
|
||||
,templates
|
||||
;; optional toString method:
|
||||
,@(toString type fields no-public toString?)
|
||||
,endclf)))))
|
||||
|
||||
;; String -> String
|
||||
(define (implements super) (if (string=? "" super) "" (format implementsf super)))
|
||||
|
||||
;; String Fields Fields -> String
|
||||
(define (class-constructor type fields super-fields)
|
||||
(apply string-append
|
||||
`( ,(format constf type (parameters (append super-fields fields)))
|
||||
#| When we switch to super in beginner, this will need to change.
|
||||
;; call to super(super-fields)
|
||||
,@(if (null? super-fields) '()
|
||||
(list (format superf (commas (map cadr super-fields)))))
|
||||
|#
|
||||
;; init for fields
|
||||
,@(map (lambda (f) (format initif (cadr f) (cadr f)))
|
||||
;; When we switch to super in beginner, ...
|
||||
(append super-fields fields))
|
||||
,endMet)))
|
||||
|
||||
|
||||
;; Fields -> String
|
||||
;; create a paremeter list from a field specifications
|
||||
(define (parameters fs)
|
||||
(commas (map (lambda (f) (format paraf (car f) (cadr f))) fs)))
|
||||
|
||||
;; String Fields Boolean -> (listof String)
|
||||
(define (make-template super fields template?)
|
||||
(if (not template?)
|
||||
(list "")
|
||||
`("\n"
|
||||
;; template method
|
||||
,cmnt/*
|
||||
,warnin
|
||||
,contef
|
||||
,@(map (lambda (f) (format (if (string=? (car f) super)
|
||||
temprf
|
||||
tempsf)
|
||||
(cadr f)))
|
||||
fields)
|
||||
,endMet
|
||||
,cmnt*/)))
|
||||
|
||||
;; String Fields -> (cons String (listof String))
|
||||
;; create a toString method for class type with _fields_
|
||||
(define toString
|
||||
(opt-lambda (type fields [toString? #t])
|
||||
(if (not toString?)
|
||||
(list "")
|
||||
(list "\n"
|
||||
(string-append
|
||||
toStrf
|
||||
(format prefix type)
|
||||
; (apply string-append)
|
||||
(if (null? fields)
|
||||
" + "
|
||||
(format
|
||||
" + ~a + " (commas (map addToString fields) infix)))
|
||||
postfix
|
||||
endMet)))))
|
||||
|
||||
(provide toString)
|
||||
|
||||
;; Field -> String
|
||||
;; create a call to toString, if necessary
|
||||
(define (addToString f)
|
||||
(let ([t (car f)] [s (cadr f)])
|
||||
(if (member t StringNative) s (format "~a.toString()" s))))
|
||||
|
||||
|
||||
;; String -> (list String)
|
||||
(define (purpose-statement prps)
|
||||
(if (string=? "" prps) '("") (list (format "// ~a~n" prps))))
|
||||
|
||||
;; identifiers ending in f are format strings, and require ~n for newline
|
||||
|
||||
;; Abstract Class
|
||||
(define abstractF "interface ~a {\n")
|
||||
;; Abstract Template
|
||||
(define purpos " // purpose statement \n")
|
||||
(define absteg " abstract ??? mmm();\n")
|
||||
;; Class
|
||||
(define classf "class ~a ~a{~n") (define extendsf "implements ~a ")
|
||||
;; Fields
|
||||
(define declaf " ~a ~a;~n")
|
||||
;; Constructor
|
||||
(define constf " ~a(~a) {~n") (define paraf "~a ~a")
|
||||
(define superf " super(~a);~n")
|
||||
(define initif " this.~a = ~a;~n")
|
||||
(define endMet " }\n")
|
||||
(define endclf "}\n")
|
||||
;; Concrete Template
|
||||
(define warnin " // ** DRAFT TEMPLATE ** Edit as needed.\n")
|
||||
(define contef " ??? mmm() {\n")
|
||||
(define tempsf " ... this.~a ...\n")
|
||||
(define temprf " ... this.~a.mmm() ...\n")
|
||||
;; toString
|
||||
(define toStrf " public String toString() {\n")
|
||||
(define prefix " return \"new ~a(\"")
|
||||
(define infix " + \",\" + ")
|
||||
(define postfix "\")\";\n")
|
||||
(define StringNative '("int" "boolean" "String" "double")) ;; and others
|
||||
;; Comments
|
||||
(define cmnt/* "/*\n")
|
||||
(define cmnt*/ "*/\n")
|
||||
|
||||
;; ------------------------------------------------------------------------
|
||||
;; Library
|
||||
|
||||
;; (Listof String) -> String
|
||||
;; create a comma-separated string from a list of strings
|
||||
(define (commas l . comma)
|
||||
(let ([comma (if (null? comma) ", " (car comma))])
|
||||
(if (null? l) ""
|
||||
(apply string-append (car l)
|
||||
(map (lambda (x) (string-append comma x)) (cdr l))))))
|
||||
|
||||
;; ------------------------------------------------------------------------
|
||||
;; TESTS:
|
||||
|
||||
(define empty-template
|
||||
`("/*\n"
|
||||
,warnin
|
||||
" ??? mmm() {\n"
|
||||
" }\n"
|
||||
"*/\n"
|
||||
"\n"))
|
||||
|
||||
#| Tests :
|
||||
(require (lib "testing.scm" "testing"))
|
||||
|
||||
(test== (commas '()) "")
|
||||
(test== (commas '("x" "y") ) "x, y")
|
||||
(test== (commas '("x" "y") " + ") "x + y")
|
||||
|
||||
(test== (parameters '()) "")
|
||||
(test== (parameters '(("int" "x"))) "int x")
|
||||
(test== (parameters '(("int" "x") ("foo" "y"))) "int x, foo y")
|
||||
(test== (commas '("x" "y") " + ") "x + y")
|
||||
(test== (commas '("x" "y" "z") " + ") "x + y + z")
|
||||
|
||||
(test== (cadr (toString "foo" '()))
|
||||
(string-append
|
||||
toStrf
|
||||
" return \"new foo(\" + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (cadr (toString "Foo" '(("Foo" "x") ("Moo" "y"))))
|
||||
(string-append
|
||||
toStrf
|
||||
" return \"new Foo(\" + x.toString() + \",\" + y.toString() + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (cadr (toString "Foo" '(("int" "x"))))
|
||||
(string-append
|
||||
toStrf
|
||||
" return \"new Foo(\" + x + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (cadr (toString "Foo" '(("Boolean" "x"))))
|
||||
(string-append
|
||||
toStrf
|
||||
" return \"new Foo(\" + x.toString() + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (cadr (toString "Foo" '(("Foo" "x") ("int" "y") ("Z" "z"))))
|
||||
(string-append
|
||||
toStrf
|
||||
" return \"new Foo(\" + x.toString() + \",\" + y + \",\" + z.toString() + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (toString "Foo" '(("Foo" "x") ("int" "y") ("Z" "z")) #f)
|
||||
(list ""))
|
||||
|
||||
(test== (class-constructor "Node" '(("int" "x")) '(("Info" "i") ("ATree" "parent")))
|
||||
(string-append
|
||||
" Node(Info i, ATree parent, int x) {\n"
|
||||
" this.i = i;\n"
|
||||
" this.parent = parent;\n"
|
||||
" this.x = x;\n"
|
||||
;; init for fields
|
||||
,@(map (lambda (f) (format initif (cadr f) (cadr f)))
|
||||
;; When we switch to super in beginner, ...
|
||||
(append super-fields fields))
|
||||
,endMet)))
|
||||
|
||||
|
||||
;; Fields -> String
|
||||
;; create a paremeter list from a field specifications
|
||||
(define (parameters fs)
|
||||
(enumerate-with-separator
|
||||
(map (lambda (f) (format paraf (car f) (cadr f))) fs)))
|
||||
|
||||
;; String String Fields Boolean -> (listof String)
|
||||
(define (make-template sig super fields template? public?)
|
||||
(define head (format contef (method sig)))
|
||||
(if (not template?)
|
||||
(list "")
|
||||
`("\n"
|
||||
;; template method
|
||||
,cmnt/*
|
||||
,warnin
|
||||
,(if public? (string-append " public " (string-trim head)) head)
|
||||
,@(map (lambda (f) (if (string=? (car f) super)
|
||||
(format temprf (cadr f) (cadr sig))
|
||||
(format tempsf (cadr f))))
|
||||
fields)
|
||||
,endMet
|
||||
,cmnt*/)))
|
||||
|
||||
;; Method -> String
|
||||
(define (method m)
|
||||
(define m+n (zip (cddr m) PARAS))
|
||||
(define sig (map (lambda (x) (format "~a ~a" (car x) (cadr x))) m+n))
|
||||
(format intff (car m) (cadr m) (enumerate-with-separator sig ",")))
|
||||
|
||||
(define PARAS '("x" "y" "z" "u" "v" "w" "s" "t"))
|
||||
|
||||
;; String Fields -> (cons String (listof String))
|
||||
;; create a toString method for class type with _fields_
|
||||
(define toString
|
||||
(opt-lambda (type fields [special? #f][toString? #t])
|
||||
(if (not toString?)
|
||||
(list "")
|
||||
(list "\n"
|
||||
(string-append
|
||||
(if special? toStrf pbStrf)
|
||||
(format prefix type)
|
||||
; (apply string-append)
|
||||
(if (null? fields)
|
||||
" + "
|
||||
(format
|
||||
" + ~a + " (enumerate-with-separator (map addToString fields) infix)))
|
||||
postfix
|
||||
endMet)))))
|
||||
|
||||
;(provide toString)
|
||||
|
||||
;; Field -> String
|
||||
;; create a call to toString, if necessary
|
||||
(define (addToString f)
|
||||
(let ([t (car f)] [s (cadr f)])
|
||||
(if (member t StringNative) s (format "~a.toString()" s))))
|
||||
|
||||
|
||||
;; String -> (list String)
|
||||
(provide/contract
|
||||
[purpose-statement (-> string? (listof string?))])
|
||||
|
||||
(define (purpose-statement prps)
|
||||
(if (string=? "" prps) '("") (list (format "// ~a~n" prps))))
|
||||
|
||||
;; identifiers ending in f are format strings, and require ~n for newline
|
||||
|
||||
;; Abstract Template
|
||||
(define purpos " // purpose statement \n")
|
||||
;; Class
|
||||
(define classf "class ~a ~a{~n") (define implementsf "implements ~a ")
|
||||
;; Fields
|
||||
(define declaf " ~a ~a;~n")
|
||||
;; Constructor
|
||||
(define constf " ~a(~a) {~n") (define paraf "~a ~a")
|
||||
(define superf " super(~a);~n")
|
||||
(define initif " this.~a = ~a;~n")
|
||||
(define endMet " }\n")
|
||||
|
||||
(provide endclf cmnt/* cmnt*/ warnin purpos)
|
||||
(define endclf "}\n")
|
||||
;; Concrete Template
|
||||
(define warnin " // ** DRAFT TEMPLATE ** Edit as needed.\n")
|
||||
(define intff "~a ~a(~a)")
|
||||
(define contef " ~a {\n")
|
||||
(define tempsf " ... this.~a ...\n")
|
||||
(define temprf " ... this.~a.~a(...) ...\n")
|
||||
;; toString
|
||||
(define pbStrf " public String toString() {\n")
|
||||
(define toStrf " String toString() {\n")
|
||||
(define prefix " return \"new ~a(\"")
|
||||
(define infix " + \",\" + ")
|
||||
(define postfix "\")\";\n")
|
||||
(define StringNative '("int" "boolean" "String" "double")) ;; and others
|
||||
;; Comments
|
||||
(define cmnt/* "/*\n")
|
||||
(define cmnt*/ "*/\n")
|
||||
|
||||
;; ------------------------------------------------------------------------
|
||||
;; Library
|
||||
|
||||
(provide/contract
|
||||
[enumerate-with-separator (opt-> ((listof string?)) (string?) string?)])
|
||||
|
||||
;; (Listof String) -> String
|
||||
;; create a comma-separated string from a list of strings
|
||||
(define (enumerate-with-separator l . comma)
|
||||
(let ([comma (if (null? comma) ", " (car comma))])
|
||||
(if (null? l) ""
|
||||
(apply string-append (car l)
|
||||
(map (lambda (x) (string-append comma x)) (cdr l))))))
|
||||
|
||||
;; ------------------------------------------------------------------------
|
||||
;; TESTS:
|
||||
|
||||
(define empty-template
|
||||
`("/*\n"
|
||||
,warnin
|
||||
" ??? mmm() {\n"
|
||||
" }\n"
|
||||
"*/\n"
|
||||
"\n"))
|
||||
|
||||
(define public-empty-template
|
||||
`("/*\n"
|
||||
,warnin
|
||||
" public ??? mmm() {\n"
|
||||
" }\n"
|
||||
"*/\n"
|
||||
"\n"))
|
||||
|
||||
#| Tests :
|
||||
(require (lib "testing.scm" "testing"))
|
||||
|
||||
(test== (enumerate-with-separator '()) "")
|
||||
(test== (enumerate-with-separator '("x" "y") ) "x, y")
|
||||
(test== (enumerate-with-separator '("x" "y") " + ") "x + y")
|
||||
|
||||
(test== (parameters '()) "")
|
||||
(test== (parameters '(("int" "x"))) "int x")
|
||||
(test== (parameters '(("int" "x") ("foo" "y"))) "int x, foo y")
|
||||
(test== (enumerate-with-separator '("x" "y") " + ") "x + y")
|
||||
(test== (enumerate-with-separator '("x" "y" "z") " + ") "x + y + z")
|
||||
|
||||
(test== (cadr (toString "foo" '()))
|
||||
(string-append
|
||||
pbStrf
|
||||
" return \"new foo(\" + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (cadr (toString "foo" '() #t))
|
||||
(string-append
|
||||
toStrf
|
||||
" return \"new foo(\" + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (cadr (toString "Foo" '(("Foo" "x") ("Moo" "y"))))
|
||||
(string-append
|
||||
pbStrf
|
||||
" return \"new Foo(\" + x.toString() + \",\" + y.toString() + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (cadr (toString "Foo" '(("Foo" "x") ("Moo" "y")) #t))
|
||||
(string-append
|
||||
toStrf
|
||||
" return \"new Foo(\" + x.toString() + \",\" + y.toString() + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (cadr (toString "Foo" '(("int" "x"))))
|
||||
(string-append
|
||||
pbStrf
|
||||
" return \"new Foo(\" + x + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (cadr (toString "Foo" '(("Boolean" "x"))))
|
||||
(string-append
|
||||
pbStrf
|
||||
" return \"new Foo(\" + x.toString() + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (cadr (toString "Foo" '(("Foo" "x") ("int" "y") ("Z" "z"))))
|
||||
(string-append
|
||||
pbStrf
|
||||
" return \"new Foo(\" + x.toString() + \",\" + y + \",\" + z.toString() + \")\";\n"
|
||||
endMet))
|
||||
|
||||
(test== (toString "Foo" '(("Foo" "x") ("int" "y") ("Z" "z")) #f #f)
|
||||
(list ""))
|
||||
|
||||
(test== (class-constructor "Node" '(("int" "x")) '(("Info" "i") ("ATree" "parent")))
|
||||
(string-append
|
||||
" Node(Info i, ATree parent, int x) {\n"
|
||||
" this.i = i;\n"
|
||||
" this.parent = parent;\n"
|
||||
" this.x = x;\n"
|
||||
" }\n"
|
||||
)
|
||||
"class constructor with super fields")
|
||||
|
||||
|
||||
(test== (make-class (list "foo" "" '()) #t #t INTERMEDIATE '() '(("???" "mmm")))
|
||||
(apply string-append
|
||||
`( "class foo {\n"
|
||||
"\n"
|
||||
" foo() {\n"
|
||||
" }\n"
|
||||
)
|
||||
"class constructor with super fields")
|
||||
|
||||
'(test== (class-constructor "Node" '(("int" "x")) '(("Info" "i") ("ATree" "parent")))
|
||||
(string-append
|
||||
" Node(Info i, ATree parent, int x) {\n"
|
||||
" super(i, parent);\n"
|
||||
" this.x = x;\n"
|
||||
"\n"
|
||||
,@empty-template
|
||||
,toStrf
|
||||
" return \"new foo(\" + \")\";\n"
|
||||
" }\n"
|
||||
)
|
||||
"class constructor with super fields")
|
||||
|
||||
(test== (make-class (list "foo" "" '()))
|
||||
(apply string-append
|
||||
`( "class foo {\n"
|
||||
"\n"
|
||||
" foo() {\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
,@empty-template
|
||||
" public String toString() {\n"
|
||||
" return \"new foo(\" + \")\";\n"
|
||||
" }\n"
|
||||
"}\n")))
|
||||
|
||||
(test== (make-class (list "moo" "foo" '()))
|
||||
(apply string-append
|
||||
`("class moo extends foo {\n"
|
||||
"\n"
|
||||
" moo() {\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
,@empty-template
|
||||
" public String toString() {\n"
|
||||
" return \"new moo(\" + \")\";\n"
|
||||
" }\n"
|
||||
"}\n")))
|
||||
|
||||
(test== (make-class (list "moo" "foo" '(("int" "x") ("foo" "f"))))
|
||||
(apply string-append
|
||||
`("class moo extends foo {\n"
|
||||
" int x;\n"
|
||||
" foo f;\n"
|
||||
"\n"
|
||||
" moo(int x, foo f) {\n"
|
||||
" this.x = x;\n"
|
||||
" this.f = f;\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
,cmnt/*
|
||||
,warnin
|
||||
" ??? mmm() {\n"
|
||||
" ... this.x ...\n"
|
||||
" ... this.f.mmm() ...\n"
|
||||
" }\n"
|
||||
,cmnt*/
|
||||
"\n"
|
||||
" public String toString() {\n"
|
||||
" return \"new moo(\" + x + \",\" + f.toString() + \")\";\n"
|
||||
" }\n"
|
||||
"}\n")))
|
||||
|
||||
(test== (make-class (list "CartPt" "" '(("int" "x") ("int" "y"))))
|
||||
(apply string-append
|
||||
`("class CartPt {\n"
|
||||
" int x;\n"
|
||||
" int y;\n"
|
||||
"\n"
|
||||
" CartPt(int x, int y) {\n"
|
||||
" this.x = x;\n"
|
||||
" this.y = y;\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
,cmnt/*
|
||||
,warnin
|
||||
" ??? mmm() {\n"
|
||||
" ... this.x ...\n"
|
||||
" ... this.y ...\n"
|
||||
" }\n"
|
||||
,cmnt*/
|
||||
"\n"
|
||||
" public String toString() {\n"
|
||||
" return \"new CartPt(\" + x + \",\" + y + \")\";\n"
|
||||
" }\n"
|
||||
"}\n")))
|
||||
|
||||
(test== (abstractClass "Foo" '() #f)
|
||||
(string-append
|
||||
"abstract class Foo {\n"
|
||||
"}\n"))
|
||||
|
||||
(test== (abstractClass "Foo" '(("int" "x")) #f)
|
||||
(string-append
|
||||
"abstract class Foo {\n"
|
||||
" int x;\n"
|
||||
"}\n")
|
||||
"abstract class with fields")
|
||||
|
||||
(test== (abstractClass "Foo" '() #t)
|
||||
(apply string-append
|
||||
`("abstract class Foo {\n"
|
||||
,cmnt/*
|
||||
,warnin
|
||||
,purpos
|
||||
" abstract ??? mmm();\n"
|
||||
,cmnt*/
|
||||
"}\n")))
|
||||
|
||||
(test== (abstractClass "Foo" '(("int" "x")) #t)
|
||||
(apply string-append
|
||||
`("abstract class Foo {\n"
|
||||
" int x;\n"
|
||||
,cmnt/*
|
||||
,warnin
|
||||
,purpos
|
||||
" abstract ??? mmm();\n"
|
||||
,cmnt*/
|
||||
"}\n"))
|
||||
"abstract class with fields and template")
|
||||
|
||||
(test==
|
||||
(make-union
|
||||
(make-dt "AList" '() '(("MT" ()) ("Cons" (("int" "first") ("AList" "rest")))) ""))
|
||||
(apply string-append
|
||||
`(
|
||||
"abstract class AList {\n"
|
||||
"/*\n"
|
||||
,warnin
|
||||
" // purpose statement \n"
|
||||
" abstract ??? mmm();\n"
|
||||
"*/\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"class MT extends AList {\n"
|
||||
"\n"
|
||||
" MT() {\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
"/*\n"
|
||||
,warnin
|
||||
" ??? mmm() {\n"
|
||||
" }\n"
|
||||
"*/\n"
|
||||
"\n"
|
||||
" public String toString() {\n"
|
||||
" return \"new MT(\" + \")\";\n"
|
||||
" }\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"class Cons extends AList {\n"
|
||||
" int first;\n"
|
||||
" AList rest;\n"
|
||||
"\n"
|
||||
" Cons(int first, AList rest) {\n"
|
||||
" this.first = first;\n"
|
||||
" this.rest = rest;\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
"/*\n"
|
||||
,warnin
|
||||
" ??? mmm() {\n"
|
||||
" ... this.first ...\n"
|
||||
" ... this.rest.mmm() ...\n"
|
||||
" }\n"
|
||||
"*/\n"
|
||||
"\n"
|
||||
" public String toString() {\n"
|
||||
" return \"new Cons(\" + first + \",\" + rest.toString() + \")\";\n"
|
||||
" }\n"
|
||||
"}\n"
|
||||
)
|
||||
)
|
||||
"full make union")
|
||||
|
||||
(test==
|
||||
(make-union
|
||||
(make-dt "AList" '() '(("MT" ()) ("Cons" (("int" "first") ("AList" "rest")))) "")
|
||||
#f #f)
|
||||
(apply string-append
|
||||
`(
|
||||
"abstract class AList {\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"class MT extends AList {\n"
|
||||
"\n"
|
||||
" MT() {\n"
|
||||
" }\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"class Cons extends AList {\n"
|
||||
" int first;\n"
|
||||
" AList rest;\n"
|
||||
"\n"
|
||||
" Cons(int first, AList rest) {\n"
|
||||
" this.first = first;\n"
|
||||
" this.rest = rest;\n"
|
||||
" }\n"
|
||||
"}\n"
|
||||
)
|
||||
)
|
||||
"partial make union")
|
||||
|
||||
(test== (make-class (list "foo" "" '() "hello world"))
|
||||
(apply string-append
|
||||
`( "// hello world\n"
|
||||
"class foo {\n"
|
||||
"\n"
|
||||
" foo() {\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
,@empty-template
|
||||
" public String toString() {\n"
|
||||
" return \"new foo(\" + \")\";\n"
|
||||
" }\n"
|
||||
"}\n")))
|
||||
"}\n"))
|
||||
"class with template in INTERMEDIATE")
|
||||
|
||||
(test== (make-class (list "moo" "foo" '()) #t #t PROFESSIONAL '() '(("???" "mmm")))
|
||||
(apply string-append
|
||||
`("class moo implements foo {\n"
|
||||
"\n"
|
||||
" moo() {\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
,@public-empty-template
|
||||
,pbStrf
|
||||
" return \"new moo(\" + \")\";\n"
|
||||
" }\n"
|
||||
"}\n")))
|
||||
|
||||
(test== (make-class (list "moo" "foo" '(("int" "x") ("foo" "f"))) #t #t PROFESSIONAL '() '(("???" "mmm")))
|
||||
(apply string-append
|
||||
`("class moo implements foo {\n"
|
||||
" int x;\n"
|
||||
" foo f;\n"
|
||||
"\n"
|
||||
" moo(int x, foo f) {\n"
|
||||
" this.x = x;\n"
|
||||
" this.f = f;\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
,cmnt/*
|
||||
,warnin
|
||||
" public ??? mmm() {\n"
|
||||
" ... this.x ...\n"
|
||||
" ... this.f.mmm(...) ...\n"
|
||||
" }\n"
|
||||
,cmnt*/
|
||||
"\n"
|
||||
,pbStrf
|
||||
" return \"new moo(\" + x + \",\" + f.toString() + \")\";\n"
|
||||
" }\n"
|
||||
"}\n")))
|
||||
|
||||
(test== (make-class (list "CartPt" "" '(("int" "x") ("int" "y"))) #t #t PROFESSIONAL '() '(("???" "mmm")))
|
||||
(apply string-append
|
||||
`("class CartPt {\n"
|
||||
" int x;\n"
|
||||
" int y;\n"
|
||||
"\n"
|
||||
" CartPt(int x, int y) {\n"
|
||||
" this.x = x;\n"
|
||||
" this.y = y;\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
,cmnt/*
|
||||
,warnin
|
||||
" public ??? mmm() {\n"
|
||||
" ... this.x ...\n"
|
||||
" ... this.y ...\n"
|
||||
" }\n"
|
||||
,cmnt*/
|
||||
"\n"
|
||||
,pbStrf
|
||||
" return \"new CartPt(\" + x + \",\" + y + \")\";\n"
|
||||
" }\n"
|
||||
"}\n")))
|
||||
|
||||
(test== (make-class (list "foo" "" '() "hello world") #t #t PROFESSIONAL '() '(("???" "mmm")))
|
||||
(apply string-append
|
||||
`( "// hello world\n"
|
||||
"class foo {\n"
|
||||
"\n"
|
||||
" foo() {\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
,@public-empty-template
|
||||
,pbStrf
|
||||
" return \"new foo(\" + \")\";\n"
|
||||
" }\n"
|
||||
"}\n")))
|
||||
|
||||
(test== (make-class (list "foo" "" '() "hello world") #t #t INTERMEDIATE '() '(("???" "mmm")))
|
||||
(apply string-append
|
||||
`( "// hello world\n"
|
||||
"class foo {\n"
|
||||
"\n"
|
||||
" foo() {\n"
|
||||
" }\n"
|
||||
"\n"
|
||||
,@empty-template
|
||||
,toStrf
|
||||
" return \"new foo(\" + \")\";\n"
|
||||
" }\n"
|
||||
"}\n")))
|
||||
|#
|
||||
)
|
||||
|
||||
(test==
|
||||
(make-union
|
||||
(make-dt "AList" '() '(("MT" ()) ("Cons" (("int" "first") ("AList" "rest")))) "hello world")
|
||||
#f #f)
|
||||
(apply string-append
|
||||
`("// hello world\n"
|
||||
"abstract class AList {\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"class MT extends AList {\n"
|
||||
"\n"
|
||||
" MT() {\n"
|
||||
" }\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"class Cons extends AList {\n"
|
||||
" int first;\n"
|
||||
" AList rest;\n"
|
||||
"\n"
|
||||
" Cons(int first, AList rest) {\n"
|
||||
" this.first = first;\n"
|
||||
" this.rest = rest;\n"
|
||||
" }\n"
|
||||
"}\n"
|
||||
)
|
||||
)
|
||||
"make union with purpose statement")
|
||||
|
||||
(test==
|
||||
(make-union
|
||||
(make-dt
|
||||
"AList" '() '(("MT" ()) ("Cons" (("int" "first") ("AList" "rest")) "pair")) "hello world")
|
||||
#f #f)
|
||||
(apply string-append
|
||||
`("// hello world\n"
|
||||
"abstract class AList {\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"class MT extends AList {\n"
|
||||
"\n"
|
||||
" MT() {\n"
|
||||
" }\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"// pair\n"
|
||||
"class Cons extends AList {\n"
|
||||
" int first;\n"
|
||||
" AList rest;\n"
|
||||
"\n"
|
||||
" Cons(int first, AList rest) {\n"
|
||||
" this.first = first;\n"
|
||||
" this.rest = rest;\n"
|
||||
" }\n"
|
||||
"}\n"
|
||||
)
|
||||
)
|
||||
"make union with purpose statement for variants")
|
||||
|
||||
(test==
|
||||
(make-union
|
||||
(make-dt
|
||||
"AList"
|
||||
'(("Common" "field") ("Common" "field2"))
|
||||
'(("MT" ()) ("Cons" (("int" "first") ("AList" "rest")) "pair"))
|
||||
"hello world")
|
||||
#f #f)
|
||||
(apply string-append
|
||||
`("// hello world\n"
|
||||
"abstract class AList {\n"
|
||||
" Common field;\n"
|
||||
" Common field2;\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"class MT extends AList {\n"
|
||||
"\n"
|
||||
" MT(Common field, Common field2) {\n"
|
||||
" this.field = field;\n"
|
||||
" this.field2 = field2;\n"
|
||||
" }\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"// pair\n"
|
||||
"class Cons extends AList {\n"
|
||||
" int first;\n"
|
||||
" AList rest;\n"
|
||||
"\n"
|
||||
" Cons(Common field, Common field2, int first, AList rest) {\n"
|
||||
" this.field = field;\n"
|
||||
" this.field2 = field2;\n"
|
||||
" this.first = first;\n"
|
||||
" this.rest = rest;\n"
|
||||
" }\n"
|
||||
"}\n"
|
||||
)
|
||||
)
|
||||
"make union with common fields")
|
||||
|#
|
||||
)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user