Build2

fortran/function_definition.go

@@ -9,23 +9,33 @@ type callArgumentSimplification struct {
 }
 
 func (c callArgumentSimplification) Visit(node goast.Node) (w goast.Visitor) {
-	// from : &((*a))
-	// to   : a
-	if id, ok := node.(*goast.Ident); ok {
-		if len(id.Name) > 6 && id.Name[:4] == "&((*" {
-			id.Name = id.Name[4 : len(id.Name)-2]
-		}
+	id, ok := node.(*goast.Ident)
+	if !ok {
+		return c
+	}
 
-		if len(id.Name) > 11 && id.Name[:11] == "*func()*int" {
-			// *func()*int{y:=6;return &y}()
-			id.Name = id.Name[15:]
-			id.Name = id.Name[:len(id.Name)-13]
-		}
-		if len(id.Name) > 8 && id.Name[:8] == "*func()*" {
-			// TODO : for other types
-			// fmt.Println("Simply : ", id.Name)
-		}
+	if len(id.Name) > 6 && id.Name[:4] == "&((*" {
+		// from : &((*a))
+		// to   : a
+		id.Name = id.Name[4 : len(id.Name)-2]
+		return c
+	}
+
+	if !strings.Contains(id.Name, "*func()") {
+		return c
+	}
+
+	// *func()*int{y:=6;return &y}()
+	// *func()*byte{y:=byte('K');return &y}()
+	index := strings.Index(id.Name, "=")
+	if index < 0 {
+		return c
+	}
+	last := strings.LastIndex(id.Name, ";")
+	if last < 0 {
+		return c
 	}
+	id.Name = id.Name[index+1 : last]
 
 	return c
 }
@@ -34,59 +44,77 @@ type intrinsic struct {
 	p *parser
 }
 
+func isGoFunc(name string) bool {
+	var list = [...]string{
+		"panic",
+		"make",
+		"real",
+		"append",
+	}
+	for i := range list {
+		if list[i] == name {
+			return true
+		}
+	}
+	return false
+}
+
 func (in intrinsic) Visit(node goast.Node) (w goast.Visitor) {
 
-	if call, ok := node.(*goast.CallExpr); ok {
-		if n, ok := call.Fun.(*goast.Ident); ok {
-			if f, ok := intrinsicFunction[strings.ToUpper(n.Name)]; ok {
-				f(in.p, call)
-			} else if n.Name != "make" && n.Name != "append" && n.Name != "panic" {
-				n.Name = strings.ToUpper(n.Name)
-			}
+	call, ok := node.(*goast.CallExpr)
+	if !ok {
+		return in
+	}
+
+	if n, ok := call.Fun.(*goast.Ident); ok {
+		if f, ok := intrinsicFunction[strings.ToUpper(n.Name)]; ok {
+			f(in.p, call)
+		} else if !isGoFunc(n.Name) {
+			n.Name = strings.ToUpper(n.Name)
 		}
 	}
-	if call, ok := node.(*goast.CallExpr); ok {
-		if sel, ok := call.Fun.(*goast.SelectorExpr); ok {
-			if x, ok := sel.X.(*goast.Ident); ok && x.Name == "intrinsic" {
 
-				var isRead bool = sel.Sel.Name == "READ"
+	if sel, ok := call.Fun.(*goast.SelectorExpr); ok {
+		if x, ok := sel.X.(*goast.Ident); ok && x.Name == "intrinsic" {
 
-				for i := range call.Args {
-					if isRead && i > 1 {
-						// for READ command other arguments is pointer always
+			var isRead bool = sel.Sel.Name == "READ"
+
+			for i := range call.Args {
+				if isRead && i > 1 {
+					// for READ command other arguments is pointer always
+					continue
+				}
+				if arg, ok := call.Args[i].(*goast.Ident); ok {
+					if len(arg.Name) > 3 && arg.Name[:2] == "&(" {
+						arg.Name = arg.Name[2 : len(arg.Name)-1]
 						continue
 					}
-					if arg, ok := call.Args[i].(*goast.Ident); ok {
-						if len(arg.Name) > 3 && arg.Name[:2] == "&(" {
-							arg.Name = arg.Name[2 : len(arg.Name)-1]
-							continue
-						}
-						if strings.Contains(arg.Name, "func()*[]byte{y:=[]byte(") {
-							arg.Name = arg.Name[17:]
-							index := strings.LastIndex(arg.Name, "\")")
-							arg.Name = arg.Name[:index+2]
-							if i > 1 {
-								arg.Name = arg.Name[7 : len(arg.Name)-1]
-							}
-							continue
-						}
-						if len(arg.Name) > 10 && arg.Name[:7] == "func()*" {
-							arg.Name = "*" + arg.Name
-							continue
+					if strings.Contains(arg.Name, "func()*[]byte{y:=[]byte(") {
+						arg.Name = arg.Name[17:]
+						index := strings.LastIndex(arg.Name, "\")")
+						arg.Name = arg.Name[:index+2]
+						if i > 1 {
+							arg.Name = arg.Name[7 : len(arg.Name)-1]
 						}
+						continue
 					}
-					if un, ok := call.Args[i].(*goast.UnaryExpr); ok {
-						if par, ok := un.X.(*goast.ParenExpr); ok {
-							if id, ok := par.X.(*goast.IndexExpr); ok {
-								call.Args[i] = id
-								continue
-							}
+					if len(arg.Name) > 10 && arg.Name[:7] == "func()*" {
+						arg.Name = "*" + arg.Name
+						continue
+					}
+				}
+				if un, ok := call.Args[i].(*goast.UnaryExpr); ok {
+					if par, ok := un.X.(*goast.ParenExpr); ok {
+						if id, ok := par.X.(*goast.IndexExpr); ok {
+							call.Args[i] = id
+							continue
 						}
 					}
 				}
 			}
 		}
 	}
+
 	return in
 }
 
@@ -169,6 +197,11 @@ var intrinsicFunction = map[string]func(*parser, *goast.CallExpr){
 		p.addImport("github.com/Konstantin8105/f4go/intrinsic")
 		intrinsicArgumentCorrection(p, f, "intrinsic.EPSILON", typeNames)
 	},
+	"CMPLX": func(p *parser, f *goast.CallExpr) {
+		typeNames := []string{"any"}
+		p.addImport("github.com/Konstantin8105/f4go/intrinsic")
+		intrinsicArgumentCorrection(p, f, "intrinsic.CMPLX", typeNames)
+	},
 	"SQRT": func(p *parser, f *goast.CallExpr) {
 		typeNames := []string{"any"}
 		p.addImport("github.com/Konstantin8105/f4go/intrinsic")

fortran/parser.go

@@ -4,6 +4,7 @@ import (
 	"bytes"
 	"fmt"
 	goast "go/ast"
+	"go/format"
 	goparser "go/parser"
 	"go/token"
 	"os"
@@ -247,6 +248,8 @@ func Parse(b []byte, packageName string) (_ goast.File, errs []error) {
 	p.ident = 0
 	decls = p.parseNodes()
 
+	p.correctCellVector(decls)
+
 	// add packages
 	for pkg := range p.pkgs {
 		p.ast.Decls = append(p.ast.Decls, &goast.GenDecl{
@@ -344,6 +347,116 @@ func Parse(b []byte, packageName string) (_ goast.File, errs []error) {
 	return p.ast, p.errs
 }
 
+type callCorrection struct {
+	args map[string][]*goast.Field
+	p    *parser
+}
+
+func (cc callCorrection) Visit(node goast.Node) (w goast.Visitor) {
+	call, ok := node.(*goast.CallExpr)
+	if !ok {
+		return cc
+	}
+
+	ident, ok := call.Fun.(*goast.Ident)
+	if !ok {
+		return cc
+	}
+
+	name := ident.Name
+
+	args, ok := cc.args[name]
+	if !ok {
+		return cc
+	}
+
+	if len(args) != len(call.Args) {
+		return cc
+	}
+
+	for i := range call.Args {
+		var count int
+		goast.Inspect(call.Args[i], func(node goast.Node) bool {
+			if _, ok := node.(*goast.IndexExpr); ok {
+				count++
+			}
+			return true
+		})
+		ident, ok := args[i].Type.(*goast.Ident)
+		if !ok {
+			continue
+		}
+		nameCount := strings.Count(ident.Name, "[")
+		if count == nameCount {
+			continue
+		}
+		if count < nameCount {
+			continue
+		}
+		if nameCount == 0 {
+			continue
+		}
+		if nameCount != 1 {
+			// TODO: not clear - is it happend?
+			continue
+		}
+		// preliminary code:
+		// CTEST(M[2][3][4])
+		//       ----------
+		//         CELL
+		//
+		// transform cell to vector
+		// CTEST((*[1000000]float64)(unsafe.Pointer(M[2][3][4]))[:])
+		//                  -------                 ----------
+		//                    TYPE                     CELL
+
+		var cell string // M[2][3][4]
+		{
+			// func Fprint(w io.Writer, fset *token.FileSet, x interface{}, f FieldFilter) error
+			var buf bytes.Buffer
+			err := format.Node(&buf, token.NewFileSet(), call.Args[i])
+			if err != nil {
+				panic(err)
+			}
+			cell = buf.String()
+		}
+
+		var typ = args[i].Type.(*goast.Ident).Name // "*[  ]complex128"
+		var typSize = strings.Replace(typ, "[", "[1000000", -1)
+
+		//	func () ( output *[]TYPE) {
+		//		output = (*[1000000]TYPE)(unsafe.Pointer(M[2][3][4]))[:]
+		//		return
+		//	}
+
+		call.Args[i] = goast.NewIdent(fmt.Sprintf(` func () ( _ %s) { output := (%s)(unsafe.Pointer(%s))[:]; return &output}() `, typ, typSize, cell))
+		cc.p.addImport("unsafe")
+	}
+
+	return cc
+}
+
+func (p *parser) correctCellVector(decls []goast.Decl) {
+	// get all goast.FuncDecl arguments
+	var cc callCorrection
+	cc.args = map[string][]*goast.Field{}
+	cc.p = p
+	for i := range decls {
+		decl, ok := decls[i].(*goast.FuncDecl)
+		if !ok {
+			continue
+		}
+		name := decl.Name.Name
+		typ := decl.Type.Params.List
+		cc.args[name] = typ
+	}
+
+	// iteration by all goast.CallExpr
+	for i := range decls {
+		goast.Walk(cc, decls[i])
+	}
+}
+
 // go/ast Visitor for comment label
 type commentLabel struct {
 	labels map[string]bool
@@ -891,10 +1004,7 @@ func (c callArg) Visit(node goast.Node) (w goast.Visitor) {
 		}
 		if call, ok := node.(*goast.CallExpr); ok {
 			if id, ok := call.Fun.(*goast.Ident); ok {
-				if id.Name == "append" {
-					return nil
-				}
-				if id.Name == "panic" {
+				if isGoFunc(id.Name) {
 					return nil
 				}
 			}
@@ -940,11 +1050,12 @@ func (c callArg) Visit(node goast.Node) (w goast.Visitor) {
 				}
 
 			case *goast.CallExpr:
-			//	var ident goast.Ident
+			//	var ident *goast.Ident
 			//	ident, ok := a.Fun.(*goast.Ident)
-			//	if ok {
+			//	if !ok {
 			//		continue
 			//	}
+			//	fmt.Println(">>>>>>", ident)
 			//	returnType, ok := p.functionReturnType[ident.Name]
 			//	if ok {
 			//		continue

intrinsic/math.go

@@ -40,6 +40,11 @@ func castToFloat64(w interface{}) float64 {
 	}
 }
 
+func CMPLX(a interface{}) complex128 {
+	A := castToFloat64(a)
+	return complex(A, 0)
+}
+
 func SQRT(a interface{}) float64 {
 	A := castToFloat64(a)
 	return math.Sqrt(A)
@@ -86,8 +91,8 @@ func DBLE(a interface{}) float64 {
 	panic(fmt.Errorf("Cannot find type : %T", a))
 }
 
-func ABS(a float64) float64 {
-	return math.Abs(a)
+func ABS(a interface{}) float64 {
+	return math.Abs(castToFloat64(a))
 }
 
 func CABS(a complex128) float64 {