Skip to content

Commits on Source 5

language: c
sudo: required
os: linux
services:
- docker
## We build on as many OCaml version as we can support. These versions
## are infact tags for the ocaml/opam2 Docker image that we pull.
env:
- TAG=4.04
- TAG=4.05
- TAG=4.06 DEPLOY=true
- TAG=4.07
- TAG=alpine
- TAG=centos
- TAG=debian-stable
- TAG=debian-testing
- TAG=debian-unstable
- TAG=fedora
- TAG=opensuse
- TAG=oraclelinux
- TAG=ubuntu
- TAG=ubuntu-lts
script:
- docker build --build-arg tag=$TAG --build-arg switch=$SWITCH --tag colisanr/morbig:$TRAVIS_BRANCH .
- docker run --entrypoint /bin/sh colisanr/morbig:$TRAVIS_BRANCH -c 'eval $(opam env) && cd /home/opam/morbig && make check && make install && make examples && make uninstall'
## We add one particular build that does not use Docker. This is the
## one testing on OSX.
matrix:
include:
- os: osx
services: null
env: null
install:
- brew install opam
- opam init --no-setup
- eval $(opam config env) && opam install --yes menhir yojson ppx_deriving_yojson visitors
script:
- make && make check && make install && make examples && make uninstall
- env: TAG=4.04
- env: TAG=4.05
- env: TAG=4.06 DEPLOY=true
- env: TAG=4.07
- env: TAG=4.08
- env: TAG=alpine
- env: TAG=centos
- env: TAG=debian-stable
- env: TAG=debian-testing
- env: TAG=debian-unstable
- env: TAG=opensuse
- env: TAG=ubuntu
- env: TAG=ubuntu-lts
## We automatically deploy sucessfull branch builds to DockerHub. This
## deployment only happens on builds that have the environment
......
......@@ -26,10 +26,10 @@ ifneq ($(LIBDIR),)
INSTALL_ARGS := $(INSTALL_ARGS) --libdir $(LIBDIR)
endif
install:
install: build
dune install $(INSTALL_ARGS)
uninstall:
uninstall: build
dune uninstall $(INSTALL_ARGS)
check: build
......
# Morbig
## A trustworthy static parser for POSIX shell
Morbig is a parser for shell scripts written in the POSIX shell script
......@@ -9,25 +10,28 @@ shell grammar of the POSIX standard.
## Download [![Build Status](https://travis-ci.org/colis-anr/morbig.svg?branch=master)](https://travis-ci.org/colis-anr/morbig)
```
git clone git@github.com:colis-anr/morbig.git
```
## License and Copyright
please see the file COPYING
Please see the file COPYING.
## Documentation
You can have a look at the
[online API documentation](https://colis-anr.github.io/docs/) or build
it yourself:
make doc
## Are you in a hurry?
Yes? Pull our docker image:
```
docker pull colisanr/morbig:latest
```
Then, define the following shell function:
```
morbig () {
D=$(cd "$(dirname "$1")"; pwd)
B=$(basename "$1")
......@@ -35,26 +39,32 @@ shell grammar of the POSIX standard.
-v "$D":/mnt \
colisanr/morbig:latest --as simple /mnt/"$B"
}
```
After that, you should be able to run ``morbig`` like this:
```
morbig my-script.sh
```
This will create a JSON file named ``my-script.sh.sjson``.
You can also build a local docker image from the root of this repository:
You can also build a local docker image from the root of this
repository:
```
docker build -t morbig . # to build a docker image with morbig inside.
```
Now if you want to use more features of ``morbig``, take the time
to follow the building instructions of the next section.
Now if you want to use more features of ``morbig``, take the time to
follow the building instructions of the next section.
## Manual instructions
### Install using OPAM
Please type
``
opam install morbig
``
to get the latest public release of `morbig`.
## Building instructions
If you want to use the development version of `morbig`, read the next sections.
### Dependencies
......
morbig (0.10.3-3) UNRELEASED; urgency=medium
morbig (0.10.4-1) unstable; urgency=medium
* Upload to unstable
* New upstream version
* Change build-dependency on dune to its new name ocaml-dune
* Drop build-dependency on ocamlbuild
* Standards-Version 4.4.0 (no change)
-- Ralf Treinen <treinen@debian.org> Tue, 23 Jul 2019 20:22:09 -0300
-- Ralf Treinen <treinen@debian.org> Fri, 08 Nov 2019 23:44:46 +0100
morbig (0.10.3-2) experimental; urgency=medium
......
......@@ -5,8 +5,7 @@ Maintainer: Debian OCaml Maintainers <debian-ocaml-maint@lists.debian.org>
Uploaders: Ralf Treinen <treinen@debian.org>,
Build-Depends: debhelper-compat (= 12), dh-ocaml,
ocaml-nox (>= 4.04),
ocamlbuild,
dune,
ocaml-dune,
ocaml-findlib,
menhir (>= 20170509),
libmenhir-ocaml-dev (>= 20170509),
......
......@@ -66,6 +66,9 @@ complete JSON output, including position information.
.TP
.I simple
simplified JSON output. Use this for human-readable output.
.TP
.I none
do not serialise the concrete syntax tree.
.RE
.TP
.B \-\-from-stdin
......
......@@ -24,14 +24,13 @@ homepage: "https://github.com/colis-anr/morbig"
bug-reports: "https://github.com/colis-anr/morbig/issues"
dev-repo: "git://github.com/colis-anr/morbig.git"
available: [os != "macos"]
depends: [
"dune" {build & >= "1.4.0"}
"menhir" {>= "20170509"}
"ocaml" {build & >= "4.04"}
"ocaml" {>= "4.04"}
"odoc" {with-doc}
"ppx_deriving_yojson"
"visitors" {build & >= "20180513"}
"visitors" {>= "20180513"}
"yojson"
]
......
......@@ -325,10 +325,11 @@ and word_component =
| WordAssignmentWord of assignment_word
| WordDoubleQuoted of word
| WordSingleQuoted of word
| WordTildePrefix of string
| WordLiteral of string
| WordVariable of variable
| WordGlobAll
| WordGlobAny
| WordGlobAll (* asterisk *)
| WordGlobAny (* question mark *)
| WordReBracketExpression of bracket_expression
(* Empty CST. Useful to represent the absence of relevant CSTs. *)
| WordEmpty
......
......@@ -91,7 +91,7 @@ let empty_linebreak' =
with_pos dummy_position LineBreak_Empty
let empty_program =
Program_LineBreak empty_linebreak'
with_pos dummy_position (Program_LineBreak empty_linebreak')
let nonempty_program p =
match p with
......@@ -163,6 +163,22 @@ module NameSet = Set.Make (struct
let compare (Name s1) (Name s2) = String.compare s1 s2
end)
let special_builtins_regexp =
[ "break" ; ":" ; "continue" ; "." ; "eval" ; "exec" ;
"exit" ; "export" ; "local" ; "readonly" ; "return" ;
"set" ; "shift" ; "times" ; "trap" ; "unset" ]
let is_special_builtin s =
List.mem s special_builtins_regexp
exception InvalidFunctionName
let make_function_name (Name s) =
if is_special_builtin s then
raise InvalidFunctionName
else
Fname_Name (Name s)
(* CST destructors *)
(** [wordlist_of_cmd_suffix] extracts the list of all words from a cmd_sufix *)
......
......@@ -15,7 +15,7 @@ open CST
(** {2 Helpers about programs and complete commands} *)
val empty_program : program
val empty_program : program located
val nonempty_program : program -> bool
val concat_programs : program located -> program located -> program located
......@@ -35,6 +35,10 @@ val string_of_word : word -> string
val word_placeholder : unit -> word' ref
exception InvalidFunctionName
val make_function_name: name -> fname
module NameSet : Set.S
(** {2 Helpers about positions} *)
......
......@@ -191,10 +191,10 @@ meta_char: MINUS {
}
;
(* There is no specification for the language of [class_name] in POSIX. *)
class_name: s=COLL_ELEM_SINGLE+
{
let b = Buffer.create 13 in
List.iter (Buffer.add_char b) s;
let s = Buffer.contents b in
if Name.is_name s then s else raise Parsing.Parse_error
Buffer.contents b
}
......@@ -14,6 +14,9 @@
open Parser
open Parser.MenhirInterpreter
let perform default f =
if not (Options.disable_alias_expansion ()) then f () else default
(**
A shell script may define aliases with the following command:
......@@ -120,6 +123,7 @@ let as_aliasing_related_command = function
error is issued. Then, for any alias and unalias toplevel invocation,
this function updates [aliases]. *)
let interpret aliases cst =
perform empty @@ fun () ->
let aliases = ref aliases in
let level = ref 0 in
let at_toplevel () = !level = 0 in
......@@ -204,7 +208,9 @@ let inside_a_substitution_combo = function
let quoted word =
let len = String.length word in
len >= 2 && word.[0] = '\'' && word.[len - 1] = '\''
len >= 2
&& ((word.[0] = '\'' && word.[len - 1] = '\'')
|| (word.[0] = '"' && word.[len - 1] = '"'))
let unquote word =
String.(sub word 1 (length word - 2))
......@@ -226,6 +232,7 @@ let only_if_end_with_whitespace word aliases state =
alias by its definition if word is not a reserved word and
if the parsing context is about to reduce a [cmd_name]. *)
let alias_substitution aliases checkpoint word =
perform (aliases, word) @@ fun () ->
if about_to_reduce_cmd_name checkpoint
&& not (Keyword.is_reserved_word word)
then
......
......@@ -21,5 +21,7 @@
(executable
(name morbigDriver)
(public_name morbig)
(ocamlopt_flags :standard)
(libraries morbig)
(preprocess (pps ppx_deriving_yojson visitors.ppx)) ;; Avoid warning about incomplete merlin files.
(modules morbigDriver))
......@@ -45,7 +45,7 @@ let parse partial (module Lexer : Lexer) =
(** Parsing loop. *)
(**--------------**)
let rec parse { aliases; checkpoint } =
let rec parse csts { aliases; checkpoint } =
match checkpoint with
(**
......@@ -58,7 +58,7 @@ let parse partial (module Lexer : Lexer) =
let (token, ps, pe, aliases) =
Lexer.next_token { aliases; checkpoint }
in
parse { aliases; checkpoint = offer checkpoint (token, ps, pe) }
parse csts { aliases; checkpoint = offer checkpoint (token, ps, pe) }
(**
......@@ -75,13 +75,21 @@ let parse partial (module Lexer : Lexer) =
assert false
| Some true ->
(** The EOF token was a real end-of-file marker. *)
cst
if Options.(backend () = NoSerialisation) then
[]
else cst :: csts
| Some false ->
(** The EOF token was a pseudo end-of-file marker.
Probably generated by a NEWLINE promoted to a EOF. *)
Lexer.shift ();
let checkpoint = entry_point (Lexer.current_position ()) in
CSTHelpers.concat_programs cst (parse { aliases; checkpoint })
let csts =
if Options.(backend () = NoSerialisation) then
[]
else
cst :: csts
in
parse csts { aliases; checkpoint }
end
(**
......@@ -113,7 +121,7 @@ let parse partial (module Lexer : Lexer) =
(** 2.b Yes? Stop here.
Put back the token that caused the syntax error.
Return the CST *)
cst
[cst]
| _status ->
(** 2.a No? It is a syntax error. *)
parse_error ()
......@@ -126,7 +134,7 @@ let parse partial (module Lexer : Lexer) =
*)
| HandlingError _env ->
parse { aliases; checkpoint = resume checkpoint }
parse csts { aliases; checkpoint = resume checkpoint }
(**
......@@ -184,11 +192,13 @@ let parse partial (module Lexer : Lexer) =
if nt = AnyN N_complete_commands then
on_top_symbol env { perform = interpret_alias_command }
else
parse { aliases; checkpoint = resume checkpoint }
let checkpoint = resume checkpoint in
parse csts { aliases; checkpoint }
and interpret_alias_command: type a. a symbol * a -> _ = function
| N N_complete_command, cst ->
let aliases = Aliases.interpret aliases cst in
parse { aliases; checkpoint = resume checkpoint }
let checkpoint = resume checkpoint in
parse csts { aliases; checkpoint }
| _ ->
assert false (* By correctness of the underlying LR automaton. *)
in
......@@ -201,16 +211,19 @@ let parse partial (module Lexer : Lexer) =
*)
| Shifting (_, _, _) ->
parse { aliases; checkpoint = resume checkpoint }
parse csts { aliases; checkpoint = resume checkpoint }
and parse_error : type a. unit -> a = fun () ->
raise (Errors.DuringParsing (Lexer.current_position ()))
in
parse {
parse [] {
aliases = Aliases.empty;
checkpoint = entry_point (Lexer.current_position ())
}
let recognize_word_if_relevant checkpoint word =
accepted_token checkpoint word <> Wrong
module Lexer (U : sig end) : Lexer = struct
(**--------------------------**)
......@@ -262,6 +275,9 @@ module Lexer (U : sig end) : Lexer = struct
let tokens = ref []
let previous_token ?(n = 0) () =
ExtPervasives.list_nth_opt !tokens n
let rec next_token { aliases; checkpoint } =
if HDL.inside_here_document () then (
!push_pretoken (HDL.next_here_document (lexbuf ()) (current ()));
......@@ -279,7 +295,7 @@ module Lexer (U : sig end) : Lexer = struct
| Pretoken.IoNumber i ->
return (IO_NUMBER (IONumber i))
| Pretoken.PreWord (w, cst) ->
| Pretoken.PreWord (w0, cst) ->
(*specification:
......@@ -306,11 +322,26 @@ module Lexer (U : sig end) : Lexer = struct
rules, or applies globally.
*)
let new_aliases, w = alias_substitution aliases checkpoint w in
let new_aliases, w = alias_substitution aliases checkpoint w0 in
let word =
if w == w0 then
WORD (Word (w, List.(flatten (map parse_pattern cst))))
else
WORD (Word (w, [WordLiteral w]))
in
let well_delimited_keyword =
match previous_token () with
| Some (Semicolon | DSEMI | NEWLINE | Rbrace | Rparen | Uppersand
| Fi) -> true
| _ -> match previous_token ~n:1 () with
| Some For -> true
| _ -> false
in
let token = FirstSuccessMonad.(
(recognize_assignment checkpoint p cst)
+> (recognize_reserved_word_if_relevant checkpoint p w)
+> return (WORD (Word (w, List.(flatten (map parse_pattern cst)))))
+> (recognize_reserved_word_if_relevant
well_delimited_keyword checkpoint p w)
+> return word
)
in
if HDL.next_word_is_here_document_delimiter () then
......@@ -362,8 +393,12 @@ module Lexer (U : sig end) : Lexer = struct
else if is_accepted_token checkpoint (NEWLINE, pstart, pstop) then
return NEWLINE
else if is_accepted_token checkpoint (Semicolon, pstart, pstop) then
return Semicolon
(** Otherwise, a [NEWLINE] is simply layout and is ignored. *)
else next_token { aliases; checkpoint }
else (* next_token { aliases; checkpoint }*)
raise (Errors.DuringParsing pstart)
let last_state = ref None
......@@ -377,7 +412,8 @@ module Lexer (U : sig end) : Lexer = struct
let next_token ({ aliases; checkpoint } as state) =
let curr_p = copy_position (lexbuf ()).Lexing.lex_curr_p in
let (raw, _, _, aliases) as token = next_token { aliases; checkpoint } in
let state' = { aliases; checkpoint } in
let (raw, _, _, aliases) as token = next_token state' in
let state = { state with aliases } in
tokens := raw :: !tokens;
last_state := Some (state, token, curr_p);
......@@ -417,6 +453,7 @@ end
let parse partial current lexbuf =
let module Lexer = Lexer (struct end) in
Lexer.initialize current lexbuf;
parse partial (module Lexer)
let csts = List.rev (parse partial (module Lexer)) in
ExtPervasives.reduce CSTHelpers.empty_program CSTHelpers.concat_programs csts
let close_knot = RecursiveParser.parse := (parse true)
......@@ -96,12 +96,13 @@ exception InvalidSuffix of string * string
let string_split k s =
let n = String.length s in
let k = min k n in
String.sub s 0 k, String.sub s k (n - k)
try String.sub s 0 k, String.sub s k (n - k) with _ -> assert false
let string_remove_suffix suffix s = String.(
let k = length s - length suffix in
let r = sub s 0 k in
let c = sub s k (length suffix) in
if k < 0 then raise (InvalidSuffix (s, suffix));
let r = try sub s 0 k with _ -> assert false in
let c = try sub s k (length suffix) with _ -> assert false in
if suffix <> c then raise (InvalidSuffix (s, suffix));
r
)
......@@ -135,16 +136,31 @@ let string_of_char_list s =
List.iter (Buffer.add_char b) s;
Buffer.contents b
let count_end_character c s =
let rec aux r i =
if i < 0 then r
else if s.[i] = c then aux (r + 1) (i - 1)
else r
in
aux 0 (String.length s - 1)
(** [strip s] returns a copy of s, without any final newline *)
let string_strip s =
let n = String.length s in
if n > 0
then let lastchar = s.[n-1] in
if lastchar = '\n' || lastchar = '\r'
then String.sub s 0 (n-1)
if lastchar = '\n'
then try String.sub s 0 (n-1) with _ -> assert false
else s
else s
let reduce default f l =
let rec aux accu = function
| [] -> accu
| x :: xs -> aux (f accu x) xs
in
if l = [] then default else aux (List.hd l) (List.tl l)
let repeat n f =
let rec aux i =
if i = n then
......@@ -179,6 +195,9 @@ let hashtbl_to_list h =
Hashtbl.iter (fun k v -> l := (k, v) :: !l) h;
!l
let list_nth_opt l n =
try Some (List.nth l n) with _ -> None
let list_hd_opt = function
| [] -> None
| x :: _ -> Some x
......@@ -253,8 +272,11 @@ let ( <$> ) x f =
let list_last l =
list_hd_opt (List.rev l)
let newline_regexp =
Str.regexp "\010"
let lines s =
Str.(split (regexp "\n") s)
Str.split_delim newline_regexp s
let string_last_line s =
lines s |> list_last
......@@ -34,7 +34,7 @@ end = struct
*)
type delim_info = {
type delimiter_info = {
(** information about a delimiter of a here document: *)
word: string;
(** delimiting word, with quotes removed *)
......@@ -45,7 +45,7 @@ end = struct
contents_placeholder: CST.word CST.located ref
(** placeholder for the contents of the here document *)
}
let delimiters_queue = (Queue.create (): delim_info Queue.t)
let delimiters_queue = (Queue.create (): delimiter_info Queue.t)
let dashed_tmp = ref (None: bool option)
let word_ref_tmp = ref (None: word located ref option)
......@@ -53,31 +53,39 @@ end = struct
| NoHereDocuments
(* we are currently not reading any here documents, nor have we seen
a here document operator on the current line. *)
| HereDocumentsStartOnNextLine
(* we have seen a here document operator but we haven't yet finished
the line, so reading of here documents has to start on the next line. *)
| GotHereOperator
(* we have seen a here document operator but we haven't seen the
corresponding delimite word yet. *)
| GotDelimiter
(* we have seen a here document operator and its delimiter word. *)
| InsideHereDocuments
(* we are currently in the process of reading here documents. *)
let state = ref NoHereDocuments
let push_here_document_operator dashed word_ref =
assert (!state <> InsideHereDocuments);
if !state = GotHereOperator then
(* FIXME: we should raise an Error.DuringParsing here if we can
get the current lexing position. *)
failwith "redirection operator found where a delimter word is expected";
assert (!state = NoHereDocuments || !state = GotDelimiter);
(* we accept a push of an operator only when the two variables
dashed_tmp and word_ref_tmp hold value None, that is either they
have never been assigned a value, or they have been assigned a value
which has been used up by push_here_document_delimiter.
dashed_tmp and word_ref_tmp hold value None, that is either
- they have not been assigned a value (state NoHereDocuments),
- or they have been assigned a value which has been used up by
push_here_document_delimiter (state GotDelimiter).
*)
assert (!dashed_tmp = None);
dashed_tmp := Some dashed;
assert (!word_ref_tmp = None);
word_ref_tmp := Some word_ref;
state := HereDocumentsStartOnNextLine
state := GotHereOperator
let push_here_document_delimiter _w cst =
(* we accept a push of a delimiting word only if we have already received
information about an operator which has not yet been used.
*)
assert (!state <> InsideHereDocuments);
assert (!state = GotHereOperator);
let quoted_flag = ref false in
let dashed = match !dashed_tmp with
| Some b -> dashed_tmp:= None; b
| None -> assert false
......@@ -89,19 +97,26 @@ end = struct
let rec unquote = function
| [] -> ""
| WordDoubleQuoted s :: w ->
quoted_flag := true;
QuoteRemoval.on_string (unword s) ^ unquote w
| WordSingleQuoted s :: w ->
quoted_flag := true;
unword s ^ unquote w
| (WordLiteral s | WordName s) :: w ->
let s = Str.(global_replace (regexp "\\") "" s) in
s ^ unquote w
let s' = Str.(global_replace (regexp "\\") "" s) in
if s <> s' then quoted_flag := true;
s' ^ unquote w
| WordVariable (VariableAtom (s, NoAttribute)) :: w ->
"$" ^ s ^ unquote w
| _ ->
failwith "Unsupported expansion in here document delimiter"
in
unquote cst
in
let quoted =
List.exists (function WordSingleQuoted _ -> true | _ -> false) cst
!quoted_flag
|| List.exists (function WordSingleQuoted _ -> true | _ -> false) cst
in
Queue.add {
(*specification:
......@@ -113,7 +128,8 @@ end = struct
quoted;
dashed;
contents_placeholder = word_ref
} delimiters_queue
} delimiters_queue;
state := GotDelimiter
let next_here_document lexbuf current =
(*specification:
......@@ -123,7 +139,11 @@ end = struct
between. Then the next here-document starts, if there is one.
*)
assert (!state = InsideHereDocuments);
let delimiter_info = Queue.take delimiters_queue in
let delimiter_info =
try
Queue.take delimiters_queue
with Queue.Empty -> failwith "here document problem"
in
let store_here_document end_marker cst contents doc_start doc_end =
(* store in the placeholder the here-document with contents [contents],
......@@ -142,7 +162,7 @@ end = struct
contents
in
let contents, cst =
remove_contents_suffix end_marker contents cst
remove_contents_suffix doc_end end_marker contents cst
in
let contents =
(*specification:
......@@ -160,21 +180,24 @@ end = struct
position = { start_p = doc_start; end_p = doc_end }
}
in
let (Word (doc, cst)), doc_start, line_end =
let ((Word (doc, cst)), doc_start, line_end) =
let current =
enter_here_document delimiter_info.dashed delimiter_info.word current
in
let result =
if delimiter_info.quoted then
let current = Prelexer.single_quotes current lexbuf in
let buffer = Buffer.create 13 in
let current = Prelexer.single_quotes buffer current lexbuf in
return lexbuf current []
else
Prelexer.token current lexbuf
in
match result with
| [Pretoken.NEWLINE, p1, p2] ->
(* Special case for empty here document. *)
(* Special case for empty here document or ended by EOF. *)
(Word ("", []), p1, p2)
| [Pretoken.EOF, _, pos] ->
raise (Errors.DuringParsing pos)
| result ->
located_word_of result
in
......@@ -189,7 +212,7 @@ end = struct
(Pretoken.NEWLINE, before_stop, line_end)
let start_here_document_lexing () =
assert (!state = HereDocumentsStartOnNextLine);
assert (!state = GotDelimiter);
state := InsideHereDocuments
let next_word_is_here_document_delimiter () =
......@@ -200,7 +223,7 @@ end = struct
!dashed_tmp <> None
let next_line_is_here_document () =
!state = HereDocumentsStartOnNextLine
!state = GotDelimiter
let inside_here_document () =
!state = InsideHereDocuments
......
......@@ -24,7 +24,7 @@ module Lexer :
bool -> CST.word CST.located ref -> unit
(** [push_here_document_operator dashed word_ref] registers a redirection
operator:
- [dashed] is [true] when the operator is <<-, and [false] if <<-
- [dashed] is [true] when the operator is <<-, and [false] if <<
- [word_ref] is a reference to a located word. This reference will
later be assigned the contents of the here document.
*)
......
......@@ -73,11 +73,20 @@ let terminal_of_keyword k =
let (_, _, t) = List.find (fun (_, k', _) -> k = k') keywords in
t
let recognize_reserved_word_if_relevant checkpoint (_pretoken, pstart, pstop) w =
let must_be_well_delimited flag = function
| Rbrace | Do | Done | Then | Else | Elif | Fi | Esac -> flag
| _ -> true
let recognize_reserved_word_if_relevant well_delimited checkpoint p w =
let (_, pstart, pstop) = p in
let valid_token kwd =
accepted_token checkpoint (kwd, pstart, pstop) <> Wrong
&& must_be_well_delimited well_delimited kwd
in
FirstSuccessMonad.(
let as_keyword =
keyword_of_string w >>= fun kwd ->
return_if (accepted_token checkpoint (kwd, pstart, pstop) <> Wrong) kwd
return_if (valid_token kwd) kwd
in
let as_name =
return_if (Name.is_name w) (NAME (CST.Name w))
......
......@@ -15,12 +15,17 @@ open Morbig
let save input_filename (cst : CST.program) =
Options.(
if backend () = NoSerialisation
then
()
else
let cout = open_out (output_file_of_input_file input_filename) in
begin match backend () with
| Bin -> save_binary_cst cout cst
| Json -> save_json_cst cout cst
| SimpleJson -> JsonHelpers.save_as_json true cout cst
| Dot -> JsonHelpers.save_as_dot cout cst
| NoSerialisation -> assert false
end;
close_out cout
)
......
......@@ -27,7 +27,17 @@
This definition implies that a name is not empty.
*)
let alpha c =
('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') || (c = '_')
let alphanum c =
alpha c || ('0' <= c && c <= '9')
let is_name s =
s <> ""
&& Str.(string_match (
regexp "^\\([a-zA-Z]\\|_\\)\\([a-zA-Z]\\|_\\|[0-9]\\)*$") s 0)
let len = String.length s in
let rec aux i =
i = len || (alphanum s.[i] && aux (i + 1))
in
if len = 0 then false
else if not (alpha s.[0]) then false
else aux 0