langscan 1.2

data/lib/langscan/ocaml/camlexer.ml

@@ -0,0 +1,28 @@
+(*
+  camlexer - Lexical Analyzer for Gonzui ocamlsupport
+
+  Copyright (C) 2005 Soutaro Matsumoto <matsumoto@soutaro.com>
+      All rights reserved.
+      This is free software with ABSOLUTELY NO WARRANTY.
+
+  You can redistribute it and/or modify it under the terms of
+  the GNU General Public License version 2.
+*)
+
+(* $Id: camlexer.ml,v 1.1.1.1 2005/09/15 19:38:39 bashi Exp $ *)
+
+let main () = 
+  try
+    let lexbuf = Lexing.from_channel stdin in
+      while true do
+	let ((lnum,bnum),tname,lexed_str) = (Lexer.token lexbuf) in
+	  begin
+	    Printf.printf "%d:%d:%s:%s\n" lnum bnum (Types.to_string tname) lexed_str;
+	    flush stdout;
+	  end
+      done
+  with
+      Lexer.EOF -> exit 0
+
+let _ = main ()
+

data/lib/langscan/ocaml/lexer.mll

@@ -0,0 +1,230 @@
+(*
+  camlexer - Lexical Analyzer for Gonzui ocamlsupport
+
+  Copyright (C) 2005 Soutaro Matsumoto <matsumoto@soutaro.com>
+      All rights reserved.
+      This is free software with ABSOLUTELY NO WARRANTY.
+
+  You can redistribute it and/or modify it under the terms of
+  the GNU General Public License version 2.
+
+*)
+
+(* $Id: lexer.mll,v 1.1.1.1 2005/09/15 19:38:39 bashi Exp $ *)
+
+{
+exception EOF
+    
+open Types
+
+let lnum = ref 1
+let inc_lnum () =
+  begin
+    lnum := !lnum+1;
+  end
+
+let reset () = 
+  lnum := 1
+
+let get_pos lexbuf = 
+  let pos = Lexing.lexeme_start_p lexbuf in
+  let boff = pos.Lexing.pos_bol in
+  let cnum = pos.Lexing.pos_cnum in
+    !lnum,boff+cnum
+
+let str_lexbuf = ref (None: (Lexing.lexbuf) option)
+
+}
+
+let newline = ('\n' | '\r' | "\r\n")
+let blank = [' ' '\t']
+let letter = ['a'-'z' 'A'-'Z']
+let num = ['0'-'9']
+let ident = (letter | '_') (letter | num | '_' | '\'')*
+let int_lit =
+    (('-')? num (num | '_')*) 
+  | (('-')? ("0x"|"0X") (num | ['A'-'F'] ['a'-'f']) (num | ['A'-'F'] ['a'-'f'] | '_')*)
+  | (('-')? ("0o"|"0O") (['0'-'7']) (['0'-'7'] | '_')*)
+  | (('-')? ("0b"|"0B") (['0'-'1']) (['0'-'1'] | '_')*)
+let float_lit =
+  ('-')? num (num | '_')* ('.' (num | '_')*)? (("e"|"E") ('+'|'-')? num (num | '_')*)?
+let regular_char = [^ '\'']
+let escape_sequence = 
+    '\\' ['\\' '\"' '\'' 'n' 't' 'b' 'r']
+  | '\\' num num num
+  | "\\x" (num | ['A'-'F'] | ['a'-'f']) (num | ['A'-'F'] | ['a'-'f'])
+let char_lit = 
+    '\'' regular_char '\''
+  | '\'' escape_sequence '\''
+let label = ['a'-'z'] (letter | num | '_' | '\'')*
+let operator_char =  ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~']
+let infix_symbol = ['=' '<' '>' '@' '|' '&' '+' '-' '*' '/' '$' '%'] operator_char*
+let prefix_symbol = ['!' '?' '~'] operator_char*
+let keywords = 
+  "and" | "as" | "assert" | "asr" | "begin" | "class"
+  | "constraint" | "do" | "done" | "downto" | "else" | "end"
+  | "exception" | "external" | "false" | "for" | "fun" | "function"
+  | "functor" | "if" | "in" | "include" | "inherit" | "initializer"
+  | "land" | "lazy" | "let" | "lor" | "lsl" | "lsr"
+  | "lxor" | "match" | "method" | "mod" | "module" | "mutable"
+  | "new" | "object" | "of" | "open" | "or" | "private"
+  | "rec" | "sig" | "struct" | "then" | "to" | "true"
+  | "try" | "type" | "val" | "virtual" | "when" | "while" | "with"
+let puncts = 
+    "!=" | "#" | "&" | "&&" | "\'" | "(" | ")" | "*" | "+" | "," | "-"
+  | "-." | "->" | "." | ".." | ":" | "::" | ":=" | ":>" | ";" | ";;" | "<"
+  | "<-" | "=" | ">" | ">]" | ">}" | "?" | "??" | "[" | "[<" | "[>" | "[|"
+  | "]" | "_" | "`" | "{" | "{<" | "|" | "|]" | "}" | "~"
+let camlp4_keywords = "parser"
+let camlp4_puncts = 
+    "<<" | "<:" | ">>" | "$" | "$$" | "$:"
+let ocamlyacc_keywords = 
+    "%token" | "%start" | "%type" | "%left" | "%right" | "%nonassoc" | "%prec"
+let ocamlyacc_puncts =
+    "%{" | "%}" | "%%"
+let ocamlyacc_ident = "$" num+
+let linenum_directive = '#' ' ' num+
+                      | '#' ' ' num+ ' ' '\"' [^ '\"']* '\"'
+let built_in_constants = "false" | "true" | "()" | "[]"
+
+rule token = parse
+  | newline
+      {
+	begin
+	  inc_lnum();
+	  token lexbuf;
+	end
+      }
+  | blank +
+      { token lexbuf }
+  | linenum_directive {
+      (get_pos lexbuf, Ttext, Lexing.lexeme lexbuf);
+    }
+  | keywords | camlp4_keywords | ocamlyacc_keywords {
+      (get_pos lexbuf, Tkeyword, Lexing.lexeme lexbuf)
+    }
+  | built_in_constants {
+      (get_pos lexbuf, Tkeyword, Lexing.lexeme lexbuf)
+    }
+  | "/*" { 
+      let pos = get_pos lexbuf in
+	(pos, Tcomment, ocamlyacc_comment 0 "/*" lexbuf);
+    }
+  | "(*" {
+      let pos = get_pos lexbuf in
+	(pos, Tcomment, comment 0 "(*" lexbuf)
+    }
+  | '\"' {
+      let pos = get_pos lexbuf in
+	(pos, Tstring, string "\"" lexbuf) }
+  | puncts | camlp4_puncts | ocamlyacc_puncts {
+      (get_pos lexbuf, Tpunct, Lexing.lexeme lexbuf)
+    }
+  | infix_symbol | prefix_symbol {
+      (get_pos lexbuf, Tident, Lexing.lexeme lexbuf)
+    }
+  | ('~'|'?') label ':' {
+      let s = Lexing.lexeme lexbuf in
+      let name = String.sub s 1 (String.length s - 2) in
+	(get_pos lexbuf, Tident, s)
+    }
+  | ident | ocamlyacc_ident {
+      (get_pos lexbuf, Tident, Lexing.lexeme lexbuf)
+    }
+  | char_lit {
+      (get_pos lexbuf, Tchar, Lexing.lexeme lexbuf)
+    }
+  | int_lit {
+      (get_pos lexbuf, Tint, Lexing.lexeme lexbuf)
+    }
+  | float_lit {
+      (get_pos lexbuf, Tfloat, Lexing.lexeme lexbuf)
+    }
+  | eof { raise EOF }
+  | _
+      { token lexbuf }
+
+and comment lv acc = parse 
+  | newline { 
+      begin
+	inc_lnum();
+	comment lv (acc ^ "\\o") lexbuf;
+      end
+    }
+  | "(*" {
+      comment (lv+1) (acc ^ Lexing.lexeme lexbuf) lexbuf
+    }
+  | "*)" {
+      if lv = 0
+      then
+	acc ^ "*)"
+      else
+	comment (lv-1) (acc ^ Lexing.lexeme lexbuf) lexbuf
+    }
+  | ([^ '\\'] as c1) "\"" {
+      let s = string "\"" lexbuf in
+	match !str_lexbuf with
+	    Some lexbuf -> comment lv (acc ^ Printf.sprintf "%c" c1 ^ s) lexbuf
+    }
+  | char_lit {
+      comment lv (acc ^ Lexing.lexeme lexbuf) lexbuf 
+    }
+  | _ {
+      let s = Lexing.lexeme lexbuf in
+	comment lv (acc^s) lexbuf
+    }
+
+and string acc = parse
+  | newline {
+      begin
+	inc_lnum();
+	string (acc ^ "\\o") lexbuf;
+      end
+    } 
+  | '\"' {
+      begin
+	str_lexbuf := Some lexbuf;
+	acc ^ "\"";
+      end
+      }
+  | escape_sequence {
+      string (acc ^ Lexing.lexeme lexbuf) lexbuf
+    }
+  | char_lit {
+      string (acc ^ Lexing.lexeme lexbuf) lexbuf
+    }
+  | _ {
+      let s = Lexing.lexeme lexbuf in
+	string (acc^s) lexbuf
+    }
+
+and ocamlyacc_comment lv acc = parse 
+  | newline { 
+      begin
+	inc_lnum();
+	ocamlyacc_comment lv (acc ^ "\\o") lexbuf;
+      end
+    }
+  | "/*" {
+      ocamlyacc_comment (lv+1) (acc ^ Lexing.lexeme lexbuf) lexbuf
+    }
+  | "*/" {
+      if lv = 0
+      then
+	acc ^ "*/"
+      else
+	ocamlyacc_comment (lv-1) (acc ^ Lexing.lexeme lexbuf) lexbuf
+    }
+  | "\"" {
+      let s = string "\"" lexbuf in
+	match !str_lexbuf with
+	    Some lexbuf -> ocamlyacc_comment lv (acc ^ s) lexbuf
+    }
+  | char_lit {
+      ocamlyacc_comment lv (acc ^ Lexing.lexeme lexbuf) lexbuf 
+    }
+  | _ {
+      let s = Lexing.lexeme lexbuf in
+	ocamlyacc_comment lv (acc^s) lexbuf
+    }
+

data/lib/langscan/ocaml/types.ml

@@ -0,0 +1,36 @@
+(*
+  camlexer - Lexical Analyzer for Gonzui ocamlsupport
+
+  Copyright (C) 2005 Soutaro Matsumoto <matsumoto@soutaro.com>
+      All rights reserved.
+      This is free software with ABSOLUTELY NO WARRANTY.
+
+  You can redistribute it and/or modify it under the terms of
+  the GNU General Public License version 2.
+*)
+
+(* $Id: types.ml,v 1.1.1.1 2005/09/15 19:38:38 bashi Exp $ *)
+
+type gonzui_type = Tident
+		   | Tpunct
+		   | Tfuncdef
+		   | Ttext
+		   | Tstring
+		   | Tcomment
+		   | Tkeyword
+		   | Tchar
+		   | Tint
+		   | Tfloat
+
+let to_string = function
+    Tident -> "ident"
+  | Tpunct -> "punct"
+  | Tfuncdef -> "funcdef"
+  | Ttext -> "text"
+  | Tstring -> "string"
+  | Tcomment -> "comment"
+  | Tkeyword -> "keyword"
+  | Tchar -> "character"
+  | Tfloat -> "float"
+  | Tint -> "integer"
+

data/lib/langscan/perl.rb

@@ -0,0 +1,87 @@
+#
+# perl.rb - a Perl module of LangScan
+#
+# Copyright (C) 2005 Tatsuhiko Miyagawa <miyagawa@bulknews.net>
+#     All rights reserved.
+#     This is free software with ABSOLUTELY NO WARRANTY.
+#
+# You can redistribute it and/or modify it under the terms of 
+# the GNU General Public License version 2.
+#
+
+dn = "/dev/null"
+dn = "nul" if (/mswin|mingw|bccwin/ =~ RUBY_PLATFORM)
+unless system("perl -MPPI -e 1 2>#{dn}")
+  raise LoadError.new("PPI module is required")
+end
+
+require 'langscan/_common'
+
+module LangScan
+  module Perl
+    module_function
+
+    def name
+      "Perl"
+    end
+
+    def abbrev
+      "perl"
+    end
+
+    def extnames
+      [".pl", ".PL", ".pm", ".t" ] # XXX remove ".t"
+    end
+
+    PERLTOKENIZER_PATH = $LOAD_PATH.map {|path|
+      File.join(path, "langscan/perl/tokenizer.pl")
+    }.find {|path| File.file?(path) }
+    raise "tokenizer.pl not found" if PERLTOKENIZER_PATH.nil?
+
+    def shell_escape(file_name)
+      '"' + file_name.gsub(/([$"\\`])/, "\\\\\\1") + '"'
+    end
+
+    def open_tokenizer 
+      command_line = sprintf("perl %s 2>/dev/null", 
+                             shell_escape(PERLTOKENIZER_PATH))
+      @io = IO.popen(command_line, "r+")
+    end
+
+    # LangScan::Perl.scan iterates over Perl program.
+    # It yields for each Fragment.
+    def scan(input)
+      open_tokenizer if @io.nil? or @io.closed? # in case of Perl error
+      @io.puts(input.length)
+      @io.write(input)
+      inputlen = input.length
+      buflen   = 0
+      begin
+        while (buflen < inputlen)
+          type    = @io.readline.chomp.intern
+          lineno  = @io.readline.chomp.to_i
+          byteno  = @io.readline.chomp.to_i
+          bodylen = @io.readline.chomp.to_i
+          text    = @io.read(bodylen)
+          if type.nil? or text.nil? or lineno.nil? or byteno.nil?
+            raise ScanFailed.new("Unexpected output from tokenizer.pl")
+          end
+          yield Fragment.new(type, text, lineno, byteno)
+          @io.read(1) # newline
+          buflen += bodylen
+        end
+      rescue EOFError
+        @io.close
+        raise  ScanFailed.new("tokenizer.pl failed to parse")
+      end
+    end
+
+    LangScan.register(self)
+  end
+end
+
+
+
+    
+    
+    

data/lib/langscan/perl/tokenizer.pl

@@ -0,0 +1,231 @@
+# tokenizer.pl: tokenize Perl scripts as gonzui langscan format
+#
+# Author:  Tatsuhiko Miyagawa <miyagawa@bulknews.net>
+# License: Same as Perl (Artistic/GPL2)
+#
+
+use strict;
+use PPI::Tokenizer;
+$PPI::Tokenizer::ALLOW_NONASCII = 1;
+
+our $Debug = 0;
+$| = 1;
+
+# TODO:
+# 'string' is abused
+# regexp is string
+# PPI fails to tokenize source code with UTF-8 binary
+
+our(%TokenMap, %ReservedWords, %BuiltinFunctions);
+
+if ($ARGV[0] && $ARGV[0] eq '-d') {
+    # debug mode
+    open my $fh, $ARGV[1] or die "$ARGV[1]: $!";
+    my $code = join '', <$fh>;
+    Tokenizer->new->tokenize(\$code);
+} else {
+    # persistent mode
+    my $tokenizer = Tokenizer->new;
+    while (1) {
+	chomp(my $length = <STDIN>);
+	last unless defined $length;
+	read(STDIN, my($code), $length);
+	$tokenizer->tokenize(\$code);
+	$tokenizer->reset();
+    }
+}
+
+package Tokenizer;
+
+sub new {
+    my $class = shift;
+    my $self = bless { }, $class;
+    $self->reset();
+    $self;
+}
+
+sub reset {
+    my $self = shift;
+    $self->{lineno}     = 0;
+    $self->{byteno}     = 0;
+    $self->{heredoc}    = undef;
+    $self->{in_sub}     = undef;
+    $self->{in_package} = undef;
+    $self->{in_arrow}   = undef;
+    $self->{in_usereq}  = undef;
+}
+
+sub tokenize {
+    my($self, $coderef) = @_;
+    my $tokenizer = PPI::Tokenizer->new($coderef) or die "Can't tokenize code: $$coderef";
+    while (my $token = $tokenizer->get_token) {
+	$self->dump_element($token);
+    }
+    my $code_length = length $$coderef;
+    $self->{byteno} == $code_length or die "Tokenize error: $self->{byteno}:$code_length";
+}
+
+sub dump_element {
+    my($self, $element) = @_;
+    if ($element->isa('PPI::Token::HereDoc')) {
+	$self->_dump("punct", $element->content);
+	$self->{heredoc} ||= [];
+	push @{$self->{heredoc}}, {
+	    body => $element->{_heredoc},
+	    eof  => $element->{_terminator_line},
+	};
+	return;
+    } elsif ($self->{heredoc} && $element->isa('PPI::Token::Whitespace') && $element->content eq "\n") {
+	$self->_dump(token_name($element), $element->content);
+	for my $heredoc (@{$self->{heredoc}}) {
+	    $self->_dump(string => join "", @{$heredoc->{body}});
+	    $self->_dump(punct  => $heredoc->{eof});
+	}
+	$self->{heredoc} = undef;
+	return;
+    } elsif ($element->isa('PPI::Token::Word') && $element->content eq 'sub') {
+	$self->{in_sub} = 1;
+    } elsif ($element->isa('PPI::Token::Word') && $element->content eq 'package') {
+	$self->{in_package} = 1;
+    } elsif ($element->isa('PPI::Token::Word') && ($element->content eq 'use' || $element->content eq 'require')) {
+	$self->{in_usereq} = 1;
+    } elsif ($element->isa('PPI::Token::Operator') && $element->content eq '->') {
+	$self->{in_arrow} = 1;
+    } elsif ($self->{in_sub} && !$element->isa('PPI::Token::Whitespace')) {
+	$self->{in_sub} = undef;
+	if ($element->isa('PPI::Token::Word')) {
+	    warn "sub $element->{content}\n" if $Debug;
+	    $self->_dump(fundef => $element->content);
+	    return;
+	}
+    } elsif ($self->{in_package} && !$element->isa('PPI::Token::Whitespace')) {
+	$self->{in_package} = undef;
+	if ($element->isa('PPI::Token::Word')) {
+	    warn "package $element->{content}\n" if $Debug;
+	    $self->_dump(classdef => $element->content);
+	    return;
+	}
+    } elsif ($self->{in_arrow} && !$element->isa('PPI::Token::Whitespace')) {
+	$self->{in_arrow} = undef;
+	if ($element->isa('PPI::Token::Word')) {
+	    warn "->$element->{content}\n" if $Debug;
+	    $self->_dump(funcall => $element->content);
+	    return;
+	}
+    } elsif ($self->{in_usereq} && !$element->isa('PPI::Token::Whitespace')) {
+	$self->{in_usereq} = undef;
+	if ($element->isa('PPI::Token::Word')) {
+	    warn "use $element->{content}\n" if $Debug;
+	    $self->_dump(classref => $element->content);
+	    return;
+	}
+    }
+    $self->_dump(token_name($element), $element->content);
+}
+
+sub _dump {
+    my($self, $type, $text) = @_;
+    my $bodysize = length $text;
+    print <<DUMP;
+$type
+$self->{lineno}
+$self->{byteno}
+$bodysize
+$text
+DUMP
+    ;
+    $self->{byteno} += $bodysize;
+    $self->{lineno} += $text =~ tr/\n//d;
+}
+
+sub token_name {
+    my $token = shift;
+    if ($token->isa('PPI::Token::Word')) {
+	return $ReservedWords{$token->content} ? "keyword" :
+	    $BuiltinFunctions{$token->content} ? "funcall" : "word";
+    } elsif (ref($token) eq 'PPI::Token::Number') {
+	return $token->{_subtype} eq 'base256' ? "floating" : "integer";
+    }
+    $TokenMap{ref($token)} || "word";
+}
+
+BEGIN {
+    %TokenMap = qw(
+PPI::Token::ArrayIndex            ident
+PPI::Token::Attribute             fundef
+PPI::Token::Cast                  punct
+PPI::Token::Comment               text
+PPI::Token::DashedWord            punct
+PPI::Token::Data                  text
+PPI::Token::End                   punct
+PPI::Token::HereDoc               *
+PPI::Token::Label                 word
+PPI::Token::Magic                 punct
+PPI::Token::Number                *
+PPI::Token::Operator              punct
+PPI::Token::Pod                   text
+PPI::Token::Prototype             punct
+PPI::Token::Quote::Double         string
+PPI::Token::Quote::Interpolate    string
+PPI::Token::Quote::Literal        string
+PPI::Token::Quote::Single         string
+PPI::Token::QuoteLike::Backtick   string
+PPI::Token::QuoteLike::Command    string
+PPI::Token::QuoteLike::Readline   string
+PPI::Token::QuoteLike::Regexp     string
+PPI::Token::QuoteLike::Words      string
+PPI::Token::Regexp::Match         word
+PPI::Token::Regexp::Substitute    word
+PPI::Token::Regexp::Transliterate word
+PPI::Token::Separator             punct
+PPI::Token::Structure             punct
+PPI::Token::Symbol                ident
+PPI::Token::Unknown               punct
+PPI::Token::Whitespace            punct
+PPI::Token::Word                  *
+);
+
+    # borrowed from Apache::PrettyPerl, with slight fixes
+    %ReservedWords = map { $_ => 1 } qw(
+	while until for foreach unless if elsif else do
+	package use no require import and or eq ne cmp
+        my our local next last redo goto return sub
+    );
+    %BuiltinFunctions = map { $_ => 1 } qw(
+	abs accept alarm atan2 bind binmode bless
+	caller chdir chmod chomp chop chown chr
+	chroot close closedir connect continue cos
+	crypt dbmclose dbmopen defined delete die
+	dump each endgrent endhostent endnetent
+	endprotoent endpwent endservent eof eval
+	exec exists exit exp fcntl fileno flock
+	fork format formline getc getgrent getgrgid
+	getgrnam gethostbyaddr gethostbyname gethostent
+	getlogin getnetbyaddr getnetbyname getnetent
+	getpeername getpgrp getppid getpriority
+	getprotobyname getprotobynumber getprotoent
+	getpwent getpwnam getpwuid getservbyname
+	getservbyport getservent getsockname
+	getsockopt glob gmtime goto grep hex index
+	int ioctl join keys kill last lc lcfirst
+	length link listen local localtime log
+	lstat map mkdir msgctl msgget msgrcv
+	msgsnd my next oct open opendir ord our pack
+	pipe pop pos print printf prototype push
+	quotemeta rand read readdir readline
+	readlink readpipe recv redo ref rename
+	reset return reverse rewinddir rindex
+	rmdir scalar seek seekdir select semctl
+	semget semop send setgrent sethostent
+	setnetent setpgrp setpriority setprotoent
+	setpwent setservent setsockopt shift shmctl
+	shmget shmread shmwrite shutdown sin sleep
+	socket socketpair sort splice split sprintf
+	sqrt srand stat study sub substr symlink
+	syscall sysopen sysread sysread sysseek
+	system syswrite tell telldir tie tied
+	time times truncate uc ucfirst umask undef
+	unlink unpack unshift untie utime values
+	vec wait waitpid wantarray warn write
+    );
+}