505 (** Isar setup **) |
502 (** Isar setup **) |
506 |
503 |
507 val (inK, module_nameK, fileK) = ("in", "module_name", "file"); |
504 val (inK, module_nameK, fileK) = ("in", "module_name", "file"); |
508 |
505 |
509 val code_exprP = |
506 val code_exprP = |
510 (Scan.repeat1 P.term_group |
507 (Scan.repeat1 Parse.term_group |
511 -- Scan.repeat (P.$$$ inK |-- P.name |
508 -- Scan.repeat (Parse.$$$ inK |-- Parse.name |
512 -- Scan.option (P.$$$ module_nameK |-- P.name) |
509 -- Scan.option (Parse.$$$ module_nameK |-- Parse.name) |
513 -- Scan.option (P.$$$ fileK |-- P.name) |
510 -- Scan.option (Parse.$$$ fileK |-- Parse.name) |
514 -- Scan.optional (P.$$$ "(" |-- Args.parse --| P.$$$ ")") [] |
511 -- Scan.optional (Parse.$$$ "(" |-- Args.parse --| Parse.$$$ ")") [] |
515 ) >> (fn (raw_cs, seris) => export_code_cmd raw_cs seris)); |
512 ) >> (fn (raw_cs, seris) => export_code_cmd raw_cs seris)); |
516 |
513 |
517 val _ = List.app OuterKeyword.keyword [inK, module_nameK, fileK]; |
514 val _ = List.app Keyword.keyword [inK, module_nameK, fileK]; |
518 |
515 |
519 val _ = |
516 val _ = |
520 OuterSyntax.command "code_class" "define code syntax for class" K.thy_decl ( |
517 Outer_Syntax.command "code_class" "define code syntax for class" Keyword.thy_decl ( |
521 parse_multi_syntax P.xname (Scan.option P.string) |
518 parse_multi_syntax Parse.xname (Scan.option Parse.string) |
522 >> (Toplevel.theory oo fold) (fn (target, syns) => |
519 >> (Toplevel.theory oo fold) (fn (target, syns) => |
523 fold (fn (raw_class, syn) => add_syntax_class_cmd target raw_class syn) syns) |
520 fold (fn (raw_class, syn) => add_syntax_class_cmd target raw_class syn) syns) |
524 ); |
521 ); |
525 |
522 |
526 val _ = |
523 val _ = |
527 OuterSyntax.command "code_instance" "define code syntax for instance" K.thy_decl ( |
524 Outer_Syntax.command "code_instance" "define code syntax for instance" Keyword.thy_decl ( |
528 parse_multi_syntax (P.xname --| P.$$$ "::" -- P.xname) (Scan.option (P.minus >> K ())) |
525 parse_multi_syntax (Parse.xname --| Parse.$$$ "::" -- Parse.xname) |
|
526 (Scan.option (Parse.minus >> K ())) |
529 >> (Toplevel.theory oo fold) (fn (target, syns) => |
527 >> (Toplevel.theory oo fold) (fn (target, syns) => |
530 fold (fn (raw_inst, add_del) => add_syntax_inst_cmd target raw_inst add_del) syns) |
528 fold (fn (raw_inst, add_del) => add_syntax_inst_cmd target raw_inst add_del) syns) |
531 ); |
529 ); |
532 |
530 |
533 val _ = |
531 val _ = |
534 OuterSyntax.command "code_type" "define code syntax for type constructor" K.thy_decl ( |
532 Outer_Syntax.command "code_type" "define code syntax for type constructor" Keyword.thy_decl ( |
535 parse_multi_syntax P.xname (Code_Printer.parse_syntax I) |
533 parse_multi_syntax Parse.xname (Code_Printer.parse_syntax I) |
536 >> (Toplevel.theory oo fold) (fn (target, syns) => |
534 >> (Toplevel.theory oo fold) (fn (target, syns) => |
537 fold (fn (raw_tyco, syn) => add_syntax_tyco_cmd target raw_tyco syn) syns) |
535 fold (fn (raw_tyco, syn) => add_syntax_tyco_cmd target raw_tyco syn) syns) |
538 ); |
536 ); |
539 |
537 |
540 val _ = |
538 val _ = |
541 OuterSyntax.command "code_const" "define code syntax for constant" K.thy_decl ( |
539 Outer_Syntax.command "code_const" "define code syntax for constant" Keyword.thy_decl ( |
542 parse_multi_syntax P.term_group (Code_Printer.parse_syntax fst) |
540 parse_multi_syntax Parse.term_group (Code_Printer.parse_syntax fst) |
543 >> (Toplevel.theory oo fold) (fn (target, syns) => |
541 >> (Toplevel.theory oo fold) (fn (target, syns) => |
544 fold (fn (raw_const, syn) => add_syntax_const_simple_cmd target raw_const syn) syns) |
542 fold (fn (raw_const, syn) => add_syntax_const_simple_cmd target raw_const syn) syns) |
545 ); |
543 ); |
546 |
544 |
547 val _ = |
545 val _ = |
548 OuterSyntax.command "code_reserved" "declare words as reserved for target language" K.thy_decl ( |
546 Outer_Syntax.command "code_reserved" "declare words as reserved for target language" |
549 P.name -- Scan.repeat1 P.name |
547 Keyword.thy_decl ( |
|
548 Parse.name -- Scan.repeat1 Parse.name |
550 >> (fn (target, reserveds) => (Toplevel.theory o fold (add_reserved target)) reserveds) |
549 >> (fn (target, reserveds) => (Toplevel.theory o fold (add_reserved target)) reserveds) |
551 ); |
550 ); |
552 |
551 |
553 val _ = |
552 val _ = |
554 OuterSyntax.command "code_include" "declare piece of code to be included in generated code" K.thy_decl ( |
553 Outer_Syntax.command "code_include" "declare piece of code to be included in generated code" |
555 P.name -- P.name -- (P.text :|-- (fn "-" => Scan.succeed NONE |
554 Keyword.thy_decl ( |
556 | s => Scan.optional (P.$$$ "attach" |-- Scan.repeat1 P.term) [] >> pair s >> SOME)) |
555 Parse.name -- Parse.name -- (Parse.text :|-- (fn "-" => Scan.succeed NONE |
|
556 | s => Scan.optional (Parse.$$$ "attach" |-- Scan.repeat1 Parse.term) [] >> pair s >> SOME)) |
557 >> (fn ((target, name), content_consts) => |
557 >> (fn ((target, name), content_consts) => |
558 (Toplevel.theory o add_include_cmd target) (name, content_consts)) |
558 (Toplevel.theory o add_include_cmd target) (name, content_consts)) |
559 ); |
559 ); |
560 |
560 |
561 val _ = |
561 val _ = |
562 OuterSyntax.command "code_modulename" "alias module to other name" K.thy_decl ( |
562 Outer_Syntax.command "code_modulename" "alias module to other name" Keyword.thy_decl ( |
563 P.name -- Scan.repeat1 (P.name -- P.name) |
563 Parse.name -- Scan.repeat1 (Parse.name -- Parse.name) |
564 >> (fn (target, modlnames) => (Toplevel.theory o fold (add_module_alias target)) modlnames) |
564 >> (fn (target, modlnames) => (Toplevel.theory o fold (add_module_alias target)) modlnames) |
565 ); |
565 ); |
566 |
566 |
567 val _ = |
567 val _ = |
568 OuterSyntax.command "code_abort" "permit constant to be implemented as program abort" K.thy_decl ( |
568 Outer_Syntax.command "code_abort" "permit constant to be implemented as program abort" |
569 Scan.repeat1 P.term_group >> (Toplevel.theory o fold allow_abort_cmd) |
569 Keyword.thy_decl ( |
570 ); |
570 Scan.repeat1 Parse.term_group >> (Toplevel.theory o fold allow_abort_cmd) |
571 |
571 ); |
572 val _ = |
572 |
573 OuterSyntax.command "export_code" "generate executable code for constants" |
573 val _ = |
574 K.diag (P.!!! code_exprP >> (fn f => Toplevel.keep (f o Toplevel.theory_of))); |
574 Outer_Syntax.command "export_code" "generate executable code for constants" |
|
575 Keyword.diag (Parse.!!! code_exprP >> (fn f => Toplevel.keep (f o Toplevel.theory_of))); |
575 |
576 |
576 fun shell_command thyname cmd = Toplevel.program (fn _ => |
577 fun shell_command thyname cmd = Toplevel.program (fn _ => |
577 (use_thy thyname; case Scan.read Token.stopper (P.!!! code_exprP) |
578 (use_thy thyname; case Scan.read Token.stopper (Parse.!!! code_exprP) |
578 ((filter Token.is_proper o OuterSyntax.scan Position.none) cmd) |
579 ((filter Token.is_proper o Outer_Syntax.scan Position.none) cmd) |
579 of SOME f => (writeln "Now generating code..."; f (theory thyname)) |
580 of SOME f => (writeln "Now generating code..."; f (theory thyname)) |
580 | NONE => error ("Bad directive " ^ quote cmd))) |
581 | NONE => error ("Bad directive " ^ quote cmd))) |
581 handle Runtime.TOPLEVEL_ERROR => OS.Process.exit OS.Process.failure; |
582 handle Runtime.TOPLEVEL_ERROR => OS.Process.exit OS.Process.failure; |
582 |
583 |
583 end; (*local*) |
584 end; (*local*) |