ocaml-pkgbuild / pbparsey.mly

%{

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 ] }
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.