391 lines
18 KiB
Scheme
391 lines
18 KiB
Scheme
(module java-signatures mzscheme
|
|
|
|
(require mzlib/unit)
|
|
|
|
(require parser-tools/lex
|
|
(lib "combinator-unit.ss" "combinator-parser")
|
|
mzlib/string)
|
|
|
|
(provide (all-defined))
|
|
|
|
;Terminal signatures
|
|
|
|
(define-signature java-operators^
|
|
((terminals Operators
|
|
(PIPE OR OREQUAL GT LT ! ~ ? : == LTEQ GTEQ != && ++ -- PLUS
|
|
MINUS DIVIDE & ^T % << >> >>> += -= *= /= &= ^= %= <<= >>= >>>=))))
|
|
|
|
(define-signature java-separators^
|
|
((terminals Separators
|
|
(O_PAREN C_PAREN O_BRACE C_BRACE O_BRACKET C_BRACKET SEMI_COLON
|
|
PERIOD COMMA EQUAL TIMES))))
|
|
|
|
(define-signature java-literals^
|
|
((terminals EmptyLiterals (NULL_LIT TRUE_LIT FALSE_LIT EOF))))
|
|
|
|
(define-signature java-expression-keywords^
|
|
((terminals ExpressionKeywords (instanceof new))))
|
|
|
|
(define-signature java-statement-keywords^
|
|
((terminals StatementKeywords (break caseT catch continue ifT doT elseT
|
|
for return switch throw try while finally))))
|
|
|
|
(define-signature java-definition-keywords^
|
|
((terminals DefinitionKeywords (abstract class extends final private implements import
|
|
interface native package protected public static
|
|
strictfp synchronized throws transient volatile))))
|
|
|
|
(define-signature java-type-keywords^
|
|
((terminals TypeKeywords (boolean byte char double float int long short voidT))))
|
|
|
|
(define-signature java-reserved^
|
|
((terminals ReservedWords (default const goto))))
|
|
|
|
(define-signature java-extras^
|
|
((terminals ExtraKeywords (dynamic check expect within -> ->> ->>> test tests testcase))))
|
|
|
|
(define-signature java-ids^ ((terminals java-vals (IDENTIFIER this super))))
|
|
|
|
(define-signature java-vals^
|
|
((terminals java-vals (STRING_LIT CHAR_LIT INTEGER_LIT LONG_LIT FLOAT_LIT DOUBLE_LIT
|
|
STRING_ERROR NUMBER_ERROR HEX_LIT OCT_LIT
|
|
HEXL_LIT OCTL_LIT))))
|
|
|
|
(define-signature java-specials^
|
|
((terminals special-toks (EXAMPLE TEST_SUITE IMAGE_SPECIAL OTHER_SPECIAL))))
|
|
|
|
;General purpose signatures
|
|
(define-signature general-productions^ (comma-sep #;variable-declaration #;name))
|
|
|
|
(define-signature java-variables^ (identifier name variable-declaration))
|
|
|
|
;Types, modifiers, operator signatures
|
|
|
|
(define-signature java-types^ (integer-types inexact-types numeric-type prim-type
|
|
other-type-base value+name-type method-type array-type))
|
|
(define-signature java-access^ (access-mods global-mods method-mods))
|
|
(define-signature java-ops^ (math-ops shift-ops compare-ops bool-ops bit-ops assignment-ops
|
|
bin-ops un-assignment un-op))
|
|
|
|
;Expression signatures
|
|
(define-signature expr-lits^ (boolean-lits textual-lits prim-numeric-lits null-lit numeric-lits
|
|
double-lits literals all-literals))
|
|
|
|
(define-signature expr-terms^ (new-class new-array simple-method-call
|
|
assignment unary-assignment-front cast
|
|
super-call))
|
|
|
|
(define-signature expr-tails^ (field-access-end
|
|
array-access-end array-init
|
|
binary-expression-end if-expr-end
|
|
method-call-end unary-assignment-back instanceof-back))
|
|
|
|
(define-signature expr-terms+^ extends expr-terms^ (checks))
|
|
|
|
;Statement signatures
|
|
|
|
(define-signature statements^ (make-statement if-s return-s this-call super-ctor-call
|
|
block expression-stmt while-l do-while for-l
|
|
break-s cont-s init))
|
|
|
|
;Member signatures
|
|
|
|
(define-signature fields^ (make-field arg args))
|
|
|
|
(define-signature methods^ (method-signature method-header make-method))
|
|
|
|
(define-signature ctors^ (make-constructor))
|
|
|
|
;Definition signatures
|
|
|
|
(define-signature interfaces^ (interface-body interface-def))
|
|
|
|
(define-signature classes^ (class-body implements-dec extend-dec class-def))
|
|
|
|
(define-signature top-forms^ (top-member import-dec make-program))
|
|
|
|
)
|
|
;
|
|
; ;
|
|
; ;
|
|
; ; ;;;;
|
|
; ; ;
|
|
; ; ;
|
|
; ; ; ;;;;; ;; ;;; ;;;; ;; ;; ;;; ;;;;; ;;;; ;; ;;;;; ;;;; ;
|
|
; ; ; ; ;; ; ; ;; ; ; ; ; ;; ; ; ; ;;
|
|
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ;;;;;; ; ; ; ; ; ; ;;;;;; ; ; ;;;;;;;;; ;;;
|
|
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;;
|
|
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
|
|
; ; ; ; ;; ; ; ; ;; ; ;; ; ;; ; ;; ; ;; ;; ;
|
|
; ; ;;;;;;; ;;;; ;; ;;; ;;; ;;;; ; ;;; ;; ;;;; ;; ;;;; ; ;;;;; ; ;;;;
|
|
; ; ; ;
|
|
; ; ; ;
|
|
; ; ;;;;; ;;;;;
|
|
;
|
|
; (define beginner-unique-base
|
|
; (simple-expression
|
|
; (list (literals (list boolean-lits textual-lits prim-numeric-lits double-lits))
|
|
; this
|
|
; IDENTIFIER
|
|
; (new-class IDENTIFIER (eta beginner-expression))
|
|
; (simple-method-call (eta beginner-expression))
|
|
; (sequence (O_PAREN (eta beginner-expression) C_PAREN) id "expression")
|
|
; (sequence (! (eta beginner-expression)) id "unary expression")
|
|
; (checks (eta beginner-expression)))))
|
|
;
|
|
; (define beginner-unique-end
|
|
; (simple-expression
|
|
; (list field-access-end
|
|
; (method-call-end (eta beginner-expression))
|
|
; (binary-expression-end (bin-ops (list math-ops compare-ops bool-ops))
|
|
; (eta beginner-expression)))))
|
|
;
|
|
; (define beginner-expression
|
|
; (sequence (beginner-unique-base (repeat beginner-unique-end)) id "expression"))
|
|
;
|
|
; (define beginner-statement
|
|
; (statement (list (if-s beginner-expression (eta beginner-statement) #f)
|
|
; (return-s beginner-expression #f))))
|
|
;
|
|
; (define beginner-field (field #f value-type beginner-expression #f))
|
|
;
|
|
; (define beginner-method-sig
|
|
; (method-signature #f value-type args))
|
|
;
|
|
; (define beginner-method
|
|
; (method beginner-method-sig beginner-statement))
|
|
;
|
|
; (define beginner-constructor (constructor #f init*))
|
|
;
|
|
; (define beginner-interface
|
|
; (interface-def #f #f (method-header* beginner-method-sig)))
|
|
;
|
|
; (define beginner-class
|
|
; (class-def #f #f (implements-dec IDENTIFIER)
|
|
; (repeat (class-body (list beginner-field beginner-method beginner-constructor)))))
|
|
;
|
|
; (define beginner-program
|
|
; (program #f (repeat import-dec)
|
|
; (repeat (top-member (list beginner-class beginner-interface)))))
|
|
;
|
|
; (define parse-beginner (parser beginner-program))
|
|
;
|
|
; (define intermediate-unique-base
|
|
; (simple-expression
|
|
; (list (literals (list boolean-lits textual-lits prim-numeric-lits double-lits))
|
|
; this
|
|
; IDENTIFIER
|
|
; (new-class IDENTIFIER (eta intermediate-expression))
|
|
; (simple-method-call (eta intermediate-expression))
|
|
; (sequence (O_PAREN (eta intermediate-expression) C_PAREN) id "expression")
|
|
; (sequence (! (eta intermediate-expression)) id "unary expression")
|
|
; (cast value-type (eta intermediate-expression))
|
|
; (super-call (eta intermediate-expression))
|
|
; (checks (eta intermediate-expression)))))
|
|
;
|
|
; (define intermediate-unique-end
|
|
; (simple-expression
|
|
; (list field-access-end
|
|
; (method-call-end (eta intermediate-expression))
|
|
; (binary-expression-end (bin-ops (list math-ops compare-ops bool-ops bit-ops))
|
|
; (eta intermediate-expression)))))
|
|
;
|
|
; (define intermediate-expression
|
|
; (sequence (intermediate-unique-base (repeat intermediate-unique-end))
|
|
; id "expression"))
|
|
;
|
|
; (define intermediate-stmt-expr
|
|
; (simple-expression (list (new-class IDENTIFIER intermediate-expression)
|
|
; (super-call intermediate-expression)
|
|
; (sequence (intermediate-expression
|
|
; (method-call-end intermediate-expression))
|
|
; id "method call")
|
|
; (assignment IDENTIFIER EQUAL intermediate-expression))))
|
|
;
|
|
; (define intermediate-statement
|
|
; (statement (list (if-s intermediate-expression (eta intermediate-statement) #f)
|
|
; (return-s intermediate-expression #t)
|
|
; (variable-declaration value-type intermediate-expression #f "local variable")
|
|
; (block (repeat (eta intermediate-statement)))
|
|
; (sequence (intermediate-stmt-expr SEMI_COLON) id "statement"))))
|
|
;
|
|
; (define intermediate-field (field access-mods value-type intermediate-expression #t))
|
|
;
|
|
; (define intermediate-method-sig-no-abs
|
|
; (method-signature access-mods
|
|
; (method-type value-type)
|
|
; args))
|
|
; (define intermediate-method-sig-abs
|
|
; (method-signature (method-mods access-mods)
|
|
; (method-type value-type)
|
|
; args))
|
|
;
|
|
; (define intermediate-method
|
|
; (choose ((method intermediate-method-sig-no-abs intermediate-statement)
|
|
; (method-header intermediate-method-sig-abs)) "method definition top"))
|
|
;
|
|
; (define intermediate-constructor
|
|
; (constructor access-mods
|
|
; (choose ((sequence ((super-call intermediate-expression) (repeat intermediate-statement)) id)
|
|
; (sequence ((this-call intermediate-expression) (repeat intermediate-statement)) id)
|
|
; (repeat intermediate-statement)) "constructor body")))
|
|
;
|
|
; (define intermediate-interface
|
|
; (interface-def
|
|
; #f
|
|
; (sequence (extends (comma-sep IDENTIFIER "interfaces")) id "extends")
|
|
; (method-header* intermediate-method-sig-no-abs)))
|
|
;
|
|
; (define intermediate-class
|
|
; (class-def abstract (extend-dec IDENTIFIER) (implements-dec (comma-sep IDENTIFIER "interfaces"))
|
|
; (repeat (class-body (list intermediate-field intermediate-method intermediate-constructor)))))
|
|
;
|
|
; (define intermediate-program
|
|
; (program #f (repeat import-dec)
|
|
; (repeat (top-member (list intermediate-class intermediate-interface)))))
|
|
;
|
|
; (define parse-intermediate (parser intermediate-program))
|
|
;
|
|
; (define advanced-unique-base
|
|
; (simple-expression
|
|
; (list (literals (list boolean-lits textual-lits prim-numeric-lits double-lits))
|
|
; this
|
|
; IDENTIFIER
|
|
; (new-class IDENTIFIER (eta advanced-expression))
|
|
; (simple-method-call (eta advanced-expression))
|
|
; (new-array value-type (eta advanced-expression))
|
|
; (sequence (O_PAREN (eta advanced-expression) C_PAREN) id "expression")
|
|
; (sequence (! (eta advanced-expression)) id "unary expression")
|
|
; (cast value-type (eta advanced-expression))
|
|
; (super-call (eta advanced-expression))
|
|
; (checks (eta advanced-expression)))))
|
|
;
|
|
; (define advanced-unique-end
|
|
; (simple-expression
|
|
; (list field-access-end
|
|
; (array-access-end (eta advanced-expression))
|
|
; (method-call-end (eta advanced-expression))
|
|
; (if-expr-end (eta advanced-expression))
|
|
; (binary-expression-end (bin-ops (list math-ops compare-ops bool-ops))
|
|
; (eta advanced-expression)))))
|
|
;
|
|
; (define advanced-expression
|
|
; (sequence (advanced-unique-base (repeat advanced-unique-end)) id "expression"))
|
|
;
|
|
;
|
|
; (define advanced-stmt-expr
|
|
; (simple-expression (list (new-class IDENTIFIER advanced-expression)
|
|
; (super-call advanced-expression)
|
|
; (sequence (advanced-expression
|
|
; (method-call-end advanced-expression)) id "method call")
|
|
; (assignment IDENTIFIER assignment-ops advanced-expression)
|
|
; (sequence (advanced-expression ++) id "unary mutation")
|
|
; (sequence (advanced-expression --) id "unary mutation")
|
|
; (sequence (++ advanced-expression) id "unary mutation")
|
|
; (sequence (-- advanced-expression) id "unary mutation"))))
|
|
;
|
|
; (define advanced-statement
|
|
; (statement (list (if-s advanced-expression (eta advanced-statement) #t)
|
|
; (return-s advanced-expression #t)
|
|
; (variable-declaration value-type advanced-expression #t "local variable")
|
|
; (block (repeat (eta advanced-statement)))
|
|
; (sequence (advanced-stmt-expr SEMI_COLON) id "statement")
|
|
; (for-l (choose ((variable-declaration value-type advanced-expression #t "for loop variable")
|
|
; (comma-sep advanced-stmt-expr "initializations")) "for loop initialization")
|
|
; #t
|
|
; advanced-expression #t
|
|
; (comma-sep advanced-stmt-expr "for loop increments") #t (eta advanced-statement))
|
|
; (while-l advanced-expression (eta advanced-statement))
|
|
; (do-while advanced-expression (eta advanced-statement))
|
|
; (break-s #f)
|
|
; (cont-s #f))))
|
|
;
|
|
; (define advanced-field (field (global-mods access-mods) value-type advanced-expression #t))
|
|
;
|
|
; (define advanced-method-sig-no-abs
|
|
; (method-signature (global-mods access-mods)
|
|
; (method-type value-type)
|
|
; args))
|
|
; (define advanced-method-sig-abs
|
|
; (method-signature (method-mods (global-mods access-mods))
|
|
; (method-type value-type)
|
|
; args))
|
|
;
|
|
; (define advanced-method
|
|
; (choose ((method advanced-method-sig-no-abs advanced-statement)
|
|
; (method-header advanced-method-sig-abs)) "method definition"))
|
|
;
|
|
; (define advanced-constructor
|
|
; (constructor access-mods
|
|
; (choose ((sequence ((super-call advanced-expression) (repeat advanced-statement)) id)
|
|
; (sequence ((this-call advanced-expression) (repeat advanced-statement)) id)
|
|
; (repeat advanced-statement)) "constructor body")))
|
|
;
|
|
; (define advanced-interface
|
|
; (interface-def
|
|
; #f
|
|
; (sequence (extends (comma-sep IDENTIFIER "interfaces")) id "extends")
|
|
; (method-header* advanced-method-sig-no-abs)))
|
|
;
|
|
; (define advanced-class
|
|
; (class-def abstract (extend-dec IDENTIFIER) (implements-dec (comma-sep IDENTIFIER "interfaces"))
|
|
; (repeat (class-body (list advanced-field advanced-method advanced-constructor
|
|
; (method-header advanced-method-sig-abs))))))
|
|
;
|
|
; (define advanced-program
|
|
; (program (sequence (package name SEMI_COLON) id "package specification")
|
|
; (repeat import-dec)
|
|
; (repeat (top-member (list advanced-class advanced-interface)))))
|
|
;
|
|
; (define parse-advanced
|
|
; (parser advanced-program))
|
|
;
|
|
; (define (old-tokens->new tok-list)
|
|
; (cond
|
|
; [(null? tok-list) null]
|
|
; [else
|
|
; (cons
|
|
; (make-position-token
|
|
; (case (token-name (position-token-token (car tok-list)))
|
|
; [(=) (token-EQUAL)]
|
|
; ((<) (token-LT))
|
|
; ((>) (token-GT))
|
|
; ((<=) (token-LTEQ))
|
|
; ((>=) (token-GTEQ))
|
|
; ((+) (token-PLUS))
|
|
; ((-) (token-MINUS))
|
|
; ((*) (token-TIMES))
|
|
; ((/) (token-DIVIDE))
|
|
; ((^) (token-^T))
|
|
; ((if) (token-ifT))
|
|
; ((do) (token-doT))
|
|
; ((case) (token-caseT))
|
|
; ((else) (token-elseT))
|
|
; ((void) (token-voidT))
|
|
; (else (position-token-token (car tok-list))))
|
|
; (position-token-start-pos (car tok-list))
|
|
; (position-token-end-pos (car tok-list)))
|
|
; (old-tokens->new (cdr tok-list)))]))
|
|
;
|
|
; )
|
|
;
|
|
; (define-unit constants@
|
|
; (import)
|
|
; (export error-format-parameters^)
|
|
; (define src? #t)
|
|
; (define input-type "file")
|
|
; (define show-options #f)
|
|
; (define max-depth 1)
|
|
; (define max-choice-depth 3))
|
|
;
|
|
; (define-compound-unit/infer java-parsers@
|
|
; (import)
|
|
; (export teaching-languages^)
|
|
; (link java-dictionary@ combinator-parser-tools@ constants@ java-grammars@))
|
|
;
|
|
; (provide java-parsers@ teaching-languages^)
|
|
;
|
|
; )
|
|
;
|