Merge branch 'master' of https://git.cduce.org/cduce

ocamliface/Makefile

@@ -3,6 +3,12 @@
 # of an OCaml source tree.
 include ../Makefile.conf
 
+ifneq ($(VERBOSE), true)
+   HIDE=@
+else
+   HIDE=
+endif
+
 all: caml_cduce.cmo caml_cduce.cmx
 
 STDLIB=$(shell ocamlc -where)
@@ -17,23 +23,23 @@ else
 endif
 
 ocaml_files:
-	mkdir ocaml_files
+	$(HIDE)test -e ocaml_files || mkdir ocaml_files
 	$(HIDE)cp $(patsubst %,$(OCAML_SRC)/%, $(COPY_FILES)) ocaml_files/
-	cp location.ml ocaml_files/location.ml
-	cp ocaml_files/asttypes.mli ocaml_files/asttypes.ml
-	sed s=STDLIB=$(STDLIB)= config.ml > ocaml_files/config.ml
-	grep cmi_magic $(OCAML_SRC)/utils/config.mlp | head -1 >> ocaml_files/config.ml
+	$(HIDE)cp location.ml ocaml_files/location.ml
+	$(HIDE)cp ocaml_files/asttypes.mli ocaml_files/asttypes.ml
+	$(HIDE)sed s=STDLIB=$(STDLIB)= config.ml > ocaml_files/config.ml
+	$(HIDE)grep cmi_magic $(OCAML_SRC)/utils/config.mlp | head -1 >> ocaml_files/config.ml
 
 caml_cduce.cmo: ocaml_files
 	@echo "Build $@"
-	(cd ocaml_files; \
+	$(HIDE)(cd ocaml_files; \
 	ocamlc $(FORPACKOPT1) -c $(COMPILE_FILES);\
 	ocamlc $(FORPACKOPT2) -pack -o $@ $(OBJECTS); \
 	cp caml_cduce.cmo caml_cduce.cmi ..)
 
 caml_cduce.cmx: ocaml_files
 	@echo "Build $@"
-	(cd ocaml_files; ocamlopt $(FORPACKOPT1) -c $(COMPILE_FILES);\
+	$(HIDE)(cd ocaml_files; ocamlopt $(FORPACKOPT1) -c $(COMPILE_FILES);\
 	ocamlopt $(FORPACKOPT2) -pack -o $@ $(XOBJECTS); \
 	cp caml_cduce.cmx caml_cduce.o caml_cduce.cmi ..)
 

ocamliface/mltypes.ml

@@ -167,12 +167,9 @@ let rec unfold_constr env p args =
       slot.def <-
 	(match decl.type_kind, decl.type_manifest with
 	   | Type_variant (cstrs), _ ->
-	       let cstrs =
-		 (* TODO: Check this solution *)
-                 List.map (function (cst,f,Some o)
-		 -> (cst,List.map (unfold env) f,Some (unfold env o))
-                    | (cst,f,None) -> (cst,List.map (unfold env) f,None)) cstrs in
-(*OLD:		 (fun (cst,f) -> (cst,List.map (unfold env) f)) cstrs in *)
+	       let cstrs = List.map (function
+	         (cst,f,Some o) -> (cst,List.map (unfold env) f,Some (unfold env o))
+	       | (cst,f,None) -> (cst,List.map (unfold env) f,None)) cstrs in
                Variant (prefix, cstrs, true)
 	   | Type_record (f,_), _ ->
 	       let f = List.map (fun (l,_,t) -> (l,unfold env t)) f in

tests/eval/Makefile

+OCAMLC		?= ocamlc
+SRCDIR		?= src
+INCDIR		?= src
+FILES		= lexer.ml parser.ml
+SRCFILES	= $(FILES:%=$(SRCDIR)/%) $(SRCDIR)/main.ml
+OBJSRCFILES	= $(SRCFILES:%.ml=%.cmo)
+INCFILES	= $(FILES:%=$(SRCDIR)/%i)
+OBJINCFILES	= $(INCFILES:%.mli=%.cmi)
+OTHERFILES	= str.cma
+
+RM		?= rm -f
+OUT		?= lambdaparser
+
+all: $(OBJINCFILES) $(OBJSRCFILES)
+	$(OCAMLC) -I $(INCDIR) -o $(OUT) $(OTHERFILES) $(OBJSRCFILES)
+
+%.cmo: %.ml
+	$(OCAMLC) -c -I $(INCDIR) -o $@ $<
+
+%.cmi: %.mli
+	$(OCAMLC) -c -I $(INCDIR) -o $@ $<
+
+clean:
+	$(RM) $(OBJINCFILES) $(OBJSRCFILES) $(SRCDIR)/main.cmi $(OUT)
+
+check: test
+
+test: all
+	tests/test.sh
+
+.PHONY: clean

tests/eval/src/lexer.ml

+open Printf
+open Str
+
+type token =
+  | Keyword of string
+  | Operator of string
+  | Id of string
+  | Int of int
+
+module StrMap = Map.Make(String);;
+let rec gen_keywords keywords list = match list with
+  | el :: rest -> gen_keywords (StrMap.add el (Keyword el) keywords) rest
+  | [] -> keywords
+
+let rec gen_ops ops list = match list with
+  | el :: rest -> gen_ops (StrMap.add el (Operator el) ops) rest
+  | [] -> ops
+
+let keywords = gen_keywords (StrMap.add "let" (Keyword "let") StrMap.empty)
+  [ "fun"; "match"; "with" ]
+
+let ops = gen_ops (StrMap.add "=" (Operator "=") StrMap.empty)
+  [ "("; ")"; ","; "|"; "&"; "->"; ";" ]
+
+(* Regexp to find an operator in a string *)
+let strops = "[=(),|&;]\\|->"
+
+let rec print_expr expr = match expr with
+  | Keyword str :: rest -> printf "%s" ("Keyword: " ^ str ^ "\n");
+    print_expr rest
+  | Operator str :: rest -> printf "%s" ("Operator: " ^ str ^ "\n");
+    print_expr rest
+  | Id str :: rest -> printf "%s" ("Id: " ^ str ^ "\n"); print_expr rest
+  | Int i :: rest -> printf "%s%d%s" "Int: " i "\n"; print_expr rest
+  | [] -> printf ""
+
+let lex str =
+  let rec _lex_noblanks list res = match list with
+    | Delim d :: rest -> _lex_noblanks rest (res @ [Operator d])
+    | Text t :: rest ->
+      (try _lex_noblanks rest (res @ [Int (int_of_string t)]);
+       with Failure exn -> _lex_noblanks rest (res @ [Id t]))
+    | [] -> res
+  in
+  let rec _lex list res = match list with
+    | el :: rest ->
+      (try let k = StrMap.find el keywords in
+	   _lex rest (res @ [k])
+       with Not_found ->
+	 try let o = StrMap.find el ops in
+	     _lex rest (res @ [o])
+	 with Not_found ->
+	   _lex rest (res @ (_lex_noblanks (Str.full_split
+					      (Str.regexp strops) el) []))
+      )
+    | [] -> res
+  in
+  _lex (Str.split (Str.regexp "[ \t\n]+") str) []

tests/eval/src/lexer.mli

+type token =
+  | Keyword of string
+  | Operator of string
+  | Id of string
+  | Int of int
+
+val lex : string -> token list
+val print_expr : token list -> unit

tests/eval/src/main.ml

+open Printf
+
+let load_file f =
+  let ic = open_in f in
+  let n = in_channel_length ic in
+  let s = String.create n in
+  really_input ic s 0 n;
+  close_in ic;
+  s
+
+let ignore a =
+  printf "Ignoring...\n"
+
+let _ =
+  if Array.length Sys.argv - 1 <> 0 then
+    let str = load_file Sys.argv.(1) in
+    let tokens = Lexer.lex str in
+    Lexer.print_expr tokens

tests/eval/src/parser.ml

+open Printf
+open Lexer
+
+let rec parse_expr expr = match expr with
+  | Keyword str :: rest -> printf "%s" ("Keyword: " ^ str ^ "\n");
+    parse_expr rest
+  | Operator str :: rest -> printf "%s" ("Operator: " ^ str ^ "\n");
+    parse_expr rest
+  | Id str :: rest -> printf "%s" ("Id: " ^ str ^ "\n"); parse_expr rest
+  | Int i :: rest -> printf "%s%d%s" "Int: " i "\n"; parse_expr rest
+  | [] -> printf ""

tests/eval/src/parser.mli

+val parse_expr : Lexer.token list -> unit

tests/eval/tests/lexer/refs/space.ref

+Keyword: let
+Id: a
+Operator: =
+Int: 2
+Keyword: let
+Id: a
+Operator: =
+Int: 2
+Keyword: let
+Id: a
+Operator: =
+Int: 2
+Keyword: let
+Id: a
+Operator: =
+Int: 2

tests/eval/tests/lexer/refs/space.res

+0

tests/eval/tests/lexer/tests/space.test

+let a = 2
+let a =2
+let a= 2
+let a=2

tests/eval/tests/test.sh

+#!/bin/sh
+
+ROOT="."
+BIN=$ROOT/`grep OUT $ROOT/Makefile | head -1 | cut -d '=' -f 2 | tr -d ' '`
+MODULES="$ROOT/tests/lexer"
+OUT=__out__
+DIFF=__diff__
+
+for i in $MODULES; do
+    NBRTESTS=0
+    NBRSUCCESS=0
+    for j in `ls $i/tests`; do
+	PREFIX=`echo $j | rev | cut -b 6- | rev`
+	EXPECTRES=`cat $i/refs/$PREFIX.res`
+	NBRTESTS=$(($TESTS + 1))
+
+	$BIN $i/tests/$j > $OUT 2>&1
+	RES=$?
+	if test $RES -ne $EXPECTRES; then
+	    echo "Error in $i/$PREFIX: Error code $RES, expected $EXPECTRES"
+	    continue
+	fi
+
+	diff $OUT $i/refs/$PREFIX.ref > $DIFF 2>&1
+	if test $? -ne 0; then
+	    echo "Error in $i/$PREFIX: output is different (see $i/errors)"
+	    test -d $i/errors || mkdir $i/errors
+	    cp $OUT $i/errors/$PREFIX.out
+	    cp $DIFF $i/errors/$PREFIX.diff
+	    continue
+	fi
+	NBRSUCCESS=$(($NBRSUCCESS + 1))
+    done
+    echo "========== Module `echo $i | rev | cut -d '/' -f 1 | rev` =========="
+    echo "Pass $NBRSUCCESS/$NBRTESTS tests"
+done
+
+rm -f $OUT $DIFF