juster avatar juster committed 09947d5

Adds all files to new HG repo.

Comments (0)

Files changed (24)

+syntax: glob
+_build
+*~
+*.output
+.git*
+*.byte
+*.native
+
+pkgname="test"
+
+echo "I'm building I swear!"
+open Bashparams
+open Printf
+
+module Bashexpand =
+  struct
+
+    (** Our error stores the index of the character where parsing failed. *)
+    exception ExpandError       of int
+    exception UnbalancedBracket of int
+
+    let get_param name plist =
+      printf "*DBG* get_param: name=%s\n" name ;
+      try List.assoc name plist
+      with Not_found -> Bashparams.param_of_string ""
+
+    let set_param name param plist =
+      (name, param) :: List.remove_assoc name plist
+
+    let parameter_expand str params =
+
+      (* Recursive helper function for parameter_expand. *)
+      let rec pexpand str idx params =
+
+        let rec expand_name str idx params =
+
+          let inbrackets = fun str -> function (idx, name) ->
+            match str.[idx] with
+              '}' -> (idx+1, name)
+            | _   -> raise Not_found
+          in
+
+          let extractname str idx =
+            if Str.string_match (Str.regexp "[a-zA-Z_-]+") str idx then
+              (Str.match_end (), Str.matched_string str)
+            else
+              raise (ExpandError idx)
+          in
+
+          printf "*DBG* str=%s idx=%d\n" str idx ;
+          
+          match str.[idx] with
+          | '$' ->
+              begin
+                try
+                  match expand_name str (idx+1) params with (newidx, name) ->
+                    (newidx, Bashparams.string_of_param (get_param name params))
+                with Invalid_argument(_) -> raise (ExpandError idx)
+              end
+          | '{' ->
+              begin
+                try inbrackets str (expand_name str (idx+1) params)
+                with Invalid_argument(_) -> raise (UnbalancedBracket idx)
+              end
+          | _ ->
+              match extractname str idx with (newidx, name) ->
+                (newidx, Bashparams.string_of_param (get_param name params))
+        in (* end of expand_name *)
+
+        try
+          let sigidx = String.index_from str idx '$' in
+          begin
+            try
+              let donechunk = String.sub str idx (sigidx - idx) in
+              match expand_name str (sigidx+1) params
+              with (nextidx, expanded) ->
+                donechunk ^ expanded ^ (pexpand str nextidx params)
+
+            (* This exception means the $ is at the end of the string. *)
+            with Invalid_argument(_) -> raise (ExpandError sigidx)
+          end
+        with Not_found ->
+          (* There are no more $'s we are done. *)
+          let len = String.length str in String.sub str idx (len - idx)
+      in (* end of pexpand *)
+
+      pexpand str 0 params
+
+  end
+
+let _ =
+  let paramslist = [ ("FOO", Bashparams.param_of_string "BAR") ;
+                     ("BAR", Bashparams.param_of_string "Hello, World!") ] in
+  print_endline (Bashexpand.parameter_expand "01$" paramslist)
+module Bashparams =
+  struct
+    type t = PString of string | PArray of string list
+
+    (** Create a parameter defined simply. ex: FOO=bar *)
+    let param_of_string rawstr = PString(rawstr)
+
+    (** Create a parameter defined as an array. ex: FOO=(bar baz) *)
+    let param_of_list rawstrlist = PArray(rawstrlist)
+
+    (** This is equivalent to expanding ${FOO[0]} in bash. *)
+    let string_of_array_elem param idx =
+      match param with
+        PString(str)  -> if idx > 0 then "" else str
+      | PArray (strs) -> try List.nth strs idx with Failure(_) -> ""
+
+    (** This is equivalent to expanding ${FOO[@]} in bash. *)
+    let string_of_array param =
+      match param with
+        PString(str)     -> str
+      | PArray (strlist) -> String.concat " " strlist
+
+    (** This is equivalent to expanding $FOO in bash. *)
+    let string_of_param param =
+      match param with
+        PString(str) -> str
+      | PArray (_)   -> string_of_array_elem param 0
+  end
+module Bashparams :
+    sig
+      type t
+
+      val param_of_string      : string -> t
+      val param_of_list        : string list -> t
+
+      val string_of_array_elem : t -> int -> string
+      val string_of_array      : t -> string
+      val string_of_param      : t -> string
+    end
+open Printf
+open Pbparsel
+open Pbparsey
+
+let string_of_token = function
+  | ASSIGN(line,name) -> sprintf "ASSIGN(%d, %s)" line name
+  | WORD(line,str) -> sprintf "WORD(%d, %s)" line str
+  | ASSIGNWORD(str) -> sprintf "ASSIGNWORD(%s)" str
+  | LPAREN -> "LPAREN"
+  | RPAREN -> "RPAREN"
+  | LARROW -> "LARROW"
+  | RARROW -> "RARROW"
+  | LCURLY -> "LCURLY"
+  | RCURLY(line) -> "RCURLY"
+  | SEMI   -> "SEMI"
+  | ENDL   -> "ENDL"
+  | EOF    -> "EOF"
+  | FOR    -> "FOR"
+  | IN     -> "IN"
+  | DO     -> "DO"
+  | DONE   -> "DONE"
+  | AND    -> "AND"
+  | AND_AND -> "AND_AND"
+  | OR_OR   -> "OR_OR"
+
+let print_token tok =
+  print_endline (string_of_token tok)
+
+let rec stream_tokens lexbuf =
+  let tok = pblex lexbuf in
+  print_token tok ;
+  match tok with EOF -> () | _ -> stream_tokens lexbuf
+
+let _ =
+  let lexbuf = Lexing.from_channel (open_in "PKGBUILD") in
+  stream_tokens lexbuf
+{
+open List
+open Expy
+
+let needs_ident = ref false
+
+let bracket_stack = ref []
+
+let reset_pbexp unit =
+  needs_ident := false ;
+  bracket_stack := [] ;
+  ()
+
+let begin_bracket unit =
+  bracket_stack := 1 :: !bracket_stack
+
+let active_bracket unit =
+  match !bracket_stack with
+    [] -> false | hd::tl -> true
+
+let push_bracket unit =
+  match !bracket_stack with
+    [] -> failwith "Bracket stack is empty"
+  | count :: tl ->
+      bracket_stack := ( count + 1 ) :: tl ; ()
+
+let pop_bracket unit =
+  match !bracket_stack with
+    [] -> failwith "Bracket stack is empty"
+  | count :: tl ->
+      begin
+        if count - 1 == 0 then
+          bracket_stack := tl
+        else
+          bracket_stack := ( count - 1 ) :: tl
+      end ;
+      count - 1
+}
+
+let ident = ['a'-'z' 'A'-'Z' '0'-'9' '_'] +
+
+rule pbexplex = parse
+| "\\$"
+    { RAWTEXT( "\\$" ) }
+| '$'
+    { needs_ident := true; SIGIL }
+| ident as name
+    { if !needs_ident then ( needs_ident := false; IDENT( name ) )
+    else RAWTEXT( name ) }
+| "${"
+    { needs_ident := true; begin_bracket (); SOPEN }
+| '{'
+    {
+  ( if active_bracket () then push_bracket () );
+  RAWTEXT( "{" )
+}
+| '}'
+    {
+  if active_bracket () then
+    if pop_bracket () == 0 then SCLOSE else RAWTEXT( "}" )
+  else RAWTEXT( "}" )
+}
+| ":-"
+    { if active_bracket () then SUBDEF else RAWTEXT( ":-" ) }
+| ":="
+    { if active_bracket () then SUBSET else RAWTEXT( ":=" ) }
+| ":?"
+    { if active_bracket () then SUBERR else RAWTEXT( ":?" ) }
+| _ as ch
+    { RAWTEXT( String.make 1 ch ) }
+| eof
+    { EOF }
+
+open Printf
+
+let _ =
+  let print_token tok =
+    print_endline
+      (match tok with
+        RAWTEXT( txt ) -> ("RAWTEXT: '" ^ txt ^ "'")
+      | IDENT( name ) -> ("IDENT: " ^ name)
+      | SIGIL -> "SIGIL"
+      | SOPEN -> "SOPEN"
+      | SCLOSE -> "SCLOSE"
+      | SUBDEF -> "SUBDEF"
+      | SUBSET -> "SUBSET"
+      | SUBERR -> "SUBERR"
+      | EOF    -> "EOF") in
+      
+  let rec dump_tokens lexbuf =
+    let tok = pbexplex lexbuf in
+    if (match tok with EOF -> false | _ -> true) then
+      (print_token tok; dump_tokens lexbuf)
+    else () in
+
+  let test_it msg =
+    dump_tokens (Lexing.from_string msg);
+    ignore (Parsing.set_trace true);
+    let lbuf = Lexing.from_string msg in
+    let presult = try pbexp pbexplex lbuf
+    with Parsing.Parse_error -> begin
+      ignore (Parsing.set_trace false);
+      failwith (sprintf "Error at chars %d-%d >>> %s"
+                  (Lexing.lexeme_start lbuf)
+                  (Lexing.lexeme_end lbuf)
+                  msg)
+    end
+    in
+    ignore (Parsing.set_trace false);
+    presult
+  in
+  
+  test_it "${FOO:=BAR} ${BAR:?OMG where is $FOO?}"
+%{
+
+open Pbparams
+
+let retrieve = Pbparams.param_string
+let assign   = Pbparams.assign_string
+
+%}
+
+%token <string> RAWTEXT
+%token <string> IDENT
+%token SIGIL SOPEN SCLOSE
+%token SUBDEF SUBSET SUBERR
+%token EOF
+
+%start pbexp
+%type <string> pbexp
+
+%%
+
+pbexp:
+| param pbexp   { $1 ^ $2 }
+| text  pbexp   { $1 ^ $2 }
+|               { "" }
+| EOF           { "" }
+
+param:
+| SIGIL pname        { try retrieve $2 with Not_found -> "" }
+| SOPEN pname SCLOSE { try retrieve $2 with Not_found -> "" }
+| SOPEN pname SUBDEF pbexp SCLOSE
+    { try retrieve $2 with Not_found -> $4 }
+| SOPEN pname SUBSET pbexp SCLOSE
+    { try retrieve $2
+      with Not_found ->
+        assign $2 $4 ;
+        retrieve $2
+    }
+| SOPEN pname SUBERR pbexp SCLOSE
+    { try retrieve $2 with Not_found -> failwith $4 }
+
+text:
+| RAWTEXT { $1   }
+| SUBDEF  { ":-" (* Convert meta-chars in wrong place back to text *) }
+| SUBSET  { ":=" (* All ways around this problem seem hackish. *)     }
+| SUBERR  { ":?" (* Owell... *) }
+
+pname:
+| IDENT { $1 }
+| param { $1 }
+
+%%
+
+* Bash Expansion
+** Parameter Expansion
+
+*** Arrays VS "Scalars"
+
+I forget what non-arrays are called. Anyways...
+I want to make sure I understand how treating an array like a "scalar" or
+a "scalar" like an array when expanding will give different results.
+Copying these results so we can fail predictably would be nice.
+
+1) A scalar is expanded
+
+   :declare FOO=bar
+   :echo $FOO
+
+   Result: bar
+
+   Duh.
+
+2) An array is expanded
+
+   :declare -a FOO=(bar baz)
+   :echo $FOO
+
+   Result: bar
+
+   Only the first element is expanded out.
+
+3) An indexed scalar is expanded
+
+   :declare FOO='bar baz'
+   :echo ${FOO[0]}
+
+   Result: bar baz
+
+   When indexing a scalar, it is equivalent to a one-element array
+
+4) An indexed array is expanded
+
+   Duh.
+
+5) A scalar is expanded for all elements (with @)
+
+   :declare FOO='hello world'
+   :echo ${FOO[@]}
+
+   Result: hello world
+
+6) An array is expanded for all elements (with @)
+
+   Duh.
+
+
+module Pbcollect =
+  struct
+    (** The type of data we can collect on a PKGBUILD. *)
+    let pb_collection : pbdata list ref = ref []
+
+    let reset unit =
+      pb_collection := [] ; ()
+
+    let add newrec =
+      pb_collection := newrec :: !pb_collection ; ()
+
+    let results unit =
+      List.rev !pb_collection
+  end
+type pbdata =
+    Assignment of (string * string list * string list)
+  | Command    of (string * string)
+  | Async      of (cmd)
+  | Function   of (string * (int * pbdata) list)
+  | SyntaxError
+
+module Pbcollect :
+  sig
+    (** The type of data we can collect on a PKGBUILD. *)
+    val reset   : unit -> unit
+    val collect : int -> pbdata -> unit
+    val results : unit -> (int * pbdata) list
+  end
+
+
+open Expy
+open Expl
+
+module Pbexpand =
+  struct
+    let find_unescaped_from str idx findme =
+      let rec find_from findme str idx len =
+        let foundidx = String.index_from str idx findme in
+        if str.[foundidx-1] != '\\' || foundidx == 0 then
+          foundidx
+        else if (foundidx + 1) == len then
+          raise Not_found
+        else
+          find_from findme str (foundidx + 1) len
+      in find_from findme str idx (String.length str)
+
+    exception Unbalanced_quotes of int
+
+    let string str =
+      let rec rawexpand str =
+      pbexp pbexplex (Lexing.from_string str)
+
+      and split_and_rec str len begidx endidx action =
+        let oldstr = String.sub str 0 begidx in
+        let midstr = String.sub str (begidx+1) (endidx-1-begidx) in
+        let remstr = (* remaining str to process *)
+          if endidx == (len-1) then ""
+          else String.sub str (endidx+1) (len-(endidx+1)) in
+        try
+          (rawexpand oldstr)
+          ^ (action midstr)
+          ^ (expand_from remstr 0 (String.length remstr))
+        with
+          Unbalanced_quotes(idx) -> raise (Unbalanced_quotes (idx+endidx+1))
+              
+      and expand_from str idx len =
+        if idx == len then
+          rawexpand str
+        else try
+          match str.[idx] with
+        (* Expands everything except text in single-quotes *)
+            '\'' ->
+              let endidx = String.index_from str (idx+1) '\'' in
+              split_and_rec str len idx endidx (fun str -> str)
+          | '"' ->
+              let endidx = find_unescaped_from str (idx+1) '"' in
+              split_and_rec str len idx endidx rawexpand
+          | _ ->
+              expand_from str (idx+1) len
+        with
+          Invalid_argument(_) | Not_found -> raise (Unbalanced_quotes idx)
+
+      in
+
+      reset_pbexp () ;
+      expand_from str 0 (String.length str)
+
+    let list strlist = List.map string strlist
+  end
+module Pbexpand :
+    sig
+      val string : string -> string
+      val list : string list -> string list
+
+      exception Unbalanced_quotes of int
+    end
+
+  
+module Pbparams =
+  struct
+    type t = PString of string | PArray of string list
+
+    let param_values : (string * t) list ref = ref []
+
+    let prepend_value pname newval =
+      param_values := (pname, newval) :: !param_values ; ()
+
+    let assign_string pname strval =
+      prepend_value pname (PString strval)
+
+    let assign_array pname strlist =
+      prepend_value pname (PArray strlist)
+
+    let array_elem param idx =
+      match param with
+        PString(str) -> if idx > 0 then 
+
+    let param_array pname =
+      match List.assoc pname !param_values with
+        PString(str)    -> [ str ]
+      | PArray(strlist) -> strlist
+
+    let param_string pname =
+      match List.assoc pname !param_values with
+        PString(str)    -> str
+      | PArray(strlist) -> String.concat " " strlist
+
+    let list unit = List.rev !param_values
+
+    let reset unit =
+      param_values := [] ; ()
+  end
+
+let string_of_param pbv =
+  match pbv with
+    Pbparams.PString(str) -> "'" ^ str ^ "'"
+  | Pbparams.PArray(strlist) ->
+      "(" ^
+      (String.concat " "
+         (List.map (fun str -> "'" ^ str ^ "'") strlist))
+      ^ ")"
+module Pbparams :
+    sig
+      type t = PString of string | PArray of string list
+      val assign_string : string -> string -> unit
+      val assign_array  : string -> string list -> unit
+      val param_array   : string -> string list
+      val param_string  : string -> string
+      val list  : unit -> (string * t) list
+      val reset : unit -> unit
+    end
+
+val string_of_param : Pbparams.t -> string
+
+open Pbparsey
+open Pbparsel
+
+let pbparse_string pbstr =
+  pbparse pblex (Lexing.from_string pbstr)
+
+let pbparse_channel pbchan =
+  pbparse pblex (Lexing.from_channel pbchan)
+(* Bash parsing is very context-dependent. The idea is to remove
+   the problem of context in this lexer. *)
+
+{
+open Pbparsey
+open Lexing
+open Printf
+
+(* The lexer has different custom states that account for this
+   context sentitivity.
+
+   PreCommand: We have not yet parsed a command and/or its arguments.
+     It is possible that we will read an 'ASSIGN=VAL' pair now.
+
+   AssignVal: We have previously read a 'VAR=' expression and we are
+     now expecting to read that variable's value.
+
+   CompoundVal: We are assigning a compound value to a parameter.
+     Compound values are surrounded by ( ... ) and follow a
+     VAR= expression.
+
+   Command: Now we parsed a command that was definately not an
+     assignment. Assignments are no longer allowed, if we see a
+     VAR= expression we treat it a command line argument!
+ *)
+
+type lexing_state = PreCommand | AssignVal | CompoundVal | Command
+
+let string_of_lexstate = function
+  | PreCommand  -> "PreCommand"
+  | AssignVal   -> "AssignVal"
+  | CompoundVal -> "CompoundVal"
+  | Command     -> "Command"
+
+let quote_start      = ref 0
+let func_quote_count = ref 0
+let lex_state        = ref PreCommand
+let compound_started = ref false
+
+let print_lexstate unit =
+  print_endline ("*DBG* LEX STATE = " ^ (string_of_lexstate !lex_state))
+
+let lex_linenum lbuf =
+  let pos = Lexing.lexeme_start_p lbuf in
+  pos.pos_lnum
+
+let rec count_newlines str idx =
+  try
+    let nlidx = String.index_from str idx '\n' in
+    1 + (count_newlines str (nlidx + 1))
+  with Not_found -> 0
+
+let note_newlines str lexbuf =
+  for unused = 1 to (count_newlines str 0) do
+    Lexing.new_line lexbuf
+  done ;
+  ()
+
+(* Use this to tokenize a word (string literal) and adjust our state. *)
+let tokenize_word str lbuf =
+  match !lex_state with
+    PreCommand  -> lex_state := Command ; WORD(lex_linenum lbuf, str)
+  | AssignVal   -> lex_state := PreCommand ; ASSIGNWORD(str)
+  | CompoundVal -> ASSIGNWORD(str)
+  | Command     -> WORD(lex_linenum lbuf, str)
+
+(* Reserved words must be at the beginning of a command. *)
+let reserved_words = [ ("for", FOR); ("done", DONE) ]
+
+let max_queue_size = 5
+let last_tokens = Array.make max_queue_size EOF
+
+let token_push tok =
+  let last = (max_queue_size - 1) in
+  begin
+    match (tok, last_tokens.(last)) with
+    (* Don't record spacer tokens. *)
+      (SEMI, _) | (ENDL, _) -> ()
+    (* Make matching a wordlist the same as matching a word.
+       We will have to catch any problems in the grammar. *)
+    | (WORD(_,_), WORD(_,_)) -> last_tokens.(last) <- tok
+    | _ ->
+        Array.blit last_tokens 1 last_tokens 0 (max_queue_size - 1) ;
+        last_tokens.(last) <- tok ;
+  end ;
+  tok
+
+(* let dump_history unit = *)
+(*   Array.iter (fun t -> printf "*DBG* token: %s\n" *)
+(*       (string_of_token t)) last_tokens *)
+
+exception Cmd_context
+
+(* If a given word matches a reserved word then return its token. *)
+let reserved_word_token word =
+  List.assoc word reserved_words
+
+(* Similar to the function at line 2665 of bash's parse.y *)
+let special_case_token word =
+  match (word, last_tokens)  with
+    ("in", [| _; _; _; FOR; WORD(_,_) |]) -> IN
+  | ("do", [| _; FOR; WORD(_,_); IN; WORD(_,_) |]) ->
+      lex_state := PreCommand ; DO
+  | _ -> raise Not_found
+
+let match_assignment word =
+  let len = String.length word in
+  if len < 2 then false
+  else word.[len-1] == '='
+
+(* Returns a token which depends on several kinds of context. *)
+let context_token lexbuf word =
+  let linenum = lex_linenum lexbuf in
+  try
+    match !lex_state with
+    (* Assignments or reserved words come before commands. *)
+      PreCommand ->
+      (* TODO: find a way not to match the '=' char twice
+         (we do this in lexword too) *)
+        if match_assignment word then begin
+          let name = String.sub word 0 ((String.length word) - 1) in
+          lex_state := AssignVal ;
+          ASSIGN(linenum, name)
+        end
+        else reserved_word_token word
+    (* tokenize_word takes care of state and token type for us *)
+    | AssignVal | CompoundVal -> raise Not_found
+    (* Special tokens can even come after what appear to be commands. *)
+    | Command -> special_case_token word
+  with Not_found -> tokenize_word word lexbuf
+}
+
+let word_re = [ ^ ';' '{' '}' '<' '>' '(' ')' '#' '\'' '"' ' ' '=' '&' '|'
+                  '\t' '\n' ] *
+
+(* Try to parse as many special characters as possible using
+   ocamllex's rules. *)
+rule pkgbuildlex = parse
+| '#' [ ' ' '\t' ]* [^'\n']*
+    { (* TODO: record comments using Pbcollect? *)
+      pkgbuildlex lexbuf }
+| [ ' ' '\t' ] + { pkgbuildlex lexbuf }
+| '\n' { Lexing.new_line lexbuf ; lex_state := PreCommand ; ENDL }
+| '\'' {
+  (* A singlequote... it may have a word directly behind it! *)
+  (* This can also start a command string, since commands can be quoted. *)
+  let qc = single_quoted lexbuf in
+  let trail = lexword lexbuf    in
+  tokenize_word ("'" ^ qc ^ "'" ^ trail) lexbuf 
+}
+| '"' {
+  let qc = double_quoted lexbuf in
+  let trail = lexword lexbuf    in
+  tokenize_word ("\"" ^ qc ^ "\"" ^ trail) lexbuf 
+}
+(* When unquoted these usually have special meaning *)
+| ';' { lex_state := PreCommand ; SEMI }
+| '<' { LARROW }
+| '>' { RARROW }
+| '{' ( [ ' ' '\t' '\n' ]+ as ws ) {
+  note_newlines ws lexbuf ;
+  (* Subshell lists must be at the beginning of the command line *)
+  if !lex_state == PreCommand then LCURLY( lex_linenum lexbuf )
+  else
+    (* Since function defs follow a string we will be in Command state *)
+    match last_tokens with
+      [| _; _; WORD(_,_); LPAREN; RPAREN |] -> LCURLY( lex_linenum lexbuf )
+    | _ -> WORD(lex_linenum lexbuf, "{")
+  (* TODO: Arithmetic for loops? *)
+}
+(* Should we count open curly brackets? *)
+| '}' {
+  if !lex_state == PreCommand then (RCURLY (lex_linenum lexbuf))
+  else WORD(lex_linenum lexbuf, "}")
+}
+| '(' {
+  if !lex_state == AssignVal then lex_state := CompoundVal else () ;
+  LPAREN
+}
+| ')' {
+  if !lex_state == CompoundVal then lex_state := PreCommand else () ;
+  RPAREN
+}
+| '&'  { lex_state := PreCommand ; AND }
+| "&&" { lex_state := PreCommand ; AND_AND }
+| "||" { lex_state := PreCommand ; OR_OR }
+| eof  { EOF }
+| _ as ch {
+  let word = (String.make 1 ch) ^ (lexword lexbuf) in
+  context_token lexbuf word
+}
+
+and lexword = parse
+| ( word_re as word ) ( [ '\'' '"' '=' ] ? as suffix )
+{
+  match (word, suffix) with
+  (* Check for an assignment. *)
+    (_, "=") -> 
+      if !lex_state == PreCommand then word ^ "="
+      else
+        (* Treat it just as a simple word. *)
+        word ^ "=" ^ (lexword lexbuf)
+
+  (* If a quoted string abuts a non-quoted string concat them. *)
+  | ("", "") -> ""
+  | (_,  "") -> word
+  | (_, "'") ->
+      let qc = single_quoted lexbuf in
+      word ^ "'"  ^  qc ^ "'" ^ (lexword lexbuf)
+  | (_,"\"") ->
+      let qc = double_quoted lexbuf in
+      word ^ "\"" ^ qc ^ "\"" ^ (lexword lexbuf)
+  | (_, _)   -> failwith(sprintf "lexword match error: word=%s; quote=%s"
+                           word suffix)
+}
+
+and single_quoted = parse
+| ( [^'\''] * as contents ) '\''
+    { note_newlines contents lexbuf; contents }
+| _ 
+    { failwith ("No closing single-quote (') found.") }
+| eof
+    { failwith ("No closing single-quote (') found.") }
+
+and double_quoted = parse
+| "\\\""
+    { "\\\"" ^ (double_quoted lexbuf) }
+| '"'
+    { "" }
+| _ as ch
+    { (String.make 1 ch) ^ (double_quoted lexbuf) }
+| eof
+    { failwith (sprintf "Line %d: No closing double-quote (\") found.\n"
+                  !quote_start) }
+
+{
+
+(* Wrap the ocamlyacc generated function in order to keep track of
+   the last few tokens. *)
+let pblex lexbuffer =
+  token_push (pkgbuildlex lexbuffer)
+} 
+
+(* Local Variables: *)
+(* mode: caml       *)
+(* End:             *)
+%{
+
+open Pbexpand
+open Pbparams
+open Pbwarn
+
+open Lexing
+open Printf
+
+(* let parse_error msg = () *)
+
+(* let collect_error () = *)
+(*   let pos = Parsing.symbol_start_pos () in *)
+(*   Pbcollect.collect pos.pos_lnum SyntaxError *)
+
+let warn_level  = ref Pbwarn.Style
+let level_check = Pbwarn.is_level_active !warn_level
+
+let style = Pbwarn.style    level_check
+let bad   = Pbwarn.bad      level_check
+let omg   = Pbwarn.horrible level_check
+
+let functions_defined = ref []
+
+(* Structure the source code the way we want to using data types
+   instead of just tokens. *)
+
+(* An assignment contains a parameter name and word list to assign. *)
+type assignment = { name : string ; content : string list }
+
+type command =
+    (* Assignments followed by program name and arguments. *)
+  | Command      of (assignment list * string list)
+  | CommandOr    of (command * command)
+  | CommandAnd   of (command * command)
+  | CommandAsync of (command)
+    (* Function bodies are usually a Group command. *)
+  | Function of (string * command)
+  | Control  of shell_command
+and shell_command =
+    (* Commands inside of a grouping have their own line-number. *)
+  | Group    of (int * command) list
+
+let good_varnames =
+  [ "pkgname"; "pkgver"; "pkgrel"; "pkgdesc"; "arch"; "url"; "license";
+    "groups"; "depends"; "makedepends"; "optdepends"; "provides";
+    "conflicts"; "replaces"; "backup"; "options"; "install";
+    "source"; "noextract";
+    "md5sums"; "sha1sums"; "sha256sums"; "sha384sums"; "sha512sums"; ]
+
+let check_top_varname lineno varname =
+  if not (List.memq varname good_varnames) then
+    if not (Str.string_match (Str.regexp "^_[a-z0-9]+$") varname 0) then
+      style lineno
+        ("The custom variable '" ^ varname ^ "' should be lowercase "
+         ^ "and preceded by an underscore ('_').")
+
+(* Check top assignments to make sure they follow style guidelines. *)
+let rec check_top_assign lineno assignlist =
+  match assignlist with
+  | []     -> ()
+  | hd::tl ->
+      check_top_varname lineno hd.name ; check_top_assign lineno tl
+        
+(* Checking commands at the global-toplevel is easy. Commands should
+   only consist of assignments! *)
+let check_top_simple_cmd lineno alist clist =
+  check_top_assign lineno alist ;
+  if (List.length clist) > 0 then
+    let cmdstr = String.concat " " clist in
+    bad lineno ("Command \"" ^ cmdstr ^ "\" is executed globally, before "
+                ^ "build() is called.")
+    
+(* Warn about unexpected function names, in case they are typod. *)
+let check_func lineno name cmds =
+  if not (List.memq name ["build"; "package"]) then
+    style lineno
+      ("Function \"" ^ name ^ "\" is not named \"build\" or \"package\".") 
+    
+let rec check_top_cmd line cmd =
+  match cmd with
+  | Command(alist, clist) ->
+      check_top_simple_cmd line alist clist
+  | CommandOr(lcmd,rcmd)
+  | CommandAnd(lcmd,rcmd) ->
+      check_top_cmd line lcmd ;
+      check_top_cmd line rcmd
+  | CommandAsync(cmd) ->
+      check_top_cmd line cmd
+  | Function(name, cmds) ->
+      check_func line name cmds
+  | Control(_) ->
+      failwith "Shell control commands are not yet implemented."
+
+(* let kill_options cmdargs = *)
+(*   List.filter begin fun str -> *)
+(*     match str.[0] with '-' -> false | _ -> true *)
+(*   end cmdargs *)
+
+(* let invalid_paths cmdargs = *)
+(*   List.filter begin fun str -> *)
+(*     not (Str.string_match (Str.regexp "SRCDIR|PKGDIR") str 0) *)
+(*   end cmdargs *)
+
+(* let check_function name cmds = *)
+(*   functions_defined := name :: !functions_defined ; *)
+(*   List.iter begin function *)
+(*       (line, "rm"::tl) -> *)
+(*         if List.length (invalid_paths (kill_options tl)) > 0 then *)
+(*           omg line (name ^ "():Malicious 'rm' command: " *)
+(*                     ^ (String.concat "\n" ("rm"::tl)) ^ "\n") *)
+(*     | _ -> () *)
+(*   end cmds *)
+
+let list_pop_last l =
+  let rec popper l a =
+    match l with 
+    | []     -> raise Not_found (* l was empty from the start. *)
+    | hd::[] -> hd::(List.rev a)
+    | hd::tl -> popper tl (hd::a)
+  in popper l []
+
+%}
+
+%token <int * string> ASSIGN WORD
+%token <string> ASSIGNWORD
+%token LPAREN RPAREN LARROW RARROW
+%token <int> LCURLY RCURLY
+%token FOR IN DO DONE
+%token AND AND_AND OR_OR
+%token SEMI ENDL EOF
+
+%left AND OR_OR AND_AND SEMI ENDL EOF
+
+%start pbparse
+%type <unit> pbparse
+
+%%
+
+pbparse:
+| simple_list pbparse {
+  ()
+}
+| ENDL pbparse { () }
+| error ENDL {
+  let pos = Parsing.symbol_start_pos () in
+  omg pos.pos_lnum "Syntax error\n"
+}
+| EOF { () }
+
+simple_list:
+| simple_list1 { $1 (* May or may not end in semi-colon. *) }
+| simple_list1 SEMI { $1 }
+
+simple_list1:
+| simple_list1 SEMI  simple_list1 { $1 @ $3 }
+| simple_list1 AND   simple_list1 {
+  try match list_pop_last $1 with
+  | (line,prevcmd)::lrem -> lrem @ (line, CommandAsync(prevcmd))::$3
+  | _ -> failwith "Internal error in simple_list1"
+  with Not_found -> failwith "Failed to pop last command from list"
+}
+| simple_list1 OR_OR newline_list simple_list1 {
+  try match (list_pop_last $1, $4) with
+  | (last::lrem, next::rrem) ->
+      begin
+        match (last, next) with
+        | ((line, lcmd), (_, rcmd)) ->
+            lrem @ (line, CommandOr(lcmd, rcmd))::rrem
+      end
+  | _ -> failwith "Internal error in simple_list1"
+  with Not_found -> failwith "Failed to pop last command from list"
+}
+| command { [ $1 ] }
+
+command:
+| simple_command {
+  print_endline "*DBG* got simple_command" ; $1 }
+| function_def   { $1 }
+| shell_command  { $1 }
+
+simple_command:
+| simple_command_element {
+  print_endline "*DBG* got simple_command_element" ; $1 }
+| simple_command_element simple_command  {
+  print_endline "*DBG* got simple_command_element" ;
+  (* We must merge commands together. *)
+  match $1, $2 with
+  | ((lline, Command(leftass,  leftcmds)),
+     (_,     Command(rightass, rightcmds)))
+    -> (lline, Command(leftass @ rightass, leftcmds @ rightcmds))
+  | _ -> failwith "Invalid simple_command_element"
+}
+
+simple_command_element:
+| WORD {
+  (* TODO: Change Pbexpand to operate on lists only. *)
+  match $1 with ( lineno, str ) ->
+    begin
+      eprintf "*DBG* %d: Expanding: %s\n" lineno str ;
+      ignore (Parsing.set_trace false) ;
+
+      let ret = ( lineno, Command( [], [ (Pbexpand.string str) ] )) in
+
+      printf "*DBG* Result: %s\n" (Pbexpand.string str) ;
+      ignore (Parsing.set_trace true) ;
+
+      ret
+    end
+}
+| ASSIGN assignment_value {
+  (* Must have the same return value as the WORD rule above. *)
+  match ($1, $2) with ((lineno, n), raw) ->
+    ignore (Parsing.set_trace false) ;
+    let x = Pbexpand.list raw in
+    Pbparams.assign_array n x ;
+    ignore (Parsing.set_trace true) ;
+    let ass = { name = n; content = x } in
+    ( lineno, Command( [ ass ], [] ))
+}
+
+assignment_value:
+| { [ "" ] }
+| ASSIGNWORD { [ $1 ] }
+| LPAREN compound_assignment RPAREN { $2 }
+
+compound_assignment:
+| { [] }
+| ASSIGNWORD compound_assignment { $1 :: $2 }
+
+function_def:
+| WORD LPAREN RPAREN newline_list function_body {
+  match ($1, $5) with
+    ((line, name), (_, cmd)) -> (line, Function(name, cmd))
+}
+
+newline_list:
+| {} | ENDL newline_list {}
+
+function_body:
+| shell_command { $1 (* TODO: redirection_list *) }
+
+shell_command:
+| group_command { $1 (* TODO: if_command *) }
+
+group_command:
+| LCURLY compound_list RCURLY {
+  ($1, Control( Group( $2 )))
+}
+
+compound_list:
+| list { $1 } | newline_list list1 { $2 }
+
+list:
+| newline_list { [] } | list0 { $1 }
+
+list0:
+| list1 ENDL newline_list { $1 }
+| list1 SEMI newline_list { $1 }
+
+list1:
+| list1 ENDL newline_list list1 { $1 @ $4 }
+| list1 SEMI newline_list list1 { $1 @ $4 }
+| list1 OR_OR newline_list list1 {
+  try
+    match (list_pop_last $1, $4) with
+      (last::lrem, next::rrem) ->
+        begin
+          match (last, next) with
+            ((line, lcmd), (_, rcmd)) ->
+              lrem @ (line, CommandOr(lcmd, rcmd))::rrem
+        end
+    | _ -> failwith "Internal error in list1:"
+  with Not_found -> failwith "Failed to pop last command from list"
+}
+| command { [ $1 ] }
+open Printf
+
+module Pbwarn =
+  struct
+    type warnlevel = Style | Bad | Horrible
+
+    let is_level_active limit lvl =
+        match (limit,lvl) with
+        | (Style,Style) | (Style,Bad) | (Style,Horrible) -> true
+        | (Bad,Style) -> false
+        | (Bad,Bad) | (Bad,Horrible) -> true
+        | (Horrible,Style) | (Horrible,Bad) -> false
+        | (Horrible,Horrible) -> true
+
+    let warning test lvl line msg =
+      if test lvl then
+        eprintf "%2d: %s" line msg
+      else ()
+    let style test    = warning test Style
+    let bad test      = warning test Bad
+    let horrible test = warning test Horrible
+
+  end
+module Pbwarn :
+  sig
+    type warnlevel = Style | Bad | Horrible
+    val is_level_active : warnlevel -> warnlevel -> bool
+    val warning : (warnlevel -> bool) -> warnlevel -> int -> string -> unit
+
+    val style : (warnlevel -> bool) -> int -> string -> unit
+    val bad   : (warnlevel -> bool) -> int -> string -> unit
+    val horrible : (warnlevel -> bool) -> int -> string -> unit
+  end
+open Pbparse
+open Pbparams
+
+open Printf
+
+(* let words wl = String.concat " " wl *)
+
+(* let rec string_of_pbrec = function (line, data) -> *)
+(*   sprintf "%d: %s" line (string_of_pbdata data) *)
+
+(* and string_of_pbdata = function *)
+(*     Assignment(n,v,x) -> *)
+(*       sprintf "VAR %s := %s (%s)" n (words v) (words x) *)
+(*   | Command(s,x) -> *)
+(*       "CMD " ^ (if s <> x then s ^ " (" ^ x ^ ")" else s) *)
+(*   | Async(cmd) -> *)
+(*       "ASYNC" ^ (string_of_pbdata cmd) *)
+(*   | Function(name,cmds) -> sprintf "FUN %s\n%s" name *)
+(*         (String.concat "\n" *)
+(*            ([ "{{{" ] @ (List.map string_of_pbrec cmds) @ [ "}}}" ])) *)
+(*   | SyntaxError -> "SYNTAX ERROR!" *)
+
+let _ =
+  try
+    Pbparams.assign_string "srcdir" "SRCDIR" ;
+    Pbparams.assign_string "pkgdir" "PKGDIR" ;
+    ignore (Parsing.set_trace true) ;
+    pbparse_channel (open_in "PKGBUILD") ;
+    ignore (Parsing.set_trace false) ;
+(*     List.iter print_endline *)
+(*       (List.map string_of_pbrec (Pbcollect.results ())) *)
+
+  with ex -> ignore (Parsing.set_trace false) ; raise ex
+      
+      
+  
+Pbparams
+Expy
+Expl
+Pbexpand
+Pbparse
+Pblex
+open Pbwarn
+
+let limit = ref Pbwarn.Style
+
+let ourtest = Pbwarn.is_level_active !limit
+
+let _ =
+  Pbwarn.style ourtest 1 "Your shoes don't match!\n" ;
+  Pbwarn.bad ourtest 2 "You really should shower.\n" ;
+  Pbwarn.horrible ourtest 3 "You smell horrible!\n"
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.